From: Adam Megacz Date: Mon, 25 Apr 2011 00:31:58 +0000 (-0700) Subject: Merge branch 'master' of http://darcs.haskell.org/ghc X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=1c6d61ee06972de3c4797e1925e265f7dc7c361c;hp=cf5905ea24904cf73a041fd7535e8723a668cb9a Merge branch 'master' of darcs.haskell.org/ghc --- diff --git a/.gitignore b/.gitignore index 32d243b..3e2e7f4 100644 --- a/.gitignore +++ b/.gitignore @@ -137,7 +137,7 @@ _darcs/ /driver/split/dist/ghc-split /driver/split/dist/ghc-split.prl /driver/stamp-pkg-conf-rts -/extra-gcc-opts +/settings /ghc.spec /ghc/ghc-bin.cabal /ghc/stage1/ diff --git a/aclocal.m4 b/aclocal.m4 index 0e72d22..4b750ef 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -181,8 +181,8 @@ AC_DEFUN([FP_EVAL_STDERR], # -------------------- # XXX # -# $1 = the command to look for -# $2 = the variable to set +# $1 = the variable to set +# $2 = the command to look for # AC_DEFUN([FP_ARG_WITH_PATH_GNU_PROG], [ @@ -646,32 +646,6 @@ fi ])# FP_PROG_AR_NEEDS_RANLIB -# FP_PROG_AR_SUPPORTS_INPUT -# ------------------------- -# Sets the output variable ArSupportsInput to "-input" or "", depending on -# whether ar supports -input flag is supported or not. -AC_DEFUN([FP_PROG_AR_SUPPORTS_INPUT], -[AC_REQUIRE([FP_PROG_AR_IS_GNU]) -AC_REQUIRE([FP_PROG_AR_ARGS]) -AC_CACHE_CHECK([whether $fp_prog_ar_raw supports -input], [fp_cv_prog_ar_supports_input], -[fp_cv_prog_ar_supports_input=no -if test $fp_prog_ar_is_gnu = no; then - rm -f conftest* - touch conftest.lst - if FP_EVAL_STDERR(["$fp_prog_ar_raw" $fp_prog_ar_args conftest.a -input conftest.lst]) >/dev/null; then - test -s conftest.err || fp_cv_prog_ar_supports_input=yes - fi - rm -f conftest* -fi]) -if test $fp_cv_prog_ar_supports_input = yes; then - ArSupportsInput="-input" -else - ArSupportsInput="" -fi -AC_SUBST([ArSupportsInput]) -])# FP_PROG_AR_SUPPORTS_INPUT - - dnl dnl AC_SHEBANG_PERL - can we she-bang perl? dnl @@ -691,38 +665,30 @@ rm -f conftest ])]) -# FP_HAVE_GCC +# FP_GCC_VERSION # ----------- # Extra testing of the result AC_PROG_CC, testing the gcc version no. Sets the -# output variables HaveGcc and GccVersion. -AC_DEFUN([FP_HAVE_GCC], +# output variable GccVersion. +AC_DEFUN([FP_GCC_VERSION], [AC_REQUIRE([AC_PROG_CC]) -if test -z "$GCC"; then - fp_have_gcc=NO -else - fp_have_gcc=YES -fi -if test "$fp_have_gcc" = "NO" -a -d $srcdir/ghc; then +if test -z "$GCC" +then AC_MSG_ERROR([gcc is required]) fi GccLT34= AC_CACHE_CHECK([version of gcc], [fp_cv_gcc_version], -[if test "$fp_have_gcc" = "YES"; then - fp_cv_gcc_version="`$CC -v 2>&1 | grep 'version ' | sed -e 's/.*version [[^0-9]]*\([[0-9.]]*\).*/\1/g'`" - FP_COMPARE_VERSIONS([$fp_cv_gcc_version], [-lt], [3.0], - [AC_MSG_ERROR([Need at least gcc version 3.0 (3.4+ recommended)])]) - # See #2770: gcc 2.95 doesn't work any more, apparently. There probably - # isn't a very good reason for that, but for now just make configure - # fail. - FP_COMPARE_VERSIONS([$fp_cv_gcc_version], [-lt], [3.4], GccLT34=YES) - else - fp_cv_gcc_version="not-installed" - fi +[ + fp_cv_gcc_version="`$CC -v 2>&1 | grep 'version ' | sed -e 's/.*version [[^0-9]]*\([[0-9.]]*\).*/\1/g'`" + FP_COMPARE_VERSIONS([$fp_cv_gcc_version], [-lt], [3.0], + [AC_MSG_ERROR([Need at least gcc version 3.0 (3.4+ recommended)])]) + # See #2770: gcc 2.95 doesn't work any more, apparently. There probably + # isn't a very good reason for that, but for now just make configure + # fail. + FP_COMPARE_VERSIONS([$fp_cv_gcc_version], [-lt], [3.4], GccLT34=YES) ]) -AC_SUBST([HaveGcc], [$fp_have_gcc]) AC_SUBST([GccVersion], [$fp_cv_gcc_version]) AC_SUBST(GccLT34) -])# FP_HAVE_GCC +])# FP_GCC_VERSION dnl Small feature test for perl version. Assumes PerlCmd dnl contains path to perl binary. @@ -1094,7 +1060,7 @@ AC_SUBST([GhcPkgCmd]) # integer wrap around. (Trac #952) # AC_DEFUN([FP_GCC_EXTRA_FLAGS], -[AC_REQUIRE([FP_HAVE_GCC]) +[AC_REQUIRE([FP_GCC_VERSION]) AC_CACHE_CHECK([for extra options to pass gcc when compiling via C], [fp_cv_gcc_extra_opts], [fp_cv_gcc_extra_opts= FP_COMPARE_VERSIONS([$fp_cv_gcc_version], [-ge], [3.4], @@ -1116,7 +1082,7 @@ if test "$RELEASE" = "NO"; then AC_MSG_RESULT(given $PACKAGE_VERSION) elif test -d .git; then changequote(, )dnl - ver_date=`git log -n 1 --date=short --pretty=format:%ci | sed "s/^.*\([0-9][0-9][0-9][0-9]\)-\([0-9][0-9]\)-\([0-9][0-9]\).*$/\1\2\3/"` + ver_date=`git log -n 1 --date=short --pretty=format:%ci | cut -d ' ' -f 1 | tr -d -` if echo $ver_date | grep '^[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]$' 2>&1 >/dev/null; then true; else changequote([, ])dnl AC_MSG_ERROR([failed to detect version date: check that git is in your path]) @@ -1528,6 +1494,21 @@ case "$1" in esac ]) +# BOOTSTRAPPING_GHC_INFO_FIELD +# -------------------------------- +# If the bootstrapping compiler is >= 7.1, then set the variable +# $1 to the value of the ghc --info field $2. Otherwise, set it to +# $3. +AC_DEFUN([BOOTSTRAPPING_GHC_INFO_FIELD],[ +if test $GhcCanonVersion -ge 701 +then + $1=`"$WithGhc" --info | grep "^ ,(\"$2\"," | sed -e 's/.*","//' -e 's/")$//'` +else + $1=$3 +fi +AC_SUBST($1) +]) + # LIBRARY_VERSION(lib) # -------------------------------- # Gets the version number of a library. diff --git a/compiler/Makefile.local b/compiler/Makefile.local deleted file mode 100644 index 1d53451..0000000 --- a/compiler/Makefile.local +++ /dev/null @@ -1,75 +0,0 @@ -# Local GHC-build-tree customization for Cabal makefiles. We want to build -# libraries using flags that the user has put in build.mk/validate.mk and -# appropriate flags for Mac OS X deployment targets. - -# Careful here: including boilerplate.mk breaks things, because paths.mk and -# opts.mk overrides some of the variable settings in the Cabal Makefile, so -# we just include config.mk and custom-settings.mk. -TOP=.. -SAVE_GHC := $(GHC) -SAVE_AR := $(AR) -SAVE_LD := $(LD) -include $(TOP)/mk/config.mk -include $(TOP)/mk/custom-settings.mk -GHC := $(SAVE_GHC) -AR := $(SAVE_AR) -LD := $(SAVE_LD) - -# Now add flags from the GHC build system to the Cabal build: -GHC_CC_OPTS += $(addprefix -optc, $(MACOSX_DEPLOYMENT_CC_OPTS)) -GHC_OPTS += $(SRC_HC_OPTS) -GHC_OPTS += $(GhcHcOpts) -GHC_OPTS += $(GhcStage$(stage)HcOpts) -GHC_OPTS += $(addprefix -optc, $(MACOSX_DEPLOYMENT_CC_OPTS)) -LIB_LD_OPTS += $(addprefix -optl, $(MACOSX_DEPLOYMENT_LD_OPTS)) - -# XXX These didn't work in the old build system, according to the -# comment at least. We should actually handle them properly at some -# point: - -# Some .hs files #include other source files, but since ghc -M doesn't spit out -# these dependencies we have to include them manually. - -# We don't add dependencies on HsVersions.h, ghcautoconf.h, or ghc_boot_platform.h, -# because then modifying one of these files would force recompilation of everything, -# which is probably not what you want. However, it does mean you have to be -# careful to recompile stuff you need if you reconfigure or change HsVersions.h. - -# Aargh, these don't work properly anyway, because GHC's recompilation checker -# just reports "compilation NOT required". Do we have to add -fforce-recomp for each -# of these .hs files? I haven't done anything about this yet. - -# $(odir)/codeGen/Bitmap.$(way_)o : ../includes/MachDeps.h -# $(odir)/codeGen/CgCallConv.$(way_)o : ../includes/StgFun.h -# $(odir)/codeGen/CgProf.$(way_)o : ../includes/MachDeps.h -# $(odir)/codeGen/CgProf.$(way_)o : ../includes/Constants.h -# $(odir)/codeGen/CgProf.$(way_)o : ../includes/DerivedConstants.h -# $(odir)/codeGen/CgTicky.$(way_)o : ../includes/DerivedConstants.h -# $(odir)/codeGen/ClosureInfo.$(way_)o : ../includes/MachDeps.h -# $(odir)/codeGen/SMRep.$(way_)o : ../includes/MachDeps.h -# $(odir)/codeGen/SMRep.$(way_)o : ../includes/ClosureTypes.h -# $(odir)/ghci/ByteCodeAsm.$(way_)o : ../includes/Bytecodes.h -# $(odir)/ghci/ByteCodeFFI.$(way_)o : nativeGen/NCG.h -# $(odir)/ghci/ByteCodeInstr.$(way_)o : ../includes/MachDeps.h -# $(odir)/ghci/ByteCodeItbls.$(way_)o : ../includes/ClosureTypes.h -# $(odir)/ghci/ByteCodeItbls.$(way_)o : nativeGen/NCG.h -# $(odir)/main/Constants.$(way_)o : ../includes/MachRegs.h -# $(odir)/main/Constants.$(way_)o : ../includes/Constants.h -# $(odir)/main/Constants.$(way_)o : ../includes/MachDeps.h -# $(odir)/main/Constants.$(way_)o : ../includes/DerivedConstants.h -# $(odir)/main/Constants.$(way_)o : ../includes/GHCConstants.h -# $(odir)/nativeGen/AsmCodeGen.$(way_)o : nativeGen/NCG.h -# $(odir)/nativeGen/MachCodeGen.$(way_)o : nativeGen/NCG.h -# $(odir)/nativeGen/MachCodeGen.$(way_)o : ../includes/MachDeps.h -# $(odir)/nativeGen/MachInstrs.$(way_)o : nativeGen/NCG.h -# $(odir)/nativeGen/MachRegs.$(way_)o : nativeGen/NCG.h -# $(odir)/nativeGen/MachRegs.$(way_)o : ../includes/MachRegs.h -# $(odir)/nativeGen/PositionIndependentCode.$(way_)o : nativeGen/NCG.h -# $(odir)/nativeGen/PprMach.$(way_)o : nativeGen/NCG.h -# $(odir)/nativeGen/RegAllocInfo.$(way_)o : nativeGen/NCG.h -# $(odir)/typecheck/TcForeign.$(way_)o : nativeGen/NCG.h -# $(odir)/utils/Binary.$(way_)o : ../includes/MachDeps.h -# $(odir)/utils/FastMutInt.$(way_)o : ../includes/MachDeps.h -# $(PRIMOP_BITS) is defined in Makefile -# $(odir)/prelude/PrimOp.o: $(PRIMOP_BITS) - diff --git a/compiler/basicTypes/Module.lhs b/compiler/basicTypes/Module.lhs index c4bdba2..03f541e 100644 --- a/compiler/basicTypes/Module.lhs +++ b/compiler/basicTypes/Module.lhs @@ -155,6 +155,7 @@ addBootSuffixLocn locn \begin{code} -- | A ModuleName is essentially a simple string, e.g. @Data.List@. newtype ModuleName = ModuleName FastString + deriving Typeable instance Uniquable ModuleName where getUnique (ModuleName nm) = getUnique nm @@ -175,8 +176,6 @@ instance Binary ModuleName where put_ bh (ModuleName fs) = put_ bh fs get bh = do fs <- get bh; return (ModuleName fs) -INSTANCE_TYPEABLE0(ModuleName,moduleNameTc,"ModuleName") - instance Data ModuleName where -- don't traverse? toConstr _ = abstractConstr "ModuleName" @@ -224,7 +223,7 @@ data Module = Module { modulePackageId :: !PackageId, -- pkg-1.0 moduleName :: !ModuleName -- A.B.C } - deriving (Eq, Ord) + deriving (Eq, Ord, Typeable) instance Uniquable Module where getUnique (Module p n) = getUnique (packageIdFS p `appendFS` moduleNameFS n) @@ -236,8 +235,6 @@ instance Binary Module where put_ bh (Module p n) = put_ bh p >> put_ bh n get bh = do p <- get bh; n <- get bh; return (Module p n) -INSTANCE_TYPEABLE0(Module,moduleTc,"Module") - instance Data Module where -- don't traverse? toConstr _ = abstractConstr "Module" @@ -280,7 +277,7 @@ pprPackagePrefix p mod = getPprStyle doc \begin{code} -- | Essentially just a string identifying a package, including the version: e.g. parsec-1.0 -newtype PackageId = PId FastString deriving( Eq ) +newtype PackageId = PId FastString deriving( Eq, Typeable ) -- here to avoid module loops with PackageConfig instance Uniquable PackageId where @@ -291,8 +288,6 @@ instance Uniquable PackageId where instance Ord PackageId where nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2 -INSTANCE_TYPEABLE0(PackageId,packageIdTc,"PackageId") - instance Data PackageId where -- don't traverse? toConstr _ = abstractConstr "PackageId" diff --git a/compiler/basicTypes/Name.lhs b/compiler/basicTypes/Name.lhs index de8a3a3..aac7670 100644 --- a/compiler/basicTypes/Name.lhs +++ b/compiler/basicTypes/Name.lhs @@ -107,6 +107,7 @@ data Name = Name { --(note later when changing Int# -> FastInt: is that still true about UNPACK?) n_loc :: !SrcSpan -- Definition site } + deriving Typeable -- NOTE: we make the n_loc field strict to eliminate some potential -- (and real!) space leaks, due to the fact that we don't look at @@ -370,8 +371,6 @@ instance Uniquable Name where instance NamedThing Name where getName n = n -INSTANCE_TYPEABLE0(Name,nameTc,"Name") - instance Data Name where -- don't traverse? toConstr _ = abstractConstr "Name" diff --git a/compiler/basicTypes/NameSet.lhs b/compiler/basicTypes/NameSet.lhs index e2acaf7..a20d8ab 100644 --- a/compiler/basicTypes/NameSet.lhs +++ b/compiler/basicTypes/NameSet.lhs @@ -48,7 +48,12 @@ import Data.Data \begin{code} type NameSet = UniqSet Name -INSTANCE_TYPEABLE0(NameSet,nameSetTc,"NameSet") +-- TODO: These Data/Typeable instances look very dubious. Surely either +-- UniqFM should have the instances, or this should be a newtype? + +nameSetTc :: TyCon +nameSetTc = mkTyCon "NameSet" +instance Typeable NameSet where { typeOf _ = mkTyConApp nameSetTc [] } instance Data NameSet where gfoldl k z s = z mkNameSet `k` nameSetToList s -- traverse abstractly diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs index c528acb..bae5419 100644 --- a/compiler/basicTypes/OccName.lhs +++ b/compiler/basicTypes/OccName.lhs @@ -225,6 +225,7 @@ data OccName = OccName { occNameSpace :: !NameSpace , occNameFS :: !FastString } + deriving Typeable \end{code} @@ -237,8 +238,6 @@ instance Ord OccName where compare (OccName sp1 s1) (OccName sp2 s2) = (s1 `compare` s2) `thenCmp` (sp1 `compare` sp2) -INSTANCE_TYPEABLE0(OccName,occNameTc,"OccName") - instance Data OccName where -- don't traverse? toConstr _ = abstractConstr "OccName" diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs index 5dcdabe..d2cbd7f 100644 --- a/compiler/basicTypes/SrcLoc.lhs +++ b/compiler/basicTypes/SrcLoc.lhs @@ -185,8 +185,6 @@ instance Outputable SrcLoc where ppr (UnhelpfulLoc s) = ftext s -INSTANCE_TYPEABLE0(SrcSpan,srcSpanTc,"SrcSpan") - instance Data SrcSpan where -- don't traverse? toConstr _ = abstractConstr "SrcSpan" @@ -237,10 +235,10 @@ data SrcSpan -- also used to indicate an empty span #ifdef DEBUG - deriving (Eq, Show) -- Show is used by Lexer.x, becuase we - -- derive Show for Token + deriving (Eq, Typeable, Show) -- Show is used by Lexer.x, becuase we + -- derive Show for Token #else - deriving Eq + deriving (Eq, Typeable) #endif -- | Built-in "bad" 'SrcSpan's for common sources of location uncertainty diff --git a/compiler/basicTypes/Var.lhs b/compiler/basicTypes/Var.lhs index ec83494..bca185f 100644 --- a/compiler/basicTypes/Var.lhs +++ b/compiler/basicTypes/Var.lhs @@ -155,6 +155,7 @@ data Var idScope :: IdScope, id_details :: IdDetails, -- Stable, doesn't change id_info :: IdInfo } -- Unstable, updated by simplifier + deriving Typeable data IdScope -- See Note [GlobalId/LocalId] = GlobalId @@ -216,8 +217,6 @@ instance Ord Var where a > b = realUnique a ># realUnique b a `compare` b = varUnique a `compare` varUnique b -INSTANCE_TYPEABLE0(Var,varTc,"Var") - instance Data Var where -- don't traverse? toConstr _ = abstractConstr "Var" diff --git a/compiler/ghc.mk b/compiler/ghc.mk index a7a353d..76b393f 100644 --- a/compiler/ghc.mk +++ b/compiler/ghc.mk @@ -134,8 +134,6 @@ compiler/stage%/build/Config.hs : mk/config.mk mk/project.mk | $$(dir $$@)/. @echo 'cLeadingUnderscore = "$(LeadingUnderscore)"' >> $@ @echo 'cRAWCPP_FLAGS :: String' >> $@ @echo 'cRAWCPP_FLAGS = "$(RAWCPP_FLAGS)"' >> $@ - @echo 'cGCC :: String' >> $@ - @echo 'cGCC = "$(WhatGccIsCalled)"' >> $@ @echo 'cMKDLL :: String' >> $@ @echo 'cMKDLL = "$(BLD_DLL)"' >> $@ @echo 'cLdIsGNULd :: String' >> $@ @@ -162,8 +160,6 @@ compiler/stage%/build/Config.hs : mk/config.mk mk/project.mk | $$(dir $$@)/. @echo 'cGHC_SYSMAN_PGM = "$(GHC_SYSMAN)"' >> $@ @echo 'cGHC_SYSMAN_DIR :: String' >> $@ @echo 'cGHC_SYSMAN_DIR = "$(GHC_SYSMAN_DIR)"' >> $@ - @echo 'cGHC_PERL :: String' >> $@ - @echo 'cGHC_PERL = "$(GHC_PERL)"' >> $@ @echo 'cDEFAULT_TMPDIR :: String' >> $@ @echo 'cDEFAULT_TMPDIR = "$(DEFAULT_TMPDIR)"' >> $@ @echo 'cRelocatableBuild :: Bool' >> $@ diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index 59f5669..b4068a7 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -569,10 +569,10 @@ newVar = liftTcM . newFlexiTyVarTy type RttiInstantiation = [(TcTyVar, TyVar)] -- Associates the typechecker-world meta type variables -- (which are mutable and may be refined), to their - -- debugger-world RuntimeUnkSkol counterparts. + -- debugger-world RuntimeUnk counterparts. -- If the TcTyVar has not been refined by the runtime type -- elaboration, then we want to turn it back into the - -- original RuntimeUnkSkol + -- original RuntimeUnk -- | Returns the instantiated type scheme ty', and the -- mapping from new (instantiated) -to- old (skolem) type variables @@ -1130,9 +1130,9 @@ zonkRttiType = zonkType (mkZonkTcTyVar zonk_unbound_meta) zonk_unbound_meta tv = ASSERT( isTcTyVar tv ) do { tv' <- skolemiseUnboundMetaTyVar tv RuntimeUnk - -- This is where RuntimeUnkSkols are born: + -- This is where RuntimeUnks are born: -- otherwise-unconstrained unification variables are - -- turned into RuntimeUnkSkols as they leave the + -- turned into RuntimeUnks as they leave the -- typechecker's monad ; return (mkTyVarTy tv') } diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 9dd9cc7..c23f674 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -1028,7 +1028,7 @@ runPhase cc_phase input_fn dflags (cmdline_include_paths ++ pkg_include_dirs) let md_c_flags = machdepCCOpts dflags - gcc_extra_viac_flags <- io $ getExtraViaCOpts dflags + let gcc_extra_viac_flags = extraGccViaCFlags dflags let pic_c_flags = picCCOpts dflags let verbFlags = getVerbFlags dflags diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 70358ee..e292722 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -1,6 +1,3 @@ -{-# OPTIONS_GHC -w #-} --- Temporary, until rtsIsProfiled is fixed - -- | -- Dynamic flags -- @@ -35,8 +32,17 @@ module DynFlags ( DPHBackend(..), dphPackageMaybe, wayNames, + Settings(..), + ghcUsagePath, ghciUsagePath, topDir, tmpDir, rawSettings, + extraGccViaCFlags, systemPackageConfig, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_s, pgm_a, pgm_l, pgm_dll, pgm_T, + pgm_sysman, pgm_windres, pgm_lo, pgm_lc, + opt_L, opt_P, opt_F, opt_c, opt_m, opt_a, opt_l, + opt_windres, opt_lo, opt_lc, + + -- ** Manipulating DynFlags - defaultDynFlags, -- DynFlags + defaultDynFlags, -- Settings -> DynFlags initDynFlags, -- DynFlags -> IO DynFlags getOpts, -- DynFlags -> (DynFlags -> [a]) -> [a] @@ -61,7 +67,6 @@ module DynFlags ( getStgToDo, -- * Compiler configuration suitable for display to the user - Printable(..), compilerInfo #ifdef GHCI -- Only in stage 2 can we be sure that the RTS @@ -90,10 +95,14 @@ import Maybes ( orElse ) import SrcLoc import FastString import Outputable +#ifdef GHCI import Foreign.C ( CInt ) +#endif import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage ) +#ifdef GHCI import System.IO.Unsafe ( unsafePerformIO ) +#endif import Data.IORef import Control.Monad ( when ) @@ -101,7 +110,7 @@ import Data.Char import Data.List import Data.Map (Map) import qualified Data.Map as Map -import Data.Maybe +-- import Data.Maybe import System.FilePath import System.IO ( stderr, hPutChar ) @@ -445,41 +454,13 @@ data DynFlags = DynFlags { libraryPaths :: [String], frameworkPaths :: [String], -- used on darwin only cmdlineFrameworks :: [String], -- ditto - tmpDir :: String, -- no trailing '/' - ghcUsagePath :: FilePath, -- Filled in by SysTools - ghciUsagePath :: FilePath, -- ditto rtsOpts :: Maybe String, rtsOptsEnabled :: RtsOptsEnabled, hpcDir :: String, -- ^ Path to store the .mix files - -- options for particular phases - opt_L :: [String], - opt_P :: [String], - opt_F :: [String], - opt_c :: [String], - opt_m :: [String], - opt_a :: [String], - opt_l :: [String], - opt_windres :: [String], - opt_lo :: [String], -- LLVM: llvm optimiser - opt_lc :: [String], -- LLVM: llc static compiler - - -- commands for particular phases - pgm_L :: String, - pgm_P :: (String,[Option]), - pgm_F :: String, - pgm_c :: (String,[Option]), - pgm_s :: (String,[Option]), - pgm_a :: (String,[Option]), - pgm_l :: (String,[Option]), - pgm_dll :: (String,[Option]), - pgm_T :: String, - pgm_sysman :: String, - pgm_windres :: String, - pgm_lo :: (String,[Option]), -- LLVM: opt llvm optimiser - pgm_lc :: (String,[Option]), -- LLVM: llc static compiler + settings :: Settings, -- For ghc -M depMakefile :: FilePath, @@ -489,8 +470,6 @@ data DynFlags = DynFlags { -- Package flags extraPkgConfs :: [FilePath], - topDir :: FilePath, -- filled in by SysTools - systemPackageConfig :: FilePath, -- ditto -- ^ The @-package-conf@ flags given on the command line, in the order -- they appeared. @@ -525,6 +504,105 @@ data DynFlags = DynFlags { haddockOptions :: Maybe String } +data Settings = Settings { + sGhcUsagePath :: FilePath, -- Filled in by SysTools + sGhciUsagePath :: FilePath, -- ditto + sTopDir :: FilePath, + sTmpDir :: String, -- no trailing '/' + -- You shouldn't need to look things up in rawSettings directly. + -- They should have their own fields instead. + sRawSettings :: [(String, String)], + sExtraGccViaCFlags :: [String], + sSystemPackageConfig :: FilePath, + -- commands for particular phases + sPgm_L :: String, + sPgm_P :: (String,[Option]), + sPgm_F :: String, + sPgm_c :: (String,[Option]), + sPgm_s :: (String,[Option]), + sPgm_a :: (String,[Option]), + sPgm_l :: (String,[Option]), + sPgm_dll :: (String,[Option]), + sPgm_T :: String, + sPgm_sysman :: String, + sPgm_windres :: String, + sPgm_lo :: (String,[Option]), -- LLVM: opt llvm optimiser + sPgm_lc :: (String,[Option]), -- LLVM: llc static compiler + -- options for particular phases + sOpt_L :: [String], + sOpt_P :: [String], + sOpt_F :: [String], + sOpt_c :: [String], + sOpt_m :: [String], + sOpt_a :: [String], + sOpt_l :: [String], + sOpt_windres :: [String], + sOpt_lo :: [String], -- LLVM: llvm optimiser + sOpt_lc :: [String] -- LLVM: llc static compiler + + } + +ghcUsagePath :: DynFlags -> FilePath +ghcUsagePath dflags = sGhcUsagePath (settings dflags) +ghciUsagePath :: DynFlags -> FilePath +ghciUsagePath dflags = sGhciUsagePath (settings dflags) +topDir :: DynFlags -> FilePath +topDir dflags = sTopDir (settings dflags) +tmpDir :: DynFlags -> String +tmpDir dflags = sTmpDir (settings dflags) +rawSettings :: DynFlags -> [(String, String)] +rawSettings dflags = sRawSettings (settings dflags) +extraGccViaCFlags :: DynFlags -> [String] +extraGccViaCFlags dflags = sExtraGccViaCFlags (settings dflags) +systemPackageConfig :: DynFlags -> FilePath +systemPackageConfig dflags = sSystemPackageConfig (settings dflags) +pgm_L :: DynFlags -> String +pgm_L dflags = sPgm_L (settings dflags) +pgm_P :: DynFlags -> (String,[Option]) +pgm_P dflags = sPgm_P (settings dflags) +pgm_F :: DynFlags -> String +pgm_F dflags = sPgm_F (settings dflags) +pgm_c :: DynFlags -> (String,[Option]) +pgm_c dflags = sPgm_c (settings dflags) +pgm_s :: DynFlags -> (String,[Option]) +pgm_s dflags = sPgm_s (settings dflags) +pgm_a :: DynFlags -> (String,[Option]) +pgm_a dflags = sPgm_a (settings dflags) +pgm_l :: DynFlags -> (String,[Option]) +pgm_l dflags = sPgm_l (settings dflags) +pgm_dll :: DynFlags -> (String,[Option]) +pgm_dll dflags = sPgm_dll (settings dflags) +pgm_T :: DynFlags -> String +pgm_T dflags = sPgm_T (settings dflags) +pgm_sysman :: DynFlags -> String +pgm_sysman dflags = sPgm_sysman (settings dflags) +pgm_windres :: DynFlags -> String +pgm_windres dflags = sPgm_windres (settings dflags) +pgm_lo :: DynFlags -> (String,[Option]) +pgm_lo dflags = sPgm_lo (settings dflags) +pgm_lc :: DynFlags -> (String,[Option]) +pgm_lc dflags = sPgm_lc (settings dflags) +opt_L :: DynFlags -> [String] +opt_L dflags = sOpt_L (settings dflags) +opt_P :: DynFlags -> [String] +opt_P dflags = sOpt_P (settings dflags) +opt_F :: DynFlags -> [String] +opt_F dflags = sOpt_F (settings dflags) +opt_c :: DynFlags -> [String] +opt_c dflags = sOpt_c (settings dflags) +opt_m :: DynFlags -> [String] +opt_m dflags = sOpt_m (settings dflags) +opt_a :: DynFlags -> [String] +opt_a dflags = sOpt_a (settings dflags) +opt_l :: DynFlags -> [String] +opt_l dflags = sOpt_l (settings dflags) +opt_windres :: DynFlags -> [String] +opt_windres dflags = sOpt_windres (settings dflags) +opt_lo :: DynFlags -> [String] +opt_lo dflags = sOpt_lo (settings dflags) +opt_lc :: DynFlags -> [String] +opt_lc dflags = sOpt_lc (settings dflags) + wayNames :: DynFlags -> [WayName] wayNames = map wayName . ways @@ -647,8 +725,8 @@ initDynFlags dflags = do -- | The normal 'DynFlags'. Note that they is not suitable for use in this form -- and must be fully initialized by 'GHC.newSession' first. -defaultDynFlags :: DynFlags -defaultDynFlags = +defaultDynFlags :: Settings -> DynFlags +defaultDynFlags mySettings = DynFlags { ghcMode = CompManager, ghcLink = LinkBinary, @@ -698,25 +776,11 @@ defaultDynFlags = libraryPaths = [], frameworkPaths = [], cmdlineFrameworks = [], - tmpDir = cDEFAULT_TMPDIR, rtsOpts = Nothing, rtsOptsEnabled = RtsOptsSafeOnly, hpcDir = ".hpc", - opt_L = [], - opt_P = (if opt_PIC - then ["-D__PIC__", "-U __PIC__"] -- this list is reversed - else []), - opt_F = [], - opt_c = [], - opt_a = [], - opt_m = [], - opt_l = [], - opt_windres = [], - opt_lo = [], - opt_lc = [], - extraPkgConfs = [], packageFlags = [], pkgDatabase = Nothing, @@ -725,25 +789,7 @@ defaultDynFlags = buildTag = panic "defaultDynFlags: No buildTag", rtsBuildTag = panic "defaultDynFlags: No rtsBuildTag", splitInfo = Nothing, - -- initSysTools fills all these in - ghcUsagePath = panic "defaultDynFlags: No ghciUsagePath", - ghciUsagePath = panic "defaultDynFlags: No ghciUsagePath", - topDir = panic "defaultDynFlags: No topDir", - systemPackageConfig = panic "no systemPackageConfig: call GHC.setSessionDynFlags", - pgm_L = panic "defaultDynFlags: No pgm_L", - pgm_P = panic "defaultDynFlags: No pgm_P", - pgm_F = panic "defaultDynFlags: No pgm_F", - pgm_c = panic "defaultDynFlags: No pgm_c", - pgm_s = panic "defaultDynFlags: No pgm_s", - pgm_a = panic "defaultDynFlags: No pgm_a", - pgm_l = panic "defaultDynFlags: No pgm_l", - pgm_dll = panic "defaultDynFlags: No pgm_dll", - pgm_T = panic "defaultDynFlags: No pgm_T", - pgm_sysman = panic "defaultDynFlags: No pgm_sysman", - pgm_windres = panic "defaultDynFlags: No pgm_windres", - pgm_lo = panic "defaultDynFlags: No pgm_lo", - pgm_lc = panic "defaultDynFlags: No pgm_lc", - -- end of initSysTools values + settings = mySettings, -- ghc -M values depMakefile = "Makefile", depIncludePkgDeps = False, @@ -917,9 +963,9 @@ setDumpPrefixForce f d = d { dumpPrefixForce = f} -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"] -- Config.hs should really use Option. -setPgmP f d = let (pgm:args) = words f in d{ pgm_P = (pgm, map Option args)} -addOptl f d = d{ opt_l = f : opt_l d} -addOptP f d = d{ opt_P = f : opt_P d} +setPgmP f = let (pgm:args) = words f in alterSettings (\s -> s { sPgm_P = (pgm, map Option args)}) +addOptl f = alterSettings (\s -> s { sOpt_l = f : sOpt_l s}) +addOptP f = alterSettings (\s -> s { sOpt_P = f : sOpt_P s}) setDepMakefile :: FilePath -> DynFlags -> DynFlags @@ -1100,30 +1146,30 @@ dynamic_flags = [ ------- Specific phases -------------------------------------------- -- need to appear before -pgmL to be parsed as LLVM flags. - , Flag "pgmlo" (hasArg (\f d -> d{ pgm_lo = (f,[])})) - , Flag "pgmlc" (hasArg (\f d -> d{ pgm_lc = (f,[])})) - , Flag "pgmL" (hasArg (\f d -> d{ pgm_L = f})) + , Flag "pgmlo" (hasArg (\f -> alterSettings (\s -> s { sPgm_lo = (f,[])}))) + , Flag "pgmlc" (hasArg (\f -> alterSettings (\s -> s { sPgm_lc = (f,[])}))) + , Flag "pgmL" (hasArg (\f -> alterSettings (\s -> s { sPgm_L = f}))) , Flag "pgmP" (hasArg setPgmP) - , Flag "pgmF" (hasArg (\f d -> d{ pgm_F = f})) - , Flag "pgmc" (hasArg (\f d -> d{ pgm_c = (f,[])})) + , Flag "pgmF" (hasArg (\f -> alterSettings (\s -> s { sPgm_F = f}))) + , Flag "pgmc" (hasArg (\f -> alterSettings (\s -> s { sPgm_c = (f,[])}))) , Flag "pgmm" (HasArg (\_ -> addWarn "The -keep-raw-s-files flag does nothing; it will be removed in a future GHC release")) - , Flag "pgms" (hasArg (\f d -> d{ pgm_s = (f,[])})) - , Flag "pgma" (hasArg (\f d -> d{ pgm_a = (f,[])})) - , Flag "pgml" (hasArg (\f d -> d{ pgm_l = (f,[])})) - , Flag "pgmdll" (hasArg (\f d -> d{ pgm_dll = (f,[])})) - , Flag "pgmwindres" (hasArg (\f d -> d{ pgm_windres = f})) + , Flag "pgms" (hasArg (\f -> alterSettings (\s -> s { sPgm_s = (f,[])}))) + , Flag "pgma" (hasArg (\f -> alterSettings (\s -> s { sPgm_a = (f,[])}))) + , Flag "pgml" (hasArg (\f -> alterSettings (\s -> s { sPgm_l = (f,[])}))) + , Flag "pgmdll" (hasArg (\f -> alterSettings (\s -> s { sPgm_dll = (f,[])}))) + , Flag "pgmwindres" (hasArg (\f -> alterSettings (\s -> s { sPgm_windres = f}))) -- need to appear before -optl/-opta to be parsed as LLVM flags. - , Flag "optlo" (hasArg (\f d -> d{ opt_lo = f : opt_lo d})) - , Flag "optlc" (hasArg (\f d -> d{ opt_lc = f : opt_lc d})) - , Flag "optL" (hasArg (\f d -> d{ opt_L = f : opt_L d})) + , Flag "optlo" (hasArg (\f -> alterSettings (\s -> s { sOpt_lo = f : sOpt_lo s}))) + , Flag "optlc" (hasArg (\f -> alterSettings (\s -> s { sOpt_lc = f : sOpt_lc s}))) + , Flag "optL" (hasArg (\f -> alterSettings (\s -> s { sOpt_L = f : sOpt_L s}))) , Flag "optP" (hasArg addOptP) - , Flag "optF" (hasArg (\f d -> d{ opt_F = f : opt_F d})) - , Flag "optc" (hasArg (\f d -> d{ opt_c = f : opt_c d})) - , Flag "optm" (hasArg (\f d -> d{ opt_m = f : opt_m d})) - , Flag "opta" (hasArg (\f d -> d{ opt_a = f : opt_a d})) + , Flag "optF" (hasArg (\f -> alterSettings (\s -> s { sOpt_F = f : sOpt_F s}))) + , Flag "optc" (hasArg (\f -> alterSettings (\s -> s { sOpt_c = f : sOpt_c s}))) + , Flag "optm" (hasArg (\f -> alterSettings (\s -> s { sOpt_m = f : sOpt_m s}))) + , Flag "opta" (hasArg (\f -> alterSettings (\s -> s { sOpt_a = f : sOpt_a s}))) , Flag "optl" (hasArg addOptl) - , Flag "optwindres" (hasArg (\f d -> d{ opt_windres = f : opt_windres d})) + , Flag "optwindres" (hasArg (\f -> alterSettings (\s -> s { sOpt_windres = f : sOpt_windres s}))) , Flag "split-objs" (NoArg (if can_split @@ -1327,7 +1373,7 @@ dynamic_flags = [ , Flag "fcontext-stack" (intSuffix (\n d -> d{ ctxtStkDepth = n })) , Flag "fstrictness-before" (intSuffix (\n d -> d{ strictnessBefore = n : strictnessBefore d })) , Flag "ffloat-lam-args" (intSuffix (\n d -> d{ floatLamArgs = Just n })) - , Flag "ffloat-all-lams" (intSuffix (\n d -> d{ floatLamArgs = Nothing })) + , Flag "ffloat-all-lams" (noArg (\d -> d{ floatLamArgs = Nothing })) ------ Profiling ---------------------------------------------------- @@ -1849,18 +1895,20 @@ foreign import ccall unsafe "rts_isProfiled" rtsIsProfiledIO :: IO CInt rtsIsProfiled :: Bool rtsIsProfiled = unsafePerformIO rtsIsProfiledIO /= 0 +#endif checkTemplateHaskellOk :: Bool -> DynP () -checkTemplateHaskellOk turn_on +#ifdef GHCI +checkTemplateHaskellOk turn_on | turn_on && rtsIsProfiled = addErr "You can't use Template Haskell with a profiled compiler" | otherwise = return () #else --- In stage 1 we don't know that the RTS has rts_isProfiled, +-- In stage 1 we don't know that the RTS has rts_isProfiled, -- so we simply say "ok". It doesn't matter because TH isn't -- available in stage 1 anyway. -checkTemplateHaskellOk turn_on = return () +checkTemplateHaskellOk _ = return () #endif {- ********************************************************************** @@ -1917,6 +1965,10 @@ unSetExtensionFlag f = upd (\dfs -> xopt_unset dfs f) -- (except for -fno-glasgow-exts, which is treated specially) -------------------------- +alterSettings :: (Settings -> Settings) -> DynFlags -> DynFlags +alterSettings f dflags = dflags { settings = f (settings dflags) } + +-------------------------- setDumpFlag' :: DynFlag -> DynP () setDumpFlag' dump_flag = do { setDynFlag dump_flag @@ -2131,7 +2183,7 @@ splitPathList s = filter notNull (splitUp s) -- tmpDir, where we store temporary files. setTmpDir :: FilePath -> DynFlags -> DynFlags -setTmpDir dir dflags = dflags{ tmpDir = normalise dir } +setTmpDir dir = alterSettings (\s -> s { sTmpDir = normalise dir }) -- we used to fix /cygdrive/c/.. on Windows, but this doesn't -- seem necessary now --SDM 7/2/2008 @@ -2156,17 +2208,16 @@ setOptHpcDir arg = upd $ \ d -> d{hpcDir = arg} -- There are some options that we need to pass to gcc when compiling -- Haskell code via C, but are only supported by recent versions of -- gcc. The configure script decides which of these options we need, --- and puts them in the file "extra-gcc-opts" in $topdir, which is --- read before each via-C compilation. The advantage of having these --- in a separate file is that the file can be created at install-time --- depending on the available gcc version, and even re-generated later --- if gcc is upgraded. +-- and puts them in the "settings" file in $topdir. The advantage of +-- having these in a separate file is that the file can be created at +-- install-time depending on the available gcc version, and even +-- re-generated later if gcc is upgraded. -- -- The options below are not dependent on the version of gcc, only the -- platform. machdepCCOpts :: DynFlags -> [String] -- flags for all C compilations -machdepCCOpts dflags = cCcOpts ++ machdepCCOpts' +machdepCCOpts _ = cCcOpts ++ machdepCCOpts' machdepCCOpts' :: [String] -- flags for all C compilations machdepCCOpts' @@ -2238,30 +2289,35 @@ can_split = cSupportsSplitObjs == "YES" -- ----------------------------------------------------------------------------- -- Compiler Info -data Printable = String String - | FromDynFlags (DynFlags -> String) - -compilerInfo :: [(String, Printable)] -compilerInfo = [("Project name", String cProjectName), - ("Project version", String cProjectVersion), - ("Booter version", String cBooterVersion), - ("Stage", String cStage), - ("Build platform", String cBuildPlatformString), - ("Host platform", String cHostPlatformString), - ("Target platform", String cTargetPlatformString), - ("Have interpreter", String cGhcWithInterpreter), - ("Object splitting supported", String cSupportsSplitObjs), - ("Have native code generator", String cGhcWithNativeCodeGen), - ("Support SMP", String cGhcWithSMP), - ("Unregisterised", String cGhcUnregisterised), - ("Tables next to code", String cGhcEnableTablesNextToCode), - ("RTS ways", String cGhcRTSWays), - ("Leading underscore", String cLeadingUnderscore), - ("Debug on", String (show debugIsOn)), - ("LibDir", FromDynFlags topDir), - ("Global Package DB", FromDynFlags systemPackageConfig), - ("C compiler flags", String (show cCcOpts)), - ("Gcc Linker flags", String (show cGccLinkerOpts)), - ("Ld Linker flags", String (show cLdLinkerOpts)) - ] +compilerInfo :: DynFlags -> [(String, String)] +compilerInfo dflags + = -- We always make "Project name" be first to keep parsing in + -- other languages simple, i.e. when looking for other fields, + -- you don't have to worry whether there is a leading '[' or not + ("Project name", cProjectName) + -- Next come the settings, so anything else can be overridden + -- in the settings file (as "lookup" uses the first match for the + -- key) + : rawSettings dflags + ++ [("Project version", cProjectVersion), + ("Booter version", cBooterVersion), + ("Stage", cStage), + ("Build platform", cBuildPlatformString), + ("Host platform", cHostPlatformString), + ("Target platform", cTargetPlatformString), + ("Have interpreter", cGhcWithInterpreter), + ("Object splitting supported", cSupportsSplitObjs), + ("Have native code generator", cGhcWithNativeCodeGen), + ("Support SMP", cGhcWithSMP), + ("Unregisterised", cGhcUnregisterised), + ("Tables next to code", cGhcEnableTablesNextToCode), + ("RTS ways", cGhcRTSWays), + ("Leading underscore", cLeadingUnderscore), + ("Debug on", show debugIsOn), + ("LibDir", topDir dflags), + ("Global Package DB", systemPackageConfig dflags), + ("C compiler flags", show cCcOpts), + ("Gcc Linker flags", show cGccLinkerOpts), + ("Ld Linker flags", show cLdLinkerOpts) + ] diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index ca2e14c..a9e652d 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -431,8 +431,8 @@ initGhcMonad mb_top_dir = do liftIO $ StaticFlags.initStaticOpts - dflags0 <- liftIO $ initDynFlags defaultDynFlags - dflags <- liftIO $ initSysTools mb_top_dir dflags0 + mySettings <- liftIO $ initSysTools mb_top_dir + dflags <- liftIO $ initDynFlags (defaultDynFlags mySettings) env <- liftIO $ newHscEnv dflags setSession env diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index 5e265e8..451f78d 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -36,7 +36,7 @@ where #include "HsVersions.h" import PackageConfig -import DynFlags ( dopt, DynFlag(..), DynFlags(..), PackageFlag(..), DPHBackend(..) ) +import DynFlags import StaticFlags import Config ( cProjectVersion ) import Name ( Name, nameModule_maybe ) diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs index 049b61f..eddc9ca 100644 --- a/compiler/main/StaticFlags.hs +++ b/compiler/main/StaticFlags.hs @@ -167,7 +167,7 @@ try_read sw str = case reads str of ((x,_):_) -> x -- Be forgiving: ignore trailing goop, and alternative parses [] -> ghcError (UsageError ("Malformed argument " ++ str ++ " for flag " ++ sw)) - -- ToDo: hack alert. We should really parse the arugments + -- ToDo: hack alert. We should really parse the arguments -- and announce errors in a more civilised way. diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index 5c64a34..2529dbf 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -26,7 +26,6 @@ module SysTools ( touch, -- String -> String -> IO () copy, copyWithHeader, - getExtraViaCOpts, -- Temporary-file management setTmpDir, @@ -47,6 +46,7 @@ import ErrUtils import Panic import Util import DynFlags +import StaticFlags import Exception import Data.IORef @@ -148,25 +148,44 @@ stuff. \begin{code} initSysTools :: Maybe String -- Maybe TopDir path (without the '-B' prefix) - - -> DynFlags - -> IO DynFlags -- Set all the mutable variables above, holding + -> IO Settings -- Set all the mutable variables above, holding -- (a) the system programs -- (b) the package-config file -- (c) the GHC usage message - - -initSysTools mbMinusB dflags0 +initSysTools mbMinusB = do { top_dir <- findTopDir mbMinusB -- see [Note topdir] -- NB: top_dir is assumed to be in standard Unix -- format, '/' separated - ; let installed :: FilePath -> FilePath + ; let settingsFile = top_dir "settings" + installed :: FilePath -> FilePath installed file = top_dir file installed_mingw_bin file = top_dir ".." "mingw" "bin" file installed_perl_bin file = top_dir ".." "perl" file + ; settingsStr <- readFile settingsFile + ; mySettings <- case maybeReadFuzzy settingsStr of + Just s -> + return s + Nothing -> + pgmError ("Can't parse " ++ show settingsFile) + ; let getSetting key = case lookup key mySettings of + Just xs -> + return xs + Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile) + ; myExtraGccViaCFlags <- getSetting "GCC extra via C opts" + -- On Windows, mingw is distributed with GHC, + -- so we look in TopDir/../mingw/bin + -- It would perhaps be nice to be able to override this + -- with the settings file, but it would be a little fiddly + -- to make that possible, so for now you can't. + ; gcc_prog <- if isWindowsHost then return $ installed_mingw_bin "gcc" + else getSetting "C compiler command" + ; perl_path <- if isWindowsHost + then return $ installed_perl_bin "perl" + else getSetting "perl command" + ; let pkgconfig_path = installed "package.conf.d" ghc_usage_msg_path = installed "ghc-usage.txt" ghci_usage_msg_path = installed "ghci-usage.txt" @@ -181,17 +200,8 @@ initSysTools mbMinusB dflags0 windres_path = installed_mingw_bin "windres" ; tmpdir <- getTemporaryDirectory - ; let dflags1 = setTmpDir tmpdir dflags0 - -- On Windows, mingw is distributed with GHC, - -- so we look in TopDir/../mingw/bin ; let - gcc_prog - | isWindowsHost = installed_mingw_bin "gcc" - | otherwise = cGCC - perl_path - | isWindowsHost = installed_perl_bin cGHC_PERL - | otherwise = cGHC_PERL -- 'touch' is a GHC util for Windows touch_path | isWindowsHost = installed cGHC_TOUCHY_PGM @@ -225,26 +235,42 @@ initSysTools mbMinusB dflags0 ; let lc_prog = "llc" lo_prog = "opt" - ; return dflags1{ - ghcUsagePath = ghc_usage_msg_path, - ghciUsagePath = ghci_usage_msg_path, - topDir = top_dir, - systemPackageConfig = pkgconfig_path, - pgm_L = unlit_path, - pgm_P = cpp_path, - pgm_F = "", - pgm_c = (gcc_prog,[]), - pgm_s = (split_prog,split_args), - pgm_a = (as_prog,[]), - pgm_l = (ld_prog,[]), - pgm_dll = (mkdll_prog,mkdll_args), - pgm_T = touch_path, - pgm_sysman = top_dir ++ "/ghc/rts/parallel/SysMan", - pgm_windres = windres_path, - pgm_lo = (lo_prog,[]), - pgm_lc = (lc_prog,[]) + ; return $ Settings { + sTmpDir = normalise tmpdir, + sGhcUsagePath = ghc_usage_msg_path, + sGhciUsagePath = ghci_usage_msg_path, + sTopDir = top_dir, + sRawSettings = mySettings, + sExtraGccViaCFlags = words myExtraGccViaCFlags, + sSystemPackageConfig = pkgconfig_path, + sPgm_L = unlit_path, + sPgm_P = cpp_path, + sPgm_F = "", + sPgm_c = (gcc_prog,[]), + sPgm_s = (split_prog,split_args), + sPgm_a = (as_prog,[]), + sPgm_l = (ld_prog,[]), + sPgm_dll = (mkdll_prog,mkdll_args), + sPgm_T = touch_path, + sPgm_sysman = top_dir ++ "/ghc/rts/parallel/SysMan", + sPgm_windres = windres_path, + sPgm_lo = (lo_prog,[]), + sPgm_lc = (lc_prog,[]), -- Hans: this isn't right in general, but you can -- elaborate it in the same way as the others + sOpt_L = [], + sOpt_P = (if opt_PIC + then -- this list gets reversed + ["-D__PIC__", "-U __PIC__"] + else []), + sOpt_F = [], + sOpt_c = [], + sOpt_a = [], + sOpt_m = [], + sOpt_l = [], + sOpt_windres = [], + sOpt_lo = [], + sOpt_lc = [] } } \end{code} @@ -448,11 +474,6 @@ copyWithHeader dflags purpose maybe_header from to = do hClose hout hClose hin -getExtraViaCOpts :: DynFlags -> IO [String] -getExtraViaCOpts dflags = do - f <- readFile (topDir dflags "extra-gcc-opts") - return (words f) - -- | read the contents of the named section in an ELF object as a -- String. readElfSection :: DynFlags -> String -> FilePath -> IO (Maybe String) @@ -527,8 +548,9 @@ newTempName dflags extn -- return our temporary directory within tmp_dir, creating one if we -- don't have one yet getTempDir :: DynFlags -> IO FilePath -getTempDir dflags@(DynFlags{tmpDir=tmp_dir}) +getTempDir dflags = do let ref = dirsToClean dflags + tmp_dir = tmpDir dflags mapping <- readIORef ref case Map.lookup tmp_dir mapping of Nothing -> diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs index 21822a8..df3b12d 100644 --- a/compiler/rename/RnBinds.lhs +++ b/compiler/rename/RnBinds.lhs @@ -306,7 +306,10 @@ rnValBindsRHS trim mb_bound_names (ValBindsIn mbinds sigs) (anal_binds, anal_dus) -> return (valbind', valbind'_dus) where valbind' = ValBindsOut anal_binds sigs' - valbind'_dus = usesOnly (hsSigsFVs sigs') `plusDU` anal_dus + valbind'_dus = anal_dus `plusDU` usesOnly (hsSigsFVs sigs') + -- Put the sig uses *after* the bindings + -- so that the binders are removed from + -- the uses in the sigs } rnValBindsRHS _ _ b = pprPanic "rnValBindsRHS" (ppr b) diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index 8249c89..db84c90 100644 --- a/compiler/simplCore/Simplify.lhs +++ b/compiler/simplCore/Simplify.lhs @@ -1237,10 +1237,10 @@ completeCall env var cont | not (dopt Opt_D_dump_inlinings dflags) = stuff | not (dopt Opt_D_verbose_core2core dflags) = if isExternalName (idName var) then - pprTrace "Inlining done:" (ppr var) stuff + pprDefiniteTrace "Inlining done:" (ppr var) stuff else stuff | otherwise - = pprTrace ("Inlining done: " ++ showSDoc (ppr var)) + = pprDefiniteTrace ("Inlining done: " ++ showSDoc (ppr var)) (vcat [text "Inlined fn: " <+> nest 2 (ppr unfolding), text "Cont: " <+> ppr cont]) stuff @@ -1393,10 +1393,10 @@ tryRules env rules fn args call_cont , not (dopt Opt_D_dump_rule_rewrites dflags) = stuff | not (dopt Opt_D_dump_rule_rewrites dflags) - = pprTrace "Rule fired:" (ftext (ru_name rule)) stuff + = pprDefiniteTrace "Rule fired:" (ftext (ru_name rule)) stuff | otherwise - = pprTrace "Rule fired" + = pprDefiniteTrace "Rule fired" (vcat [text "Rule:" <+> ftext (ru_name rule), text "Before:" <+> hang (ppr fn) 2 (sep (map pprParendExpr args)), text "After: " <+> pprCoreExpr rule_rhs, diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs index f714943..645c43a 100644 --- a/compiler/typecheck/TcErrors.lhs +++ b/compiler/typecheck/TcErrors.lhs @@ -15,6 +15,7 @@ import TcMType import TcSMonad import TcType import TypeRep +import Type( isTyVarTy ) import Inst import InstEnv @@ -320,15 +321,10 @@ reportEqErr ctxt ty1 ty2 reportTyVarEqErr :: ReportErrCtxt -> TcTyVar -> TcType -> TcM () -- tv1 and ty2 are already tidied reportTyVarEqErr ctxt tv1 ty2 - | not is_meta1 - , Just tv2 <- tcGetTyVar_maybe ty2 - , isMetaTyVar tv2 - = -- sk ~ alpha: swap - reportTyVarEqErr ctxt tv2 ty1 - - | (not is_meta1) - = -- sk ~ ty, where ty isn't a meta-tyvar: mis-match - addErrorReport (addExtraInfo ctxt ty1 ty2) + | isSkolemTyVar tv1 -- ty2 won't be a meta-tyvar, or else the thing would + -- be oriented the other way round; see TcCanonical.reOrient + || isSigTyVar tv1 && not (isTyVarTy ty2) + = addErrorReport (addExtraInfo ctxt ty1 ty2) (misMatchOrCND ctxt ty1 ty2) -- So tv is a meta tyvar, and presumably it is @@ -376,21 +372,26 @@ reportTyVarEqErr ctxt tv1 ty2 , ptext (sLit "bound at") <+> ppr (ctLocOrigin implic_loc)] ; addErrorReport (addExtraInfo ctxt ty1 ty2) (msg $$ nest 2 extra) } - | otherwise -- This can happen, by a recursive decomposition of frozen - -- occurs check constraints - -- Example: alpha ~ T Int alpha has frozen. - -- Then alpha gets unified to T beta gamma - -- So now we have T beta gamma ~ T Int (T beta gamma) - -- Decompose to (beta ~ Int, gamma ~ T beta gamma) - -- The (gamma ~ T beta gamma) is the occurs check, but - -- the (beta ~ Int) isn't an error at all. So return () - = return () - + | otherwise + = pprTrace "reportTyVarEqErr" (ppr tv1 $$ ppr ty2 $$ ppr (cec_encl ctxt)) $ + return () + -- I don't think this should happen, and if it does I want to know + -- Trac #5130 happened because an actual type error was not + -- reported at all! So not reporting is pretty dangerous. + -- + -- OLD, OUT OF DATE COMMENT + -- This can happen, by a recursive decomposition of frozen + -- occurs check constraints + -- Example: alpha ~ T Int alpha has frozen. + -- Then alpha gets unified to T beta gamma + -- So now we have T beta gamma ~ T Int (T beta gamma) + -- Decompose to (beta ~ Int, gamma ~ T beta gamma) + -- The (gamma ~ T beta gamma) is the occurs check, but + -- the (beta ~ Int) isn't an error at all. So return () where - is_meta1 = isMetaTyVar tv1 - k1 = tyVarKind tv1 - k2 = typeKind ty2 - ty1 = mkTyVarTy tv1 + k1 = tyVarKind tv1 + k2 = typeKind ty2 + ty1 = mkTyVarTy tv1 mkTyFunInfoMsg :: TcType -> TcType -> SDoc -- See Note [Non-injective type functions] @@ -458,12 +459,22 @@ typeExtraInfoMsg :: [Implication] -> Type -> SDoc -- Shows a bit of extra info about skolem constants typeExtraInfoMsg implics ty | Just tv <- tcGetTyVar_maybe ty - , isTcTyVar tv - , isSkolemTyVar tv - = pprSkolTvBinding implics tv - where -typeExtraInfoMsg _ _ = empty -- Normal case - + , isTcTyVar tv, isSkolemTyVar tv + , let pp_tv = quotes (ppr tv) + = case tcTyVarDetails tv of + SkolemTv {} -> pp_tv <+> ppr_skol (getSkolemInfo implics tv) (getSrcLoc tv) + FlatSkol {} -> pp_tv <+> ptext (sLit "is a flattening type variable") + RuntimeUnk {} -> pp_tv <+> ptext (sLit "is an interactive-debugger skolem") + MetaTv {} -> empty + + | otherwise -- Normal case + = empty + + where + ppr_skol UnkSkol _ = ptext (sLit "is an unknown type variable") -- Unhelpful + ppr_skol info loc = sep [ptext (sLit "is a rigid type variable bound by"), + sep [ppr info, ptext (sLit "at") <+> ppr loc]] + -------------------- unifyCtxt :: EqOrigin -> TidyEnv -> TcM (TidyEnv, SDoc) unifyCtxt (UnifyOrigin { uo_actual = act_ty, uo_expected = exp_ty }) tidy_env @@ -659,7 +670,6 @@ mkMonomorphismMsg :: ReportErrCtxt -> [TcTyVar] -> TcM (TidyEnv, SDoc) -- ASSUMPTION: the Insts are fully zonked mkMonomorphismMsg ctxt inst_tvs = do { dflags <- getDOpts - ; traceTc "Mono" (vcat (map (pprSkolTvBinding (cec_encl ctxt)) inst_tvs)) ; (tidy_env, docs) <- findGlobals ctxt (mkVarSet inst_tvs) ; return (tidy_env, mk_msg dflags docs) } where @@ -685,28 +695,6 @@ monomorphism_fix dflags else empty] -- Only suggest adding "-XNoMonomorphismRestriction" -- if it is not already set! - -pprSkolTvBinding :: [Implication] -> TcTyVar -> SDoc --- Print info about the binding of a skolem tyvar, --- or nothing if we don't have anything useful to say -pprSkolTvBinding implics tv - | isTcTyVar tv = quotes (ppr tv) <+> ppr_details (tcTyVarDetails tv) - | otherwise = quotes (ppr tv) <+> ppr_skol (getSkolemInfo implics tv) - where - ppr_details (SkolemTv {}) = ppr_skol (getSkolemInfo implics tv) - ppr_details (FlatSkol {}) = ptext (sLit "is a flattening type variable") - ppr_details (RuntimeUnk {}) = ptext (sLit "is an interactive-debugger skolem") - ppr_details (MetaTv (SigTv n) _) = ptext (sLit "is bound by the type signature for") - <+> quotes (ppr n) - ppr_details (MetaTv _ _) = ptext (sLit "is a meta type variable") - - - ppr_skol UnkSkol = ptext (sLit "is an unknown type variable") -- Unhelpful - ppr_skol RuntimeUnkSkol = ptext (sLit "is an unknown runtime type") - ppr_skol info = sep [ptext (sLit "is a rigid type variable bound by"), - sep [ppr info, - ptext (sLit "at") <+> ppr (getSrcLoc tv)]] - getSkolemInfo :: [Implication] -> TcTyVar -> SkolemInfo getSkolemInfo [] tv = WARN( True, ptext (sLit "No skolem info:") <+> ppr tv ) diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs index 7453334..1d163aa 100644 --- a/compiler/typecheck/TcMType.lhs +++ b/compiler/typecheck/TcMType.lhs @@ -34,8 +34,8 @@ module TcMType ( -------------------------------- -- Instantiation - tcInstTyVar, tcInstTyVars, tcInstSigTyVars, - tcInstType, instMetaTyVar, + tcInstTyVars, tcInstSigTyVars, + tcInstType, tcInstSkolTyVars, tcInstSuperSkolTyVars, tcInstSkolTyVar, tcInstSkolType, tcSkolDFunType, tcSuperSkolTyVars, @@ -258,8 +258,17 @@ tcInstSkolType ty = tcInstType tcInstSkolTyVars ty tcInstSigTyVars :: [TyVar] -> TcM [TcTyVar] -- Make meta SigTv type variables for patten-bound scoped type varaibles -- We use SigTvs for them, so that they can't unify with arbitrary types -tcInstSigTyVars = mapM (\tv -> instMetaTyVar (SigTv (tyVarName tv)) tv) - -- ToDo: the "function binding site is bogus +tcInstSigTyVars = mapM tcInstSigTyVar + +tcInstSigTyVar :: TyVar -> TcM TcTyVar +tcInstSigTyVar tyvar + = do { uniq <- newMetaUnique + ; ref <- newMutVar Flexi + ; let name = setNameUnique (tyVarName tyvar) uniq + -- Use the same OccName so that the tidy-er + -- doesn't rename 'a' to 'a0' etc + kind = tyVarKind tyvar + ; return (mkTcTyVar name kind (MetaTv SigTv ref)) } \end{code} @@ -277,9 +286,9 @@ newMetaTyVar meta_info kind ; ref <- newMutVar Flexi ; let name = mkTcTyVarName uniq s s = case meta_info of - TauTv -> fsLit "t" - TcsTv -> fsLit "u" - SigTv _ -> fsLit "a" + TauTv -> fsLit "t" + TcsTv -> fsLit "u" + SigTv -> fsLit "a" ; return (mkTcTyVar name kind (MetaTv meta_info ref)) } mkTcTyVarName :: Unique -> FastString -> Name @@ -287,16 +296,6 @@ mkTcTyVarName :: Unique -> FastString -> Name -- leaving the un-cluttered names free for user names mkTcTyVarName uniq str = mkSysTvName uniq str -instMetaTyVar :: MetaInfo -> TyVar -> TcM TcTyVar --- Make a new meta tyvar whose Name and Kind --- come from an existing TyVar -instMetaTyVar meta_info tyvar - = do { uniq <- newMetaUnique - ; ref <- newMutVar Flexi - ; let name = mkSystemName uniq (getOccName tyvar) - kind = tyVarKind tyvar - ; return (mkTcTyVar name kind (MetaTv meta_info ref)) } - readMetaTyVar :: TyVar -> TcM MetaDetails readMetaTyVar tyvar = ASSERT2( isMetaTyVar tyvar, ppr tyvar ) readMutVar (metaTvRef tyvar) @@ -394,10 +393,6 @@ newFlexiTyVarTy kind = do newFlexiTyVarTys :: Int -> Kind -> TcM [TcType] newFlexiTyVarTys n kind = mapM newFlexiTyVarTy (nOfThem n kind) -tcInstTyVar :: TyVar -> TcM TcTyVar --- Instantiate with a META type variable -tcInstTyVar tyvar = instMetaTyVar TauTv tyvar - tcInstTyVars :: [TyVar] -> TcM ([TcTyVar], [TcType], TvSubst) -- Instantiate with META type variables tcInstTyVars tyvars @@ -407,6 +402,16 @@ tcInstTyVars tyvars -- Since the tyvars are freshly made, -- they cannot possibly be captured by -- any existing for-alls. Hence zipTopTvSubst + +tcInstTyVar :: TyVar -> TcM TcTyVar +-- Make a new unification variable tyvar whose Name and Kind +-- come from an existing TyVar +tcInstTyVar tyvar + = do { uniq <- newMetaUnique + ; ref <- newMutVar Flexi + ; let name = mkSystemName uniq (getOccName tyvar) + kind = tyVarKind tyvar + ; return (mkTcTyVar name kind (MetaTv TauTv ref)) } \end{code} diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index ada8180..79f2a74 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -1042,9 +1042,6 @@ data SkolemInfo -- polymorphic Ids, and are now checking that their RHS -- constraints are satisfied. - | RuntimeUnkSkol -- a type variable used to represent an unknown - -- runtime type (used in the GHCi debugger) - | BracketSkol -- Template Haskell bracket | UnkSkol -- Unhelpful info (until I improve it) @@ -1079,8 +1076,7 @@ pprSkolInfo (InferSkol ids) = sep [ ptext (sLit "the inferred type of") -- UnkSkol -- For type variables the others are dealt with by pprSkolTvBinding. -- For Insts, these cases should not happen -pprSkolInfo UnkSkol = WARN( True, text "pprSkolInfo: UnkSkol" ) ptext (sLit "UnkSkol") -pprSkolInfo RuntimeUnkSkol = WARN( True, text "pprSkolInfo: RuntimeUnkSkol" ) ptext (sLit "RuntimeUnkSkol") +pprSkolInfo UnkSkol = WARN( True, text "pprSkolInfo: UnkSkol" ) ptext (sLit "UnkSkol") \end{code} diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index cbf9330..647f22f 100644 --- a/compiler/typecheck/TcSMonad.lhs +++ b/compiler/typecheck/TcSMonad.lhs @@ -528,7 +528,8 @@ runTcS context untouch tcs #ifdef DEBUG ; count <- TcM.readTcRef step_count ; when (count > 0) $ - TcM.dumpTcRn (ptext (sLit "Constraint solver steps =") <+> int count <+> ppr context) + TcM.debugDumpTcRn (ptext (sLit "Constraint solver steps =") + <+> int count <+> ppr context) #endif -- And return ; ev_binds <- TcM.readTcRef evb_ref diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs index eab0732..d9166d1 100644 --- a/compiler/typecheck/TcType.lhs +++ b/compiler/typecheck/TcType.lhs @@ -306,14 +306,12 @@ data MetaInfo -- A TauTv is always filled in with a tau-type, which -- never contains any ForAlls - | SigTv Name -- A variant of TauTv, except that it should not be + | SigTv -- A variant of TauTv, except that it should not be -- unified with a type, only with a type variable -- SigTvs are only distinguished to improve error messages -- see Note [Signature skolems] -- The MetaDetails, if filled in, will -- always be another SigTv or a SkolemTv - -- The Name is the name of the function from whose - -- type signature we got this skolem | TcsTv -- A MetaTv allocated by the constraint solver -- Its particular property is that it is always "touchable" @@ -392,12 +390,12 @@ kind_var_occ = mkOccName tvName "k" \begin{code} pprTcTyVarDetails :: TcTyVarDetails -> SDoc -- For debugging -pprTcTyVarDetails (SkolemTv {}) = ptext (sLit "sk") -pprTcTyVarDetails (RuntimeUnk {}) = ptext (sLit "rt") -pprTcTyVarDetails (FlatSkol {}) = ptext (sLit "fsk") -pprTcTyVarDetails (MetaTv TauTv _) = ptext (sLit "tau") -pprTcTyVarDetails (MetaTv TcsTv _) = ptext (sLit "tcs") -pprTcTyVarDetails (MetaTv (SigTv _) _) = ptext (sLit "sig") +pprTcTyVarDetails (SkolemTv {}) = ptext (sLit "sk") +pprTcTyVarDetails (RuntimeUnk {}) = ptext (sLit "rt") +pprTcTyVarDetails (FlatSkol {}) = ptext (sLit "fsk") +pprTcTyVarDetails (MetaTv TauTv _) = ptext (sLit "tau") +pprTcTyVarDetails (MetaTv TcsTv _) = ptext (sLit "tcs") +pprTcTyVarDetails (MetaTv SigTv _) = ptext (sLit "sig") pprUserTypeCtxt :: UserTypeCtxt -> SDoc pprUserTypeCtxt (FunSigCtxt n) = ptext (sLit "the type signature for") <+> quotes (ppr n) @@ -552,8 +550,8 @@ isTyConableTyVar tv -- not a SigTv = ASSERT( isTcTyVar tv) case tcTyVarDetails tv of - MetaTv (SigTv _) _ -> False - _ -> True + MetaTv SigTv _ -> False + _ -> True isSkolemTyVar tv = ASSERT2( isTcTyVar tv, ppr tv ) @@ -583,8 +581,8 @@ isSigTyVar :: Var -> Bool isSigTyVar tv = ASSERT( isTcTyVar tv ) case tcTyVarDetails tv of - MetaTv (SigTv _) _ -> True - _ -> False + MetaTv SigTv _ -> True + _ -> False metaTvRef :: TyVar -> IORef MetaDetails metaTvRef tv diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs index 4fc50b3..31352e1 100644 --- a/compiler/typecheck/TcUnify.lhs +++ b/compiler/typecheck/TcUnify.lhs @@ -899,8 +899,8 @@ uUnfilledVars origin swapped tv1 details1 tv2 details2 ty1 = mkTyVarTy tv1 ty2 = mkTyVarTy tv2 - nicer_to_update_tv1 _ (SigTv _) = True - nicer_to_update_tv1 (SigTv _) _ = False + nicer_to_update_tv1 _ SigTv = True + nicer_to_update_tv1 SigTv _ = False nicer_to_update_tv1 _ _ = isSystemName (Var.varName tv1) -- Try not to update SigTvs; and try to update sys-y type -- variables in preference to ones gotten (say) by diff --git a/compiler/utils/Bag.lhs b/compiler/utils/Bag.lhs index 097a112..700878a 100644 --- a/compiler/utils/Bag.lhs +++ b/compiler/utils/Bag.lhs @@ -41,6 +41,7 @@ data Bag a | UnitBag a | TwoBags (Bag a) (Bag a) -- INVARIANT: neither branch is empty | ListBag [a] -- INVARIANT: the list is non-empty + deriving Typeable emptyBag :: Bag a emptyBag = EmptyBag @@ -262,8 +263,6 @@ bagToList b = foldrBag (:) [] b instance (Outputable a) => Outputable (Bag a) where ppr bag = braces (pprWithCommas ppr (bagToList bag)) -INSTANCE_TYPEABLE1(Bag,bagTc,"Bag") - instance Data a => Data (Bag a) where gfoldl k z b = z listToBag `k` bagToList b -- traverse abstract type abstractly toConstr _ = abstractConstr $ "Bag("++show (typeOf (undefined::a))++")" diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs index e178e99..c4a685b 100644 --- a/compiler/utils/Outputable.lhs +++ b/compiler/utils/Outputable.lhs @@ -60,7 +60,7 @@ module Outputable ( -- * Error handling and debugging utilities pprPanic, pprSorry, assertPprPanic, pprPanicFastInt, pprPgmError, - pprTrace, warnPprTrace, + pprTrace, pprDefiniteTrace, warnPprTrace, trace, pgmError, panic, sorry, panicFastInt, assertPanic ) where @@ -800,6 +800,9 @@ pprTrace str doc x | opt_NoDebugOutput = x | otherwise = pprAndThen trace str doc x +pprDefiniteTrace :: String -> SDoc -> a -> a +-- ^ Same as pprTrace, but show even if -dno-debug-output is on +pprDefiniteTrace str doc x = pprAndThen trace str doc x pprPanicFastInt :: String -> SDoc -> FastInt -- ^ Specialization of pprPanic that can be safely used with 'FastInt' diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs index 0e46889..dc4f32e 100644 --- a/compiler/utils/Util.lhs +++ b/compiler/utils/Util.lhs @@ -66,6 +66,9 @@ module Util ( -- * Floating point readRational, + -- * read helpers + maybeReadFuzzy, + -- * IO-ish utilities createDirectoryHierarchy, doesDirNameExist, @@ -966,6 +969,17 @@ readRational top_s ----------------------------------------------------------------------------- +-- read helpers + +maybeReadFuzzy :: Read a => String -> Maybe a +maybeReadFuzzy str = case reads str of + [(x, s)] + | all isSpace s -> + Just x + _ -> + Nothing + +----------------------------------------------------------------------------- -- Create a hierarchy of directories createDirectoryHierarchy :: FilePath -> IO () diff --git a/configure.ac b/configure.ac index 7baa3dd..9278126 100644 --- a/configure.ac +++ b/configure.ac @@ -132,10 +132,12 @@ if test "$WithGhc" != ""; then GhcCanonVersion="$GhcMajVersion$GhcMinVersion2" if test $GhcCanonVersion -ge 613; then ghc_ge_613=YES; else ghc_ge_613=NO; fi AC_SUBST(ghc_ge_613)dnl + + BOOTSTRAPPING_GHC_INFO_FIELD([CC_STAGE0],[C compiler command],['$(CC)']) fi dnl ** Must have GHC to build GHC, unless --enable-hc-boot is on -if test "$BootingFromHc" = "NO" -a -d "$srcdir/compiler"; then +if test "$BootingFromHc" = "NO"; then if test "$WithGhc" = ""; then AC_MSG_ERROR([GHC is required unless bootstrapping from .hc files.]) fi @@ -537,7 +539,7 @@ dnl ** look for GCC and find out which version dnl Figure out which C compiler to use. Gcc is preferred. dnl If gcc, make sure it's at least 2.1 dnl -FP_HAVE_GCC +FP_GCC_VERSION FPTOOLS_SET_C_LD_FLAGS([target],[CFLAGS],[LDFLAGS],[IGNORE_LINKER_LD_FLAGS],[CPPFLAGS]) FPTOOLS_SET_C_LD_FLAGS([build],[CONF_CC_OPTS_STAGE0],[CONF_GCC_LINKER_OPTS_STAGE0],[CONF_LD_LINKER_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) @@ -578,7 +580,6 @@ AC_DEFINE([HAVE_BIN_SH], [1], [Define to 1 if you have /bin/sh.]) dnl ** how to invoke `ar' and `ranlib' FP_PROG_AR_SUPPORTS_ATFILE FP_PROG_AR_NEEDS_RANLIB -FP_PROG_AR_SUPPORTS_INPUT dnl ** Check to see whether ln -s works AC_PROG_LN_S @@ -931,7 +932,7 @@ if grep ' ' compiler/ghc.cabal.in 2>&1 >/dev/null; then AC_MSG_ERROR([compiler/ghc.cabal.in contains tab characters; please remove them]) fi -AC_CONFIG_FILES([mk/config.mk mk/install.mk mk/project.mk compiler/ghc.cabal ghc/ghc-bin.cabal utils/runghc/runghc.cabal ghc.spec extra-gcc-opts docs/users_guide/ug-book.xml docs/users_guide/ug-ent.xml docs/index.html libraries/prologue.txt distrib/ghc.iss distrib/configure.ac]) +AC_CONFIG_FILES([mk/config.mk mk/install.mk mk/project.mk compiler/ghc.cabal ghc/ghc-bin.cabal utils/runghc/runghc.cabal ghc.spec settings docs/users_guide/ug-book.xml docs/users_guide/ug-ent.xml docs/index.html libraries/prologue.txt distrib/ghc.iss distrib/configure.ac]) AC_CONFIG_COMMANDS([mk/stamp-h],[echo timestamp > mk/stamp-h]) AC_OUTPUT diff --git a/distrib/Makefile b/distrib/Makefile index f1d63bc..7f8add1 100644 --- a/distrib/Makefile +++ b/distrib/Makefile @@ -34,7 +34,7 @@ install:: $(MAKE) -C gmp install DOING_BIN_DIST=YES $(MAKE) -C docs install-docs DOING_BIN_DIST=YES $(MAKE) -C libraries/Cabal/doc install-docs DOING_BIN_DIST=YES - $(INSTALL_DATA) $(INSTALL_OPTS) extra-gcc-opts $(libdir) + $(INSTALL_DATA) $(INSTALL_OPTS) settings $(libdir) install :: postinstall denounce diff --git a/distrib/configure.ac.in b/distrib/configure.ac.in index d5aa2be..7df0f3b 100644 --- a/distrib/configure.ac.in +++ b/distrib/configure.ac.in @@ -55,7 +55,7 @@ export CC WhatGccIsCalled="$CC" AC_SUBST(WhatGccIsCalled) -FP_HAVE_GCC +FP_GCC_VERSION AC_PROG_CPP # @@ -88,7 +88,7 @@ dnl ** how to invoke `ar' and `ranlib' FP_PROG_AR_NEEDS_RANLIB # -AC_CONFIG_FILES(extra-gcc-opts mk/config.mk mk/install.mk) +AC_CONFIG_FILES(settings mk/config.mk mk/install.mk) AC_OUTPUT # We get caught by diff --git a/docs/users_guide/shared_libs.xml b/docs/users_guide/shared_libs.xml index def773c..89b656a 100644 --- a/docs/users_guide/shared_libs.xml +++ b/docs/users_guide/shared_libs.xml @@ -16,7 +16,7 @@ shared between several programs. In contrast, with static linking the code is copied into each program. Using shared libraries can thus save disk space. They also allow a single copy of code to be shared in memory - between several programs that use it. Shared libraires are often used as + between several programs that use it. Shared libraries are often used as a way of structuring large projects, especially where different parts are written in different programming languages. Shared libraries are also commonly used as a plugin mechanism by various applications. This is diff --git a/extra-gcc-opts.in b/extra-gcc-opts.in deleted file mode 100644 index 8c9832c..0000000 --- a/extra-gcc-opts.in +++ /dev/null @@ -1 +0,0 @@ -@GccExtraViaCOpts@ diff --git a/ghc.mk b/ghc.mk index 76120ba..3d3c3a6 100644 --- a/ghc.mk +++ b/ghc.mk @@ -750,7 +750,7 @@ TAGS: TAGS_compiler # ----------------------------------------------------------------------------- # Installation -install: install_packages install_libs install_libexecs install_headers \ +install: install_libs install_packages install_libexecs install_headers \ install_libexec_scripts install_bins install_topdirs ifeq "$(HADDOCK_DOCS)" "YES" install: install_docs @@ -904,7 +904,7 @@ $(eval $(call bindist,.,\ README \ INSTALL \ configure config.sub config.guess install-sh \ - extra-gcc-opts.in \ + settings.in \ packages \ Makefile \ mk/config.mk.in \ @@ -933,7 +933,7 @@ $(eval $(call bindist,.,\ compiler/stage2/doc \ $(wildcard libraries/*/dist-install/doc/) \ $(wildcard libraries/*/*/dist-install/doc/) \ - $(filter-out extra-gcc-opts,$(INSTALL_LIBS)) \ + $(filter-out settings,$(INSTALL_LIBS)) \ $(filter-out %/project.mk mk/config.mk %/mk/install.mk,$(MAKEFILE_LIST)) \ mk/project.mk \ mk/install.mk.in \ @@ -954,7 +954,7 @@ BIN_DIST_MK = $(BIN_DIST_PREP_DIR)/bindist.mk unix-binary-dist-prep: "$(RM)" $(RM_OPTS_REC) bindistprep/ "$(MKDIRHIER)" $(BIN_DIST_PREP_DIR) - set -e; for i in packages LICENSE compiler ghc rts libraries utils docs libffi includes driver mk rules Makefile aclocal.m4 config.sub config.guess install-sh extra-gcc-opts.in ghc.mk inplace distrib/configure.ac distrib/README distrib/INSTALL; do ln -s ../../$$i $(BIN_DIST_PREP_DIR)/; done + set -e; for i in packages LICENSE compiler ghc rts libraries utils docs libffi includes driver mk rules Makefile aclocal.m4 config.sub config.guess install-sh settings.in ghc.mk inplace distrib/configure.ac distrib/README distrib/INSTALL; do ln -s ../../$$i $(BIN_DIST_PREP_DIR)/; done echo "HADDOCK_DOCS = $(HADDOCK_DOCS)" >> $(BIN_DIST_MK) echo "LATEX_DOCS = $(LATEX_DOCS)" >> $(BIN_DIST_MK) echo "BUILD_DOCBOOK_HTML = $(BUILD_DOCBOOK_HTML)" >> $(BIN_DIST_MK) @@ -1043,7 +1043,7 @@ SRC_DIST_DIRS = mk rules docs distrib bindisttest libffi includes utils docs rts SRC_DIST_FILES += \ configure.ac config.guess config.sub configure \ aclocal.m4 README ANNOUNCE HACKING LICENSE Makefile install-sh \ - ghc.spec.in ghc.spec extra-gcc-opts.in VERSION \ + ghc.spec.in ghc.spec settings.in VERSION \ boot boot-pkgs packages ghc.mk SRC_DIST_TARBALL = $(SRC_DIST_NAME)-src.tar.bz2 @@ -1158,7 +1158,7 @@ distclean : clean "$(RM)" $(RM_OPTS) config.cache config.status config.log mk/config.h mk/stamp-h "$(RM)" $(RM_OPTS) mk/config.mk mk/are-validating.mk mk/project.mk "$(RM)" $(RM_OPTS) mk/config.mk.old mk/project.mk.old - "$(RM)" $(RM_OPTS) extra-gcc-opts docs/users_guide/ug-book.xml + "$(RM)" $(RM_OPTS) settings docs/users_guide/ug-book.xml "$(RM)" $(RM_OPTS) compiler/ghc.cabal compiler/ghc.cabal.old "$(RM)" $(RM_OPTS) ghc/ghc-bin.cabal "$(RM)" $(RM_OPTS) libraries/base/include/HsBaseConfig.h diff --git a/ghc/Main.hs b/ghc/Main.hs index 9c99334..12d8dd2 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -78,7 +78,8 @@ import Data.Maybe main :: IO () main = do hSetBuffering stdout NoBuffering - GHC.defaultErrorHandler defaultDynFlags $ do + let defaultErrorHandlerDynFlags = defaultDynFlags (panic "No settings") + GHC.defaultErrorHandler defaultErrorHandlerDynFlags $ do -- 1. extract the -B flag from the args argv0 <- getArgs @@ -358,9 +359,6 @@ showVersionMode = mkPreStartupMode ShowVersion showNumVersionMode = mkPreStartupMode ShowNumVersion showSupportedExtensionsMode = mkPreStartupMode ShowSupportedExtensions -printMode :: String -> Mode -printMode str = mkPreStartupMode (Print str) - mkPreStartupMode :: PreStartupMode -> Mode mkPreStartupMode = Left @@ -383,8 +381,10 @@ showGhcUsageMode = mkPreLoadMode ShowGhcUsage showGhciUsageMode = mkPreLoadMode ShowGhciUsage showInfoMode = mkPreLoadMode ShowInfo -printWithDynFlagsMode :: (DynFlags -> String) -> Mode -printWithDynFlagsMode f = mkPreLoadMode (PrintWithDynFlags f) +printSetting :: String -> Mode +printSetting k = mkPreLoadMode (PrintWithDynFlags f) + where f dflags = fromMaybe (panic ("Setting not found: " ++ show k)) + $ lookup k (compilerInfo dflags) mkPreLoadMode :: PreLoadMode -> Mode mkPreLoadMode = Right . Left @@ -504,14 +504,30 @@ mode_flags = , Flag "-supported-languages" (PassFlag (setMode showSupportedExtensionsMode)) , Flag "-supported-extensions" (PassFlag (setMode showSupportedExtensionsMode)) ] ++ - [ Flag k' (PassFlag (setMode mode)) - | (k, v) <- compilerInfo, + [ Flag k' (PassFlag (setMode (printSetting k))) + | k <- ["Project version", + "Booter version", + "Stage", + "Build platform", + "Host platform", + "Target platform", + "Have interpreter", + "Object splitting supported", + "Have native code generator", + "Support SMP", + "Unregisterised", + "Tables next to code", + "RTS ways", + "Leading underscore", + "Debug on", + "LibDir", + "Global Package DB", + "C compiler flags", + "Gcc Linker flags", + "Ld Linker flags"], let k' = "-print-" ++ map (replaceSpace . toLower) k replaceSpace ' ' = '-' replaceSpace c = c - mode = case v of - String str -> printMode str - FromDynFlags f -> printWithDynFlagsMode f ] ++ ------- interfaces ---------------------------------------------------- [ Flag "-show-iface" (HasArg (\f -> setMode (showInterfaceMode f) @@ -649,9 +665,7 @@ showBanner _postLoadMode dflags = do showInfo :: DynFlags -> IO () showInfo dflags = do let sq x = " [" ++ x ++ "\n ]" - putStrLn $ sq $ concat $ intersperse "\n ," $ map (show . flatten) compilerInfo - where flatten (k, String v) = (k, v) - flatten (k, FromDynFlags f) = (k, f dflags) + putStrLn $ sq $ intercalate "\n ," $ map show $ compilerInfo dflags showSupportedExtensions :: IO () showSupportedExtensions = mapM_ putStrLn supportedLanguagesAndExtensions diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in index 420c918..61b7b34 100644 --- a/ghc/ghc-bin.cabal.in +++ b/ghc/ghc-bin.cabal.in @@ -14,7 +14,7 @@ Description: XXX Category: XXX Data-Dir: .. -Data-Files: extra-gcc-opts +Data-Files: settings Build-Type: Simple Cabal-Version: >= 1.2 diff --git a/ghc/ghc.mk b/ghc/ghc.mk index 93199d9..da9fd8a 100644 --- a/ghc/ghc.mk +++ b/ghc/ghc.mk @@ -108,15 +108,15 @@ all_ghc_stage1 : $(GHC_STAGE1) all_ghc_stage2 : $(GHC_STAGE2) all_ghc_stage3 : $(GHC_STAGE3) -$(INPLACE_LIB)/extra-gcc-opts : extra-gcc-opts +$(INPLACE_LIB)/settings : settings "$(CP)" $< $@ # The GHC programs need to depend on all the helper programs they might call, # and the settings files they use -$(GHC_STAGE1) : | $(UNLIT) $(INPLACE_LIB)/extra-gcc-opts -$(GHC_STAGE2) : | $(UNLIT) $(INPLACE_LIB)/extra-gcc-opts -$(GHC_STAGE3) : | $(UNLIT) $(INPLACE_LIB)/extra-gcc-opts +$(GHC_STAGE1) : | $(UNLIT) $(INPLACE_LIB)/settings +$(GHC_STAGE2) : | $(UNLIT) $(INPLACE_LIB)/settings +$(GHC_STAGE3) : | $(UNLIT) $(INPLACE_LIB)/settings ifeq "$(GhcUnregisterised)" "NO" $(GHC_STAGE1) : | $(SPLIT) @@ -137,7 +137,7 @@ endif endif -INSTALL_LIBS += extra-gcc-opts +INSTALL_LIBS += settings ifeq "$(Windows)" "NO" install: install_ghc_link diff --git a/libffi/ghc.mk b/libffi/ghc.mk index 080c43f..f7caeda 100644 --- a/libffi/ghc.mk +++ b/libffi/ghc.mk @@ -34,8 +34,6 @@ # # We use libffi's own configuration stuff. -PLATFORM := $(shell echo $(HOSTPLATFORM) | sed 's/i[567]86/i486/g') - # 2007-07-05 # Passing # as_ln_s='cp -p' @@ -116,16 +114,16 @@ $(libffi_STAMP_CONFIGURE): PATH=`pwd`:$$PATH; \ export PATH; \ cd build && \ - CC=$(WhatGccIsCalled) \ + CC=$(CC_STAGE1) \ LD=$(LD) \ - AR=$(AR) \ + AR=$(AR_STAGE1) \ NM=$(NM) \ CFLAGS="$(SRC_CC_OPTS) $(CONF_CC_OPTS_STAGE1) -w" \ LDFLAGS="$(SRC_LD_OPTS) $(CONF_GCC_LINKER_OPTS_STAGE1) -w" \ "$(SHELL)" configure \ --enable-static=yes \ --enable-shared=$(libffi_EnableShared) \ - --host=$(PLATFORM) --build=$(PLATFORM) + --host=$(HOSTPLATFORM) --build=$(BUILDPLATFORM) # libffi.so needs to be built with the correct soname. # NOTE: this builds libffi_convience.so with the incorrect @@ -179,7 +177,7 @@ $(eval $(call all-target,libffi,$(INSTALL_HEADERS) $(INSTALL_LIBS))) libffi/dist-install/build/HSffi.o: libffi/dist-install/build/libHSffi.a cd libffi/dist-install/build && \ touch empty.c && \ - "$(CC)" $(SRC_CC_OPTS) $(CONF_CC_OPTS_STAGE1) -c empty.c -o HSffi.o + "$(CC_STAGE1)" $(SRC_CC_OPTS) $(CONF_CC_OPTS_STAGE1) -c empty.c -o HSffi.o $(eval $(call all-target,libffi,libffi/dist-install/build/HSffi.o)) @@ -227,4 +225,3 @@ $(eval $(call manual-package-config,libffi)) # binary-dist BINDIST_EXTRAS += libffi/package.conf.in - diff --git a/libraries/Makefile.common b/libraries/Makefile.common deleted file mode 100644 index 8fe1462..0000000 --- a/libraries/Makefile.common +++ /dev/null @@ -1,118 +0,0 @@ -# This Makefile.common is used only in an nhc98 build of the libraries. -# It is included from each package's individual Makefile.nhc98. -# We assume the following definitions have already been made in -# the importing Makefile. -# -# THISPKG = e.g. mypkg -# SEARCH = e.g. -P../IO -P../PreludeIO -package base -# SRCS = all .hs .gc and .c files -# -# EXTRA_H_FLAGS = e.g. -prelude -# EXTRA_C_FLAGS = e.g. -I../Binary -include ../Makefile.inc - -# nasty hack - replace flags for ghc, nhc98, with hbc specific ones -ifeq "hbc" "${BUILDCOMP}" -EXTRA_H_FLAGS := ${EXTRA_HBC_FLAGS} -endif - -DIRS = $(shell ${LOCAL}pkgdirlist ${THISPKG}) - -OBJDIR = ${BUILDDIR}/${OBJ}/libraries/${THISPKG} -OBJDIRS = $(patsubst %, ${OBJDIR}/%, ${DIRS}) -FINALLIB = ${DST}/libHS${THISPKG}.$A -INCDIRS = ${INCDIR}/packages/${THISPKG} \ - $(patsubst %, ${INCDIR}/packages/${THISPKG}/%, ${DIRS}) -.SUFFIXES: .hi .hs .lhs .o .gc .c .hc .p.o .p.c .z.o .z.c .hsc - -SRCS_HS = $(filter %.hs, ${SRCS}) -SRCS_LHS = $(filter %.lhs,${SRCS}) -SRCS_GC = $(filter %.gc, ${SRCS}) -SRCS_HSC = $(filter %.hsc,${SRCS}) -SRCS_C = $(filter %.c, ${SRCS}) -SRCS_HASK= $(SRCS_HS) $(SRCS_LHS) $(SRCS_GC) $(SRCS_HSC) - -OBJS_HS = $(patsubst %.hs, ${OBJDIR}/%.$O, ${SRCS_HS}) -OBJS_LHS = $(patsubst %.lhs,${OBJDIR}/%.$O, ${SRCS_LHS}) -OBJS_GC = $(patsubst %.gc, ${OBJDIR}/%.$O, ${SRCS_GC}) -OBJS_HSC = $(patsubst %.hsc,${OBJDIR}/%.$O, ${SRCS_HSC}) -OBJS_C = $(patsubst %.c, ${OBJDIR}/%.$O, ${SRCS_C}) -OBJS_HASK= ${OBJS_HS} ${OBJS_LHS} ${OBJS_GC} ${OBJS_HSC} -OBJS = $(OBJS_HASK) $(OBJS_C) - -CFILES_HS = $(patsubst %.hs, %.$C, ${SRCS_HS}) -CFILES_LHS = $(patsubst %.lhs,%.$C, ${SRCS_LHS}) -CFILES_GC = $(patsubst %.gc, %.$C, ${SRCS_GC}) -CFILES_XS = $(patsubst %.gc, %_.$C, ${SRCS_GC}) \ - $(patsubst %.gc, %_.hs, ${SRCS_GC}) -CFILES_HSC = $(patsubst %.hsc,%.$C, ${SRCS_HSC}) -CFILES_GEN = ${CFILES_HS} ${CFILES_LHS} ${CFILES_GC} ${CFILES_HSC} - -ifeq "p" "${PROFILING}" -HC += -p -endif - -ifeq "z" "${TPROF}" -HC += -z -endif - -all: ${OBJDIR} ${OBJDIRS} ${INCDIRS} extra ${OBJS} ${FINALLIB} -extra: -cfiles: extracfiles ${CFILES_GEN} -extracfiles: -fromC: ${OBJDIR} ${OBJS_C} ${OBJDIRS} - $(HC) -c -d $(OBJDIR) $(EXTRA_C_FLAGS) ${SEARCH} ${CFILES_GEN} - echo $(OBJS) | xargs ar cr ${FINALLIB} -objdir: ${OBJDIR} ${OBJDIRS} ${INCDIRS} -${OBJDIR} ${OBJDIRS} ${INCDIRS}: - mkdir -p $@ -${FINALLIB}: ${OBJS} - echo $(OBJS) | xargs ar cr $@ -cleanhi: - -rm -f $(patsubst %, %/*.hi, ${DIRS}) -cleanC: cleanExtraC - -rm -f ${CFILES_GEN} ${CFILES_XS} -clean: cleanhi - -rm -f $(patsubst %, ${OBJDIR}/%/*.$O, ${DIRS}) - -rm -f $(patsubst %.gc, %_.hs, $(filter %.gc, $(SRCS))) - -rm -f $(patsubst %.gc, %_.$C, $(filter %.gc, $(SRCS))) -cleanExtraC: - -# general build rules for making objects from Haskell files -$(OBJS_HASK): #$(OBJDIR) $(OBJDIRS) $(SRCS_HASK) - $(LOCAL)hmake -hc=$(HC) -hidir $(INCDIR)/packages/$(THISPKG) \ - $(SEARCH) $(EXTRA_H_FLAGS) -d$(OBJDIR) \ - $(SRCS_HASK) -${OBJS_HS}: ${OBJDIR}/%.$O : %.hs -${OBJS_LHS}: ${OBJDIR}/%.$O : %.lhs -${OBJS_GC}: ${OBJDIR}/%.$O : %.gc -${OBJS_HSC}: ${OBJDIR}/%.$O : %.hsc - -# general build rule for making objects from C files -${OBJS_C}: ${OBJDIR}/%.$O : cbits/%.c - $(CC) -c -I$(INCDIR) $(ENDIAN) $(filter -I%, ${SEARCH}) \ - $(EXTRA_C_FLAGS) -o $@ $< - -# general build rules for making bootstrap C files from Haskell files -$(CFILES_GEN): - $(LOCAL)hmake -hc=$(HC) -C -hidir $(INCDIR)/packages/$(THISPKG) \ - $(SEARCH) $(EXTRA_H_FLAGS) \ - $(SRCS_HASK) -${CFILES_HS}: %.$C : %.hs -${CFILES_LHS}: %.$C : %.lhs -${CFILES_GC}: %.$C : %.gc -${CFILES_HSC}: %.$C : %.hsc - -# hack to get round mutual recursion between libraries -HIFILES = $(patsubst %.hs,../${THISLIB}/%.${HISUFFIX},$(filter %.hs, ${SRCS})) -${HIFILES}: ../${THISLIB}/%.${HISUFFIX} : %.hs - $(HC) -c $(PART_FLAGS) -o /dev/null $< - -# The importing Makefile may now define extra individual dependencies -# e.g. -# ${OBJDIR}/Function.$O: Function.hs ${OBJDIR}/Other.$O -# -# and C-files dependencies likewise -# e.g. -# AlignBin.c: BinHandle.c - diff --git a/libraries/Makefile.inc b/libraries/Makefile.inc deleted file mode 100644 index 0b54f52..0000000 --- a/libraries/Makefile.inc +++ /dev/null @@ -1,8 +0,0 @@ -ifeq "" "${MKDIR}" -MKDIR:=$(shell pwd) -#MKDIR:=$(PWD) -else -MKDIR:=$(patsubst %/$(notdir ${MKDIR}),%, ${MKDIR}) -endif -include ${MKDIR}/Makefile.inc - diff --git a/libraries/Makefile.local b/libraries/Makefile.local deleted file mode 100644 index 84b90a6..0000000 --- a/libraries/Makefile.local +++ /dev/null @@ -1,38 +0,0 @@ -# Local GHC-build-tree customization for Cabal makefiles. We want to build -# libraries using flags that the user has put in build.mk/validate.mk and -# appropriate flags for Mac OS X deployment targets. - -# Careful here: including boilerplate.mk breaks things, because paths.mk and -# opts.mk overrides some of the variable settings in the Cabal Makefile, so -# we just include config.mk and custom-settings.mk. -include ../defineTOP.mk -SAVE_GHC := $(GHC) -SAVE_AR := $(AR) -SAVE_LD := $(LD) -include $(TOP)/mk/config.mk -include $(TOP)/mk/custom-settings.mk -GHC := $(SAVE_GHC) -AR := $(SAVE_AR) -LD := $(SAVE_LD) - -# We want all warnings on -GhcLibHcOpts += -Wall - -# Cabal has problems with deprecated flag warnings, as it needs to pass -# deprecated flags in pragmas in order to support older GHCs. Thus for -# now at least we just disable them completely. -GhcLibHcOpts += -fno-warn-deprecated-flags - -ifeq "$(filter-out Win32-% dph%,$(package))" "" -# XXX We are one of the above list, i.e. we are a package that is not -# yet warning-clean. Thus turn warnings off for now so that validate -# goes through. -GhcLibHcOpts += -w -endif - -# Now add flags from the GHC build system to the Cabal build: -GHC_OPTS += $(SRC_HC_OPTS) -GHC_OPTS += $(GhcLibHcOpts) - -include $(TOP)/mk/bindist.mk - diff --git a/libraries/tarballs/time-1.2.0.3.tar.gz b/libraries/tarballs/time-1.2.0.3.tar.gz deleted file mode 100644 index 525b019..0000000 Binary files a/libraries/tarballs/time-1.2.0.3.tar.gz and /dev/null differ diff --git a/libraries/tarballs/time-1.2.0.4.tar.gz b/libraries/tarballs/time-1.2.0.4.tar.gz new file mode 100644 index 0000000..6bbbd75 Binary files /dev/null and b/libraries/tarballs/time-1.2.0.4.tar.gz differ diff --git a/mk/config.mk.in b/mk/config.mk.in index be8b57b..f96302b 100644 --- a/mk/config.mk.in +++ b/mk/config.mk.in @@ -540,18 +540,14 @@ endif # the flag --with-gcc= instead. The reason is that the configure script # needs to know which gcc you're using in order to perform its tests. -HaveGcc = @HaveGcc@ -UseGcc = YES WhatGccIsCalled = @WhatGccIsCalled@ GccVersion = @GccVersion@ -GccLT34 = @GccLT34@ -ifeq "$(strip $(HaveGcc))" "YES" -ifneq "$(strip $(UseGcc))" "YES" - CC = cc -else - CC = $(WhatGccIsCalled) -endif -endif +GccLT34 = @GccLT34@ +CC = $(WhatGccIsCalled) +CC_STAGE0 = @CC_STAGE0@ +CC_STAGE1 = $(CC) +CC_STAGE2 = $(CC) +CC_STAGE3 = $(CC) # C compiler and linker flags from configure (e.g. -m to select # correct C compiler backend). The stage number is the stage of GHC @@ -601,10 +597,24 @@ DLLTOOL = inplace/mingw/bin/dlltool.exe AR = @ArCmd@ AR_OPTS = @ArArgs@ -ArSupportsInput = @ArSupportsInput@ ArSupportsAtFile = @ArSupportsAtFile@ -# Yuckage: for ghc/utils/parallel -- todo: nuke this dependency!! -BASH = /usr/local/bin/bash + +AR_STAGE0 = $(AR) +AR_STAGE1 = $(AR) +AR_STAGE2 = $(AR) +AR_STAGE3 = $(AR) +AR_OPTS_STAGE0 = $(AR_OPTS) +AR_OPTS_STAGE1 = $(AR_OPTS) +AR_OPTS_STAGE2 = $(AR_OPTS) +AR_OPTS_STAGE3 = $(AR_OPTS) +EXTRA_AR_ARGS_STAGE0 = $(EXTRA_AR_ARGS) +EXTRA_AR_ARGS_STAGE1 = $(EXTRA_AR_ARGS) +EXTRA_AR_ARGS_STAGE2 = $(EXTRA_AR_ARGS) +EXTRA_AR_ARGS_STAGE3 = $(EXTRA_AR_ARGS) +ArSupportsAtFile_STAGE0 = $(ArSupportsAtFile) +ArSupportsAtFile_STAGE1 = $(ArSupportsAtFile) +ArSupportsAtFile_STAGE2 = $(ArSupportsAtFile) +ArSupportsAtFile_STAGE3 = $(ArSupportsAtFile) CONTEXT_DIFF = @ContextDiffCmd@ CP = cp @@ -637,7 +647,6 @@ NROFF = nroff PERL = @PerlCmd@ PYTHON = @PythonCmd@ PIC = pic -PREPROCESSCMD = $(CC) -E RANLIB = @RANLIB@ SED = @SedCmd@ TR = tr diff --git a/rts/Linker.c b/rts/Linker.c index c840857..c1310b0 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -1186,11 +1186,11 @@ initLinker( void ) # endif /* RTLD_DEFAULT */ compileResult = regcomp(&re_invalid, - "(([^ \t()])+\\.so([^ \t:()])*):([ \t])*invalid ELF header", + "(([^ \t()])+\\.so([^ \t:()])*):([ \t])*(invalid ELF header|file too short)", REG_EXTENDED); ASSERT( compileResult == 0 ); compileResult = regcomp(&re_realso, - "GROUP *\\( *(([^ )])+)", + "(GROUP|INPUT) *\\( *(([^ )])+)", REG_EXTENDED); ASSERT( compileResult == 0 ); # endif @@ -1361,8 +1361,8 @@ addDLL( char *dll_name ) if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) { // success -- try to dlopen the first named file IF_DEBUG(linker, debugBelch("match%s\n","")); - line[match[1].rm_eo] = '\0'; - errmsg = internal_dlopen(line+match[1].rm_so); + line[match[2].rm_eo] = '\0'; + errmsg = internal_dlopen(line+match[2].rm_so); break; } // if control reaches here, no GROUP ( ... ) directive was found diff --git a/rts/ghc.mk b/rts/ghc.mk index 53bb72c..a236945 100644 --- a/rts/ghc.mk +++ b/rts/ghc.mk @@ -194,8 +194,8 @@ endif else $$(rts_$1_LIB) : $$(rts_$1_OBJS) $$(rts_$1_DTRACE_OBJS) "$$(RM)" $$(RM_OPTS) $$@ - echo $$(rts_$1_OBJS) $$(rts_$1_DTRACE_OBJS) | "$$(XARGS)" $$(XARGS_OPTS) "$$(AR)" \ - $$(AR_OPTS) $$(EXTRA_AR_ARGS) $$@ + echo $$(rts_$1_OBJS) $$(rts_$1_DTRACE_OBJS) | "$$(XARGS)" $$(XARGS_OPTS) "$$(AR_STAGE1)" \ + $$(AR_OPTS_STAGE1) $$(EXTRA_AR_ARGS_STAGE1) $$@ endif endif @@ -499,7 +499,7 @@ endif ifneq "$(BINDIST)" "YES" rts/dist/build/libHSrtsmain.a : rts/dist/build/Main.o "$(RM)" $(RM_OPTS) $@ - "$(AR)" $(AR_OPTS) $(EXTRA_AR_ARGS) $@ $< + "$(AR_STAGE1)" $(AR_OPTS_STAGE1) $(EXTRA_AR_ARGS_STAGE1) $@ $< endif # ----------------------------------------------------------------------------- diff --git a/rules/build-package-way.mk b/rules/build-package-way.mk index d6c1560..a7dc918 100644 --- a/rules/build-package-way.mk +++ b/rules/build-package-way.mk @@ -87,10 +87,10 @@ ifeq "$$($1_$2_SplitObjs)" "YES" else echo $$($1_$2_$3_ALL_OBJS) >> $$@.contents endif -ifeq "$$(ArSupportsAtFile)" "YES" - "$$(AR)" $$(AR_OPTS) $$(EXTRA_AR_ARGS) $$@ @$$@.contents +ifeq "$$($1_$2_ArSupportsAtFile)" "YES" + "$$($1_$2_AR)" $$($1_$2_AR_OPTS) $$($1_$2_EXTRA_AR_ARGS) $$@ @$$@.contents else - "$$(XARGS)" $$(XARGS_OPTS) "$$(AR)" $$(AR_OPTS) $$(EXTRA_AR_ARGS) $$@ < $$@.contents + "$$(XARGS)" $$(XARGS_OPTS) "$$($1_$2_AR)" $$($1_$2_AR_OPTS) $$($1_$2_EXTRA_AR_ARGS) $$@ < $$@.contents endif "$$(RM)" $$(RM_OPTS) $$@.contents endif diff --git a/rules/build-prog.mk b/rules/build-prog.mk index c39f947..99093d3 100644 --- a/rules/build-prog.mk +++ b/rules/build-prog.mk @@ -156,7 +156,7 @@ $1/$2/build/tmp/$$($1_$2_PROG) : $$($1_$2_v_HS_OBJS) $$($1_$2_v_C_OBJS) $$($1_$2 "$$($1_$2_HC)" -o $$@ $$($1_$2_v_ALL_HC_OPTS) $$(LD_OPTS) $$($1_$2_GHC_LD_OPTS) $$($1_$2_v_HS_OBJS) $$($1_$2_v_C_OBJS) $$($1_$2_v_S_OBJS) $$($1_$2_OTHER_OBJS) $$(addprefix -l,$$($1_$2_EXTRA_LIBRARIES)) else $1/$2/build/tmp/$$($1_$2_PROG) : $$($1_$2_v_HS_OBJS) $$($1_$2_v_C_OBJS) $$($1_$2_v_S_OBJS) $$($1_$2_OTHER_OBJS) | $$$$(dir $$$$@)/. - "$$(CC)" -o $$@ $$($1_$2_v_ALL_CC_OPTS) $$(LD_OPTS) $$($1_$2_v_HS_OBJS) $$($1_$2_v_C_OBJS) $$($1_$2_v_S_OBJS) $$($1_$2_OTHER_OBJS) $$($1_$2_v_EXTRA_CC_OPTS) $$(addprefix -l,$$($1_$2_EXTRA_LIBRARIES)) + "$$($1_$2_CC)" -o $$@ $$($1_$2_v_ALL_CC_OPTS) $$(LD_OPTS) $$($1_$2_v_HS_OBJS) $$($1_$2_v_C_OBJS) $$($1_$2_v_S_OBJS) $$($1_$2_OTHER_OBJS) $$($1_$2_v_EXTRA_CC_OPTS) $$(addprefix -l,$$($1_$2_EXTRA_LIBRARIES)) endif # Note [lib-depends] if this program is built with stage1 or greater, we diff --git a/rules/c-suffix-rules.mk b/rules/c-suffix-rules.mk index fa7dd6f..bba73a8 100644 --- a/rules/c-suffix-rules.mk +++ b/rules/c-suffix-rules.mk @@ -43,19 +43,19 @@ $1/$2/build/%.$$($3_way_)s : $1/%.c $$($1_$2_HC_DEP) else $1/$2/build/%.$$($3_osuf) : $1/%.c | $$$$(dir $$$$@)/. - "$$(CC)" $$($1_$2_$3_ALL_CC_OPTS) -c $$< -o $$@ + "$$($1_$2_CC)" $$($1_$2_$3_ALL_CC_OPTS) -c $$< -o $$@ $1/$2/build/%.$$($3_osuf) : $1/$2/build/%.c - "$$(CC)" $$($1_$2_$3_ALL_CC_OPTS) -c $$< -o $$@ + "$$($1_$2_CC)" $$($1_$2_$3_ALL_CC_OPTS) -c $$< -o $$@ $1/$2/build/%.$$($3_osuf) : $1/$2/build/%.$$($3_way_)s "$$(AS)" $$($1_$2_$3_ALL_AS_OPTS) -o $$@ $$< $1/$2/build/%.$$($3_osuf) : $1/%.S | $$$$(dir $$$$@)/. - "$$(CC)" $$($1_$2_$3_ALL_CC_OPTS) -c $$< -o $$@ + "$$($1_$2_CC)" $$($1_$2_$3_ALL_CC_OPTS) -c $$< -o $$@ $1/$2/build/%.$$($3_way_)s : $1/$2/build/%.c - "$$(CC)" $$($1_$2_$3_ALL_CC_OPTS) -S $$< -o $$@ + "$$($1_$2_CC)" $$($1_$2_$3_ALL_CC_OPTS) -S $$< -o $$@ endif diff --git a/rules/hs-suffix-rules-srcdir.mk b/rules/hs-suffix-rules-srcdir.mk index 7e9c8d3..bdb9d00 100644 --- a/rules/hs-suffix-rules-srcdir.mk +++ b/rules/hs-suffix-rules-srcdir.mk @@ -52,10 +52,10 @@ endif # .hs->.o rule, I don't know why --SDM $1/$2/build/%.$$($3_osuf) : $1/$4/%.hc includes/ghcautoconf.h includes/ghcplatform.h | $$$$(dir $$$$@)/. - "$$(CC)" $$($1_$2_$3_ALL_CC_OPTS) -Iincludes -x c -c $$< -o $$@ + "$$($1_$2_CC)" $$($1_$2_$3_ALL_CC_OPTS) -Iincludes -x c -c $$< -o $$@ $1/$2/build/%.$$($3_osuf) : $1/$2/build/%.hc includes/ghcautoconf.h includes/ghcplatform.h - "$$(CC)" $$($1_$2_$3_ALL_CC_OPTS) -Iincludes -x c -c $$< -o $$@ + "$$($1_$2_CC)" $$($1_$2_$3_ALL_CC_OPTS) -Iincludes -x c -c $$< -o $$@ # $1/$2/build/%.$$($3_osuf) : $1/$2/build/%.$$($3_way_)hc # "$$($1_$2_HC)" $$($1_$2_$3_ALL_HC_OPTS) -c $$< -o $$@ diff --git a/rules/package-config.mk b/rules/package-config.mk index 2091779..7873157 100644 --- a/rules/package-config.mk +++ b/rules/package-config.mk @@ -16,6 +16,11 @@ $(call trace, package-config($1,$2,$3)) $(call profStart, package-config($1,$2,$3)) $1_$2_HC = $$(GHC_STAGE$3) +$1_$2_CC = $$(CC_STAGE$3) +$1_$2_AR = $$(AR_STAGE$3) +$1_$2_AR_OPTS = $$(AR_OPTS_STAGE$3) +$1_$2_EXTRA_AR_ARGS = $$(EXTRA_AR_ARGS_STAGE$3) +$1_$2_ArSupportsAtFile = $$(ArSupportsAtFile_STAGE$3) # configuration stuff that depends on which GHC we're building with ifeq "$3" "0" diff --git a/settings.in b/settings.in new file mode 100644 index 0000000..f4e922a --- /dev/null +++ b/settings.in @@ -0,0 +1,4 @@ +[("GCC extra via C opts", "@GccExtraViaCOpts@"), + ("C compiler command", "@WhatGccIsCalled@"), + ("perl command", "@PerlCmd@")] + diff --git a/sync-all b/sync-all index 06c183a..7ccc71d 100755 --- a/sync-all +++ b/sync-all @@ -389,6 +389,10 @@ sub scmall { scm ($localpath, $scm, "grep", @args) unless $scm eq "darcs"; } + elsif ($command =~ /^clean$/) { + scm ($localpath, $scm, "clean", @args) + unless $scm eq "darcs"; + } elsif ($command =~ /^reset$/) { scm ($localpath, $scm, "reset", @args) unless $scm eq "darcs"; @@ -426,6 +430,7 @@ Supported commands: * remote rm * remote set-url [--push] * grep + * clean * reset * config diff --git a/utils/ghctags/Main.hs b/utils/ghctags/Main.hs index a25537e..b3ed58f 100644 --- a/utils/ghctags/Main.hs +++ b/utils/ghctags/Main.hs @@ -10,6 +10,7 @@ import DriverPhases ( isHaskellSrcFilename ) import HscTypes ( msHsFilePath ) import Name ( getOccString ) --import ErrUtils ( printBagOfErrors ) +import Panic ( panic ) import DynFlags ( defaultDynFlags ) import Bag import Exception @@ -100,7 +101,7 @@ main = do then Just `liftM` openFile "TAGS" openFileMode else return Nothing - GHC.defaultErrorHandler defaultDynFlags $ + GHC.defaultErrorHandler (defaultDynFlags (panic "No settings")) $ runGhc (Just ghc_topdir) $ do --liftIO $ print "starting up session" dflags <- getSessionDynFlags