Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC

Commits:

6 changed files:

Changes:

  • cabal.project-reinstall
    ... ... @@ -59,6 +59,7 @@ constraints: ghc +internal-interpreter +dynamic-system-linke,
    59 59
                  ghc-bin +internal-interpreter +threaded,
    
    60 60
                  ghci +internal-interpreter,
    
    61 61
                  haddock +in-ghc-tree,
    
    62
    +             haddock-api +in-ghc-tree,
    
    62 63
                  any.array installed,
    
    63 64
                  any.base installed,
    
    64 65
                  any.deepseq installed,
    
    ... ... @@ -68,6 +69,8 @@ constraints: ghc +internal-interpreter +dynamic-system-linke,
    68 69
                  any.pretty installed,
    
    69 70
                  any.template-haskell installed
    
    70 71
     
    
    72
    +package *
    
    73
    +    happy-options: --strict
    
    71 74
     
    
    72 75
     benchmarks: False
    
    73 76
     tests: False
    

  • compiler/Setup.hs
    1 1
     {-# LANGUAGE NamedFieldPuns #-}
    
    2
    +{-# LANGUAGE CPP #-}
    
    2 3
     module Main where
    
    3 4
     
    
    4 5
     import Distribution.Simple
    
    ... ... @@ -12,6 +13,8 @@ import Distribution.Simple.Program
    12 13
     import Distribution.Simple.Utils
    
    13 14
     import Distribution.Simple.Setup
    
    14 15
     import Distribution.Simple.PackageIndex
    
    16
    +import qualified Distribution.Simple.LocalBuildInfo as LBI
    
    17
    +
    
    15 18
     
    
    16 19
     import System.IO
    
    17 20
     import System.Process
    
    ... ... @@ -59,8 +62,9 @@ primopIncls =
    59 62
     ghcAutogen :: Verbosity -> LocalBuildInfo -> IO ()
    
    60 63
     ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameMap,installedPkgs}
    
    61 64
       = do
    
    65
    +  let i = LBI.interpretSymbolicPathLBI lbi
    
    62 66
       -- Get compiler/ root directory from the cabal file
    
    63
    -  let Just compilerRoot = takeDirectory <$> pkgDescrFile
    
    67
    +  let Just compilerRoot = takeDirectory . i <$> pkgDescrFile
    
    64 68
     
    
    65 69
       -- Require the necessary programs
    
    66 70
       (gcc   ,withPrograms) <- requireProgram normal gccProgram withPrograms
    
    ... ... @@ -80,15 +84,19 @@ ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameM
    80 84
       -- Call genprimopcode to generate *.hs-incl
    
    81 85
       forM_ primopIncls $ \(file,command) -> do
    
    82 86
         contents <- readProcess "genprimopcode" [command] primopsStr
    
    83
    -    rewriteFileEx verbosity (buildDir lbi </> file) contents
    
    87
    +    rewriteFileEx verbosity (i (buildDir lbi) </> file) contents
    
    84 88
     
    
    85 89
       -- Write GHC.Platform.Constants
    
    86
    -  let platformConstantsPath = autogenPackageModulesDir lbi </> "GHC/Platform/Constants.hs"
    
    90
    +  let platformConstantsPath = i (autogenPackageModulesDir lbi) </> "GHC/Platform/Constants.hs"
    
    87 91
           targetOS = case lookup "target os" settings of
    
    88 92
             Nothing -> error "no target os in settings"
    
    89 93
             Just os -> os
    
    90 94
       createDirectoryIfMissingVerbose verbosity True (takeDirectory platformConstantsPath)
    
    95
    +#if MIN_VERSION_Cabal(3,14,0)
    
    96
    +  withTempFile "Constants_tmp.hs" $ \tmp h -> do
    
    97
    +#else
    
    91 98
       withTempFile (takeDirectory platformConstantsPath) "Constants_tmp.hs" $ \tmp h -> do
    
    99
    +#endif
    
    92 100
         hClose h
    
    93 101
         callProcess "deriveConstants" ["--gen-haskell-type","-o",tmp,"--target-os",targetOS]
    
    94 102
         renameFile tmp platformConstantsPath
    
    ... ... @@ -103,7 +111,7 @@ ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameM
    103 111
             _ -> error "Couldn't find unique ghc-internal library when building ghc"
    
    104 112
     
    
    105 113
       -- Write GHC.Settings.Config
    
    106
    -      configHsPath = autogenPackageModulesDir lbi </> "GHC/Settings/Config.hs"
    
    114
    +      configHsPath = i (autogenPackageModulesDir lbi) </> "GHC/Settings/Config.hs"
    
    107 115
           configHs = generateConfigHs cProjectUnitId cGhcInternalUnitId settings
    
    108 116
       createDirectoryIfMissingVerbose verbosity True (takeDirectory configHsPath)
    
    109 117
       rewriteFileEx verbosity configHsPath configHs
    

  • compiler/ghc.cabal.in
    ... ... @@ -50,7 +50,7 @@ extra-source-files:
    50 50
     
    
    51 51
     
    
    52 52
     custom-setup
    
    53
    -    setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.14, directory, process, filepath, containers
    
    53
    +    setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.16, directory, process, filepath, containers
    
    54 54
     
    
    55 55
     Flag internal-interpreter
    
    56 56
         Description: Build with internal interpreter support.
    

  • libraries/ghc-boot/Setup.hs
    ... ... @@ -10,6 +10,7 @@ import Distribution.Verbosity
    10 10
     import Distribution.Simple.Program
    
    11 11
     import Distribution.Simple.Utils
    
    12 12
     import Distribution.Simple.Setup
    
    13
    +import qualified Distribution.Simple.LocalBuildInfo as LBI
    
    13 14
     
    
    14 15
     import System.IO
    
    15 16
     import System.Directory
    
    ... ... @@ -32,12 +33,13 @@ main = defaultMainWithHooks ghcHooks
    32 33
     ghcAutogen :: Verbosity -> LocalBuildInfo -> IO ()
    
    33 34
     ghcAutogen verbosity lbi@LocalBuildInfo{..} = do
    
    34 35
       -- Get compiler/ root directory from the cabal file
    
    35
    -  let Just compilerRoot = takeDirectory <$> pkgDescrFile
    
    36
    +  let Just compilerRoot = takeDirectory . i <$> pkgDescrFile
    
    36 37
     
    
    37
    -  let platformHostFile = "GHC/Platform/Host.hs"
    
    38
    -      platformHostPath = autogenPackageModulesDir lbi </> platformHostFile
    
    38
    +      i = LBI.interpretSymbolicPathLBI lbi
    
    39
    +      platformHostFile = "GHC/Platform/Host.hs"
    
    40
    +      platformHostPath = i (autogenPackageModulesDir lbi) </> platformHostFile
    
    39 41
           ghcVersionFile = "GHC/Version.hs"
    
    40
    -      ghcVersionPath = autogenPackageModulesDir lbi </> ghcVersionFile
    
    42
    +      ghcVersionPath = i (autogenPackageModulesDir lbi) </> ghcVersionFile
    
    41 43
     
    
    42 44
       -- Get compiler settings
    
    43 45
       settings <- lookupEnv "HADRIAN_SETTINGS" >>= \case
    

  • libraries/ghc-boot/ghc-boot.cabal.in
    ... ... @@ -28,7 +28,7 @@ build-type: Custom
    28 28
     extra-source-files: changelog.md
    
    29 29
     
    
    30 30
     custom-setup
    
    31
    -    setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.14, directory, filepath
    
    31
    +    setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.16, directory, filepath
    
    32 32
     
    
    33 33
     source-repository head
    
    34 34
         type:     git
    

  • utils/genprimopcode/genprimopcode.cabal
    ... ... @@ -32,4 +32,4 @@ Executable genprimopcode
    32 32
         Build-Depends: base       >= 4   && < 5,
    
    33 33
                        array
    
    34 34
         if flag(build-tool-depends)
    
    35
    -      build-tool-depends: alex:alex >= 3.2.6, happy:happy >= 1.20.0
    35
    +      build-tool-depends: alex:alex >= 3.2.6, happy:happy >= 2.1.5 || == 1.20.0 || == 1.20.1.1