[Git][ghc/ghc][wip/T22096] Make ghcDebugAssertions into a Stage predicate (Stage -> Bool)

[Matthew Pickering (@mpickering)]

Matthew Pickering pushed to branch wip/T22096 at Glasgow Haskell Compiler / GHC


Commits:
e210b504 by Matthew Pickering at 2022-08-31T11:01:59+01:00
Make ghcDebugAssertions into a Stage predicate (Stage -> Bool)

We also care whether we have debug assertions enabled for a stage one
compiler, but the way which we turned on the assertions was quite
different from the stage2 compiler. This makes the logic for turning on
consistent across both and has the advantage of being able to correct
determine in in-tree args whether a flavour enables assertions or not.

Ticket #22096

- - - - -


7 changed files:

- hadrian/src/Flavour.hs
- hadrian/src/Flavour/Type.hs
- hadrian/src/Settings/Builders/RunTest.hs
- hadrian/src/Settings/Default.hs
- hadrian/src/Settings/Flavours/Development.hs
- hadrian/src/Settings/Flavours/Validate.hs
- hadrian/src/Settings/Packages.hs


Changes:

=====================================
hadrian/src/Flavour.hs
=====================================
@@ -241,7 +241,10 @@ enableLateCCS = addArgs
 
 -- | Enable assertions for the stage2 compiler
 enableAssertions :: Flavour -> Flavour
-enableAssertions flav = flav { ghcDebugAssertions = True }
+enableAssertions flav = flav { ghcDebugAssertions = f }
+  where
+    f Stage2 = True
+    f st = ghcDebugAssertions flav st
 
 -- | Produce fully statically-linked executables and build libraries suitable
 -- for static linking.


=====================================
hadrian/src/Flavour/Type.hs
=====================================
@@ -35,7 +35,7 @@ data Flavour = Flavour {
     -- | Build GHC with the debug RTS.
     ghcDebugged :: Stage -> Bool,
     -- | Build GHC with debug assertions.
-    ghcDebugAssertions :: Bool,
+    ghcDebugAssertions :: Stage -> Bool,
     -- | Build the GHC executable against the threaded runtime system.
     ghcThreaded :: Stage -> Bool,
     -- | Whether to build docs and which ones


=====================================
hadrian/src/Settings/Builders/RunTest.hs
=====================================
@@ -100,9 +100,7 @@ inTreeCompilerArgs stg = do
     withInterpreter     <- ghcWithInterpreter
     unregisterised      <- flag GhcUnregisterised
     withSMP             <- targetSupportsSMP
-    debugAssertions     <- if stg >= Stage2
-                            then ghcDebugAssertions <$> flavour
-                            else return False
+    debugAssertions     <- ($ stg) . ghcDebugAssertions <$> flavour
     profiled            <- ghcProfiled        <$> flavour <*> pure stg
 
     os          <- setting HostOs


=====================================
hadrian/src/Settings/Default.hs
=====================================
@@ -240,7 +240,7 @@ defaultFlavour = Flavour
     , ghcProfiled        = const False
     , ghcDebugged        = const False
     , ghcThreaded        = const True
-    , ghcDebugAssertions = False
+    , ghcDebugAssertions = const False
     , ghcDocs            = cmdDocsArgs }
 
 -- | Default logic for determining whether to build


=====================================
hadrian/src/Settings/Flavours/Development.hs
=====================================
@@ -15,7 +15,7 @@ developmentFlavour ghcStage = defaultFlavour
     , libraryWays = pure $ Set.fromList [vanilla]
     , rtsWays = pure $ Set.fromList [vanilla, debug, threaded, threadedDebug]
     , dynamicGhcPrograms = return False
-    , ghcDebugAssertions = True }
+    , ghcDebugAssertions = (>= Stage2) }
     where
       stageString Stage2 = "2"
       stageString Stage1 = "1"


=====================================
hadrian/src/Settings/Flavours/Validate.hs
=====================================
@@ -23,6 +23,7 @@ validateFlavour = enableLinting $ werror $ defaultFlavour
                             [ dynamic, threadedDynamic, debugDynamic, threadedDebugDynamic
                             ]
                         ]
+    , ghcDebugAssertions = (<= Stage1)
     }
 
 validateArgs :: Args
@@ -33,15 +34,16 @@ validateArgs = sourceArgs SourceArgs
                            , notStage0 ? arg "-dno-debug-output"
                            ]
     , hsLibrary  = pure ["-O"]
-    , hsCompiler = mconcat [ stage0 ? pure ["-O2", "-DDEBUG"]
+    , hsCompiler = mconcat [ stage0 ? pure ["-O2"]
                            , notStage0 ? pure ["-O" ]
                            ]
     , hsGhc      = pure ["-O"] }
 
+
 slowValidateFlavour :: Flavour
 slowValidateFlavour = validateFlavour
     { name = "slow-validate"
-    , ghcDebugAssertions = True
+    , ghcDebugAssertions = const True
     }
 
 quickValidateArgs :: Args


=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -52,7 +52,7 @@ packageArgs = do
           [ builder Alex ? arg "--latin1"
 
           , builder (Ghc CompileHs) ? mconcat
-            [ debugAssertions ? notStage0 ? arg "-DDEBUG"
+            [ debugAssertions stage ?  arg "-DDEBUG"
 
             , inputs ["**/GHC.hs", "**/GHC/Driver/Make.hs"] ? arg "-fprof-auto"
             , input "**/Parser.hs" ?
@@ -83,7 +83,7 @@ packageArgs = do
         , package ghc ? mconcat
           [ builder Ghc ? mconcat
              [ arg ("-I" ++ compilerPath)
-             , debugAssertions ? notStage0 ? arg "-DDEBUG" ]
+             , debugAssertions stage ? arg "-DDEBUG" ]
 
           , builder (Cabal Flags) ? mconcat
             [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter"



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e210b504a10813407be6d551da3c78c893e8b68c

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e210b504a10813407be6d551da3c78c893e8b68c
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/20220831/776533c4/attachment-0001.html>