...
 
Commits (108)
......@@ -767,6 +767,7 @@ validate-x86_64-linux-fedora27:
.build-windows:
<<: *only-default
allow_failure: true
before_script:
- git clean -xdf
......@@ -815,12 +816,10 @@ validate-x86_64-linux-fedora27:
- |
python boot
bash -c './configure --enable-tarballs-autodownload GHC=`pwd`/toolchain/bin/ghc HAPPY=`pwd`/toolchain/bin/happy ALEX=`pwd`/toolchain/bin/alex'
- bash -c "PATH=`pwd`/toolchain/bin:$PATH hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --flavour=Quick --docs=no-sphinx binary-dist"
- bash -c "PATH=`pwd`/toolchain/bin:$PATH hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --docs=no-sphinx binary-dist"
- mv _build/bindist/ghc*.tar.xz ghc.tar.xz
- bash -c "export TOP=$(pwd); cd _build/bindist/ghc-*/ && PATH=$TOP/toolchain/bin:$PATH ./configure --prefix=$TOP/_build/install && make install && cd ../../../"
- bash -c "export TOP=$(pwd); PATH=$TOP/toolchain/bin:$PATH hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` --flavour=quick test --summary-junit=./junit.xml --skip-perf --test-compiler=$TOP/_build/install/bin/ghc"
# skipping perf tests for now since we build a quick-flavoured GHC,
# which might result in some broken perf tests?
- bash -c "export TOP=$(pwd); PATH=$TOP/toolchain/bin:$PATH hadrian/build.cabal.sh --flavour=$FLAVOUR -j`mk/detect-cpu-count.sh` test --summary-junit=./junit.xml --test-compiler=$TOP/_build/install/bin/ghc"
tags:
- x86_64-windows
artifacts:
......@@ -834,6 +833,7 @@ validate-x86_64-linux-fedora27:
validate-x86_64-windows-hadrian:
extends: .build-windows-hadrian
stage: full-build
variables:
MSYSTEM: MINGW64
TEST_ENV: "x86_64-windows-hadrian"
......
......@@ -647,6 +647,7 @@ AC_DEFUN([FP_SET_CFLAGS_C99],
# $5 is the name of the CPP flags variable
AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS],
[
AC_REQUIRE([FP_PROG_LD_IS_GNU])
AC_MSG_CHECKING([Setting up $2, $3, $4 and $5])
case $$1 in
i386-*)
......@@ -663,10 +664,20 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS],
$2="$$2 -march=i686"
;;
x86_64-unknown-solaris2)
# Solaris is a multi-lib platform, providing both 32- and 64-bit
# user-land. It appears to default to 32-bit builds but we of course want to
# compile for 64-bits on x86-64.
#
# On OpenSolaris uses gnu ld whereas SmartOS appears to use the Solaris
# implementation, which rather uses the -64 flag.
$2="$$2 -m64"
$3="$$3 -m64"
$4="$$4 -m64"
$5="$$5 -m64"
if test "$fp_cv_gnu_ld" = "yes"; then
$4="$$4 -m64"
else
$4="$$4 -64"
fi
;;
alpha-*)
# For now, to suppress the gcc warning "call-clobbered
......@@ -999,7 +1010,7 @@ else
fi;
changequote([, ])dnl
])
if test ! -f compiler/parser/Parser.hs || test ! -f compiler/cmm/CmmParse.hs
if test ! -f compiler/parser/Parser.hs || test ! -f compiler/GHC/Cmm/Parser.hs
then
FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.19.10],
[AC_MSG_ERROR([Happy version 1.19.10 or later is required to compile GHC.])])[]
......
......@@ -4,8 +4,8 @@
-- (c) The University of Glasgow 2002-2006
--
-- | ByteCodeLink: Bytecode assembler and linker
module ByteCodeAsm (
-- | Bytecode assembler and linker
module GHC.ByteCode.Asm (
assembleBCOs, assembleOneBCO,
bcoFreeNames,
......@@ -17,11 +17,11 @@ module ByteCodeAsm (
import GhcPrelude
import ByteCodeInstr
import ByteCodeItbls
import ByteCodeTypes
import GHC.ByteCode.Instr
import GHC.ByteCode.InfoTable
import GHC.ByteCode.Types
import GHCi.RemoteTypes
import GHCi
import GHC.Runtime.Interpreter
import HscTypes
import Name
......@@ -30,7 +30,7 @@ import Literal
import TyCon
import FastString
import GHC.StgToCmm.Layout ( ArgRep(..) )
import SMRep
import GHC.Runtime.Heap.Layout
import DynFlags
import Outputable
import GHC.Platform
......@@ -55,7 +55,7 @@ import Data.Array.Unsafe( castSTUArray )
import Foreign
import Data.Char ( ord )
import Data.List
import Data.List ( genericLength )
import Data.Map (Map)
import Data.Maybe (fromMaybe)
import qualified Data.Map as Map
......@@ -460,8 +460,8 @@ assembleI dflags i = case i of
LitNumWord -> int (fromIntegral i)
LitNumInt64 -> int64 (fromIntegral i)
LitNumWord64 -> int64 (fromIntegral i)
LitNumInteger -> panic "ByteCodeAsm.literal: LitNumInteger"
LitNumNatural -> panic "ByteCodeAsm.literal: LitNumNatural"
LitNumInteger -> panic "GHC.ByteCode.Asm.literal: LitNumInteger"
LitNumNatural -> panic "GHC.ByteCode.Asm.literal: LitNumNatural"
-- We can lower 'LitRubbish' to an arbitrary constant, but @NULL@ is most
-- likely to elicit a crash (rather than corrupt memory) in case absence
-- analysis messed up.
......
......@@ -4,15 +4,15 @@
-- (c) The University of Glasgow 2002-2006
--
-- | ByteCodeItbls: Generate infotables for interpreter-made bytecodes
module ByteCodeItbls ( mkITbls ) where
-- | Generate infotables for interpreter-made bytecodes
module GHC.ByteCode.InfoTable ( mkITbls ) where
#include "HsVersions.h"
import GhcPrelude
import ByteCodeTypes
import GHCi
import GHC.ByteCode.Types
import GHC.Runtime.Interpreter
import DynFlags
import HscTypes
import Name ( Name, getName )
......
......@@ -4,8 +4,8 @@
-- (c) The University of Glasgow 2002-2006
--
-- | ByteCodeInstrs: Bytecode instruction definitions
module ByteCodeInstr (
-- | Bytecode instruction definitions
module GHC.ByteCode.Instr (
BCInstr(..), ProtoBCO(..), bciStackUse,
) where
......@@ -13,7 +13,7 @@ module ByteCodeInstr (
import GhcPrelude
import ByteCodeTypes
import GHC.ByteCode.Types
import GHCi.RemoteTypes
import GHCi.FFI (C_ffi_cif)
import GHC.StgToCmm.Layout ( ArgRep(..) )
......@@ -28,7 +28,7 @@ import Literal
import DataCon
import VarSet
import PrimOp
import SMRep
import GHC.Runtime.Heap.Layout
import Data.Word
import GHC.Stack.CCS (CostCentre)
......
......@@ -8,8 +8,8 @@
-- (c) The University of Glasgow 2002-2006
--
-- | ByteCodeLink: Bytecode assembler and linker
module ByteCodeLink (
-- | Bytecode assembler and linker
module GHC.ByteCode.Linker (
ClosureEnv, emptyClosureEnv, extendClosureEnv,
linkBCO, lookupStaticPtr,
lookupIE,
......@@ -25,8 +25,8 @@ import GHCi.ResolvedBCO
import GHCi.BreakArray
import SizedSeq
import GHCi
import ByteCodeTypes
import GHC.Runtime.Interpreter
import GHC.ByteCode.Types
import HscTypes
import Name
import NameEnv
......@@ -90,7 +90,7 @@ lookupStaticPtr hsc_env addr_of_label_string = do
m <- lookupSymbol hsc_env addr_of_label_string
case m of
Just ptr -> return ptr
Nothing -> linkFail "ByteCodeLink: can't find label"
Nothing -> linkFail "GHC.ByteCode.Linker: can't find label"
(unpackFS addr_of_label_string)
lookupIE :: HscEnv -> ItblEnv -> Name -> IO (Ptr ())
......@@ -108,7 +108,7 @@ lookupIE hsc_env ie con_nm =
n <- lookupSymbol hsc_env sym_to_find2
case n of
Just addr -> return addr
Nothing -> linkFail "ByteCodeLink.lookupIE"
Nothing -> linkFail "GHC.ByteCode.Linker.lookupIE"
(unpackFS sym_to_find1 ++ " or " ++
unpackFS sym_to_find2)
......@@ -118,7 +118,7 @@ lookupPrimOp hsc_env primop = do
m <- lookupSymbol hsc_env (mkFastString sym_to_find)
case m of
Just p -> return (toRemotePtr p)
Nothing -> linkFail "ByteCodeLink.lookupCE(primop)" sym_to_find
Nothing -> linkFail "GHC.ByteCode.Linker.lookupCE(primop)" sym_to_find
resolvePtr
:: HscEnv -> ItblEnv -> ClosureEnv -> NameEnv Int -> RemoteRef BreakArray
......@@ -135,7 +135,7 @@ resolvePtr hsc_env _ie ce bco_ix _ (BCOPtrName nm)
m <- lookupSymbol hsc_env sym_to_find
case m of
Just p -> return (ResolvedBCOStaticPtr (toRemotePtr p))
Nothing -> linkFail "ByteCodeLink.lookupCE" (unpackFS sym_to_find)
Nothing -> linkFail "GHC.ByteCode.Linker.lookupCE" (unpackFS sym_to_find)
resolvePtr hsc_env _ _ _ _ (BCOPtrPrimOp op) =
ResolvedBCOStaticPtr <$> lookupPrimOp hsc_env op
resolvePtr hsc_env ie ce bco_ix breakarray (BCOPtrBCO bco) =
......
......@@ -4,7 +4,7 @@
--
-- | Bytecode assembler types
module ByteCodeTypes
module GHC.ByteCode.Types
( CompiledByteCode(..), seqCompiledByteCode, FFIInfo(..)
, UnlinkedBCO(..), BCOPtr(..), BCONPtr(..)
, ItblEnv, ItblPtr(..)
......@@ -114,7 +114,7 @@ data CgBreakInfo
{ cgb_vars :: [Maybe (Id,Word16)]
, cgb_resty :: Type
}
-- See Note [Syncing breakpoint info] in compiler/main/InteractiveEval.hs
-- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
-- Not a real NFData instance because we can't rnf Id or Type
seqCgBreakInfo :: CgBreakInfo -> ()
......
-- Cmm representations using Hoopl's Graph CmmNode e x.
{-# LANGUAGE GADTs #-}
module Cmm (
module GHC.Cmm (
-- * Cmm top-level datatypes
CmmProgram, CmmGroup, GenCmmGroup,
CmmDecl, GenCmmDecl(..),
CmmProgram, CmmGroup, CmmGroupSRTs, RawCmmGroup, GenCmmGroup,
CmmDecl, CmmDeclSRTs, GenCmmDecl(..),
CmmGraph, GenCmmGraph(..),
CmmBlock,
RawCmmDecl, RawCmmGroup,
Section(..), SectionType(..), CmmStatics(..), CmmStatic(..),
CmmBlock, RawCmmDecl,
Section(..), SectionType(..), CmmStatics(..), RawCmmStatics(..), CmmStatic(..),
isSecConstant,
-- ** Blocks containing lists
......@@ -21,23 +20,23 @@ module Cmm (
ProfilingInfo(..), ConstrDescription,
-- * Statements, expressions and types
module CmmNode,
module CmmExpr,
module GHC.Cmm.Node,
module GHC.Cmm.Expr,
) where
import GhcPrelude
import Id
import CostCentre
import CLabel
import BlockId
import CmmNode
import SMRep
import CmmExpr
import Hoopl.Block
import Hoopl.Collections
import Hoopl.Graph
import Hoopl.Label
import GHC.Cmm.CLabel
import GHC.Cmm.BlockId
import GHC.Cmm.Node
import GHC.Runtime.Heap.Layout
import GHC.Cmm.Expr
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Dataflow.Label
import Outputable
import Data.ByteString (ByteString)
......@@ -56,8 +55,12 @@ import Data.ByteString (ByteString)
type CmmProgram = [CmmGroup]
type GenCmmGroup d h g = [GenCmmDecl d h g]
type CmmGroup = GenCmmGroup CmmStatics CmmTopInfo CmmGraph
type RawCmmGroup = GenCmmGroup CmmStatics (LabelMap CmmStatics) CmmGraph
-- | Cmm group before SRT generation
type CmmGroup = GenCmmGroup CmmStatics CmmTopInfo CmmGraph
-- | Cmm group with SRTs
type CmmGroupSRTs = GenCmmGroup RawCmmStatics CmmTopInfo CmmGraph
-- | "Raw" cmm group (TODO (osa): not sure what that means)
type RawCmmGroup = GenCmmGroup RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
-----------------------------------------------------------------------------
-- CmmDecl, GenCmmDecl
......@@ -89,12 +92,13 @@ data GenCmmDecl d h g
Section
d
type CmmDecl = GenCmmDecl CmmStatics CmmTopInfo CmmGraph
type CmmDecl = GenCmmDecl CmmStatics CmmTopInfo CmmGraph
type CmmDeclSRTs = GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph
type RawCmmDecl
= GenCmmDecl
CmmStatics
(LabelMap CmmStatics)
RawCmmStatics
(LabelMap RawCmmStatics)
CmmGraph
-----------------------------------------------------------------------------
......@@ -126,7 +130,7 @@ data CmmStackInfo
-- used by the stack allocator later.
updfr_space :: Maybe ByteOff,
-- XXX: this never contains anything useful, but it should.
-- See comment in CmmLayoutStack.
-- See comment in GHC.Cmm.LayoutStack.
do_layout :: Bool
-- Do automatic stack layout for this proc. This is
-- True for all code generated by the code generator,
......@@ -149,13 +153,13 @@ data CmmInfoTable
-- the code generator, because we might want to add SRT
-- entries to them later (for FUNs at least; THUNKs are
-- treated the same for consistency). See Note [SRTs] in
-- CmmBuildInfoTables, in particular the [FUN] optimisation.
-- GHC.Cmm.Info.Build, in particular the [FUN] optimisation.
--
-- This is strictly speaking not a part of the info table that
-- will be finally generated, but it's the only convenient
-- place to convey this information from the code generator to
-- where we build the static closures in
-- CmmBuildInfoTables.doSRTs.
-- GHC.Cmm.Info.Build.doSRTs.
}
data ProfilingInfo
......@@ -199,8 +203,20 @@ data CmmStatic
| CmmString ByteString
-- string of 8-bit values only, not zero terminated.
-- Static data before SRT generation
data CmmStatics
= Statics
= CmmStatics
CLabel -- Label of statics
CmmInfoTable
CostCentreStack
[CmmLit] -- Payload
| CmmStaticsRaw
CLabel -- Label of statics
[CmmStatic] -- The static data itself
-- Static data, after SRTs are generated
data RawCmmStatics
= RawCmmStatics
CLabel -- Label of statics
[CmmStatic] -- The static data itself
......
......@@ -2,7 +2,7 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- BlockId module should probably go away completely, being superseded by Label -}
module BlockId
module GHC.Cmm.BlockId
( BlockId, mkBlockId -- ToDo: BlockId should be abstract, but it isn't yet
, newBlockId
, blockLbl, infoTblLbl
......@@ -10,13 +10,13 @@ module BlockId
import GhcPrelude
import CLabel
import GHC.Cmm.CLabel
import IdInfo
import Name
import Unique
import UniqSupply
import Hoopl.Label (Label, mkHooplLabel)
import GHC.Cmm.Dataflow.Label (Label, mkHooplLabel)
----------------------------------------------------------------
--- Block Ids, their environments, and their sets
......
module BlockId (BlockId, mkBlockId) where
module GHC.Cmm.BlockId (BlockId, mkBlockId) where
import Hoopl.Label (Label)
import GHC.Cmm.Dataflow.Label (Label)
import Unique (Unique)
type BlockId = Label
......
......@@ -7,8 +7,9 @@
-----------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
module CLabel (
module GHC.Cmm.CLabel (
CLabel, -- abstract type
ForeignLabelSource(..),
pprDebugCLabel,
......@@ -106,7 +107,8 @@ module CLabel (
pprCLabel,
isInfoTableLabel,
isConInfoTableLabel
isConInfoTableLabel,
isIdLabel
) where
#include "HsVersions.h"
......@@ -115,7 +117,7 @@ import GhcPrelude
import IdInfo
import BasicTypes
import {-# SOURCE #-} BlockId (BlockId, mkBlockId)
import {-# SOURCE #-} GHC.Cmm.BlockId (BlockId, mkBlockId)
import Packages
import Module
import Name
......@@ -262,6 +264,10 @@ data CLabel
deriving Eq
isIdLabel :: CLabel -> Bool
isIdLabel IdLabel{} = True
isIdLabel _ = False
-- This is laborious, but necessary. We can't derive Ord because
-- Unique doesn't have an Ord instance. Note nonDetCmpUnique in the
-- implementation. See Note [No Ord for Unique]
......@@ -463,7 +469,7 @@ mkRednCountsLabel name =
mkLocalClosureLabel :: Name -> CafInfo -> CLabel
mkLocalInfoTableLabel :: Name -> CafInfo -> CLabel
mkLocalClosureTableLabel :: Name -> CafInfo -> CLabel
mkLocalClosureLabel name c = IdLabel name c Closure
mkLocalClosureLabel !name !c = IdLabel name c Closure
mkLocalInfoTableLabel name c = IdLabel name c LocalInfoTable
mkLocalClosureTableLabel name c = IdLabel name c ClosureTable
......@@ -746,7 +752,7 @@ hasCAF _ = False
-- Until 14 Feb 2013, every ticky counter was associated with a
-- closure. Thus, ticky labels used IdLabel. It is odd that
-- CmmBuildInfoTables.cafTransfers would consider such a ticky label
-- GHC.Cmm.Info.Build.cafTransfers would consider such a ticky label
-- reason to add the name to the CAFEnv (and thus eventually the SRT),
-- but it was harmless because the ticky was only used if the closure
-- was also.
......
module CmmCallConv (
module GHC.Cmm.CallConv (
ParamLocation(..),
assignArgumentsPos,
assignStack,
......@@ -7,10 +7,10 @@ module CmmCallConv (
import GhcPrelude
import CmmExpr
import SMRep
import Cmm (Convention(..))
import PprCmm () -- For Outputable instances
import GHC.Cmm.Expr
import GHC.Runtime.Heap.Layout
import GHC.Cmm (Convention(..))
import GHC.Cmm.Ppr () -- For Outputable instances
import DynFlags
import GHC.Platform
......
{-# LANGUAGE GADTs, BangPatterns, ScopedTypeVariables #-}
module CmmCommonBlockElim
module GHC.Cmm.CommonBlockElim
( elimCommonBlocks
)
where
......@@ -8,16 +8,16 @@ where
import GhcPrelude hiding (iterate, succ, unzip, zip)
import BlockId
import Cmm
import CmmUtils
import CmmSwitch (eqSwitchTargetWith)
import CmmContFlowOpt
import GHC.Cmm.BlockId
import GHC.Cmm
import GHC.Cmm.Utils
import GHC.Cmm.Switch (eqSwitchTargetWith)
import GHC.Cmm.ContFlowOpt
import Hoopl.Block
import Hoopl.Graph
import Hoopl.Label
import Hoopl.Collections
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.Dataflow.Collections
import Data.Bits
import Data.Maybe (mapMaybe)
import qualified Data.List as List
......
{-# LANGUAGE GADTs #-}
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
module CmmContFlowOpt
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module GHC.Cmm.ContFlowOpt
( cmmCfgOpts
, cmmCfgOptsProc
, removeUnreachableBlocksProc
......@@ -11,14 +12,14 @@ where
import GhcPrelude hiding (succ, unzip, zip)
import Hoopl.Block
import Hoopl.Collections
import Hoopl.Graph
import Hoopl.Label
import BlockId
import Cmm
import CmmUtils
import CmmSwitch (mapSwitchTargets, switchTargetsToList)
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.BlockId
import GHC.Cmm
import GHC.Cmm.Utils
import GHC.Cmm.Switch (mapSwitchTargets, switchTargetsToList)
import Maybes
import Panic
import Util
......
......@@ -17,7 +17,7 @@
-- specialised to the UniqSM monad.
--
module Hoopl.Dataflow
module GHC.Cmm.Dataflow
( C, O, Block
, lastNode, entryLabel
, foldNodesBwdOO
......@@ -36,7 +36,7 @@ where
import GhcPrelude
import Cmm
import GHC.Cmm
import UniqSupply
import Data.Array
......@@ -44,10 +44,10 @@ import Data.Maybe
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Hoopl.Block
import Hoopl.Graph
import Hoopl.Collections
import Hoopl.Label
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow.Label
type family Fact (x :: Extensibility) f :: *
type instance Fact C f = FactBase f
......
......@@ -6,7 +6,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
module Hoopl.Block
module GHC.Cmm.Dataflow.Block
( Extensibility (..)
, O
, C
......
......@@ -4,7 +4,7 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Hoopl.Collections
module GHC.Cmm.Dataflow.Collections
( IsSet(..)
, setInsertList, setDeleteList, setUnions
, IsMap(..)
......@@ -167,11 +167,14 @@ instance IsMap UniqueMap where
mapFoldr k z (UM m) = M.foldr k z m
mapFoldlWithKey k z (UM m) = M.foldlWithKey' k z m
mapFoldMapWithKey f (UM m) = M.foldMapWithKey f m
{-# INLINEABLE mapFilter #-}
mapFilter f (UM m) = UM (M.filter f m)
{-# INLINEABLE mapFilterWithKey #-}
mapFilterWithKey f (UM m) = UM (M.filterWithKey f m)
mapElems (UM m) = M.elems m
mapKeys (UM m) = M.keys m
{-# INLINEABLE mapToList #-}
mapToList (UM m) = M.toList m
mapFromList assocs = UM (M.fromList assocs)
mapFromListWith f assocs = UM (M.fromListWith f assocs)
......@@ -5,7 +5,7 @@
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Hoopl.Graph
module GHC.Cmm.Dataflow.Graph
( Body
, Graph
, Graph'(..)
......@@ -23,9 +23,9 @@ module Hoopl.Graph
import GhcPrelude
import Util
import Hoopl.Label
import Hoopl.Block
import Hoopl.Collections
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Collections
-- | A (possibly empty) collection of closed/closed blocks
type Body n = LabelMap (Block n C C)
......
......@@ -4,7 +4,7 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Hoopl.Label
module GHC.Cmm.Dataflow.Label
( Label
, LabelMap
, LabelSet
......@@ -18,7 +18,7 @@ import GhcPrelude
import Outputable
-- TODO: This should really just use GHC's Unique and Uniq{Set,FM}
import Hoopl.Collections
import GHC.Cmm.Dataflow.Collections
import Unique (Uniquable(..))
import TrieMap
......@@ -107,11 +107,14 @@ instance IsMap LabelMap where
mapFoldlWithKey k z (LM m) =
mapFoldlWithKey (\a v -> k a (mkHooplLabel v)) z m
mapFoldMapWithKey f (LM m) = mapFoldMapWithKey (\k v -> f (mkHooplLabel k) v) m
{-# INLINEABLE mapFilter #-}
mapFilter f (LM m) = LM (mapFilter f m)
{-# INLINEABLE mapFilterWithKey #-}
mapFilterWithKey f (LM m) = LM (mapFilterWithKey (f . mkHooplLabel) m)
mapElems (LM m) = mapElems m
mapKeys (LM m) = map mkHooplLabel (mapKeys m)
{-# INLINEABLE mapToList #-}
mapToList (LM m) = [(mkHooplLabel k, v) | (k, v) <- mapToList m]
mapFromList assocs = LM (mapFromList [(lblToUnique k, v) | (k, v) <- assocs])
mapFromListWith f assocs = LM (mapFromListWith f [(lblToUnique k, v) | (k, v) <- assocs])
......