Simon Hengel pushed to branch wip/sol/dont-use-global-variables at Glasgow Haskell Compiler / GHC

Commits:

4 changed files:

Changes:

  • clean.sh
    1
    +#!/usr/bin/env bash
    
    2
    +
    
    3
    +set -o nounset
    
    4
    +set -o errexit
    
    5
    +
    
    6
    +dst=$(git describe --tags | sed s/-release//)
    
    7
    +
    
    8
    +rm -rf "$dst" "$dst.tar.gz"
    
    9
    +
    
    10
    +mkdir -p "$dst"
    
    11
    +find _build/stage1/ -name '*.hie' -print0 | xargs -0 cp --parents -t "$dst"
    
    12
    +
    
    13
    +rm -r "$dst/_build/stage1/utils/"
    
    14
    +rm -r "$dst/_build/stage1/ghc/"
    
    15
    +
    
    16
    +mv "$dst/_build/stage1/compiler/build" "$dst/ghc"
    
    17
    +
    
    18
    +find "$dst/_build/" -type d -name build | while read -r dir
    
    19
    +do
    
    20
    +  pkg=$(basename "$(dirname "$dir")")
    
    21
    +  mv "$dir" "$dst/$pkg"
    
    22
    +done
    
    23
    +
    
    24
    +rm -r "$dst/_build/"
    
    25
    +
    
    26
    +tar -czvf "$dst.tar.gz" "$dst"
    
    27
    +
    
    28
    +rm -rf "$dst"

  • compiler/GHC/Driver/DynFlags.hs
    ... ... @@ -545,6 +545,7 @@ initDynFlags dflags = do
    545 545
                              `catchIOError` \_ -> return False
    
    546 546
      ghcNoUnicodeEnv <- lookupEnv "GHC_NO_UNICODE"
    
    547 547
      let useUnicode' = isNothing ghcNoUnicodeEnv && canUseUnicode
    
    548
    + canUseColor <- stderrSupportsAnsiColors
    
    548 549
      maybeGhcColorsEnv  <- lookupEnv "GHC_COLORS"
    
    549 550
      maybeGhcColoursEnv <- lookupEnv "GHC_COLOURS"
    
    550 551
      let adjustCols (Just env) = Col.parseScheme env
    
    ... ... @@ -556,9 +557,9 @@ initDynFlags dflags = do
    556 557
      return dflags{
    
    557 558
             useUnicode    = useUnicode',
    
    558 559
             useColor      = useColor',
    
    559
    -        canUseColor   = stderrSupportsAnsiColors,
    
    560
    +        canUseColor   = canUseColor,
    
    560 561
             -- if the terminal supports color, we assume it supports links as well
    
    561
    -        canUseErrorLinks = stderrSupportsAnsiColors,
    
    562
    +        canUseErrorLinks = canUseColor,
    
    562 563
             colScheme     = colScheme',
    
    563 564
             tmpDir        = TempDir tmp_dir
    
    564 565
             }
    

  • compiler/GHC/SysTools/Terminal.hs
    ... ... @@ -14,17 +14,9 @@ import qualified Graphics.Win32 as Win32
    14 14
     import qualified System.Win32 as Win32
    
    15 15
     #endif
    
    16 16
     
    
    17
    -import System.IO.Unsafe
    
    18
    -
    
    19
    --- | Does the controlling terminal support ANSI color sequences?
    
    20
    --- This memoized to avoid thread-safety issues in ncurses (see #17922).
    
    21
    -stderrSupportsAnsiColors :: Bool
    
    22
    -stderrSupportsAnsiColors = unsafePerformIO stderrSupportsAnsiColors'
    
    23
    -{-# NOINLINE stderrSupportsAnsiColors #-}
    
    24
    -
    
    25 17
     -- | Check if ANSI escape sequences can be used to control color in stderr.
    
    26
    -stderrSupportsAnsiColors' :: IO Bool
    
    27
    -stderrSupportsAnsiColors' = do
    
    18
    +stderrSupportsAnsiColors :: IO Bool
    
    19
    +stderrSupportsAnsiColors = do
    
    28 20
     #if !defined(mingw32_HOST_OS)
    
    29 21
       -- Equivalent of https://hackage.haskell.org/package/ansi-terminal/docs/System-Console-ANSI.html#v:hSupportsANSI
    
    30 22
       isTerminal <- hIsTerminalDevice stderr
    

  • libraries/ghc-internal/src/GHC/Internal/IO/Handle/Internals.hs
    ... ... @@ -143,8 +143,8 @@ original handle is always replaced.
    143 143
     
    
    144 144
     {-# INLINE withHandle #-}
    
    145 145
     withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
    
    146
    -withHandle fun h@(FileHandle _ m)     act = withHandle' fun h m act
    
    147
    -withHandle fun h@(DuplexHandle _ m _) act = withHandle' fun h m act
    
    146
    +withHandle fun h@(FileHandle _ m)     = withHandle' fun h m
    
    147
    +withHandle fun h@(DuplexHandle _ m _) = withHandle' fun h m
    
    148 148
     
    
    149 149
     withHandle' :: String -> Handle -> MVar Handle__
    
    150 150
        -> (Handle__ -> IO (Handle__,a)) -> IO a
    
    ... ... @@ -157,8 +157,8 @@ withHandle' fun h m act =
    157 157
     
    
    158 158
     {-# INLINE withHandle_ #-}
    
    159 159
     withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
    
    160
    -withHandle_ fun h@(FileHandle _ m)     act = withHandle_' fun h m act
    
    161
    -withHandle_ fun h@(DuplexHandle _ m _) act = withHandle_' fun h m act
    
    160
    +withHandle_ fun h@(FileHandle _ m)     = withHandle_' fun h m
    
    161
    +withHandle_ fun h@(DuplexHandle _ m _) = withHandle_' fun h m
    
    162 162
     
    
    163 163
     withHandle_' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
    
    164 164
     withHandle_' fun h m act = withHandle' fun h m $ \h_ -> do