Hassan Al-Awwadi pushed to branch wip/haanss/depdir at Glasgow Haskell Compiler / GHC

Commits:

25 changed files:

Changes:

  • compiler/GHC/HsToCore/Usage.hs
    ... ... @@ -75,14 +75,15 @@ data UsageConfig = UsageConfig
    75 75
    76 76 
     mkUsageInfo :: UsageConfig -> Plugins -> FinderCache -> UnitEnv
    77 77 
                 -> Module -> ImportedMods -> [ImportUserSpec] -> NameSet
    78 
    -            -> [FilePath] -> [(Module, Fingerprint)] -> [Linkable] -> PkgsLoaded
    78 
    +            -> [FilePath] -> [FilePath] -> [(Module, Fingerprint)] -> [Linkable] -> PkgsLoaded
    79 79 
                 -> IfG [Usage]
    80 80 
     mkUsageInfo uc plugins fc unit_env
    81 81 
       this_mod dir_imp_mods imp_decls used_names
    82 
    -  dependent_files merged needed_links needed_pkgs
    82 
    +  dependent_files dependent_dirs merged needed_links needed_pkgs
    83 83 
       = do
    84 84 
         eps <- liftIO $ readIORef (euc_eps (ue_eps unit_env))
    85 
    -    hashes <- liftIO $ mapM getFileHash dependent_files
    85 
    +    file_hashes <- liftIO $ mapM getFileHash dependent_files
    86 
    +    dirs_hashes <- liftIO $ mapM getDirHash dependent_dirs
    86 87 
         let hu = ue_unsafeHomeUnit unit_env
    87 88 
             hug = ue_home_unit_graph unit_env
    88 89 
         -- Dependencies on object files due to TH and plugins
    ... ... @@ -93,7 +94,11 @@ mkUsageInfo uc plugins fc unit_env
    93 94 
         let usages = mod_usages ++ [ UsageFile { usg_file_path = mkFastString f
    94 95 
                                                , usg_file_hash = hash
    95 96 
                                                , usg_file_label = Nothing }
    96 
    -                               | (f, hash) <- zip dependent_files hashes ]
    97 
    +                               | (f, hash) <- zip dependent_files file_hashes ]
    98 
    +                            ++ [ UsageDirectory { usg_dir_path = mkFastString d
    99 
    +                                                , usg_dir_hash = hash
    100 
    +                                                , usg_dir_label = Nothing }
    101 
    +                               | (d, hash) <- zip dependent_dirs dirs_hashes]
    97 102 
                                 ++ [ UsageMergedRequirement
    98 103 
                                         { usg_mod = mod,
    99 104 
                                           usg_mod_hash = hash

  • compiler/GHC/Iface/Make.hs
    ... ... @@ -269,6 +269,7 @@ mkRecompUsageInfo hsc_env tc_result = do
    269 269 
         else do
    270 270 
          let used_names = mkUsedNames tc_result
    271 271 
          dep_files <- (readIORef (tcg_dependent_files tc_result))
    272 
    +     dep_dirs  <- (readIORef (tcg_dependent_dirs tc_result))
    272 273 
          (needed_links, needed_pkgs) <- readIORef (tcg_th_needed_deps tc_result)
    273 274 
          let uc = initUsageConfig hsc_env
    274 275 
              plugins = hsc_plugins hsc_env
    ... ... @@ -289,6 +290,7 @@ mkRecompUsageInfo hsc_env tc_result = do
    289 290 
               (tcg_import_decls tc_result)
    290 291 
               used_names
    291 292 
               dep_files
    293 
    +          dep_dirs
    292 294 
               (tcg_merged tc_result)
    293 295 
               needed_links
    294 296 
               needed_pkgs

  • compiler/GHC/Iface/Recomp.hs
    ... ... @@ -194,6 +194,7 @@ data RecompReason
    194 194 
       | ModuleChangedRaw ModuleName
    195 195 
       | ModuleChangedIface ModuleName
    196 196 
       | FileChanged FilePath
    197 
    +  | DirChanged FilePath
    197 198 
       | CustomReason String
    198 199 
       | FlagsChanged
    199 200 
       | LinkFlagsChanged
    ... ... @@ -230,6 +231,7 @@ instance Outputable RecompReason where
    230 231 
         ModuleRemoved (_st, _uid, m)   -> ppr m <+> text "removed"
    231 232 
         ModuleAdded (_st, _uid, m)     -> ppr m <+> text "added"
    232 233 
         FileChanged fp           -> text fp <+> text "changed"
    234 
    +    DirChanged dp            -> text dp <+> text "changed"
    233 235 
         CustomReason s           -> text s
    234 236 
         FlagsChanged             -> text "Flags changed"
    235 237 
         LinkFlagsChanged         -> text "Flags changed"
    ... ... @@ -815,6 +817,22 @@ checkModUsage fc UsageFile{ usg_file_path = file,
    815 817 
           then \e -> pprTrace "UsageFile" (text (show e)) $ return recomp
    816 818 
           else \_ -> return recomp -- if we can't find the file, just recompile, don't fail
    817 819
    820 
    +checkModUsage fc UsageDirectory{ usg_dir_path = dir,
    821 
    +                                 usg_dir_hash = old_hash,
    822 
    +                                 usg_dir_label = mlabel } =
    823 
    +  liftIO $
    824 
    +    handleIO handler $ do
    825 
    +      new_hash <- lookupDirCache fc $ unpackFS dir
    826 
    +      if (old_hash /= new_hash)
    827 
    +         then return recomp
    828 
    +         else return UpToDate
    829 
    + where
    830 
    +   reason  = DirChanged $ unpackFS dir
    831 
    +   recomp  = needsRecompileBecause $ fromMaybe reason $ fmap CustomReason mlabel
    832 
    +   handler = if debugIsOn
    833 
    +      then \e -> pprTrace "UsageDirectory" (text (show e)) $ return recomp
    834 
    +      else \_ -> return recomp -- if we can't find the dir, just recompile, don't fail
    835 
    +
    818 836 
     -- | We are importing a module whose exports have changed.
    819 837 
     -- Does this require recompilation?
    820 838 
     --

  • compiler/GHC/Iface/Recomp/Types.hs
    ... ... @@ -140,6 +140,10 @@ pprUsage usage@UsageFile{}
    140 140 
       = hsep [text "addDependentFile",
    141 141 
               doubleQuotes (ftext (usg_file_path usage)),
    142 142 
               ppr (usg_file_hash usage)]
    143 
    +pprUsage usage@UsageDirectory{}
    144 
    +  = hsep [text "AddDependentDirectory",
    145 
    +          doubleQuotes (ftext (usg_dir_path usage)),
    146 
    +          ppr (usg_dir_hash usage)]
    143 147 
     pprUsage usage@UsageMergedRequirement{}
    144 148 
       = hsep [text "merged", ppr (usg_mod usage), ppr (usg_mod_hash usage)]
    145 149 
     pprUsage usage@UsageHomeModuleInterface{}

  • compiler/GHC/Tc/Gen/Splice.hs
    ... ... @@ -173,8 +173,6 @@ import GHC.Parser.HaddockLex (lexHsDoc)
    173 173 
     import GHC.Parser (parseIdentifier)
    174 174 
     import GHC.Rename.Doc (rnHsDoc)
    175 175
    176 
    -
    177 
    -
    178 176 
     {-
    179 177 
     Note [Template Haskell state diagram]
    180 178 
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ... ... @@ -1524,6 +1522,11 @@ instance TH.Quasi TcM where
    1524 1522 
         dep_files <- readTcRef ref
    1525 1523 
         writeTcRef ref (fp:dep_files)
    1526 1524
    1525 
    +  qAddDependentDirectory dp = do
    1526 
    +    ref <- fmap tcg_dependent_dirs getGblEnv
    1527 
    +    dep_dirs <- readTcRef ref
    1528 
    +    writeTcRef ref (dp:dep_dirs)
    1529 
    +
    1527 1530 
       qAddTempFile suffix = do
    1528 1531 
         dflags <- getDynFlags
    1529 1532 
         logger <- getLogger
    ... ... @@ -1928,6 +1931,7 @@ handleTHMessage msg = case msg of
    1928 1931 
       ReifyConStrictness nm -> wrapTHResult $ TH.qReifyConStrictness nm
    1929 1932 
       GetPackageRoot -> wrapTHResult $ TH.qGetPackageRoot
    1930 1933 
       AddDependentFile f -> wrapTHResult $ TH.qAddDependentFile f
    1934 
    +  AddDependentDirectory d -> wrapTHResult $ TH.qAddDependentDirectory d
    1931 1935 
       AddTempFile s -> wrapTHResult $ TH.qAddTempFile s
    1932 1936 
       AddModFinalizer r -> do
    1933 1937 
         interp <- hscInterp <$> getTopEnv

  • compiler/GHC/Tc/Types.hs
    ... ... @@ -603,6 +603,7 @@ data TcGblEnv
    603 603 
               -- decls.
    604 604
    605 605 
             tcg_dependent_files :: TcRef [FilePath], -- ^ dependencies from addDependentFile
    606 
    +        tcg_dependent_dirs  :: TcRef [FilePath], -- ^ dependencies from addDependentDirectory
    606 607
    607 608 
             tcg_th_topdecls :: TcRef [LHsDecl GhcPs],
    608 609 
             -- ^ Top-level declarations from addTopDecls

  • compiler/GHC/Tc/Utils/Monad.hs
    ... ... @@ -55,7 +55,7 @@ module GHC.Tc.Utils.Monad(
    55 55 
       getRdrEnvs, getImports,
    56 56 
       getFixityEnv, extendFixityEnv,
    57 57 
       getDeclaredDefaultTys,
    58 
    -  addDependentFiles,
    58 
    +  addDependentFiles, addDependentDirectories,
    59 59
    60 60 
       -- * Error management
    61 61 
       getSrcSpanM, setSrcSpan, setSrcSpanA, addLocM,
    ... ... @@ -274,6 +274,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
    274 274 
             let { type_env_var = hsc_type_env_vars hsc_env };
    275 275
    276 276 
             dependent_files_var <- newIORef [] ;
    277 
    +        dependent_dirs_var <- newIORef [] ;
    277 278 
             static_wc_var       <- newIORef emptyWC ;
    278 279 
             cc_st_var           <- newIORef newCostCentreState ;
    279 280 
             th_topdecls_var      <- newIORef [] ;
    ... ... @@ -369,6 +370,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
    369 370 
                     tcg_safe_infer     = infer_var,
    370 371 
                     tcg_safe_infer_reasons = infer_reasons_var,
    371 372 
                     tcg_dependent_files = dependent_files_var,
    373 
    +                tcg_dependent_dirs  = dependent_dirs_var,
    372 374 
                     tcg_tc_plugin_solvers   = [],
    373 375 
                     tcg_tc_plugin_rewriters = emptyUFM,
    374 376 
                     tcg_defaulting_plugins  = [],
    ... ... @@ -957,6 +959,12 @@ addDependentFiles fs = do
    957 959 
       dep_files <- readTcRef ref
    958 960 
       writeTcRef ref (fs ++ dep_files)
    959 961
    962 
    +addDependentDirectories :: [FilePath] -> TcRn ()
    963 
    +addDependentDirectories ds = do
    964 
    +  ref <- fmap tcg_dependent_dirs getGblEnv
    965 
    +  dep_dirs <- readTcRef ref
    966 
    +  writeTcRef ref (ds ++ dep_dirs)
    967 
    +
    960 968 
     {-
    961 969 
     ************************************************************************
    962 970 
     *                                                                      *

  • compiler/GHC/Unit/Finder.hs
    ... ... @@ -31,6 +31,9 @@ module GHC.Unit.Finder (
    31 31
    32 32 
         findObjectLinkableMaybe,
    33 33 
         findObjectLinkable,
    34 
    +
    35 
    +    -- important that GHC.HsToCore.Usage uses the same hashing method for usage dirs as is used here.
    36 
    +    getDirHash,
    34 37 
       ) where
    35 38
    36 39 
     import GHC.Prelude
    ... ... @@ -68,7 +71,9 @@ import qualified Data.Map as M
    68 71 
     import GHC.Driver.Env
    69 72 
     import GHC.Driver.Config.Finder
    70 73 
     import qualified Data.Set as Set
    74 
    +import qualified Data.List as L(sort)
    71 75 
     import Data.List.NonEmpty ( NonEmpty (..) )
    76 
    +import qualified System.Directory as SD
    72 77 
     import qualified System.OsPath as OsPath
    73 78 
     import qualified Data.List.NonEmpty as NE
    74 79
    ... ... @@ -107,10 +112,12 @@ initFinderCache :: IO FinderCache
    107 112 
     initFinderCache = do
    108 113 
       mod_cache <- newIORef emptyInstalledModuleEnv
    109 114 
       file_cache <- newIORef M.empty
    115 
    +  dir_cache <- newIORef M.empty
    110 116 
       let flushFinderCaches :: UnitEnv -> IO ()
    111 117 
           flushFinderCaches ue = do
    112 118 
             atomicModifyIORef' mod_cache $ \fm -> (filterInstalledModuleEnv is_ext fm, ())
    113 119 
             atomicModifyIORef' file_cache $ \_ -> (M.empty, ())
    120 
    +        atomicModifyIORef' dir_cache  $ \_ -> (M.empty, ())
    114 121 
            where
    115 122 
             is_ext mod _ = not (isUnitEnvInstalledModule ue mod)
    116 123
    ... ... @@ -137,8 +144,29 @@ initFinderCache = do
    137 144 
                  atomicModifyIORef' file_cache $ \c -> (M.insert key hash c, ())
    138 145 
                  return hash
    139 146 
                Just fp -> return fp
    147 
    +      lookupDirCache :: FilePath -> IO Fingerprint
    148 
    +      lookupDirCache key = do
    149 
    +         c <- readIORef dir_cache
    150 
    +         case M.lookup key c of
    151 
    +           Nothing -> do
    152 
    +             hash <- getDirHash key
    153 
    +             atomicModifyIORef' dir_cache $ \c -> (M.insert key hash c, ())
    154 
    +             return hash
    155 
    +           Just fp -> return fp
    140 156 
       return FinderCache{..}
    141 157
    158 
    +-- | This function computes a shallow hash of a directory, so really just what files and directories are directly inside it.
    159 
    +-- It does not look at the contents of the files, or the contents of the directories it contains.
    160 
    +getDirHash :: FilePath -> IO Fingerprint
    161 
    +getDirHash dir = do
    162 
    +  contents <- SD.listDirectory dir
    163 
    +  -- The documentation of Fingerprints describes this as an easy naive implementation
    164 
    +  -- I wonder if we should do something more sophisticated here?
    165 
    +  let hashes  = fingerprintString <$> contents
    166 
    +  let s_hashes = L.sort hashes
    167 
    +  let hash    = fingerprintFingerprints s_hashes
    168 
    +  return hash
    169 
    +
    142 170 
     -- -----------------------------------------------------------------------------
    143 171 
     -- The three external entry points
    144 172

  • compiler/GHC/Unit/Finder/Types.hs
    ... ... @@ -37,6 +37,7 @@ data FinderCache = FinderCache { flushFinderCaches :: UnitEnv -> IO ()
    37 37 
                                    , lookupFileCache   :: FilePath -> IO Fingerprint
    38 38 
                                    -- ^ Look for the hash of a file in the cache. This should add it to the
    39 39 
                                    -- cache. If the file doesn't exist, raise an IOException.
    40 
    +                               , lookupDirCache    :: FilePath -> IO Fingerprint
    40 41 
                                    }
    41 42
    42 43 
     data InstalledFindResult

  • compiler/GHC/Unit/Module/Deps.hs
    ... ... @@ -357,6 +357,23 @@ data Usage
    357 357 
             -- contents don't change.  This previously lead to odd
    358 358 
             -- recompilation behaviors; see #8114
    359 359 
       }
    360 
    +  | UsageDirectory {
    361 
    +        usg_dir_path  :: FastString,
    362 
    +        -- ^ External dir dependency. From TH addDependentFile.
    363 
    +        -- Should be absolute.
    364 
    +        usg_dir_hash  :: Fingerprint,
    365 
    +        -- ^ 'Fingerprint' of the directories contents.
    366 
    +
    367 
    +        usg_dir_label :: Maybe String
    368 
    +        -- ^ An optional string which is used in recompilation messages if
    369 
    +        -- dir in question has changed.
    370 
    +
    371 
    +        -- Note: We do a very shallow check indeed, just what the contents of
    372 
    +        -- the directory are, aka what files and directories are within it.
    373 
    +        -- If those files/directories have their own contents changed...
    374 
    +        -- We won't spot it here, better recursive add them to your usage
    375 
    +        -- seperately.
    376 
    +  }
    360 377 
       | UsageHomeModuleInterface {
    361 378 
             usg_mod_name :: ModuleName
    362 379 
             -- ^ Name of the module
    ... ... @@ -395,6 +412,7 @@ instance NFData Usage where
    395 412 
       rnf (UsagePackageModule mod hash safe) = rnf mod `seq` rnf hash `seq` rnf safe `seq` ()
    396 413 
       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` ()
    397 414 
       rnf (UsageFile file hash label) = rnf file `seq` rnf hash `seq` rnf label `seq` ()
    415 
    +  rnf (UsageDirectory dir hash label) = rnf dir `seq` rnf hash `seq` rnf label `seq` ()
    398 416 
       rnf (UsageMergedRequirement mod hash) = rnf mod `seq` rnf hash `seq` ()
    399 417 
       rnf (UsageHomeModuleInterface mod uid hash) = rnf mod `seq` rnf uid `seq` rnf hash `seq` ()
    400 418
    ... ... @@ -431,6 +449,12 @@ instance Binary Usage where
    431 449 
             put_ bh (usg_unit_id  usg)
    432 450 
             put_ bh (usg_iface_hash usg)
    433 451
    452 
    +    put_ bh usg@UsageDirectory{} = do
    453 
    +        putByte bh 5
    454 
    +        put_ bh (usg_dir_path usg)
    455 
    +        put_ bh (usg_dir_hash usg)
    456 
    +        put_ bh (usg_dir_label usg)
    457 
    +
    434 458 
         get bh = do
    435 459 
             h <- getByte bh
    436 460 
             case h of
    ... ... @@ -462,6 +486,12 @@ instance Binary Usage where
    462 486 
                 uid <- get bh
    463 487 
                 hash <- get bh
    464 488 
                 return UsageHomeModuleInterface { usg_mod_name = mod, usg_unit_id = uid, usg_iface_hash = hash }
    489 
    +          5 -> do
    490 
    +            dp    <- get bh
    491 
    +            hash  <- get bh
    492 
    +            label <- get bh
    493 
    +            return UsageDirectory { usg_dir_path = dp, usg_dir_hash = hash, usg_dir_label = label }
    494 
    +
    465 495 
               i -> error ("Binary.get(Usage): " ++ show i)
    466 496
    467 497 
     -- | Records the imports that we depend on from a home module,

  • docs/users_guide/9.14.1-notes.rst
    ... ... @@ -232,6 +232,11 @@ Cmm
    232 232 
       They are replaced, respectively, by ``SpecialiseEP``, ``pragSpecED`` and
    233 233 
       ``pragSpecInlED``.
    234 234
    235 
    +- We have added the ``addDependentDirectory`` function to match
    236 
    +  ``addDependentFile``, which adds a directory to the list of dependencies that
    237 
    +  the recompilation checker will look at to determine if a module needs to be
    238 
    +  recompiled.
    239 
    +
    235 240 
     Included libraries
    236 241 
     ~~~~~~~~~~~~~~~~~~
    237 242

  • docs/users_guide/eventlog-formats.rst
    ... ... @@ -779,9 +779,9 @@ the total time spent profiling.
    779 779 
     Cost-centre break-down
    780 780 
     ^^^^^^^^^^^^^^^^^^^^^^
    781 781
    782 
    -A variable-length packet encoding a heap profile sample broken down by,
    783 
    - * cost-centre (:rts-flag:`-hc`)
    784 
    -
    782 
    +A variable-length packet encoding a heap profile sample.
    783 
    +This event is only emitted when the heap profile type is set to :rts-flag:`-hc` or :rts-flag:`-hb`.
    784 
    +Otherwise, a :event-type:`HEAP_PROF_SAMPLE_STRING` event is emitted instead.
    785 785
    786 786 
     .. event-type:: HEAP_PROF_SAMPLE_COST_CENTRE
    787 787
    ... ... @@ -796,11 +796,19 @@ A variable-length packet encoding a heap profile sample broken down by,
    796 796 
     String break-down
    797 797 
     ^^^^^^^^^^^^^^^^^
    798 798
    799 
    -A variable-length event encoding a heap sample broken down by,
    799 
    +A variable-length event encoding a heap sample.
    800 
    +The content of the sample label varies depending on the heap profile type:
    801 
    +
    802 
    +   * :rts-flag:`-hT` The sample label contains a closure type, e.g., ``"ghc-bignum:GHC.Num.Integer.IS"``.
    803 
    +   * :rts-flag:`-hm` The sample label contains a module name, e.g., ``"GHC.Num.Integer"``.
    804 
    +   * :rts-flag:`-hd` The sample label contains a closure description, e.g., ``"IS"``.
    805 
    +   * :rts-flag:`-hy` The sample label contains a type description, e.g., ``"Integer"``.
    806 
    +   * :rts-flag:`-he` The sample label contains a stringified era, e.g., ``"1"``.
    807 
    +   * :rts-flag:`-hr` The sample label contains a retainer set description, e.g., ``"(184)$stoIntegralSized1"``.
    808 
    +   * :rts-flag:`-hi` The sample label contains a stringified pointer, e.g., ``"0x1008b7588"``,
    809 
    +     which can be matched to an info table description emitted by the :event-type:`IPE` event.
    800 810
    801 
    - * type description (:rts-flag:`-hy`)
    802 
    - * closure description (:rts-flag:`-hd`)
    803 
    - * module (:rts-flag:`-hm`)
    811 
    +If the heap profile type is set to :rts-flag:`-hc` or :rts-flag:`-hb`, a :event-type:`HEAP_PROF_SAMPLE_COST_CENTRE` event is emitted instead.
    804 812
    805 813 
     .. event-type:: HEAP_PROF_SAMPLE_STRING
    806 814
    ... ... @@ -808,7 +816,7 @@ A variable-length event encoding a heap sample broken down by,
    808 816 
        :length: variable
    809 817 
        :field Word8: profile ID
    810 818 
        :field Word64: heap residency in bytes
    811 
    -   :field String: type or closure description, or module name
    819 
    +   :field String: sample label
    812 820
    813 821 
     .. _time-profiler-events:
    814 822

  • docs/users_guide/separate_compilation.rst
    ... ... @@ -710,7 +710,7 @@ beautiful sight!
    710 710 
     You can read about :ghc-wiki:`how all this works <commentary/compiler/recompilation-avoidance>` in the GHC commentary.
    711 711
    712 712 
     Recompilation for Template Haskell and Plugins
    713 
    -^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    713 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    714 714
    715 715 
     Recompilation checking gets a bit more complicated when using Template Haskell or
    716 716 
     plugins. Both these features execute code at compile time and so if any of the
    ... ... @@ -727,6 +727,19 @@ if ``foo`` is from module ``A`` and ``bar`` is from module ``B``, the module wil
    727 727 
     now depend on ``A.o`` and ``B.o``, if either of these change then the module will
    728 728 
     be recompiled.
    729 729
    730 
    +``addDependentFile`` and ``addDependentDirectory``
    731 
    +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    732 
    +
    733 
    +When using Template Haskell or plugins, you can use the functions
    734 
    +``addDependentFile`` and ``addDependentDirectory`` to add additional
    735 
    +dependencies to the module being compiled.
    736 
    +
    737 
    +- When adding a file, this means that the contents of the file changing between
    738 
    +  compilations will trigger a recompilation of the module.
    739 
    +- When adding a directory, this means that any file or subdirectory *added* to or
    740 
    +  *removed* from the directory will trigger recompilation of the module, so
    741 
    +  it is not a recursive dependency.
    742 
    +
    730 743 
     .. _mutual-recursion:
    731 744
    732 745 
     Mutually recursive modules and hs-boot files

  • libraries/ghc-internal/src/GHC/Internal/Base.hs
    ... ... @@ -1047,7 +1047,7 @@ class Functor f where
    1047 1047 
     -- * sequence computations and combine their results ('<*>' and 'liftA2').
    1048 1048 
     --
    1049 1049 
     -- A minimal complete definition must include implementations of 'pure'
    1050 
    +-- and one of either '<*>' or 'liftA2'. If it defines both, then they must behave
    1050 1051 
     -- the same as their default definitions:
    1051 1052 
     --
    1052 1053 
     --      @('<*>') = 'liftA2' 'id'@

  • libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs
    ... ... @@ -135,6 +135,9 @@ class (MonadIO m, MonadFail m) => Quasi m where
    135 135 
       -- | See 'addDependentFile'.
    136 136 
       qAddDependentFile :: FilePath -> m ()
    137 137
    138 
    +  -- | See 'addDependentDirectory'.
    139 
    +  qAddDependentDirectory :: FilePath -> m ()
    140 
    +
    138 141 
       -- | See 'addTempFile'.
    139 142 
       qAddTempFile :: String -> m FilePath
    140 143
    ... ... @@ -181,30 +184,31 @@ instance Quasi IO where
    181 184 
       qReport True  msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
    182 185 
       qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
    183 186
    184 
    -  qLookupName _ _       = badIO "lookupName"
    185 
    -  qReify _              = badIO "reify"
    186 
    -  qReifyFixity _        = badIO "reifyFixity"
    187 
    -  qReifyType _          = badIO "reifyFixity"
    188 
    -  qReifyInstances _ _   = badIO "reifyInstances"
    189 
    -  qReifyRoles _         = badIO "reifyRoles"
    190 
    -  qReifyAnnotations _   = badIO "reifyAnnotations"
    191 
    -  qReifyModule _        = badIO "reifyModule"
    192 
    -  qReifyConStrictness _ = badIO "reifyConStrictness"
    193 
    -  qLocation             = badIO "currentLocation"
    194 
    -  qRecover _ _          = badIO "recover" -- Maybe we could fix this?
    195 
    -  qGetPackageRoot       = badIO "getProjectRoot"
    196 
    -  qAddDependentFile _   = badIO "addDependentFile"
    197 
    -  qAddTempFile _        = badIO "addTempFile"
    198 
    -  qAddTopDecls _        = badIO "addTopDecls"
    199 
    -  qAddForeignFilePath _ _ = badIO "addForeignFilePath"
    200 
    -  qAddModFinalizer _    = badIO "addModFinalizer"
    201 
    -  qAddCorePlugin _      = badIO "addCorePlugin"
    202 
    -  qGetQ                 = badIO "getQ"
    203 
    -  qPutQ _               = badIO "putQ"
    204 
    -  qIsExtEnabled _       = badIO "isExtEnabled"
    205 
    -  qExtsEnabled          = badIO "extsEnabled"
    206 
    -  qPutDoc _ _           = badIO "putDoc"
    207 
    -  qGetDoc _             = badIO "getDoc"
    187 
    +  qLookupName _ _          = badIO "lookupName"
    188 
    +  qReify _                 = badIO "reify"
    189 
    +  qReifyFixity _           = badIO "reifyFixity"
    190 
    +  qReifyType _             = badIO "reifyFixity"
    191 
    +  qReifyInstances _ _      = badIO "reifyInstances"
    192 
    +  qReifyRoles _            = badIO "reifyRoles"
    193 
    +  qReifyAnnotations _      = badIO "reifyAnnotations"
    194 
    +  qReifyModule _           = badIO "reifyModule"
    195 
    +  qReifyConStrictness _    = badIO "reifyConStrictness"
    196 
    +  qLocation                = badIO "currentLocation"
    197 
    +  qRecover _ _             = badIO "recover" -- Maybe we could fix this?
    198 
    +  qGetPackageRoot          = badIO "getProjectRoot"
    199 
    +  qAddDependentFile _      = badIO "addDependentFile"
    200 
    +  qAddDependentDirectory _ = badIO "AddDependentDirectory"
    201 
    +  qAddTempFile _           = badIO "addTempFile"
    202 
    +  qAddTopDecls _           = badIO "addTopDecls"
    203 
    +  qAddForeignFilePath _ _  = badIO "addForeignFilePath"
    204 
    +  qAddModFinalizer _       = badIO "addModFinalizer"
    205 
    +  qAddCorePlugin _         = badIO "addCorePlugin"
    206 
    +  qGetQ                    = badIO "getQ"
    207 
    +  qPutQ _                  = badIO "putQ"
    208 
    +  qIsExtEnabled _          = badIO "isExtEnabled"
    209 
    +  qExtsEnabled             = badIO "extsEnabled"
    210 
    +  qPutDoc _ _              = badIO "putDoc"
    211 
    +  qGetDoc _                = badIO "getDoc"
    208 212
    209 213 
     instance Quote IO where
    210 214 
       newName = newNameIO
    ... ... @@ -822,6 +826,26 @@ getPackageRoot :: Q FilePath
    822 826 
     getPackageRoot = Q qGetPackageRoot
    823 827
    824 828
    829 
    +-- | Record external directories that runIO is using (dependent upon).
    830 
    +-- The compiler can then recognize that it should re-compile the Haskell file
    831 
    +-- when a directory changes.
    832 
    +--
    833 
    +-- Expects an absolute directory path.
    834 
    +--
    835 
    +-- Notes:
    836 
    +--
    837 
    +--   * ghc -M does not know about these dependencies - it does not execute TH.
    838 
    +--
    839 
    +--   * The dependency is shallow, based only on the direct content.
    840 
    +--     Basically, it only sees a list of names. It does not look at directory
    841 
    +--     metadata, recurse into subdirectories, or look at file contents. As
    842 
    +--     long as the list of names remains the same, the directory is considered
    843 
    +--     unchanged.
    844 
    +--
    845 
    +--   * The state of the directory is read at the interface generation time,
    846 
    +--     not at the time of the function call.
    847 
    +addDependentDirectory :: FilePath -> Q ()
    848 
    +addDependentDirectory dp = Q (qAddDependentDirectory dp)
    825 849
    826 850 
     -- | Record external files that runIO is using (dependent upon).
    827 851 
     -- The compiler can then recognize that it should re-compile the Haskell file
    ... ... @@ -833,7 +857,11 @@ getPackageRoot = Q qGetPackageRoot
    833 857 
     --
    834 858 
     --   * ghc -M does not know about these dependencies - it does not execute TH.
    835 859 
     --
    836 
    ---   * The dependency is based on file content, not a modification time
    860 
    +--   * The dependency is based on file content, not a modification time or
    861 
    +--     any other metadata associated with the file (e.g. permissions).
    862 
    +--
    863 
    +--   * The state of the file is read at the interface generation time,
    864 
    +--     not at the time of the function call.
    837 865 
     addDependentFile :: FilePath -> Q ()
    838 866 
     addDependentFile fp = Q (qAddDependentFile fp)
    839 867
    ... ... @@ -961,32 +989,33 @@ instance MonadIO Q where
    961 989 
       liftIO = runIO
    962 990
    963 991 
     instance Quasi Q where
    964 
    -  qNewName            = newName
    965 
    -  qReport             = report
    966 
    -  qRecover            = recover
    967 
    -  qReify              = reify
    968 
    -  qReifyFixity        = reifyFixity
    969 
    -  qReifyType          = reifyType
    970 
    -  qReifyInstances     = reifyInstances
    971 
    -  qReifyRoles         = reifyRoles
    972 
    -  qReifyAnnotations   = reifyAnnotations
    973 
    -  qReifyModule        = reifyModule
    974 
    -  qReifyConStrictness = reifyConStrictness
    975 
    -  qLookupName         = lookupName
    976 
    -  qLocation           = location
    977 
    -  qGetPackageRoot     = getPackageRoot
    978 
    -  qAddDependentFile   = addDependentFile
    979 
    -  qAddTempFile        = addTempFile
    980 
    -  qAddTopDecls        = addTopDecls
    981 
    -  qAddForeignFilePath = addForeignFilePath
    982 
    -  qAddModFinalizer    = addModFinalizer
    983 
    -  qAddCorePlugin      = addCorePlugin
    984 
    -  qGetQ               = getQ
    985 
    -  qPutQ               = putQ
    986 
    -  qIsExtEnabled       = isExtEnabled
    987 
    -  qExtsEnabled        = extsEnabled
    988 
    -  qPutDoc             = putDoc
    989 
    -  qGetDoc             = getDoc
    992 
    +  qNewName               = newName
    993 
    +  qReport                = report
    994 
    +  qRecover               = recover
    995 
    +  qReify                 = reify
    996 
    +  qReifyFixity           = reifyFixity
    997 
    +  qReifyType             = reifyType
    998 
    +  qReifyInstances        = reifyInstances
    999 
    +  qReifyRoles            = reifyRoles
    1000 
    +  qReifyAnnotations      = reifyAnnotations
    1001 
    +  qReifyModule           = reifyModule
    1002 
    +  qReifyConStrictness    = reifyConStrictness
    1003 
    +  qLookupName            = lookupName
    1004 
    +  qLocation              = location
    1005 
    +  qGetPackageRoot        = getPackageRoot
    1006 
    +  qAddDependentFile      = addDependentFile
    1007 
    +  qAddDependentDirectory = addDependentDirectory
    1008 
    +  qAddTempFile           = addTempFile
    1009 
    +  qAddTopDecls           = addTopDecls
    1010 
    +  qAddForeignFilePath    = addForeignFilePath
    1011 
    +  qAddModFinalizer       = addModFinalizer
    1012 
    +  qAddCorePlugin         = addCorePlugin
    1013 
    +  qGetQ                  = getQ
    1014 
    +  qPutQ                  = putQ
    1015 
    +  qIsExtEnabled          = isExtEnabled
    1016 
    +  qExtsEnabled           = extsEnabled
    1017 
    +  qPutDoc                = putDoc
    1018 
    +  qGetDoc                = getDoc
    990 1019
    991 1020
    992 1021 
     ----------------------------------------------------

  • libraries/ghci/GHCi/Message.hs
    ... ... @@ -291,6 +291,7 @@ data THMessage a where
    291 291
    292 292 
       GetPackageRoot :: THMessage (THResult FilePath)
    293 293 
       AddDependentFile :: FilePath -> THMessage (THResult ())
    294 
    +  AddDependentDirectory :: FilePath -> THMessage (THResult ())
    294 295 
       AddTempFile :: String -> THMessage (THResult FilePath)
    295 296 
       AddModFinalizer :: RemoteRef (TH.Q ()) -> THMessage (THResult ())
    296 297 
       AddCorePlugin :: String -> THMessage (THResult ())
    ... ... @@ -343,6 +344,7 @@ getTHMessage = do
    343 344 
         23 -> THMsg <$> (PutDoc <$> get <*> get)
    344 345 
         24 -> THMsg <$> GetDoc <$> get
    345 346 
         25 -> THMsg <$> return GetPackageRoot
    347 
    +    26 -> THMsg <$> AddDependentDirectory <$> get
    346 348 
         n -> error ("getTHMessage: unknown message " ++ show n)
    347 349
    348 350 
     putTHMessage :: THMessage a -> Put
    ... ... @@ -373,7 +375,7 @@ putTHMessage m = case m of
    373 375 
       PutDoc l s                  -> putWord8 23 >> put l >> put s
    374 376 
       GetDoc l                    -> putWord8 24 >> put l
    375 377 
       GetPackageRoot              -> putWord8 25
    376 
    -
    378 
    +  AddDependentDirectory a     -> putWord8 26 >> put a
    377 379
    378 380 
     data EvalOpts = EvalOpts
    379 381 
       { useSandboxThread :: Bool

  • libraries/ghci/GHCi/TH.hs
    ... ... @@ -198,6 +198,7 @@ instance TH.Quasi GHCiQ where
    198 198 
       qLocation = fromMaybe noLoc . qsLocation <$> getState
    199 199 
       qGetPackageRoot        = ghcCmd GetPackageRoot
    200 200 
       qAddDependentFile file = ghcCmd (AddDependentFile file)
    201 
    +  qAddDependentDirectory dir = ghcCmd (AddDependentDirectory dir)
    201 202 
       qAddTempFile suffix = ghcCmd (AddTempFile suffix)
    202 203 
       qAddTopDecls decls = ghcCmd (AddTopDecls decls)
    203 204 
       qAddForeignFilePath lang fp = ghcCmd (AddForeignFilePath lang fp)

  • libraries/template-haskell/Language/Haskell/TH/Syntax.hs
    ... ... @@ -32,6 +32,7 @@ module Language.Haskell.TH.Syntax (
    32 32 
         ModName (..),
    33 33 
         addCorePlugin,
    34 34 
         addDependentFile,
    35 
    +    addDependentDirectory,
    35 36 
         addForeignFile,
    36 37 
         addForeignFilePath,
    37 38 
         addForeignSource,

  • testsuite/.gitignore
    ... ... @@ -1523,6 +1523,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk
    1523 1523 
     /tests/th/T8633
    1524 1524 
     /tests/th/TH_Depends
    1525 1525 
     /tests/th/TH_Depends_external.txt
    1526 
    +/tests/th/TH_Depends_external/dummy.txt
    1526 1527 
     /tests/th/TH_StringPrimL
    1527 1528 
     /tests/th/TH_import_loop/ModuleA.hi-boot
    1528 1529 
     /tests/th/TH_import_loop/ModuleA.o-boot

  • testsuite/tests/interface-stability/template-haskell-exports.stdout
    ... ... @@ -1715,6 +1715,7 @@ module Language.Haskell.TH.Syntax where
    1715 1715 
         qRunIO :: forall a. GHC.Internal.Types.IO a -> m a
    1716 1716 
         qGetPackageRoot :: m GHC.Internal.IO.FilePath
    1717 1717 
         qAddDependentFile :: GHC.Internal.IO.FilePath -> m ()
    1718 
    +    qAddDependentDirectory :: GHC.Internal.IO.FilePath -> m ()
    1718 1719 
         qAddTempFile :: GHC.Internal.Base.String -> m GHC.Internal.IO.FilePath
    1719 1720 
         qAddTopDecls :: [Dec] -> m ()
    1720 1721 
         qAddForeignFilePath :: ForeignSrcLang -> GHC.Internal.Base.String -> m ()
    ... ... @@ -1726,7 +1727,7 @@ module Language.Haskell.TH.Syntax where
    1726 1727 
         qExtsEnabled :: m [Extension]
    1727 1728 
         qPutDoc :: DocLoc -> GHC.Internal.Base.String -> m ()
    1728 1729 
         qGetDoc :: DocLoc -> m (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String)
    1729 
    -    {-# MINIMAL qNewName, qReport, qRecover, qLookupName, qReify, qReifyFixity, qReifyType, qReifyInstances, qReifyRoles, qReifyAnnotations, qReifyModule, qReifyConStrictness, qLocation, qGetPackageRoot, qAddDependentFile, qAddTempFile, qAddTopDecls, qAddForeignFilePath, qAddModFinalizer, qAddCorePlugin, qGetQ, qPutQ, qIsExtEnabled, qExtsEnabled, qPutDoc, qGetDoc #-}
    1730 
    +    {-# MINIMAL qNewName, qReport, qRecover, qLookupName, qReify, qReifyFixity, qReifyType, qReifyInstances, qReifyRoles, qReifyAnnotations, qReifyModule, qReifyConStrictness, qLocation, qGetPackageRoot, qAddDependentFile, qAddDependentDirectory, qAddTempFile, qAddTopDecls, qAddForeignFilePath, qAddModFinalizer, qAddCorePlugin, qGetQ, qPutQ, qIsExtEnabled, qExtsEnabled, qPutDoc, qGetDoc #-}
    1730 1731 
       type Quote :: (* -> *) -> Constraint
    1731 1732 
       class GHC.Internal.Base.Monad m => Quote m where
    1732 1733 
         newName :: GHC.Internal.Base.String -> m Name
    ... ... @@ -1779,6 +1780,7 @@ module Language.Haskell.TH.Syntax where
    1779 1780 
       type VarStrictType :: *
    1780 1781 
       type VarStrictType = VarBangType
    1781 1782 
       addCorePlugin :: GHC.Internal.Base.String -> Q ()
    1783 
    +  addDependentDirectory :: GHC.Internal.IO.FilePath -> Q ()
    1782 1784 
       addDependentFile :: GHC.Internal.IO.FilePath -> Q ()
    1783 1785 
       addForeignFile :: ForeignSrcLang -> GHC.Internal.Base.String -> Q ()
    1784 1786 
       addForeignFilePath :: ForeignSrcLang -> GHC.Internal.IO.FilePath -> Q ()

  • testsuite/tests/th/Makefile
    ... ... @@ -43,6 +43,20 @@ TH_Depends:
    43 43 
     	'$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) --make -v0 TH_Depends
    44 44 
     	./TH_Depends
    45 45
    46 
    +.PHONY: TH_Depends_Dir
    47 
    +TH_Depends_Dir:
    48 
    +	rm -rf TH_Depends_external
    49 
    +	$(RM) TH_Depends_Dir TH_Depends_Dir.exe
    50 
    +	$(RM) TH_Depends_Dir.o TH_Depends_Dir.hi
    51 
    +	$(RM) TH_Depends_Dir_External.o TH_Depends_Dir_External.hi
    52 
    +
    53 
    +	mkdir TH_Depends_external
    54 
    +	'$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) --make -v0 TH_Depends_Dir
    55 
    +	./TH_Depends_Dir
    56 
    +	sleep 2
    57 
    +	echo "dummy" > TH_Depends_external/dummy.txt
    58 
    +	'$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) --make -v0 TH_Depends_Dir
    59 
    +	./TH_Depends_Dir
    46 60
    47 61 
     T8333:
    48 62 
     	'$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) $(ghcThWayFlags) T8333.hs < /dev/null

  • testsuite/tests/th/TH_Depends_Dir.hs
    1 
    +
    2 
    +{-# LANGUAGE TemplateHaskell #-}
    3 
    +
    4 
    +module Main where
    5 
    +
    6 
    +import TH_Depends_Dir_External (checkDirectoryContent)
    7 
    +
    8 
    +main :: IO ()
    9 
    +main = putStrLn $checkDirectoryContent
    \ No newline at end of file

  • testsuite/tests/th/TH_Depends_Dir.stdout
    1 
    +no files?
    2 
    +yes files!
    \ No newline at end of file

  • testsuite/tests/th/TH_Depends_Dir_External.hs
    1 
    +
    2 
    +module TH_Depends_Dir_External where
    3 
    +
    4 
    +import Language.Haskell.TH.Syntax
    5 
    +import Language.Haskell.TH.Lib
    6 
    +import System.Directory (listDirectory)
    7 
    +
    8 
    +checkDirectoryContent :: Q Exp
    9 
    +checkDirectoryContent = do
    10 
    +  qAddDependentDirectory "TH_Depends_external"
    11 
    +  l <- qRunIO $ listDirectory "TH_Depends_external"
    12 
    +  let s = case l of
    13 
    +        [] -> "no files?"
    14 
    +        _  -> "yes files!"
    15 
    +  stringE s
    \ No newline at end of file

  • testsuite/tests/th/all.T
    ... ... @@ -214,6 +214,7 @@ test('T5434', [], multimod_compile,
    214 214 
          ['T5434', '-v0 -Wall ' + config.ghc_th_way_flags])
    215 215 
     test('T5508', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
    216 216 
     test('TH_Depends', [only_ways(['normal'])], makefile_test, ['TH_Depends'])
    217 
    +test('TH_Depends_Dir', [only_ways(['normal'])], makefile_test, ['TH_Depends_Dir'])
    217 218 
     test('T5597', [], multimod_compile, ['T5597', '-v0 ' + config.ghc_th_way_flags])
    218 219 
     test('T5665', [], multimod_compile, ['T5665', '-v0 ' + config.ghc_th_way_flags])
    219 220 
     test('T5700', [], multimod_compile,

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help