From 727fae32ea0b6ca6ebdf1b3137649813e4d7ac3d Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Thu, 7 Feb 2008 01:57:14 +0000 Subject: [PATCH] Make some more modules use LazyUniqFM instead of UniqFM If these modules use UniqFM then we get a stack overflow when compiling modules that use fundeps. I haven't tracked down the actual cause. --- compiler/basicTypes/NewDemand.lhs | 2 +- compiler/basicTypes/VarEnv.lhs | 2 +- compiler/coreSyn/CoreFVs.lhs | 2 +- compiler/coreSyn/CoreTidy.lhs | 2 +- compiler/nativeGen/AsmCodeGen.lhs | 2 +- compiler/nativeGen/MachRegs.lhs | 11 ++++++----- compiler/nativeGen/RegAllocColor.hs | 2 +- compiler/nativeGen/RegAllocLinear.hs | 2 +- compiler/nativeGen/RegAllocStats.hs | 2 +- compiler/nativeGen/RegLiveness.hs | 2 +- compiler/nativeGen/RegSpillCost.hs | 2 +- compiler/simplCore/OccurAnal.lhs | 2 +- compiler/stranal/DmdAnal.lhs | 2 +- compiler/typecheck/TcGadt.lhs | 2 +- compiler/utils/GraphBase.hs | 2 +- compiler/utils/GraphColor.hs | 2 +- compiler/utils/GraphOps.hs | 2 +- compiler/utils/GraphPpr.hs | 2 +- compiler/utils/LazyUniqFM.lhs | 4 +++- compiler/utils/UniqSet.lhs | 2 +- compiler/vectorise/VectType.hs | 2 +- 21 files changed, 28 insertions(+), 25 deletions(-) diff --git a/compiler/basicTypes/NewDemand.lhs b/compiler/basicTypes/NewDemand.lhs index 062e25f..2361972 100644 --- a/compiler/basicTypes/NewDemand.lhs +++ b/compiler/basicTypes/NewDemand.lhs @@ -35,7 +35,7 @@ module NewDemand( import StaticFlags import BasicTypes import VarEnv -import UniqFM +import LazyUniqFM import Util import Outputable \end{code} diff --git a/compiler/basicTypes/VarEnv.lhs b/compiler/basicTypes/VarEnv.lhs index 3b0be0b..dbef903 100644 --- a/compiler/basicTypes/VarEnv.lhs +++ b/compiler/basicTypes/VarEnv.lhs @@ -46,7 +46,7 @@ module VarEnv ( import OccName import Var import VarSet -import UniqFM +import LazyUniqFM import Unique import Util import Maybes diff --git a/compiler/coreSyn/CoreFVs.lhs b/compiler/coreSyn/CoreFVs.lhs index 57316c7..199cc69 100644 --- a/compiler/coreSyn/CoreFVs.lhs +++ b/compiler/coreSyn/CoreFVs.lhs @@ -38,7 +38,7 @@ import CoreSyn import Id import IdInfo import NameSet -import UniqFM +import LazyUniqFM import Name import VarSet import Var diff --git a/compiler/coreSyn/CoreTidy.lhs b/compiler/coreSyn/CoreTidy.lhs index 5acee51..4da1dc3 100644 --- a/compiler/coreSyn/CoreTidy.lhs +++ b/compiler/coreSyn/CoreTidy.lhs @@ -22,7 +22,7 @@ import IdInfo import Type import Var import VarEnv -import UniqFM +import LazyUniqFM import Name hiding (tidyNameOcc) import OccName import SrcLoc diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs index 6d3bf7c..e0608cb 100644 --- a/compiler/nativeGen/AsmCodeGen.lhs +++ b/compiler/nativeGen/AsmCodeGen.lhs @@ -40,7 +40,7 @@ import MachOp import CLabel import State -import UniqFM +import LazyUniqFM import Unique ( Unique, getUnique ) import UniqSupply import List ( groupBy, sortBy ) diff --git a/compiler/nativeGen/MachRegs.lhs b/compiler/nativeGen/MachRegs.lhs index 85c88b2..0174fac 100644 --- a/compiler/nativeGen/MachRegs.lhs +++ b/compiler/nativeGen/MachRegs.lhs @@ -105,7 +105,8 @@ import UniqSet import Constants import FastTypes import FastBool -import UniqFM +import qualified UniqFM as S +import LazyUniqFM #if powerpc_TARGET_ARCH import Data.Word ( Word8, Word16, Word32 ) @@ -518,20 +519,20 @@ worst n classN classC {-# INLINE regClass #-} trivColorable :: RegClass -> UniqSet Reg -> UniqSet Reg -> Bool -trivColorable classN conflicts exclusions +trivColorable classN (MkUniqFM conflicts) (MkUniqFM exclusions) = {-# SCC "trivColorable" #-} let {-# INLINE isSqueesed #-} isSqueesed cI cF ufm = case ufm of - NodeUFM _ _ left right + S.NodeUFM _ _ left right -> case isSqueesed cI cF right of (# s, cI', cF' #) -> case s of False -> isSqueesed cI' cF' left True -> (# True, cI', cF' #) - LeafUFM _ reg + S.LeafUFM _ (Lazy reg) -> case regClass reg of RcInteger -> case cI +# _ILIT(1) of @@ -541,7 +542,7 @@ trivColorable classN conflicts exclusions -> case cF +# _ILIT(1) of cF' -> (# cF' >=# ALLOCATABLE_REGS_DOUBLE, cI, cF' #) - EmptyUFM + S.EmptyUFM -> (# False, cI, cF #) in case isSqueesed (_ILIT(0)) (_ILIT(0)) conflicts of diff --git a/compiler/nativeGen/RegAllocColor.hs b/compiler/nativeGen/RegAllocColor.hs index 51a0bff..e2e002a 100644 --- a/compiler/nativeGen/RegAllocColor.hs +++ b/compiler/nativeGen/RegAllocColor.hs @@ -24,7 +24,7 @@ import PprMach import UniqSupply import UniqSet -import UniqFM +import LazyUniqFM import Bag import Outputable import DynFlags diff --git a/compiler/nativeGen/RegAllocLinear.hs b/compiler/nativeGen/RegAllocLinear.hs index e6491b7..b333c68 100644 --- a/compiler/nativeGen/RegAllocLinear.hs +++ b/compiler/nativeGen/RegAllocLinear.hs @@ -97,7 +97,7 @@ import Cmm hiding (RegSet) import Digraph import Unique ( Uniquable(getUnique), Unique ) import UniqSet -import UniqFM +import LazyUniqFM import UniqSupply import Outputable import State diff --git a/compiler/nativeGen/RegAllocStats.hs b/compiler/nativeGen/RegAllocStats.hs index 8eb8660..9f8415f 100644 --- a/compiler/nativeGen/RegAllocStats.hs +++ b/compiler/nativeGen/RegAllocStats.hs @@ -30,7 +30,7 @@ import MachInstrs import Cmm import Outputable -import UniqFM +import LazyUniqFM import UniqSet import State diff --git a/compiler/nativeGen/RegLiveness.hs b/compiler/nativeGen/RegLiveness.hs index 9ee9897..6f21db8 100644 --- a/compiler/nativeGen/RegLiveness.hs +++ b/compiler/nativeGen/RegLiveness.hs @@ -42,7 +42,7 @@ import Digraph import Outputable import Unique import UniqSet -import UniqFM +import LazyUniqFM import UniqSupply import Bag import State diff --git a/compiler/nativeGen/RegSpillCost.hs b/compiler/nativeGen/RegSpillCost.hs index d987937..b492738 100644 --- a/compiler/nativeGen/RegSpillCost.hs +++ b/compiler/nativeGen/RegSpillCost.hs @@ -23,7 +23,7 @@ import MachInstrs import MachRegs import Cmm -import UniqFM +import LazyUniqFM import UniqSet import Outputable import State diff --git a/compiler/simplCore/OccurAnal.lhs b/compiler/simplCore/OccurAnal.lhs index bdf38ee..efc51ba 100644 --- a/compiler/simplCore/OccurAnal.lhs +++ b/compiler/simplCore/OccurAnal.lhs @@ -33,7 +33,7 @@ import Maybes ( orElse ) import Digraph ( stronglyConnCompR, SCC(..) ) import PrelNames ( buildIdKey, foldrIdKey, runSTRepIdKey, augmentIdKey ) import Unique ( Unique ) -import UniqFM ( keysUFM, intersectUFM_C, foldUFM_Directly ) +import LazyUniqFM ( keysUFM, intersectUFM_C, foldUFM_Directly ) import Util ( mapAndUnzip ) import Outputable diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index eec165a..84c2968 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -45,7 +45,7 @@ import Var ( Var ) import VarEnv import TysWiredIn ( unboxedPairDataCon ) import TysPrim ( realWorldStatePrimTy ) -import UniqFM ( plusUFM_C, addToUFM_Directly, lookupUFM_Directly, +import LazyUniqFM ( plusUFM_C, addToUFM_Directly, lookupUFM_Directly, keysUFM, minusUFM, ufmToList, filterUFM ) import Type ( isUnLiftedType, coreEqType, splitTyConApp_maybe ) import Coercion ( coercionKind ) diff --git a/compiler/typecheck/TcGadt.lhs b/compiler/typecheck/TcGadt.lhs index b556e89..b3156ed 100644 --- a/compiler/typecheck/TcGadt.lhs +++ b/compiler/typecheck/TcGadt.lhs @@ -40,7 +40,7 @@ import Control.Monad import Outputable import TcType import Unique -import UniqFM +import LazyUniqFM \end{code} diff --git a/compiler/utils/GraphBase.hs b/compiler/utils/GraphBase.hs index 04eda96..3948c81 100644 --- a/compiler/utils/GraphBase.hs +++ b/compiler/utils/GraphBase.hs @@ -14,7 +14,7 @@ module GraphBase ( where import UniqSet -import UniqFM +import LazyUniqFM -- | A fn to check if a node is trivially colorable diff --git a/compiler/utils/GraphColor.hs b/compiler/utils/GraphColor.hs index 8e7989d..e381fbf 100644 --- a/compiler/utils/GraphColor.hs +++ b/compiler/utils/GraphColor.hs @@ -19,7 +19,7 @@ import GraphOps import GraphPpr import Unique -import UniqFM +import LazyUniqFM import UniqSet import Outputable diff --git a/compiler/utils/GraphOps.hs b/compiler/utils/GraphOps.hs index 880f3c6..a82ff68 100644 --- a/compiler/utils/GraphOps.hs +++ b/compiler/utils/GraphOps.hs @@ -24,7 +24,7 @@ import GraphBase import Outputable import Unique import UniqSet -import UniqFM +import LazyUniqFM import Data.List hiding (union) import Data.Maybe diff --git a/compiler/utils/GraphPpr.hs b/compiler/utils/GraphPpr.hs index 1df5158..0e82b31 100644 --- a/compiler/utils/GraphPpr.hs +++ b/compiler/utils/GraphPpr.hs @@ -12,7 +12,7 @@ import GraphBase import Outputable import Unique import UniqSet -import UniqFM +import LazyUniqFM import Data.List import Data.Maybe diff --git a/compiler/utils/LazyUniqFM.lhs b/compiler/utils/LazyUniqFM.lhs index d8132e3..b7ac15d 100644 --- a/compiler/utils/LazyUniqFM.lhs +++ b/compiler/utils/LazyUniqFM.lhs @@ -13,7 +13,9 @@ Basically, the things need to be in class @Uniquable@, and we use the \begin{code} {-# OPTIONS -Wall -fno-warn-name-shadowing -Werror -fallow-undecidable-instances #-} module LazyUniqFM ( - UniqFM, -- abstract type + UniqFM(..), -- abstract type + -- XXX Not actually abstract because of nativeGen/MachRegs; sigh + Lazy(Lazy), -- XXX Also for nativeGen/MachRegs; sigh emptyUFM, unitUFM, diff --git a/compiler/utils/UniqSet.lhs b/compiler/utils/UniqSet.lhs index 08d3575..ba312dd 100644 --- a/compiler/utils/UniqSet.lhs +++ b/compiler/utils/UniqSet.lhs @@ -22,7 +22,7 @@ module UniqSet ( ) where import Maybes -import UniqFM +import LazyUniqFM import Unique #if ! OMIT_NATIVE_CODEGEN diff --git a/compiler/vectorise/VectType.hs b/compiler/vectorise/VectType.hs index 86dcaf2..972aca1 100644 --- a/compiler/vectorise/VectType.hs +++ b/compiler/vectorise/VectType.hs @@ -39,7 +39,7 @@ import TysWiredIn import TysPrim ( intPrimTy ) import Unique -import UniqFM +import LazyUniqFM import UniqSet import Util ( singleton ) import Digraph ( SCC(..), stronglyConnComp ) -- 1.7.10.4