Rodrigo Mesquita pushed to branch wip/romes/24212 at Glasgow Haskell Compiler / GHC

Commits:

12 changed files:

Changes:

  • compiler/GHC/Driver/Session.hs
    ... ... @@ -3513,9 +3513,8 @@ compilerInfo dflags
    3513 3513
         showBool False = "NO"
    
    3514 3514
         platform  = targetPlatform dflags
    
    3515 3515
         isWindows = platformOS platform == OSMinGW32
    
    3516
    -    useInplaceMinGW = toolSettings_useInplaceMinGW $ toolSettings dflags
    
    3517 3516
         expandDirectories :: FilePath -> Maybe FilePath -> String -> String
    
    3518
    -    expandDirectories topd mtoold = expandToolDir useInplaceMinGW mtoold . expandTopDir topd
    
    3517
    +    expandDirectories topd mtoold = expandToolDir mtoold . expandTopDir topd
    
    3519 3518
     
    
    3520 3519
     -- Note [Special unit-ids]
    
    3521 3520
     -- ~~~~~~~~~~~~~~~~~~~~~~~
    

  • compiler/GHC/Settings.hs
    ... ... @@ -23,7 +23,6 @@ module GHC.Settings
    23 23
       , sMergeObjsSupportsResponseFiles
    
    24 24
       , sLdIsGnuLd
    
    25 25
       , sGccSupportsNoPie
    
    26
    -  , sUseInplaceMinGW
    
    27 26
       , sArSupportsDashL
    
    28 27
       , sPgm_L
    
    29 28
       , sPgm_P
    
    ... ... @@ -102,7 +101,6 @@ data ToolSettings = ToolSettings
    102 101
       , toolSettings_mergeObjsSupportsResponseFiles :: Bool
    
    103 102
       , toolSettings_ldIsGnuLd               :: Bool
    
    104 103
       , toolSettings_ccSupportsNoPie         :: Bool
    
    105
    -  , toolSettings_useInplaceMinGW         :: Bool
    
    106 104
       , toolSettings_arSupportsDashL         :: Bool
    
    107 105
       , toolSettings_cmmCppSupportsG0        :: Bool
    
    108 106
     
    
    ... ... @@ -221,8 +219,6 @@ sLdIsGnuLd :: Settings -> Bool
    221 219
     sLdIsGnuLd = toolSettings_ldIsGnuLd . sToolSettings
    
    222 220
     sGccSupportsNoPie :: Settings -> Bool
    
    223 221
     sGccSupportsNoPie = toolSettings_ccSupportsNoPie . sToolSettings
    
    224
    -sUseInplaceMinGW :: Settings -> Bool
    
    225
    -sUseInplaceMinGW = toolSettings_useInplaceMinGW . sToolSettings
    
    226 222
     sArSupportsDashL :: Settings -> Bool
    
    227 223
     sArSupportsDashL = toolSettings_arSupportsDashL . sToolSettings
    
    228 224
     
    

  • compiler/GHC/Settings/IO.hs
    ... ... @@ -68,16 +68,10 @@ initSettings top_dir = do
    68 68
           getBooleanSetting key = either pgmError pure $
    
    69 69
             getRawBooleanSetting settingsFile mySettings key
    
    70 70
     
    
    71
    -  -- On Windows, by mingw is often distributed with GHC,
    
    72
    -  -- so we look in TopDir/../mingw/bin,
    
    73
    -  -- as well as TopDir/../../mingw/bin for hadrian.
    
    74
    -  -- But we might be disabled, in which we we don't do that.
    
    75
    -  useInplaceMinGW <- getBooleanSetting "Use inplace MinGW toolchain"
    
    76
    -
    
    77 71
       -- see Note [topdir: How GHC finds its files]
    
    78 72
       -- NB: top_dir is assumed to be in standard Unix
    
    79 73
       -- format, '/' separated
    
    80
    -  mtool_dir <- liftIO $ findToolDir useInplaceMinGW top_dir
    
    74
    +  mtool_dir <- liftIO $ findToolDir top_dir
    
    81 75
             -- see Note [tooldir: How GHC finds mingw on Windows]
    
    82 76
     
    
    83 77
       let getSetting_raw key = either pgmError pure $
    
    ... ... @@ -85,11 +79,11 @@ initSettings top_dir = do
    85 79
           getSetting_topDir top key = either pgmError pure $
    
    86 80
             getRawFilePathSetting top settingsFile mySettings key
    
    87 81
           getSetting_toolDir top tool key =
    
    88
    -        expandToolDir useInplaceMinGW tool <$> getSetting_topDir top key
    
    82
    +        expandToolDir tool <$> getSetting_topDir top key
    
    89 83
           getSetting key = getSetting_topDir top_dir key
    
    90 84
           getToolSetting key = getSetting_toolDir top_dir mtool_dir key
    
    91 85
     
    
    92
    -      expandDirVars top tool = expandToolDir useInplaceMinGW tool . expandTopDir top
    
    86
    +      expandDirVars top tool = expandToolDir tool . expandTopDir top
    
    93 87
     
    
    94 88
           getToolPath :: (Target -> Program) -> String
    
    95 89
           getToolPath key = expandDirVars top_dir mtool_dir (prgPath . key $ target)
    
    ... ... @@ -189,7 +183,6 @@ initSettings top_dir = do
    189 183
           , toolSettings_mergeObjsSupportsResponseFiles
    
    190 184
                                           = maybe False mergeObjsSupportsResponseFiles
    
    191 185
                                                              $ tgtMergeObjs target
    
    192
    -      , toolSettings_useInplaceMinGW  = useInplaceMinGW
    
    193 186
           , toolSettings_arSupportsDashL  = arSupportsDashL  $ tgtAr target
    
    194 187
           , toolSettings_cmmCppSupportsG0 = cmmCppSupportsG0 $ tgtCmmCPreprocessor target
    
    195 188
     
    

  • compiler/GHC/SysTools/BaseDir.hs
    ... ... @@ -119,15 +119,14 @@ play nice with the system compiler instead.
    119 119
     -- | Expand occurrences of the @$tooldir@ interpolation in a string
    
    120 120
     -- on Windows, leave the string untouched otherwise.
    
    121 121
     expandToolDir
    
    122
    -  :: Bool -- ^ whether we use the ambient mingw toolchain
    
    123
    -  -> Maybe FilePath -- ^ tooldir
    
    122
    +  :: Maybe FilePath -- ^ tooldir
    
    124 123
       -> String -> String
    
    125 124
     #if defined(mingw32_HOST_OS)
    
    126
    -expandToolDir False (Just tool_dir) s = expandPathVar "tooldir" tool_dir s
    
    127
    -expandToolDir False Nothing         _ = panic "Could not determine $tooldir"
    
    128
    -expandToolDir True  _               s = s
    
    125
    +expandToolDir (Just tool_dir) s = expandPathVar "tooldir" tool_dir s
    
    126
    +expandToolDir Nothing         _ = panic "Could not determine $tooldir"
    
    127
    +expandToolDir _               s = s
    
    129 128
     #else
    
    130
    -expandToolDir _ _ s = s
    
    129
    +expandToolDir _ s = s
    
    131 130
     #endif
    
    132 131
     
    
    133 132
     -- | Returns a Unix-format path pointing to TopDir.
    
    ... ... @@ -161,13 +160,13 @@ tryFindTopDir Nothing
    161 160
     -- Returns @Nothing@ when not on Windows.
    
    162 161
     -- When called on Windows, it either throws an error when the
    
    163 162
     -- tooldir can't be located, or returns @Just tooldirpath@.
    
    164
    --- If the distro toolchain is being used we treat Windows the same as Linux
    
    163
    +-- If the distro toolchain is being used, there will be no variables to
    
    164
    +-- substitute for anyway, so this is a no-op.
    
    165 165
     findToolDir
    
    166
    -  :: Bool -- ^ whether we use the ambient mingw toolchain
    
    167
    -  -> FilePath -- ^ topdir
    
    166
    +  :: FilePath -- ^ topdir
    
    168 167
       -> IO (Maybe FilePath)
    
    169 168
     #if defined(mingw32_HOST_OS)
    
    170
    -findToolDir False top_dir = go 0 (top_dir </> "..") []
    
    169
    +findToolDir top_dir = go 0 (top_dir </> "..") []
    
    171 170
       where maxDepth = 3
    
    172 171
             go :: Int -> FilePath -> [FilePath] -> IO (Maybe FilePath)
    
    173 172
             go k path tried
    
    ... ... @@ -180,7 +179,7 @@ findToolDir False top_dir = go 0 (top_dir </> "..") []
    180 179
                   if oneLevel
    
    181 180
                     then return (Just path)
    
    182 181
                     else go (k+1) (path </> "..") tried'
    
    183
    -findToolDir True _ = return Nothing
    
    182
    +findToolDir _ = return Nothing
    
    184 183
     #else
    
    185
    -findToolDir _ _ = return Nothing
    
    184
    +findToolDir _ = return Nothing
    
    186 185
     #endif

  • configure.ac
    ... ... @@ -132,6 +132,7 @@ AC_ARG_ENABLE(distro-toolchain,
    132 132
       [FP_CAPITALIZE_YES_NO(["$enableval"], [EnableDistroToolchain])],
    
    133 133
       [EnableDistroToolchain=NO]
    
    134 134
     )
    
    135
    +AC_SUBST([EnableDistroToolchain])
    
    135 136
     
    
    136 137
     if test "$EnableDistroToolchain" = "YES"; then
    
    137 138
       TarballsAutodownload=NO
    
    ... ... @@ -752,8 +753,6 @@ FP_PROG_AR_NEEDS_RANLIB
    752 753
     dnl ** Check to see whether ln -s works
    
    753 754
     AC_PROG_LN_S
    
    754 755
     
    
    755
    -FP_SETTINGS
    
    756
    -
    
    757 756
     dnl ** Find the path to sed
    
    758 757
     AC_PATH_PROGS(SedCmd,gsed sed,sed)
    
    759 758
     
    

  • distrib/configure.ac.in
    ... ... @@ -91,6 +91,7 @@ AC_ARG_ENABLE(distro-toolchain,
    91 91
       [FP_CAPITALIZE_YES_NO(["$enableval"], [EnableDistroToolchain])],
    
    92 92
       [EnableDistroToolchain=@EnableDistroToolchain@]
    
    93 93
     )
    
    94
    +AC_SUBST([EnableDistroToolchain])
    
    94 95
     
    
    95 96
     if test "$HostOS" = "mingw32" -a "$EnableDistroToolchain" = "NO"; then
    
    96 97
       FP_SETUP_WINDOWS_TOOLCHAIN([$hardtop/mingw/], [\$\$topdir/../mingw/])
    
    ... ... @@ -384,8 +385,6 @@ fi
    384 385
     
    
    385 386
     AC_SUBST(BaseUnitId)
    
    386 387
     
    
    387
    -FP_SETTINGS
    
    388
    -
    
    389 388
     # We get caught by
    
    390 389
     #     http://savannah.gnu.org/bugs/index.php?1516
    
    391 390
     #     $(eval ...) inside conditionals causes errors
    
    ... ... @@ -418,6 +417,32 @@ AC_OUTPUT
    418 417
     
    
    419 418
     VALIDATE_GHC_TOOLCHAIN([default.target],[default.target.ghc-toolchain])
    
    420 419
     
    
    420
    +if test "$EnableDistroToolchain" = "YES"; then
    
    421
    +    # If the user specified --enable-distro-toolchain then we just use the
    
    422
    +    # executable names, not paths. We do this by finding strings of paths to
    
    423
    +    # programs and keeping the basename only:
    
    424
    +    cp Target.hs Target.hs.bak
    
    425
    +
    
    426
    +    while IFS= read -r line; do
    
    427
    +      if echo "$line" | grep -q 'prgPath = "'; then
    
    428
    +        path=$(echo "$line" | sed -E 's/.*prgPath = "([^"]+)".*/\1/')
    
    429
    +        base=$(basename "$path")
    
    430
    +        echo "$line" | sed "s|$path|$base|"
    
    431
    +      else
    
    432
    +        echo "$line"
    
    433
    +      fi
    
    434
    +    done < Target.hs.bak > Target.hs
    
    435
    +fi
    
    436
    +
    
    437
    +if test "$windows" = YES -a "$EnableDistroToolchain" = "NO"; then
    
    438
    +    # Handle the Windows toolchain installed in FP_SETUP_WINDOWS_TOOLCHAIN.
    
    439
    +    # We need to issue a substitution to use $tooldir,
    
    440
    +    # See Note [tooldir: How GHC finds mingw on Windows]
    
    441
    +    SUBST_TOOLDIR([default.target])
    
    442
    +    echo "Applied tooldir substitution to default.target:"
    
    443
    +    cat default.target
    
    444
    +fi
    
    445
    +
    
    421 446
     rm -Rf acargs acghc-toolchain actmp-ghc-toolchain
    
    422 447
     
    
    423 448
     echo "****************************************************"
    

  • hadrian/bindist/Makefile
    ... ... @@ -87,8 +87,8 @@ lib/settings : config.mk
    87 87
     	@rm -f $@
    
    88 88
     	@echo '[("target os", "$(HaskellTargetOs)")' >> $@
    
    89 89
     	@echo ',("target arch", "$(HaskellTargetArch)")' >> $@
    
    90
    +	@echo ',("target has libm", "$(TargetHasLibm)")' >> $@
    
    90 91
     	@echo ',("unlit command", "$$topdir/../bin/$(CrossCompilePrefix)unlit")' >> $@
    
    91
    -	@echo ',("Use inplace MinGW toolchain", "$(EnableDistroToolchain)")' >> $@
    
    92 92
     	@echo ',("target RTS linker only supports shared libraries", "$(TargetRTSLinkerOnlySupportsSharedLibs)")' >> $@
    
    93 93
     	@echo ',("Use interpreter", "$(GhcWithInterpreter)")' >> $@
    
    94 94
     	@echo ',("Support SMP", "$(GhcWithSMP)")' >> $@
    
    ... ... @@ -98,6 +98,11 @@ lib/settings : config.mk
    98 98
     	@echo ',("base unit-id", "$(BaseUnitId)")' >> $@
    
    99 99
     	@echo "]" >> $@
    
    100 100
     
    
    101
    +lib/targets/default.target : config.mk default.target
    
    102
    +	@rm -f $@
    
    103
    +	@echo "Copying the bindist-configured default.target to lib/targets/default.target"
    
    104
    +	cp default.target $@
    
    105
    +
    
    101 106
     # We need to install binaries relative to libraries.
    
    102 107
     BINARIES = $(wildcard ./bin/*)
    
    103 108
     .PHONY: install_bin_libdir
    

  • hadrian/src/Rules/BinaryDist.hs
    ... ... @@ -141,7 +141,6 @@ bindistRules = do
    141 141
             installPrefix <- fromMaybe (error prefixErr) <$> cmdPrefix
    
    142 142
             installTo NotRelocatable installPrefix
    
    143 143
     
    
    144
    -    -- TODO: ROMES: TOUCH HERE?
    
    145 144
         phony "binary-dist-dir" $ do
    
    146 145
             version        <- setting ProjectVersion
    
    147 146
             targetPlatform <- setting TargetPlatformFull
    

  • hadrian/src/Rules/Generate.hs
    ... ... @@ -487,7 +487,6 @@ generateSettings settingsFile = do
    487 487
             , ("target arch",      queryTarget (show . archOS_arch . tgtArchOs))
    
    488 488
             , ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit })))
    
    489 489
             , ("target has libm", expr $  lookupSystemConfig "target-has-libm")
    
    490
    -        , ("Use inplace MinGW toolchain", expr $ lookupSystemConfig "settings-use-distro-mingw")
    
    491 490
             , ("target RTS linker only supports shared libraries", expr $ yesNo <$> targetRTSLinkerOnlySupportsSharedLibs)
    
    492 491
             , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter (predStage stage))
    
    493 492
             , ("Support SMP", expr $ yesNo <$> targetSupportsSMP)
    

  • m4/fp_setup_windows_toolchain.m4
    ... ... @@ -77,6 +77,7 @@ AC_DEFUN([FP_INSTALL_WINDOWS_TOOLCHAIN],[
    77 77
     # $2 the location that the windows toolchain will be installed in relative to the libdir
    
    78 78
     AC_DEFUN([FP_SETUP_WINDOWS_TOOLCHAIN],[
    
    79 79
     
    
    80
    +    # TODO: UPDATE COMMENT
    
    80 81
         # N.B. The parameters which get plopped in the `settings` file used by the
    
    81 82
         # resulting compiler are computed in `FP_SETTINGS`. Specifically, we use
    
    82 83
         # $$topdir-relative paths instead of fullpaths to the toolchain, by replacing
    

  • m4/fp_settings.m4m4/subst_tooldir.m4
    ... ... @@ -16,13 +16,11 @@ dnl
    16 16
     dnl * FP_SETUP_WINDOWS_TOOLCHAIN will set the toolchain variables to paths
    
    17 17
     dnl   to the bundled toolchain (e.g. CFLAGS=/full/path/to/mingw/bin/gcc)
    
    18 18
     dnl
    
    19
    -dnl * Later on, in FP_SETTINGS, we substitute occurrences of the path to the
    
    19
    +dnl * Later on, at the end of distrib/configure.ac, we substitute occurrences of the path to the
    
    20 20
     dnl   mingw tooldir by $tooldir (see SUBST_TOOLDIR).
    
    21 21
     dnl   The reason is the Settings* variants of toolchain variables are used by the bindist configure to
    
    22 22
     dnl   create the settings file, which needs the windows bundled toolchain to be relative to $tooldir.
    
    23 23
     dnl
    
    24
    -dnl * Finally, hadrian will also substitute the mingw prefix by $tooldir before writing the toolchain to the settings file (see generateSettings)
    
    25
    -dnl
    
    26 24
     dnl The ghc-toolchain program isn't concerned with any of these complications:
    
    27 25
     dnl it is passed either the full paths to the toolchain executables, or the bundled
    
    28 26
     dnl mingw path is set first on $PATH before invoking it. And ghc-toolchain
    
    ... ... @@ -35,7 +33,7 @@ dnl ghc-toolchain.
    35 33
     
    
    36 34
     # SUBST_TOOLDIR
    
    37 35
     # ----------------------------------
    
    38
    -# $1 - the variable where to search for occurrences of the path to the
    
    36
    +# $1 - the filepath where to search for occurrences of the path to the
    
    39 37
     #      inplace mingw, and update by substituting said occurrences by
    
    40 38
     #      the value of $mingw_install_prefix, where the mingw toolchain will be at
    
    41 39
     #      install time
    
    ... ... @@ -43,30 +41,5 @@ dnl ghc-toolchain.
    43 41
     # See Note [How we configure the bundled windows toolchain]
    
    44 42
     AC_DEFUN([SUBST_TOOLDIR],
    
    45 43
     [
    
    46
    -    dnl and Note [How we configure the bundled windows toolchain]
    
    47
    -    $1=`echo "$$1" | sed 's%'"$mingw_prefix"'%'"$mingw_install_prefix"'%g'`
    
    48
    -])
    
    49
    -
    
    50
    -# FP_SETTINGS
    
    51
    -# ----------------------------------
    
    52
    -# Set the variables used in the settings file
    
    53
    -AC_DEFUN([FP_SETTINGS],
    
    54
    -[
    
    55
    -    # LLVM backend tools
    
    56
    -
    
    57
    -    if test "$EnableDistroToolchain" = "YES"; then
    
    58
    -        # If the user specified --enable-distro-toolchain then we just use the
    
    59
    -        # executable names, not paths.
    
    60
    -        dnl XXX="$(basename XXX)"
    
    61
    -        SettingsLdCommand="$(basename $SettingsLdCommand)"
    
    62
    -    fi
    
    63
    -
    
    64
    -    if test "$windows" = YES -a "$EnableDistroToolchain" = "NO"; then
    
    65
    -        # Handle the Windows toolchain installed in FP_SETUP_WINDOWS_TOOLCHAIN.
    
    66
    -        # We need to issue a substitution to use $tooldir,
    
    67
    -        # See Note [tooldir: How GHC finds mingw on Windows]
    
    68
    -        dnl SUBST_TOOLDIR([XXX])
    
    69
    -    fi
    
    70
    -
    
    71
    -    AC_SUBST(EnableDistroToolchain)
    
    44
    +    sed -i.bkp $1 's%'"$mingw_prefix"'%'"$mingw_install_prefix"'%g'
    
    72 45
     ])

  • utils/ghc-toolchain/exe/Main.hs
    ... ... @@ -534,4 +534,3 @@ mkTarget opts = do
    534 534
                        }
    
    535 535
         return t
    
    536 536
     
    537
    ---- ROMES:TODO: fp_settings.m4 in general which I don't think was ported completely (e.g. the basenames and windows llvm-XX and such)