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

Commits:

23 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 "Contents of" <+> 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,
    ... ... @@ -273,6 +273,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
    273 273 
             let { type_env_var = hsc_type_env_vars hsc_env };
    274 274
    275 275 
             dependent_files_var <- newIORef [] ;
    276 
    +        dependent_dirs_var <- newIORef [] ;
    276 277 
             static_wc_var       <- newIORef emptyWC ;
    277 278 
             cc_st_var           <- newIORef newCostCentreState ;
    278 279 
             th_topdecls_var      <- newIORef [] ;
    ... ... @@ -368,6 +369,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
    368 369 
                     tcg_safe_infer     = infer_var,
    369 370 
                     tcg_safe_infer_reasons = infer_reasons_var,
    370 371 
                     tcg_dependent_files = dependent_files_var,
    372 
    +                tcg_dependent_dirs  = dependent_dirs_var,
    371 373 
                     tcg_tc_plugin_solvers   = [],
    372 374 
                     tcg_tc_plugin_rewriters = emptyUFM,
    373 375 
                     tcg_defaulting_plugins  = [],
    ... ... @@ -956,6 +958,12 @@ addDependentFiles fs = do
    956 958 
       dep_files <- readTcRef ref
    957 959 
       writeTcRef ref (fs ++ dep_files)
    958 960
    961 
    +addDependentDirectories :: [FilePath] -> TcRn ()
    962 
    +addDependentDirectories ds = do
    963 
    +  ref <- fmap tcg_dependent_dirs getGblEnv
    964 
    +  dep_dirs <- readTcRef ref
    965 
    +  writeTcRef ref (ds ++ dep_dirs)
    966 
    +
    959 967 
     {-
    960 968 
     ************************************************************************
    961 969 
     *                                                                      *

  • 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,27 @@ 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 
    +  let hashes  = fingerprintString <$> contents
    164 
    +  let s_hashes = L.sort hashes
    165 
    +  let hash    = fingerprintFingerprints s_hashes
    166 
    +  return hash
    167 
    +
    142 168 
     -- -----------------------------------------------------------------------------
    143 169 
     -- The three external entry points
    144 170

  • 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, then
    374 
    +        -- we won't spot it here. If you do want to spot that, the caller
    375 
    +        -- should recursively add them to their useage.
    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.16.1-notes.rst
    ... ... @@ -50,6 +50,11 @@ Cmm
    50 50 
     ``template-haskell`` library
    51 51 
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    52 52
    53 
    +- We have added the ``addDependentDirectory`` function to match
    54 
    +  ``addDependentFile``, which adds a directory to the list of dependencies that
    55 
    +  the recompilation checker will look at to determine if a module needs to be
    56 
    +  recompiled.
    57 
    +
    53 58 
     Included libraries
    54 59 
     ~~~~~~~~~~~~~~~~~~
    55 60

  • 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/TH/Syntax.hs
    ... ... @@ -132,6 +132,9 @@ class (MonadIO m, MonadFail m) => Quasi m where
    132 132 
       -- | See 'addDependentFile'.
    133 133 
       qAddDependentFile :: FilePath -> m ()
    134 134
    135 
    +  -- | See 'addDependentDirectory'.
    136 
    +  qAddDependentDirectory :: FilePath -> m ()
    137 
    +
    135 138 
       -- | See 'addTempFile'.
    136 139 
       qAddTempFile :: String -> m FilePath
    137 140
    ... ... @@ -202,6 +205,7 @@ instance Quasi IO where
    202 205 
       qExtsEnabled          = badIO "extsEnabled"
    203 206 
       qPutDoc _ _           = badIO "putDoc"
    204 207 
       qGetDoc _             = badIO "getDoc"
    208 
    +  qAddDependentDirectory _ = badIO "AddDependentDirectory"
    205 209
    206 210 
     instance Quote IO where
    207 211 
       newName = newNameIO
    ... ... @@ -819,6 +823,24 @@ getPackageRoot :: Q FilePath
    819 823 
     getPackageRoot = Q qGetPackageRoot
    820 824
    821 825
    826 
    +-- | Record external directories that runIO is using (dependent upon).
    827 
    +-- The compiler can then recognize that it should re-compile the Haskell file
    828 
    +-- when a directory changes.
    829 
    +--
    830 
    +-- Notes:
    831 
    +--
    832 
    +--   * ghc -M does not know about these dependencies - it does not execute TH.
    833 
    +--
    834 
    +--   * The dependency is shallow, based only on the direct content.
    835 
    +--     Basically, it only sees a list of names. It does not look at directory
    836 
    +--     metadata, recurse into subdirectories, or look at file contents. As
    837 
    +--     long as the list of names remains the same, the directory is considered
    838 
    +--     unchanged.
    839 
    +--
    840 
    +--   * The state of the directory is read at the interface generation time,
    841 
    +--     not at the time of the function call.
    842 
    +addDependentDirectory :: FilePath -> Q ()
    843 
    +addDependentDirectory dp = Q (qAddDependentDirectory dp)
    822 844
    823 845 
     -- | Record external files that runIO is using (dependent upon).
    824 846 
     -- The compiler can then recognize that it should re-compile the Haskell file
    ... ... @@ -830,7 +852,11 @@ getPackageRoot = Q qGetPackageRoot
    830 852 
     --
    831 853 
     --   * ghc -M does not know about these dependencies - it does not execute TH.
    832 854 
     --
    833 
    ---   * The dependency is based on file content, not a modification time
    855 
    +--   * The dependency is based on file content, not a modification time or
    856 
    +--     any other metadata associated with the file (e.g. permissions).
    857 
    +--
    858 
    +--   * The state of the file is read at the interface generation time,
    859 
    +--     not at the time of the function call.
    834 860 
     addDependentFile :: FilePath -> Q ()
    835 861 
     addDependentFile fp = Q (qAddDependentFile fp)
    836 862
    ... ... @@ -952,32 +978,33 @@ instance MonadIO Q where
    952 978 
       liftIO = runIO
    953 979
    954 980 
     instance Quasi Q where
    955 
    -  qNewName            = newName
    956 
    -  qReport             = report
    957 
    -  qRecover            = recover
    958 
    -  qReify              = reify
    959 
    -  qReifyFixity        = reifyFixity
    960 
    -  qReifyType          = reifyType
    961 
    -  qReifyInstances     = reifyInstances
    962 
    -  qReifyRoles         = reifyRoles
    963 
    -  qReifyAnnotations   = reifyAnnotations
    964 
    -  qReifyModule        = reifyModule
    965 
    -  qReifyConStrictness = reifyConStrictness
    966 
    -  qLookupName         = lookupName
    967 
    -  qLocation           = location
    968 
    -  qGetPackageRoot     = getPackageRoot
    969 
    -  qAddDependentFile   = addDependentFile
    970 
    -  qAddTempFile        = addTempFile
    971 
    -  qAddTopDecls        = addTopDecls
    972 
    -  qAddForeignFilePath = addForeignFilePath
    973 
    -  qAddModFinalizer    = addModFinalizer
    974 
    -  qAddCorePlugin      = addCorePlugin
    975 
    -  qGetQ               = getQ
    976 
    -  qPutQ               = putQ
    977 
    -  qIsExtEnabled       = isExtEnabled
    978 
    -  qExtsEnabled        = extsEnabled
    979 
    -  qPutDoc             = putDoc
    980 
    -  qGetDoc             = getDoc
    981 
    +  qNewName               = newName
    982 
    +  qReport                = report
    983 
    +  qRecover               = recover
    984 
    +  qReify                 = reify
    985 
    +  qReifyFixity           = reifyFixity
    986 
    +  qReifyType             = reifyType
    987 
    +  qReifyInstances        = reifyInstances
    988 
    +  qReifyRoles            = reifyRoles
    989 
    +  qReifyAnnotations      = reifyAnnotations
    990 
    +  qReifyModule           = reifyModule
    991 
    +  qReifyConStrictness    = reifyConStrictness
    992 
    +  qLookupName            = lookupName
    993 
    +  qLocation              = location
    994 
    +  qGetPackageRoot        = getPackageRoot
    995 
    +  qAddDependentFile      = addDependentFile
    996 
    +  qAddDependentDirectory = addDependentDirectory
    997 
    +  qAddTempFile           = addTempFile
    998 
    +  qAddTopDecls           = addTopDecls
    999 
    +  qAddForeignFilePath    = addForeignFilePath
    1000 
    +  qAddModFinalizer       = addModFinalizer
    1001 
    +  qAddCorePlugin         = addCorePlugin
    1002 
    +  qGetQ                  = getQ
    1003 
    +  qPutQ                  = putQ
    1004 
    +  qIsExtEnabled          = isExtEnabled
    1005 
    +  qExtsEnabled           = extsEnabled
    1006 
    +  qPutDoc                = putDoc
    1007 
    +  qGetDoc                = getDoc
    981 1008
    982 1009
    983 1010 
     ----------------------------------------------------

  • 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
    ... ... @@ -34,6 +34,7 @@ module Language.Haskell.TH.Syntax (
    34 34 
         ModName (..),
    35 35 
         addCorePlugin,
    36 36 
         addDependentFile,
    37 
    +    addDependentDirectory,
    37 38 
         addForeignFile,
    38 39 
         addForeignFilePath,
    39 40 
         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
    ... ... @@ -1717,6 +1717,7 @@ module Language.Haskell.TH.Syntax where
    1717 1717 
         qRunIO :: forall a. GHC.Internal.Types.IO a -> m a
    1718 1718 
         qGetPackageRoot :: m GHC.Internal.IO.FilePath
    1719 1719 
         qAddDependentFile :: GHC.Internal.IO.FilePath -> m ()
    1720 
    +    qAddDependentDirectory :: GHC.Internal.IO.FilePath -> m ()
    1720 1721 
         qAddTempFile :: GHC.Internal.Base.String -> m GHC.Internal.IO.FilePath
    1721 1722 
         qAddTopDecls :: [Dec] -> m ()
    1722 1723 
         qAddForeignFilePath :: ForeignSrcLang -> GHC.Internal.Base.String -> m ()
    ... ... @@ -1728,7 +1729,7 @@ module Language.Haskell.TH.Syntax where
    1728 1729 
         qExtsEnabled :: m [Extension]
    1729 1730 
         qPutDoc :: DocLoc -> GHC.Internal.Base.String -> m ()
    1730 1731 
         qGetDoc :: DocLoc -> m (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String)
    1731 
    -    {-# 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 #-}
    1732 
    +    {-# 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 #-}
    1732 1733 
       type Quote :: (* -> *) -> Constraint
    1733 1734 
       class GHC.Internal.Base.Monad m => Quote m where
    1734 1735 
         newName :: GHC.Internal.Base.String -> m Name
    ... ... @@ -1781,6 +1782,7 @@ module Language.Haskell.TH.Syntax where
    1781 1782 
       type VarStrictType :: *
    1782 1783 
       type VarStrictType = VarBangType
    1783 1784 
       addCorePlugin :: GHC.Internal.Base.String -> Q ()
    1785 
    +  addDependentDirectory :: GHC.Internal.IO.FilePath -> Q ()
    1784 1786 
       addDependentFile :: GHC.Internal.IO.FilePath -> Q ()
    1785 1787 
       addForeignFile :: ForeignSrcLang -> GHC.Internal.Base.String -> Q ()
    1786 1788 
       addForeignFilePath :: ForeignSrcLang -> GHC.Internal.IO.FilePath -> Q ()

  • testsuite/tests/th/Makefile
    ... ... @@ -43,6 +43,46 @@ 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 TRIGGER_RECOMP
    49 
    +	rm -rf DONT_TRIGGER_RECOMP
    50 
    +	$(RM) TH_Depends_Dir TH_Depends_Dir.exe
    51 
    +	$(RM) TH_Depends_Dir.o TH_Depends_Dir.hi
    52 
    +	$(RM) TH_Depends_Dir_External.o TH_Depends_Dir_External.hi
    53 
    +
    54 
    +	mkdir TRIGGER_RECOMP
    55 
    +	mkdir DONT_TRIGGER_RECOMP
    56 
    +
    57 
    +# First build with an empty dependent directory
    58 
    +	'$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) --make -package directory -package template-haskell -v0 TH_Depends_Dir
    59 
    +	./TH_Depends_Dir
    60 
    +
    61 
    +# Create a file in the dependent directory to trigger recompilation
    62 
    +	sleep 2
    63 
    +	echo "dummy" > TRIGGER_RECOMP/dummy.txt
    64 
    +	'$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) --make -package directory -package template-haskell -v0 TH_Depends_Dir
    65 
    +	./TH_Depends_Dir
    66 
    +
    67 
    +# Remove the file to check that recompilation is triggered
    68 
    +	sleep 2
    69 
    +	$(RM) TRIGGER_RECOMP/dummy.txt
    70 
    +	'$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) --make -package directory -package template-haskell -v0 TH_Depends_Dir
    71 
    +	./TH_Depends_Dir
    72 
    +
    73 
    +# Should not trigger recompilation
    74 
    +	sleep 2
    75 
    +	echo "dummy" > DONT_TRIGGER_RECOMP/dummy.txt
    76 
    +	'$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) --make -package directory -package template-haskell -v0 TH_Depends_Dir
    77 
    +	./TH_Depends_Dir
    78 
    +
    79 
    +# Should trigger a recompilation. Note that we should also see the change
    80 
    +# in the non-dependent directory now, since it is still rechecked as long
    81 
    +# as we recompile, it just doesn't *trigger* a recompilation.
    82 
    +	sleep 2
    83 
    +	rm -rf TRIGGER_RECOMP
    84 
    +	'$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) --make -package directory -package template-haskell -v0 TH_Depends_Dir
    85 
    +	./TH_Depends_Dir
    46 86
    47 87 
     T8333:
    48 88 
     	'$(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 = do
    10 
    +  print $checkDirectoryContent

  • testsuite/tests/th/TH_Depends_Dir.stdout
    1 
    +"dependent directory is empty, non-dependent directory is empty."
    2 
    +"dependent directory is non-empty, non-dependent directory is empty."
    3 
    +"dependent directory is empty, non-dependent directory is empty."
    4 
    +"dependent directory is empty, non-dependent directory is empty."
    5 
    +"dependent directory does not exist, non-dependent directory is non-empty."

  • 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, doesDirectoryExist)
    7 
    +
    8 
    +-- | This function checks the contents of a dependent directory and a non-dependent directory.
    9 
    +-- So its value will change if the contents of the dependent directory change.
    10 
    +-- It will not change if the contents of the non-dependent directory change.
    11 
    +checkDirectoryContent :: Q Exp
    12 
    +checkDirectoryContent = do
    13 
    +  let dependentDir = "TRIGGER_RECOMP"
    14 
    +  let nonDependentDir = "DONT_TRIGGER_RECOMP"
    15 
    +
    16 
    +  -- this will error when dependentDir does not exist
    17 
    +  -- which is the last thing we test for in the Makefile
    18 
    +  exists <- qRunIO $ doesDirectoryExist dependentDir
    19 
    +  dep_str <- if exists
    20 
    +    then do
    21 
    +      qAddDependentDirectory dependentDir
    22 
    +      l <- qRunIO $ listDirectory dependentDir
    23 
    +      case l of
    24 
    +        [] -> pure "dependent directory is empty"
    25 
    +        _  -> pure "dependent directory is non-empty"
    26 
    +    else do
    27 
    +      -- note that once we are here we no longer depend on the directory
    28 
    +      -- so no more recompilation will happen.
    29 
    +      pure "dependent directory does not exist"
    30 
    +
    31 
    +  -- Now the part that shouldn't trigger recompilation.
    32 
    +  -- This is somewhat of a sanity check, if we change nonDependentDir
    33 
    +  -- and it triggers recompilation, then something must be wrong
    34 
    +  -- with the recompilation logic.
    35 
    +  non_deps <- qRunIO $ listDirectory nonDependentDir
    36 
    +  non_dep_str <- case non_deps of
    37 
    +    [] -> pure "non-dependent directory is empty."
    38 
    +    _  -> pure "non-dependent directory is non-empty."
    39 
    +
    40 
    +  -- Return the result as a string expression
    41 
    +  stringE $ dep_str ++ ", " ++ non_dep_str

  • 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']), js_skip], 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