[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: simplifier: Fix space leak during demand analysis
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Sep 3 12:14:50 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
3a5bebf8 by Matthew Pickering at 2024-08-28T14:16:42-04:00
simplifier: Fix space leak during demand analysis
The lazy structure (a list) in a strict field in `DmdType` is not fully
forced which leads to a very large thunk build-up.
It seems there is likely still more work to be done here as it seems we
may be trading space usage for work done. For now, this is the right
choice as rather than using all the memory on my computer, compilation
just takes a little bit longer.
See #25196
- - - - -
c2525e9e by Ryan Scott at 2024-08-28T14:17:17-04:00
Add missing parenthesizeHsType in cvtp's InvisP case
We need to ensure that when we convert an `InvisP` (invisible type pattern) to
a `Pat`, we parenthesize it (at precedence `appPrec`) so that patterns such as
`@(a :: k)` will parse correctly when roundtripped back through the parser.
Fixes #25209.
- - - - -
1499764f by Sjoerd Visscher at 2024-08-29T16:52:56+02:00
Haddock: Add no-compilation flag
This flag makes sure to avoid recompilation of the code when generating documentation by only reading the .hi and .hie files, and throw an error if it can't find them.
- - - - -
6f239537 by Andreas Klebinger at 2024-09-03T08:14:22-04:00
Add functions to check for weakly pinned arrays.
This commit adds `isByteArrayWeaklyPinned#` and `isMutableByteArrayWeaklyPinned#` primops.
These check if a bytearray is *weakly* pinned. Which means it can still be explicitly moved
by the user via compaction but won't be moved by the RTS.
This moves us one more stop closer to nailing down #22255.
- - - - -
3ad9ee55 by Arsen Arsenović at 2024-09-03T08:14:29-04:00
ghc-toolchain: Don't leave stranded a.outs when testing for -g0
This happened because, when ghc-toolchain tests for -g0, it does so by
compiling an empty program. This compilation creates an a.out.
Since we create a temporary directory, lets place the test program
compilation in it also, so that it gets cleaned up.
Fixes: 25b0b40467d0a12601497117c0ad14e1fcab0b74
Closes: https://gitlab.haskell.org/ghc/ghc/-/issues/25203
- - - - -
86761127 by Torsten Schmits at 2024-09-03T08:14:29-04:00
Build foreign objects for TH with interpreter's way when loading from iface
Fixes #25211
When linking bytecode for TH from interface core bindings with
`-fprefer-byte-code`, foreign sources are loaded from the interface as
well and compiled to object code in an ad-hoc manner.
The results are then loaded by the interpreter, whose way may differ
from the current build's target way.
This patch ensures that foreign objects are compiled with the
interpreter's way.
- - - - -
29 changed files:
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/Driver/Main.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToJS/Prim.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/Demand.hs
- compiler/GHC/Unit/Module/WholeCoreBindings.hs
- docs/users_guide/9.12.1-notes.rst
- docs/users_guide/exts/ffi.rst
- libraries/base/src/GHC/Base.hs
- libraries/base/src/GHC/Exts.hs
- libraries/ghc-prim/changelog.md
- rts/PrimOps.cmm
- rts/RtsSymbols.c
- rts/include/stg/MiscClosures.h
- testsuite/tests/rts/T13894.hs
- + testsuite/tests/th/T25209.hs
- + testsuite/tests/th/T25209.stderr
- testsuite/tests/th/all.T
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs
- utils/haddock/.gitignore
- utils/haddock/CHANGES.md
- utils/haddock/doc/invoking.rst
- utils/haddock/haddock-api/src/Haddock.hs
- utils/haddock/haddock-api/src/Haddock/Interface.hs
- utils/haddock/haddock-api/src/Haddock/Options.hs
- utils/haddock/haddock-test/src/Test/Haddock.hs
- utils/haddock/haddock-test/src/Test/Haddock/Config.hs
- utils/haddock/latex-test/Main.hs
Changes:
=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -1925,7 +1925,25 @@ primop MutableByteArrayIsPinnedOp "isMutableByteArrayPinned#" GenPrimOp
primop ByteArrayIsPinnedOp "isByteArrayPinned#" GenPrimOp
ByteArray# -> Int#
- {Determine whether a 'ByteArray#' is guaranteed not to move during GC.}
+ {Determine whether a 'ByteArray#' is guaranteed not to move.}
+ with out_of_line = True
+
+primop ByteArrayIsWeaklyPinnedOp "isByteArrayWeaklyPinned#" GenPrimOp
+ ByteArray# -> Int#
+ {Similar to 'isByteArrayPinned#'. Weakly pinned byte arrays are allowed
+ to be copied into compact regions by the user, potentially invalidating
+ the results of earlier calls to 'byteArrayContents#'.
+
+ See the section `Pinned Byte Arrays` in the user guide for more information.
+
+ This function also returns true for regular pinned bytearrays.
+ }
+ with out_of_line = True
+
+primop MutableByteArrayIsWeaklyPinnedOp "isMutableByteArrayWeaklyPinned#" GenPrimOp
+ MutableByteArray# s -> Int#
+ { 'isByteArrayWeaklyPinned#' but for mutable arrays.
+ }
with out_of_line = True
primop ByteArrayContents_Char "byteArrayContents#" GenPrimOp
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -1,5 +1,4 @@
{-# LANGUAGE LambdaCase #-}
-
{-# LANGUAGE NondecreasingIndentation #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiWayIf #-}
@@ -295,13 +294,13 @@ import Data.Time
import System.IO.Unsafe ( unsafeInterleaveIO )
import GHC.Iface.Env ( trace_if )
+import GHC.Platform.Ways
import GHC.Stg.InferTags.TagSig (seqTagSig)
import GHC.StgToCmm.Utils (IPEStats)
import GHC.Types.Unique.FM
import GHC.Types.Unique.DFM
import GHC.Cmm.Config (CmmConfig)
-
{- **********************************************************************
%* *
Initialisation
@@ -990,6 +989,27 @@ initModDetails hsc_env iface =
-- in make mode, since this HMI will go into the HPT.
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
+-- those are object code built outside of the pipeline, which means they aren't
+-- subject to the mechanism in 'enableCodeGenWhen' that requests dynamic build
+-- outputs for dependencies when the interpreter used for TH is dynamic but the
+-- main outputs aren't.
+-- Furthermore, the HPT only stores one set of objects with different names for
+-- bytecode linking in 'HomeModLinkable', so the usual hack for switching
+-- between ways in 'get_link_deps' doesn't work.
+compile_for_interpreter :: HscEnv -> (HscEnv -> IO a) -> IO a
+compile_for_interpreter hsc_env use =
+ use (hscUpdateFlags update hsc_env)
+ where
+ update dflags = dflags {
+ targetWays_ = adapt_way interpreterDynamic WayDyn $
+ adapt_way interpreterProfiled WayProf $
+ targetWays_ dflags
+ }
+
+ adapt_way want = if want (hscInterp hsc_env) then addWay else removeWay
+
-- | 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.
--
@@ -2063,9 +2083,10 @@ generateByteCode :: HscEnv
-> IO (CompiledByteCode, [FilePath])
generateByteCode hsc_env cgguts mod_location = do
(hasStub, comp_bc) <- hscInteractive hsc_env cgguts mod_location
- stub_o <- traverse (compileForeign hsc_env LangC) hasStub
- foreign_files_o <- traverse (uncurry (compileForeign hsc_env)) (cgi_foreign_files cgguts)
- pure (comp_bc, maybeToList stub_o ++ foreign_files_o)
+ compile_for_interpreter hsc_env $ \ i_env -> do
+ stub_o <- traverse (compileForeign i_env LangC) hasStub
+ foreign_files_o <- traverse (uncurry (compileForeign i_env)) (cgi_foreign_files cgguts)
+ pure (comp_bc, maybeToList stub_o ++ foreign_files_o)
generateFreshByteCode :: HscEnv
-> ModuleName
=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -1668,10 +1668,12 @@ emitPrimOp cfg primop =
NewPinnedByteArrayOp_Char -> alwaysExternal
NewAlignedPinnedByteArrayOp_Char -> alwaysExternal
MutableByteArrayIsPinnedOp -> alwaysExternal
+ MutableByteArrayIsWeaklyPinnedOp -> alwaysExternal
DoubleDecode_2IntOp -> alwaysExternal
DoubleDecode_Int64Op -> alwaysExternal
FloatDecode_IntOp -> alwaysExternal
ByteArrayIsPinnedOp -> alwaysExternal
+ ByteArrayIsWeaklyPinnedOp -> alwaysExternal
ShrinkMutableByteArrayOp_Char -> alwaysExternal
ResizeMutableByteArrayOp_Char -> alwaysExternal
ShrinkSmallMutableArrayOp_Char -> alwaysExternal
=====================================
compiler/GHC/StgToJS/Prim.hs
=====================================
@@ -670,6 +670,8 @@ genPrim prof bound ty op = case op of
NewAlignedPinnedByteArrayOp_Char -> \[r] [l,_align] -> pure $ PrimInline (newByteArray r l)
MutableByteArrayIsPinnedOp -> \[r] [_] -> pure $ PrimInline $ r |= one_
ByteArrayIsPinnedOp -> \[r] [_] -> pure $ PrimInline $ r |= one_
+ ByteArrayIsWeaklyPinnedOp -> \[r] [_] -> pure $ PrimInline $ r |= one_
+ MutableByteArrayIsWeaklyPinnedOp -> \[r] [_] -> pure $ PrimInline $ r |= one_
ByteArrayContents_Char -> \[a,o] [b] -> pure $ PrimInline $ mconcat [a |= b, o |= zero_]
MutableByteArrayContents_Char -> \[a,o] [b] -> pure $ PrimInline $ mconcat [a |= b, o |= zero_]
ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> pure $ PrimInline $ appS hdShrinkMutableByteArrayStr [a,n]
=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -1519,7 +1519,7 @@ cvtp (ViewP e p) = do { e' <- cvtl e; p' <- cvtPat p
; wrapParLA gParPat $ ViewPat noAnn e' p'}
cvtp (TypeP t) = do { t' <- cvtType t
; return $ EmbTyPat noAnn (mkHsTyPat t') }
-cvtp (InvisP t) = do { t' <- cvtType t
+cvtp (InvisP t) = do { t' <- parenthesizeHsType appPrec <$> cvtType t
; pure (InvisPat noAnn (mkHsTyPat t'))}
cvtp (OrP ps) = do { ps' <- cvtPats ps
; pure (OrPat noExtField ps')}
=====================================
compiler/GHC/Types/Demand.hs
=====================================
@@ -1913,7 +1913,7 @@ multDmdType :: Card -> DmdType -> DmdType
multDmdType n (DmdType fv args)
= -- pprTrace "multDmdType" (ppr n $$ ppr fv $$ ppr (multDmdEnv n fv)) $
DmdType (multDmdEnv n fv)
- (map (multDmd n) args)
+ (strictMap (multDmd n) args)
peelFV :: DmdType -> Var -> (DmdType, Demand)
peelFV (DmdType fv ds) id = -- pprTrace "rfv" (ppr id <+> ppr dmd $$ ppr fv)
=====================================
compiler/GHC/Unit/Module/WholeCoreBindings.hs
=====================================
@@ -190,13 +190,9 @@ Even if that wasn't an issue, they are compiled for the session's 'Way', not its
associated module's, so the dynamic variant wouldn't be available when building
only static outputs.
-For now, this doesn't have much of an impact, since we're only supporting
-foreign imports initially, which produce very simple objects that can easily be
-handled by the linker when 'GHC.Linker.Loader.dynLoadObjs' creates a shared
-library from all object file inputs.
-However, for more complex circumstances, we should compile foreign stubs
-specially for TH according to the interpreter 'Way', or request dynamic products
-for TH dependencies like it happens for the conventional case.
+To mitigate this, we instead build foreign objects specially for the
+interpreter, updating the build flags in 'compile_for_interpreter' to use the
+interpreter's way.
Problem 4:
=====================================
docs/users_guide/9.12.1-notes.rst
=====================================
@@ -163,6 +163,12 @@ Runtime system
~~~~~~~~~~~~~~~~~~~~
- Usage of deprecated primops is now correctly reported (#19629).
+- New primops `isMutableByteArrayWeaklyPinned#` and `isByteArrayWeaklyPinned#`
+ to allow users to avoid copying large arrays safely when dealing with ffi.
+ See the users guide for more details on the different kinds of
+ pinned arrays in 9.12.
+
+ This need for this distinction originally surfaced in https://gitlab.haskell.org/ghc/ghc/-/issues/22255
``ghc`` library
=====================================
docs/users_guide/exts/ffi.rst
=====================================
@@ -1114,21 +1114,67 @@ Pinned Byte Arrays
A pinned byte array is one that the garbage collector is not allowed
to move. Consequently, it has a stable address that can be safely
-requested with ``byteArrayContents#``. Not that being pinned doesn't
-prevent the byteArray from being gc'ed in the same fashion a regular
-byte array would be.
+requested with ``byteArrayContents#``. As long as the array remains live
+the address returned by ``byteArrayContents#`` will remain valid. Note that
+being pinned doesn't prevent the byteArray from being gc'ed in the same fashion
+a regular byte array would be if there are no more references to the ``ByteArray#``.
There are a handful of primitive functions in :base-ref:`GHC.Exts.`
used to enforce or check for pinnedness: ``isByteArrayPinned#``,
-``isMutableByteArrayPinned#``, and ``newPinnedByteArray#``. A
-byte array can be pinned as a result of three possible causes:
+``isMutableByteArrayPinned#``, ``isByteArrayWeaklyPinned#``,
+``isMutableByteArrayWeaklyPinned#``, and ``newPinnedByteArray#``. A
+byte array can be pinned or weakly pinned as a result of three possible causes:
-1. It was allocated by ``newPinnedByteArray#``.
-2. It is large. Currently, GHC defines large object to be one
+1. It was allocated by ``newPinnedByteArray#``. This results in a regular pinned byte array.
+2. It is large, this results in a weakly pinned byte array. Currently, GHC defines large object to be one
that is at least as large as 80% of a 4KB block (i.e. at
least 3277 bytes).
-3. It has been copied into a compact region. The documentation
+3. It has been copied into a compact region, resulting in a weakly pinned array. The documentation
for ``ghc-compact`` and ``compact`` describes this process.
+The difference between a pinned array and a weakly pinned array is simply that
+trying to compact a pinned array will result in an exception. Trying to compact
+a weakly pinned array will succeed. However the result of earlier
+calls to ``byteArrayContents#`` is not updated during compaction, which means
+these results will still point to the address where the array was located originally,
+and not to the new address inside the compact region.
+
+This is particularly dangerous when an address to a byte arrays content is stored
+inside a datastructure along with a reference to the byte array.
+If the data structure is compacted later on the pointer won't be updated but the
+reference to the byte array will point to a copy inside the compact region.
+A common data type susceptible to this is `ForeignPtr` when used to represent a ByteArray#.
+
+Here is an example to illustrate this:
+
+.. code-block:: haskell
+
+ workWithArrayContents :: (ByteArray, Ptr Word8) -> (Ptr Word8 -> IO ()) -> IO ()
+ workWithArrayContents (arr@(ByteArray uarr),ptr) worker =
+ case () of
+ _
+ -- Conservative but safe
+ | isByteArrayPinned arr -> keepAliveUnlifted uarr (worker ptr)
+ -- Potentially dangerous, the program needs to ensures the Ptr points into the array.
+ | isByteArrayWeaklyPinned arr -> keepAliveUnlifted uarr (worker ptr)
+ | otherwise -> ... -- Otherwise we can't directly use it for safe FFI calls directly at all.
+
+ main :: IO ()
+ main = do
+ -- We create a large array, which causes it to be implicitly pinned
+ arr <- newByteArray 5000
+ arr@(ByteArray uarr) <- freezeByteArray arr 0 5000 -- Make it immutable
+ let ptr = byteArrayContents arr
+
+ -- Compacting a data structure that contains both an array and a ptr to
+ -- the arrays content's is dangerous and usually the wrong thing to do.
+ let foo = (arr, ptr)
+ foo_compacted <- compact foo
+
+ -- This is fine
+ workWithArrayContents foo do_work
+ -- This is unsound
+ workWithArrayContents (getCompact foo_compacted) do_work
+
.. [1] Prior to GHC 8.10, when passing an ``ArrayArray#`` argument
to a foreign function, the foreign function would see a pointer
to the ``StgMutArrPtrs`` rather than just the payload.
=====================================
libraries/base/src/GHC/Base.hs
=====================================
@@ -139,7 +139,8 @@ module GHC.Base
) where
import GHC.Internal.Base
-import GHC.Prim hiding (dataToTagLarge#, dataToTagSmall#, whereFrom#)
+import GHC.Prim hiding (dataToTagLarge#, dataToTagSmall#, whereFrom#,
+ isByteArrayWeaklyPinned#, isMutableByteArrayWeaklyPinned#)
-- Hide dataToTagLarge# because it is expected to break for
-- GHC-internal reasons in the near future, and shouldn't
-- be exposed from base (not even GHC.Exts)
=====================================
libraries/base/src/GHC/Exts.hs
=====================================
@@ -112,7 +112,9 @@ module GHC.Exts
import GHC.Internal.Exts
import GHC.Internal.ArrayArray
-import GHC.Prim hiding ( coerce, dataToTagSmall#, dataToTagLarge#, whereFrom# )
+import GHC.Prim hiding (
+ coerce, dataToTagSmall#, dataToTagLarge#, whereFrom#,
+ isByteArrayWeaklyPinned#, isMutableByteArrayWeaklyPinned# )
-- Hide dataToTag# ops because they are expected to break for
-- GHC-internal reasons in the near future, and shouldn't
-- be exposed from base (not even GHC.Exts)
=====================================
libraries/ghc-prim/changelog.md
=====================================
@@ -1,3 +1,12 @@
+## 0.13.0
+
+- Shipped with GHC 9.12.1
+
+- Add primops that allow users to distinguish weakly pinned byte arrays from unpinned ones.
+
+ isMutableByteArrayWeaklyPinned# :: MutableByteArray# s -> Int#
+ isByteArrayWeaklyPinned# :: ByteArray# s -> Int#
+
## 0.12.0
- Shipped with GHC 9.10.1
=====================================
rts/PrimOps.cmm
=====================================
@@ -215,12 +215,29 @@ stg_isByteArrayPinnedzh ( gcptr ba )
return (flags & BF_PINNED != 0);
}
+stg_isByteArrayWeaklyPinnedzh ( gcptr ba )
+// ByteArray# s -> Int#
+{
+ W_ bd, flags;
+ bd = Bdescr(ba);
+ // See #22255 and the primop docs.
+ flags = TO_W_(bdescr_flags(bd));
+
+ return (flags & (BF_PINNED | BF_COMPACT | BF_LARGE) != 0);
+}
+
stg_isMutableByteArrayPinnedzh ( gcptr mba )
// MutableByteArray# s -> Int#
{
jump stg_isByteArrayPinnedzh(mba);
}
+stg_isMutableByteArrayWeaklyPinnedzh ( gcptr mba )
+// MutableByteArray# s -> Int#
+{
+ jump stg_isByteArrayWeaklyPinnedzh(mba);
+}
+
/* Note [LDV profiling and resizing arrays]
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
* As far as the LDV profiler is concerned arrays are "inherently used" which
=====================================
rts/RtsSymbols.c
=====================================
@@ -656,6 +656,8 @@ extern char **environ;
SymI_HasDataProto(stg_newAlignedPinnedByteArrayzh) \
SymI_HasDataProto(stg_isByteArrayPinnedzh) \
SymI_HasDataProto(stg_isMutableByteArrayPinnedzh) \
+ SymI_HasDataProto(stg_isByteArrayWeaklyPinnedzh) \
+ SymI_HasDataProto(stg_isMutableByteArrayWeaklyPinnedzh) \
SymI_HasDataProto(stg_shrinkMutableByteArrayzh) \
SymI_HasDataProto(stg_resizzeMutableByteArrayzh) \
SymI_HasDataProto(stg_shrinkSmallMutableArrayzh) \
=====================================
rts/include/stg/MiscClosures.h
=====================================
@@ -454,6 +454,8 @@ RTS_FUN_DECL(stg_newPinnedByteArrayzh);
RTS_FUN_DECL(stg_newAlignedPinnedByteArrayzh);
RTS_FUN_DECL(stg_isByteArrayPinnedzh);
RTS_FUN_DECL(stg_isMutableByteArrayPinnedzh);
+RTS_FUN_DECL(stg_isByteArrayWeaklyPinnedzh);
+RTS_FUN_DECL(stg_isMutableByteArrayWeaklyPinnedzh);
RTS_FUN_DECL(stg_shrinkMutableByteArrayzh);
RTS_FUN_DECL(stg_resizzeMutableByteArrayzh);
RTS_FUN_DECL(stg_shrinkSmallMutableArrayzh);
=====================================
testsuite/tests/rts/T13894.hs
=====================================
@@ -6,6 +6,7 @@
import Control.Monad
import GHC.Exts
+import GHC.Internal.Exts (isMutableByteArrayWeaklyPinned#)
import GHC.IO
main :: IO ()
@@ -16,3 +17,10 @@ main = do
case isMutableByteArrayPinned# arr# of
n# -> (# s1, isTrue# n# #)
when pinned $ putStrLn "BAD"
+
+ weakly_pinned <- IO $ \s0 ->
+ case newByteArray# 1000000# s0 of
+ (# s1, arr# #) ->
+ case isMutableByteArrayWeaklyPinned# arr# of
+ n# -> (# s1, isTrue# n# #)
+ when (not weakly_pinned) $ putStrLn "BAD"
=====================================
testsuite/tests/th/T25209.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeAbstractions #-}
+module T25209 where
+
+import Data.Proxy
+
+$([d| f :: Proxy a -> Proxy a
+ f @(a :: k) p = p
+ |])
=====================================
testsuite/tests/th/T25209.stderr
=====================================
@@ -0,0 +1,6 @@
+T25209.hs:(7,2)-(9,7): Splicing declarations
+ [d| f :: Proxy a -> Proxy a
+ f @(a :: k) p = p |]
+ ======>
+ f :: Proxy a -> Proxy a
+ f @(a :: k) p = p
=====================================
testsuite/tests/th/all.T
=====================================
@@ -622,4 +622,5 @@ test('T24572a', normal, compile, [''])
test('T24572b', normal, compile_fail, [''])
test('T24572c', normal, compile_fail, [''])
test('T24572d', normal, compile, [''])
+test('T25209', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('TH_MultilineStrings', normal, compile_and_run, [''])
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs
=====================================
@@ -39,10 +39,10 @@ data CmmCpp = CmmCpp { cmmCppProgram :: Program
}
deriving (Show, Read, Eq, Ord)
-checkFlag :: String -> Program -> String -> M ()
-checkFlag conftest cpp flag = checking ("for "++flag++" support") $
+checkFlag :: String -> Program -> String -> [String] -> M ()
+checkFlag conftest cpp flag extra_args = checking ("for "++flag++" support") $
-- Werror to ensure that unrecognized warnings result in an error
- callProgram cpp ["-Werror", flag, conftest]
+ callProgram cpp $ ["-Werror", flag, conftest] ++ extra_args
-- tryFlag :: String -> Program -> String -> M [String]
-- tryFlag conftest cpp flag =
-- ([flag] <$ checkFlag conftest cpp flag) <|> return []
@@ -167,7 +167,7 @@ findCmmCpp progOpt cc = checking "for a Cmm preprocessor" $ do
cmmCppSupportsG0 <- withTempDir $ \dir -> do
let conftest = dir </> "conftest.c"
writeFile conftest "int main(void) {}"
- True <$ checkFlag conftest cpp "-g0" <|> return False
+ True <$ checkFlag conftest cpp "-g0" ["-o", dir </> "conftest"] <|> return False
-- Always add the -E flag to the CPP, regardless of the user options
let cmmCppProgram = foldr addFlagIfNew cpp ["-E"]
=====================================
utils/haddock/.gitignore
=====================================
@@ -11,6 +11,10 @@
/hypsrc-test/one-shot-out/
/latex-test/one-shot-out/
/hoogle-test/one-shot-out/
+/html-test/no-compilation-out/
+/hypsrc-test/no-compilation-out/
+/latex-test/no-compilation-out/
+/hoogle-test/no-compilation-out/
*.o
*.hi
=====================================
utils/haddock/CHANGES.md
=====================================
@@ -3,6 +3,10 @@
* Add incremental mode to support rendering documentation one module at a time.
+ * The flag `--no-compilation` has been added. This flag causes Haddock to avoid
+ recompilation of the code when generating documentation by only reading
+ the `.hi` and `.hie` files, and will throw an error if it can't find them.
+
* Fix large margin on top of small headings
* Include `package_info` with haddock's `--show-interface` option.
=====================================
utils/haddock/doc/invoking.rst
=====================================
@@ -542,6 +542,13 @@ The following options are available:
``cabal`` uses temporary `response files
<https://gcc.gnu.org/wiki/Response_Files>`_ to pass arguments to Haddock.
+.. option:: --no-compilation
+
+ Always :ref:`avoids recompilation<avoiding-recompilation>`, only loads the
+ required ``.hi`` and ``.hie`` files. Haddock will throw an error when it can't
+ find them. This will not check if the input files are out of date.
+ (This flag implies :option:`--no-tmp-comp-dir`.)
+
.. option:: --incremental=<module>
Use Haddock in :ref:`incremental mode<incremental-mode>`. Haddock will generate
@@ -555,6 +562,8 @@ sources are accepted without the need for the user to do anything. To
use the C pre-processor, however, the user must pass the ``-cpp``
option to GHC using :option:`--optghc`.
+.. _avoiding-recompilation:
+
Avoiding recompilation
----------------------
@@ -579,32 +588,15 @@ should write the ``.hi`` and ``.hie`` files by providing the
are building your application with ``cabal build``, the default location is in
``dist-newstyle/build/<arch>-<os>/ghc-<ghc-version>/<component>-0.1.0/build``.
-The next step is to ensure that the flags which Haddock passes to GHC will not
-trigger recompilation. Unfortunately, this is not very easy to do if you are
-invoking Haddock through ``cabal haddock``. Upon ``cabal haddock``, Cabal passes
-a ``--optghc="-optP-D__HADDOCK_VERSION__=NNNN"`` (where ``NNNN`` is the Haddock
-version number) flag to Haddock, which forwards the ``-optP=...`` flag to GHC
-and triggers a recompilation (unless the existing build results were also
-created by a ``cabal haddock``). Additionally, Cabal passes a
-``--optghc="-stubdir=<temp directory>"`` flag to Haddock, which forwards the
-``-stubdir=<temp directory>`` flag to GHC and triggers a recompilation since
-``-stubdir`` adds a global include directory. Moreover, since the ``stubdir``
-that Cabal passes is a temporary directory, a recompilation is triggered even
-for immediately successive invocations. To avoid recompilations due to these
-flags, one must manually extract the arguments passed to Haddock by Cabal and
-remove the ``--optghc="-optP-D__HADDOCK_VERSION__=NNNN"`` and
-``--optghc="-stubdir=<temp directory>"`` flags. This can be achieved using the
-:option:`--trace-args` flag by invoking ``cabal haddock`` with
-``--haddock-option="--trace-args"`` and copying the traced arguments to a script
-which makes an equivalent call to Haddock without the aformentioned flags.
-
-In addition to the above, Cabal passes a temporary directory as ``-hidir`` to
-Haddock by default. Obviously, this also triggers a recompilation for every
-invocation of ``cabal haddock``, since it will never find the necessary
+The next step is to make sure Haddock runs in no-compilation mode by using
+the :option:`--no-compilation` flag. In addition, Cabal passes a
+temporary directory as ``-hidir`` to Haddock by default. This will cause
+``cabal haddock`` to error, since it will never find the necessary
interface files in that temporary directory. To remedy this, pass a
``--optghc="-hidir=/path/to/hidir"`` flag to Haddock, where ``/path/to/hidir``
is the path to the directory in which your build process is writing ``.hi``
-files.
+files. You can do this by invoking ``cabal haddock`` with
+``--haddock-options="--no-compilation --optghc=-hidir --optghc=/path/to/hidir"``.
Following the steps above will allow you to take full advantage of "hi-haddock"
and generate Haddock documentation from existing build results without requiring
=====================================
utils/haddock/haddock-api/src/Haddock.hs
=====================================
@@ -166,14 +166,14 @@ haddockWithGhc ghc args = handleTopExceptions $ do
qual <- rightOrThrowE (qualification flags)
sinceQual <- rightOrThrowE (sinceQualification flags)
- let isOneShotMode = isJust (optOneShot flags)
+ let noCompilation = isJust (optOneShot flags) || Flag_NoCompilation `elem` flags
-- Inject dynamic-too into ghc options if the ghc we are using was built with
- -- dynamic linking (except when in one-shot mode)
+ -- dynamic linking (except when not doing any compilation)
flags'' <- ghc flags $ do
df <- getDynFlags
case lookup "GHC Dynamic" (compilerInfo df) of
- Just "YES" | not isOneShotMode -> return $ Flag_OptGhc "-dynamic-too" : flags
+ Just "YES" | not noCompilation -> return $ Flag_OptGhc "-dynamic-too" : flags
_ -> return flags
-- Inject `-j` into ghc options, if given to Haddock
@@ -191,8 +191,7 @@ haddockWithGhc ghc args = handleTopExceptions $ do
-- Output dir needs to be set before calling 'depanal' since 'depanal' uses it
-- to compute output file names that are stored in the 'DynFlags' of the
-- resulting 'ModSummary's.
- let withDir | Flag_NoTmpCompDir `elem` flags = id
- | isOneShotMode = id
+ let withDir | Flag_NoTmpCompDir `elem` flags || noCompilation = id
| otherwise = withTempOutputDir
-- Output warnings about potential misuse of some flags
=====================================
utils/haddock/haddock-api/src/Haddock/Interface.hs
=====================================
@@ -176,19 +176,21 @@ createIfaces verbosity modules flags instIfaceMap = do
dflags <- getSessionDynFlags
let dflags' = dflags { ldInputs = map (FileOption "") o_files
++ ldInputs dflags }
- _ <- setSessionDynFlags dflags'
+ dflags'' = if Flag_NoCompilation `elem` flags then dflags' { ghcMode = OneShot } else dflags'
+ _ <- setSessionDynFlags dflags''
targets <- mapM (\(filePath, _) -> guessTarget filePath Nothing Nothing) hs_srcs
setTargets targets
(_errs, modGraph) <- depanalE [] False
- liftIO $ traceMarkerIO "Load started"
- -- Create (if necessary) and load .hi-files.
- success <- withTimingM "load'" (const ()) $
- load' noIfaceCache LoadAllTargets mkUnknownDiagnostic (Just batchMsg) modGraph
- when (failed success) $ do
- out verbosity normal "load' failed"
- liftIO exitFailure
- liftIO $ traceMarkerIO "Load ended"
+ -- Create (if necessary) and load .hi-files. With --no-compilation this happens later.
+ when (Flag_NoCompilation `notElem` flags) $ do
+ liftIO $ traceMarkerIO "Load started"
+ success <- withTimingM "load'" (const ()) $
+ load' noIfaceCache LoadAllTargets mkUnknownDiagnostic (Just batchMsg) modGraph
+ when (failed success) $ do
+ out verbosity normal "load' failed"
+ liftIO exitFailure
+ liftIO $ traceMarkerIO "Load ended"
-- We topologically sort the module graph including boot files,
-- so it should be acylic (hopefully we failed much earlier if this is not the case)
@@ -260,6 +262,20 @@ dropErr :: MaybeErr e a -> Maybe a
dropErr (Succeeded a) = Just a
dropErr (Failed _) = Nothing
+loadHiFile :: HscEnv -> Outputable.SDoc -> Module -> IO (ModIface, ([ClsInst], [FamInst]))
+loadHiFile hsc_env doc theModule = initIfaceLoad hsc_env $ do
+
+ mod_iface <- loadSysInterface doc theModule
+
+ insts <- initIfaceLcl (mi_semantic_module mod_iface) doc (mi_boot mod_iface) $ do
+
+ new_eps_insts <- mapM tcIfaceInst (mi_insts mod_iface)
+ new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts mod_iface)
+
+ pure (new_eps_insts, new_eps_fam_insts)
+
+ pure (mod_iface, insts)
+
processModule :: Verbosity -> ModSummary -> [Flag] -> IfaceMap -> InstIfaceMap -> WarningMap -> Ghc (Maybe Interface)
processModule verbosity modSummary flags ifaceMap instIfaceMap warningMap = do
out verbosity verbose $ "Checking module " ++ moduleString (ms_mod modSummary) ++ "..."
@@ -267,17 +283,19 @@ processModule verbosity modSummary flags ifaceMap instIfaceMap warningMap = do
hsc_env <- getSession
dflags <- getDynFlags
let sDocContext = DynFlags.initSDocContext dflags Outputable.defaultUserStyle
- let hmi = case lookupHpt (hsc_HPT hsc_env) (moduleName $ ms_mod modSummary) of
- Nothing -> error "processModule: All modules should be loaded into the HPT by this point"
- Just x -> x
- mod_iface = hm_iface hmi
+ doc = text "processModule"
unit_state = hsc_units hsc_env
- cls_insts = instEnvElts . md_insts $ hm_details hmi
+ (mod_iface, insts) <- if Flag_NoCompilation `elem` flags
+ then liftIO $ loadHiFile hsc_env doc $ ms_mod modSummary
+ else
+ let hmi = case lookupHpt (hsc_HPT hsc_env) (moduleName $ ms_mod modSummary) of
+ Nothing -> error "processModule: All modules should be loaded into the HPT by this point"
+ Just x -> x
+ cls_insts = instEnvElts . md_insts $ hm_details hmi
+ fam_insts = md_fam_insts $ hm_details hmi
- fam_insts = md_fam_insts $ hm_details hmi
-
- insts = (cls_insts, fam_insts)
+ in pure (hm_iface hmi, (cls_insts, fam_insts))
!interface <- do
logger <- getLogger
@@ -363,18 +381,7 @@ createOneShotIface verbosity flags instIfaceMap moduleNameStr = do
modifySession $ hscSetFlags dflags
hsc_env <- getSession
- (iface, insts) <- liftIO $ initIfaceLoad hsc_env $ do
-
- iface <- loadSysInterface doc $ mkMainModule_ moduleNm
-
- insts <- initIfaceLcl (mi_semantic_module iface) doc (mi_boot iface) $ do
-
- new_eps_insts <- mapM tcIfaceInst (mi_insts iface)
- new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
-
- pure (new_eps_insts, new_eps_fam_insts)
-
- pure (iface, insts)
+ (iface, insts) <- liftIO $ loadHiFile hsc_env doc $ mkMainModule_ moduleNm
-- Update the DynFlags with the extensions from the source file (as stored in the interface file)
-- This is instead of ms_hspp_opts from ModSummary, which is not available in one-shot mode.
=====================================
utils/haddock/haddock-api/src/Haddock/Options.hs
=====================================
@@ -124,6 +124,7 @@ data Flag
| Flag_ParCount (Maybe Int)
| Flag_TraceArgs
| Flag_OneShot String
+ | Flag_NoCompilation
deriving (Eq, Show)
options :: Bool -> [OptDescr Flag]
@@ -158,6 +159,11 @@ options backwardsCompat =
["show-interface"]
(ReqArg Flag_ShowInterface "FILE")
"print the interface in a human readable form"
+ , Option
+ []
+ ["no-compilation"]
+ (NoArg Flag_NoCompilation)
+ "never compile the code, just read the .hi files"
, Option
[]
["incremental"]
=====================================
utils/haddock/haddock-test/src/Test/Haddock.hs
=====================================
@@ -10,6 +10,7 @@ module Test.Haddock
import Control.Monad
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map.Strict as Map
+import Data.Foldable (for_)
import Data.Maybe
import GHC.ResponseFile
import System.Directory
@@ -74,6 +75,7 @@ maybeDiff cfg@(Config{cfgDiffTool = (Just diff)}) files = do
runHaddock :: Config c -> IO Bool
runHaddock cfg@(Config{..}) = do
createEmptyDirectory $ cfgOutDir cfg
+ createEmptyDirectory $ cfgNoCompilationOutDir cfg
createEmptyDirectory $ cfgOneShotOutDir cfg
putStrLn "Generating documentation..."
@@ -93,41 +95,65 @@ runHaddock cfg@(Config{..}) = do
succeeded <- waitForSuccess msg stdout =<< runProcess' cfgHaddockPath pc
unless succeeded $ removeDirectoryRecursive (outDir cfgDirConfig tpkg)
- if cfgSkipOneShot then pure succeeded else do
- let oneShotDir = oneshotOutDir cfgDirConfig tpkg
- hiDir = oneShotDir </> "hi"
- hieDir = oneShotDir </> "hie"
+ let noCompilationDir = noCompilationOutDir cfgDirConfig tpkg
+ hiDir = noCompilationDir </> "hi"
+ hieDir = noCompilationDir </> "hie"
+
+ createEmptyDirectory noCompilationDir
+ createEmptyDirectory hiDir
+ createEmptyDirectory hieDir
+
+ -- Build .hi files
+ let pc =
+ processConfig
+ { pcArgs =
+ concat
+ [
+ [ "--make"
+ , "-haddock"
+ , "-fwrite-interface"
+ , "-fwrite-ide-info"
+ , "-no-keep-o-files"
+ , "-hidir=" ++ hiDir
+ , "-hiedir=" ++ hieDir
+ ]
+ , tpkgFiles tpkg
+ ]
+ , pcEnv = Just cfgEnv
+ }
+ let msg = "Failed to run GHC on test package '" ++ tpkgName tpkg ++ "'"
+ _ <- waitForSuccess msg stdout =<< runProcess' cfgGhcPath pc
+
+ -- Generate documentation with no-compilation flag
+ let pc =
+ processConfig
+ { pcArgs =
+ concat
+ [ cfgHaddockArgs
+ , [ "--odir=" ++ noCompilationDir
+ , "--optghc=-hidir=" ++ hiDir
+ , "--optghc=-hiedir=" ++ hieDir
+ , "--no-compilation"
+ ]
+ , tpkgFiles tpkg
+ ]
+ , pcEnv = Just cfgEnv
+ }
+
+ let msg = "Failed to run Haddock in no-compilation mode on test package '" ++ tpkgName tpkg ++ "'"
+ succeededNC <- waitForSuccess msg stdout =<< runProcess' cfgHaddockPath pc
+
+ -- Generate documentation incrementally
+ if cfgSkipOneShot then pure (succeeded && succeededNC) else do
+ let oneShotDir = oneShotOutDir cfgDirConfig tpkg
responseFile = hiDir </> "response-file"
createEmptyDirectory oneShotDir
- createEmptyDirectory hiDir
- createEmptyDirectory hieDir
writeFile responseFile $ escapeArgs
[ "--odir=" ++ oneShotDir
, "--optghc=-hidir=" ++ hiDir
, "--optghc=-hiedir=" ++ hieDir
]
- -- Build .hi files
- let pc' =
- processConfig
- { pcArgs =
- concat
- [
- [ "--make"
- , "-haddock"
- , "-fwrite-interface"
- , "-fwrite-ide-info"
- , "-no-keep-o-files"
- , "-hidir=" ++ hiDir
- , "-hiedir=" ++ hieDir
- ]
- , tpkgFiles tpkg
- ]
- , pcEnv = Just cfgEnv
- }
- let msg = "Failed to run GHC on test package '" ++ tpkgName tpkg ++ "'"
- _ <- waitForSuccess msg stdout =<< runProcess' cfgGhcPath pc'
-
files <- filter ((== ".hi") . takeExtension) <$> listDirectory hiDir
-- Use the output order of GHC as a simple dependency order
filesSorted <- Map.elems . Map.fromList <$> traverse (\file -> (,file) <$> getModificationTime (hiDir </> file)) files
@@ -157,37 +183,30 @@ runHaddock cfg@(Config{..}) = do
escapeArgs [ "--read-interface=" ++ srcRef ++ haddockFile ]
loop files
else pure False
- succeeded2 <- loop filesSorted
- when succeeded2 $ do
+ succeededOS <- loop filesSorted
+ when (succeededNC && succeededOS) $ do
removeDirectoryRecursive hiDir
removeDirectoryRecursive hieDir
- pure succeeded2
+ pure (succeeded && succeededNC && succeededOS)
let somethingFailed = any not successes
pure somethingFailed
checkFile :: Config c -> FilePath -> IO CheckResult
checkFile cfg file = do
- hasRef <- doesFileExist $ refFile dcfg file
- if hasRef
- then do
- mout <- readOut cfg file
- mref <- readRef cfg file
- case (mout, mref) of
- (Just out, Just ref)
- | ccfgEqual ccfg out ref ->
- if cfgSkipOneShot cfg || dcfgCheckIgnoreOneShot (cfgDirConfig cfg) file
- then return Pass
- else do
- mOneShotOut <- readOneShotOut cfg file
- return $ case mOneShotOut of
- Just oneShotOut
- | ccfgEqual ccfg oneShotOut out -> Pass
- | otherwise -> Fail
- Nothing -> Error "Failed to parse one-shot input file"
- | otherwise -> return Fail
- _ -> return $ Error "Failed to parse input files"
- else return NoRef
+ mref <- readRef cfg file
+ case mref of
+ Just ref -> do
+ let checkStep dcfgDir = ccfgEqual ccfg ref <$> readOut cfg dcfgDir file
+ result <- checkStep dcfgOutDir
+ resultNC <- if dcfgCheckIgnoreNoCompilation (cfgDirConfig cfg) file
+ then pure True
+ else checkStep dcfgNoCompilationOutDir
+ resultOS <- if cfgSkipOneShot cfg || dcfgCheckIgnoreOneShot (cfgDirConfig cfg) file
+ then pure True
+ else checkStep dcfgOneShotOutDir
+ pure $ if and [result, resultNC, resultOS] then Pass else Fail
+ Nothing -> return NoRef
where
ccfg = cfgCheckConfig cfg
dcfg = cfgDirConfig cfg
@@ -207,59 +226,50 @@ readRef cfg file =
dcfg = cfgDirConfig cfg
-- | Read (and clean) the test output artifact for a test
-readOut :: Config c -> FilePath -> IO (Maybe c)
-readOut cfg file =
- fmap (ccfgClean ccfg file) . ccfgRead ccfg . BS.unpack
- <$> BS.readFile (outFile dcfg file)
- where
- ccfg = cfgCheckConfig cfg
- dcfg = cfgDirConfig cfg
-
-readOneShotOut :: Config c -> FilePath -> IO (Maybe c)
-readOneShotOut cfg file =
- fmap (ccfgClean ccfg file) . ccfgRead ccfg . BS.unpack
- <$> BS.readFile (oneShotOutFile dcfg file)
+readOut :: Config c -> (DirConfig -> FilePath) -> FilePath -> IO c
+readOut cfg dcfgDir file = do
+ res <- fmap (ccfgClean ccfg file) . ccfgRead ccfg . BS.unpack
+ <$> BS.readFile outFile
+ case res of
+ Just out -> return out
+ Nothing -> error $ "Failed to parse output file: " ++ outFile
where
ccfg = cfgCheckConfig cfg
dcfg = cfgDirConfig cfg
+ outFile = dcfgDir dcfg </> file
diffFile :: Config c -> FilePath -> FilePath -> IO ()
diffFile cfg diff file = do
- Just out <- readOut cfg file
- Just oneShotOut <- readOneShotOut cfg file
Just ref <- readRef cfg file
- writeFile outFile' $ ccfgDump ccfg out
- writeFile oneShotOutFile' $ ccfgDump ccfg oneShotOut
- writeFile refFile' $ ccfgDump ccfg ref
-
- putStrLn $ "Diff for file \"" ++ file ++ "\":"
- hFlush stdout
- handle <-
- runProcess' diff $
- processConfig
- { pcArgs = [outFile', refFile']
- , pcStdOut = Just stdout
- }
- void $ waitForProcess handle
- handle' <-
- runProcess' diff $
- processConfig
- { pcArgs = [oneShotOutFile', outFile']
- , pcStdOut = Just stdout
- }
- void $ waitForProcess handle'
- return ()
+ out <- readOut cfg dcfgOutDir file
+ noCompilationOut <- readOut cfg dcfgNoCompilationOutDir file
+ oneShotOut <- readOut cfg dcfgOneShotOutDir file
+ writeFile (dumpFile "ref") $ ccfgDump ccfg ref
+ writeFile (dumpFile "out") $ ccfgDump ccfg out
+ writeFile (dumpFile "oneShot") $ ccfgDump ccfg oneShotOut
+ writeFile (dumpFile "noCompilation") $ ccfgDump ccfg oneShotOut
+
+ for_ ["out", "oneShot", "noCompilation"] $ \nm -> do
+ let outFile = dumpFile nm
+ refFile = dumpFile "ref"
+ putStrLn $ "Diff for file \"" ++ outFile ++ "\":"
+ hFlush stdout
+ handle <-
+ runProcess' diff $
+ processConfig
+ { pcArgs = [outFile, refFile]
+ , pcStdOut = Just stdout
+ }
+ void $ waitForProcess handle
where
dcfg = cfgDirConfig cfg
ccfg = cfgCheckConfig cfg
- outFile' = outFile dcfg file <.> "dump"
- oneShotOutFile' = oneShotOutFile dcfg file <.> "dump"
- refFile' = outFile dcfg file <.> "ref" <.> "dump"
+ dumpFile nm = dcfgOutDir dcfg </> file <.> nm <.> "dump"
maybeAcceptFile :: Config c -> FilePath -> CheckResult -> IO CheckResult
maybeAcceptFile cfg file result
| cfgAccept cfg && result `elem` [NoRef, Fail] = do
- Just out <- readOut cfg file
+ out <- readOut cfg dcfgOutDir file
let ref = refFile dcfg file
createDirectoryIfMissing True (takeDirectory ref)
writeFile ref $ ccfgDump ccfg out
@@ -272,14 +282,11 @@ maybeAcceptFile _ _ result = pure result
outDir :: DirConfig -> TestPackage -> FilePath
outDir dcfg tpkg = dcfgOutDir dcfg </> tpkgName tpkg
-oneshotOutDir :: DirConfig -> TestPackage -> FilePath
-oneshotOutDir dcfg tpkg = dcfgOneShotOutDir dcfg </> tpkgName tpkg
-
-outFile :: DirConfig -> FilePath -> FilePath
-outFile dcfg file = dcfgOutDir dcfg </> file
+oneShotOutDir :: DirConfig -> TestPackage -> FilePath
+oneShotOutDir dcfg tpkg = dcfgOneShotOutDir dcfg </> tpkgName tpkg
-oneShotOutFile :: DirConfig -> FilePath -> FilePath
-oneShotOutFile dcfg file = dcfgOneShotOutDir dcfg </> file
+noCompilationOutDir :: DirConfig -> TestPackage -> FilePath
+noCompilationOutDir dcfg tpkg = dcfgNoCompilationOutDir dcfg </> tpkgName tpkg
refFile :: DirConfig -> FilePath -> FilePath
refFile dcfg file = dcfgRefDir dcfg </> file
=====================================
utils/haddock/haddock-test/src/Test/Haddock/Config.hs
=====================================
@@ -4,7 +4,7 @@
module Test.Haddock.Config
( TestPackage(..), CheckConfig(..), DirConfig(..), Config(..)
, defaultDirConfig
- , cfgSrcDir, cfgRefDir, cfgOutDir, cfgResDir, cfgOneShotOutDir
+ , cfgSrcDir, cfgRefDir, cfgOutDir, cfgResDir, cfgOneShotOutDir, cfgNoCompilationOutDir
, parseArgs, checkOpt, loadConfig
) where
@@ -58,9 +58,11 @@ data DirConfig = DirConfig
, dcfgRefDir :: FilePath
, dcfgOutDir :: FilePath
, dcfgOneShotOutDir :: FilePath
+ , dcfgNoCompilationOutDir :: FilePath
, dcfgResDir :: FilePath
, dcfgCheckIgnore :: FilePath -> Bool
, dcfgCheckIgnoreOneShot :: FilePath -> Bool
+ , dcfgCheckIgnoreNoCompilation :: FilePath -> Bool
}
@@ -70,9 +72,11 @@ defaultDirConfig baseDir = DirConfig
, dcfgRefDir = baseDir </> "ref"
, dcfgOutDir = baseDir </> "out"
, dcfgOneShotOutDir = baseDir </> "one-shot-out"
+ , dcfgNoCompilationOutDir = baseDir </> "no-compilation-out"
, dcfgResDir = rootDir </> "resources"
, dcfgCheckIgnore = const False
, dcfgCheckIgnoreOneShot = const False
+ , dcfgCheckIgnoreNoCompilation = const False
}
where
rootDir = baseDir </> ".."
@@ -92,12 +96,13 @@ data Config c = Config
}
-cfgSrcDir, cfgRefDir, cfgOutDir, cfgResDir, cfgOneShotOutDir :: Config c -> FilePath
+cfgSrcDir, cfgRefDir, cfgOutDir, cfgResDir, cfgOneShotOutDir, cfgNoCompilationOutDir :: Config c -> FilePath
cfgSrcDir = dcfgSrcDir . cfgDirConfig
cfgRefDir = dcfgRefDir . cfgDirConfig
cfgOutDir = dcfgOutDir . cfgDirConfig
cfgResDir = dcfgResDir . cfgDirConfig
cfgOneShotOutDir = dcfgOneShotOutDir . cfgDirConfig
+cfgNoCompilationOutDir = dcfgNoCompilationOutDir . cfgDirConfig
=====================================
utils/haddock/latex-test/Main.hs
=====================================
@@ -23,6 +23,7 @@ dirConfig = (defaultDirConfig $ takeDirectory __FILE__)
{ dcfgCheckIgnore = (`elem` ["haddock.sty", "main.tex"]) . takeFileName
-- Just a discrepancy in output order
, dcfgCheckIgnoreOneShot = (`elem` ["ConstructorArgs.tex"]) . takeFileName
+ , dcfgCheckIgnoreNoCompilation = (`elem` ["ConstructorArgs.tex"]) . takeFileName
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9c0ddce1eab8e4bbb8117328911cac63ae67a9ba...867611279614f3fd44f90c92404a7a08b7a0d0a0
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9c0ddce1eab8e4bbb8117328911cac63ae67a9ba...867611279614f3fd44f90c92404a7a08b7a0d0a0
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240903/f3ba2c40/attachment-0001.html>
More information about the ghc-commits
mailing list