Commit dc257508 authored by benl's avatar benl

Merge branch 'master' of /Users/benl/devel/ghc/ghc-head

parents 8fb6e595 7bb96844
......@@ -7,6 +7,7 @@
*.BAK
*.orig
*.prof
*.rej
*.hi
*.hi-boot
......@@ -29,6 +30,12 @@ config.log
config.status
configure
# -----------------------------------------------------------------------------
# Ignore any overlapped darcs repos and back up files
*-darcs-backup*
_darcs/
# -----------------------------------------------------------------------------
# sub-repositories
......@@ -79,9 +86,7 @@ configure
/bindist-list
/bindistprep/
/bindisttest/HelloWorld
/bindisttest/a/
/bindisttest/install\ dir/
/bindisttest/output
/bindisttest/
/ch01.html
/ch02.html
/compiler/cmm/CmmLex.hs
......@@ -119,8 +124,12 @@ configure
/docs/users_guide/users_guide.xml
/docs/users_guide/users_guide/
/docs/users_guide/what_glasgow_exts_does.gen.xml
/driver/ghc/dist/
/driver/haddock/dist/
/driver/ghci/ghc-pkg-inplace
/driver/ghci/ghci-inplace
/driver/ghci/dist/
/driver/ghci/ghci.res
/driver/mangler/dist/ghc-asm
/driver/mangler/dist/ghc-asm.prl
/driver/package.conf
......@@ -128,7 +137,7 @@ configure
/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/
......@@ -150,6 +159,8 @@ configure
/libffi/package.conf.inplace
/libffi/package.conf.inplace.raw
/libffi/stamp*
/libffi/package.conf.install
/libffi/package.conf.install.raw
/libraries/bin-package-db/GNUmakefile
/libraries/bin-package-db/ghc.mk
/libraries/bootstrapping.conf
......@@ -185,6 +196,8 @@ configure
/rts/package.conf.inplace.raw
/rts/sm/Evac_thr.c
/rts/sm/Scav_thr.c
/rts/package.conf.install
/rts/package.conf.install.raw
/stage3.package.conf
/testsuite_summary.txt
/testlog
......@@ -218,3 +231,4 @@ configure
/utils/runghc/runhaskell
/utils/runstdtest/runstdtest
/utils/unlit/unlit
......@@ -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.
......
......@@ -5,8 +5,10 @@ use strict;
use Cwd;
my %required_tag;
my $validate;
$required_tag{"-"} = 1;
$validate = 0;
while ($#ARGV ne -1) {
my $arg = shift @ARGV;
......@@ -14,11 +16,32 @@ while ($#ARGV ne -1) {
if ($arg =~ /^--required-tag=(.*)/) {
$required_tag{$1} = 1;
}
elsif ($arg =~ /^--validate$/) {
$validate = 1;
}
else {
die "Bad arg: $arg";
}
}
{
local $/ = undef;
open FILE, "packages" or die "Couldn't open file: $!";
binmode FILE;
my $string = <FILE>;
close FILE;
if ($string =~ /\r/) {
print STDERR <<EOF;
Found ^M in packages.
Perhaps you need to run
git config --global core.autocrlf false
and re-check out the tree?
EOF
exit 1;
}
}
# Create libraries/*/{ghc.mk,GNUmakefile}
system("/usr/bin/perl", "-w", "boot-pkgs") == 0
or die "Running boot-pkgs failed: $?";
......@@ -70,3 +93,19 @@ foreach $dir (".", glob("libraries/*/")) {
}
}
if ($validate eq 0 && ! -f "mk/build.mk") {
print <<EOF;
WARNING: You don't have a mk/build.mk file.
By default a standard GHC build will be done, which uses optimisation
and builds the profiling libraries. This will take a long time, so may
not be what you want if you are developing GHC or the libraries, rather
than simply building it to use it.
For information on creating a mk/build.mk file, please see:
http://hackage.haskell.org/trac/ghc/wiki/Building/Using#Buildconfiguration
EOF
}
# 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)
......@@ -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"
......
......@@ -106,6 +106,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
......@@ -363,8 +364,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"
......
......@@ -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
......@@ -176,7 +181,7 @@ duDefs dus = foldr get emptyNameSet dus
get (Just d1, _u1) d2 = d1 `unionNameSets` d2
allUses :: DefUses -> Uses
-- ^ Just like 'allUses', but 'Defs' are not eliminated from the 'Uses' returned
-- ^ Just like 'duUses', but 'Defs' are not eliminated from the 'Uses' returned
allUses dus = foldr get emptyNameSet dus
where
get (_d1, u1) u2 = u1 `unionNameSets` u2
......@@ -184,8 +189,7 @@ allUses dus = foldr get emptyNameSet dus
duUses :: DefUses -> Uses
-- ^ Collect all 'Uses', regardless of whether the group is itself used,
-- but remove 'Defs' on the way
duUses dus
= foldr get emptyNameSet dus
duUses dus = foldr get emptyNameSet dus
where
get (Nothing, rhs_uses) uses = rhs_uses `unionNameSets` uses
get (Just defs, rhs_uses) uses = (rhs_uses `unionNameSets` uses)
......
......@@ -209,6 +209,7 @@ data OccName = OccName
{ occNameSpace :: !NameSpace
, occNameFS :: !FastString
}
deriving Typeable
\end{code}
......@@ -221,8 +222,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"
......
......@@ -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
......
......@@ -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"
......
......@@ -101,7 +101,7 @@ module CLabel (
hasCAF,
infoLblToEntryLbl, entryLblToInfoLbl, cvtToClosureLbl, cvtToSRTLbl,
needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
isMathFun,
isMathFun, isCas,
isCFunctionLabel, isGcPtrLabel, labelDynamic,
pprCLabel
......@@ -590,9 +590,17 @@ maybeAsmTemp (AsmTempLabel uq) = Just uq
maybeAsmTemp _ = Nothing
-- | Check whether a label corresponds to our cas function.
-- We #include the prototype for this, so we need to avoid
-- generating out own C prototypes.
isCas :: CLabel -> Bool
isCas (CmmLabel pkgId fn _) = pkgId == rtsPackageId && fn == fsLit "cas"
isCas _ = False
-- | Check whether a label corresponds to a C function that has
-- a prototype in a system header somehere, or is built-in
-- to the C compiler. For these labels we abovoid generating our
-- to the C compiler. For these labels we avoid generating our
-- own C prototypes.
isMathFun :: CLabel -> Bool
isMathFun (ForeignLabel fs _ _ _) = fs `elementOfUniqSet` math_funs
......
......@@ -9,10 +9,11 @@
#endif
module Cmm
( CmmGraph(..), CmmBlock
( CmmGraph, GenCmmGraph(..), CmmBlock
, CmmStackInfo(..), CmmTopInfo(..), Cmm, CmmTop
, CmmReplGraph, CmmFwdRewrite, CmmBwdRewrite
, modifyGraph
, lastNode, replaceLastNode, insertBetween
, ofBlockMap, toBlockMap, insertBlock
, ofBlockList, toBlockList, bodyToBlockList
......@@ -41,7 +42,8 @@ import Panic
-------------------------------------------------
-- CmmBlock, CmmGraph and Cmm
data CmmGraph = CmmGraph { g_entry :: BlockId, g_graph :: Graph CmmNode C C }
type CmmGraph = GenCmmGraph CmmNode
data GenCmmGraph n = CmmGraph { g_entry :: BlockId, g_graph :: Graph n C C }
type CmmBlock = Block CmmNode C C
type CmmReplGraph e x = FuelUniqSM (Maybe (Graph CmmNode e x))
......@@ -56,6 +58,9 @@ type CmmTop = GenCmmTop CmmStatic CmmTopInfo CmmGraph
-------------------------------------------------
-- Manipulating CmmGraphs
modifyGraph :: (Graph n C C -> Graph n' C C) -> GenCmmGraph n -> GenCmmGraph n'
modifyGraph f g = CmmGraph {g_entry=g_entry g, g_graph=f (g_graph g)}
toBlockMap :: CmmGraph -> LabelMap CmmBlock
toBlockMap (CmmGraph {g_graph=GMany NothingO body NothingO}) = body
......@@ -150,26 +155,26 @@ insertBetween b ms succId = insert $ lastNode b
-- Running dataflow analysis and/or rewrites
-- Constructing forward and backward analysis-only pass
analFwd :: Monad m => DataflowLattice f -> FwdTransfer CmmNode f -> FwdPass m CmmNode f
analBwd :: Monad m => DataflowLattice f -> BwdTransfer CmmNode f -> BwdPass m CmmNode f
analFwd :: Monad m => DataflowLattice f -> FwdTransfer n f -> FwdPass m n f
analBwd :: Monad m => DataflowLattice f -> BwdTransfer n f -> BwdPass m n f
analFwd lat xfer = analRewFwd lat xfer noFwdRewrite
analBwd lat xfer = analRewBwd lat xfer noBwdRewrite
-- Constructing forward and backward analysis + rewrite pass
analRewFwd :: Monad m => DataflowLattice f -> FwdTransfer CmmNode f -> FwdRewrite m CmmNode f -> FwdPass m CmmNode f
analRewBwd :: Monad m => DataflowLattice f -> BwdTransfer CmmNode f -> BwdRewrite m CmmNode f -> BwdPass m CmmNode f
analRewFwd :: Monad m => DataflowLattice f -> FwdTransfer n f -> FwdRewrite m n f -> FwdPass m n f
analRewBwd :: Monad m => DataflowLattice f -> BwdTransfer n f -> BwdRewrite m n f -> BwdPass m n f
analRewFwd lat xfer rew = FwdPass {fp_lattice = lat, fp_transfer = xfer, fp_rewrite = rew}
analRewBwd lat xfer rew = BwdPass {bp_lattice = lat, bp_transfer = xfer, bp_rewrite = rew}
-- Running forward and backward dataflow analysis + optional rewrite
dataflowPassFwd :: CmmGraph -> [(BlockId, f)] -> FwdPass FuelUniqSM CmmNode f -> FuelUniqSM (CmmGraph, BlockEnv f)
dataflowPassFwd :: NonLocal n => GenCmmGraph n -> [(BlockId, f)] -> FwdPass FuelUniqSM n f -> FuelUniqSM (GenCmmGraph n, BlockEnv f)
dataflowPassFwd (CmmGraph {g_entry=entry, g_graph=graph}) facts fwd = do
(graph, facts, NothingO) <- analyzeAndRewriteFwd fwd (JustC [entry]) graph (mkFactBase (fp_lattice fwd) facts)
return (CmmGraph {g_entry=entry, g_graph=graph}, facts)
dataflowPassBwd :: CmmGraph -> [(BlockId, f)] -> BwdPass FuelUniqSM CmmNode f -> FuelUniqSM (CmmGraph, BlockEnv f)
dataflowPassBwd :: NonLocal n => GenCmmGraph n -> [(BlockId, f)] -> BwdPass FuelUniqSM n f -> FuelUniqSM (GenCmmGraph n, BlockEnv f)
dataflowPassBwd (CmmGraph {g_entry=entry, g_graph=graph}) facts bwd = do
(graph, facts, NothingO) <- analyzeAndRewriteBwd bwd (JustC [entry]) graph (mkFactBase (bp_lattice bwd) facts)
return (CmmGraph {g_entry=entry, g_graph=graph}, facts)
......@@ -24,7 +24,6 @@ import OldPprCmm()
import Constants
import FastString
import Control.Monad
import Data.Maybe
-- -----------------------------------------------------------------------------
......@@ -70,8 +69,10 @@ lintCmmBlock labels (BasicBlock id stmts)
lintCmmExpr :: CmmExpr -> CmmLint CmmType
lintCmmExpr (CmmLoad expr rep) = do