Commit c9959e41 authored by Ian Lynagh's avatar Ian Lynagh

Remove LazyUniqFM; fixes trac #3880

parent 78f5cf9c
......@@ -75,7 +75,7 @@ import Outputable
import qualified Pretty
import Unique
import FiniteMap
import LazyUniqFM
import UniqFM
import FastString
import Binary
import Util
......
......@@ -24,7 +24,7 @@ module NameEnv (
import Name
import Unique
import LazyUniqFM
import UniqFM
import Maybes
import Outputable
\end{code}
......
......@@ -430,7 +430,6 @@ Library
GraphPpr
IOEnv
Interval
LazyUniqFM
ListSetOps
Maybes
MonadUtils
......
......@@ -38,7 +38,7 @@ import Name
import NameEnv
import NameSet
import qualified OccName
import LazyUniqFM
import UniqFM
import Module
import ListSetOps
import DynFlags
......
......@@ -28,7 +28,7 @@ import Var
import Name
import PrelNames
import Module
import LazyUniqFM
import UniqFM
import FastString
import UniqSupply
import FiniteMap
......
......@@ -42,7 +42,7 @@ import Module
import Maybes
import ErrUtils
import Finder
import LazyUniqFM
import UniqFM
import StaticFlags
import Outputable
import BinIface
......
......@@ -83,7 +83,7 @@ import Digraph
import SrcLoc
import Outputable
import BasicTypes hiding ( SuccessFlag(..) )
import LazyUniqFM
import UniqFM
import Unique
import Util hiding ( eqListBy )
import FiniteMap
......
......@@ -48,7 +48,7 @@ import NameEnv
import OccurAnal ( occurAnalyseExpr )
import Demand ( isBottomingSig )
import Module
import LazyUniqFM
import UniqFM
import UniqSupply
import Outputable
import ErrUtils
......
......@@ -19,7 +19,7 @@ module Annotations (
import Name
import Module ( Module )
import Outputable
import LazyUniqFM
import UniqFM
import Serialized
import Unique
......
......@@ -35,7 +35,7 @@ import Finder
import HscTypes
import Outputable
import Module
import LazyUniqFM ( eltsUFM )
import UniqFM ( eltsUFM )
import ErrUtils
import DynFlags
import StaticFlags ( v_Ld_inputs, opt_Static, WayName(..) )
......
......@@ -34,7 +34,7 @@ import Util
import PrelNames ( gHC_PRIM )
import DynFlags
import Outputable
import LazyUniqFM
import UniqFM
import Maybes ( expectJust )
import Exception ( evaluate )
......
......@@ -284,8 +284,7 @@ import SysTools ( initSysTools, cleanTempFiles, cleanTempFilesExcept,
cleanTempDirs )
import Annotations
import Module
import LazyUniqFM
import qualified UniqFM as UFM
import UniqFM
import FiniteMap
import Panic
import Digraph
......@@ -2533,7 +2532,7 @@ packageDbModules :: GhcMonad m =>
-> m [Module]
packageDbModules only_exposed = do
dflags <- getSessionDynFlags
let pkgs = UFM.eltsUFM (pkgIdMap (pkgState dflags))
let pkgs = eltsUFM (pkgIdMap (pkgState dflags))
return $
[ mkModule pid modname | p <- pkgs
, not only_exposed || exposed p
......
......@@ -109,7 +109,7 @@ import HscStats ( ppSourceStats )
import HscTypes
import MkExternalCore ( emitExternalCore )
import FastString
import LazyUniqFM ( emptyUFM )
import UniqFM ( emptyUFM )
import UniqSupply ( initUs_ )
import Bag ( unitBag )
import Exception
......
......@@ -146,7 +146,7 @@ import Maybes ( orElse, expectJust, catMaybes )
import Outputable
import BreakArray
import SrcLoc ( SrcSpan, Located(..) )
import LazyUniqFM ( lookupUFM, eltsUFM, emptyUFM )
import UniqFM ( lookupUFM, eltsUFM, emptyUFM )
import UniqSupply ( UniqSupply )
import FastString
import StringBuffer ( StringBuffer )
......
......@@ -59,7 +59,7 @@ import Unique
import UniqSupply
import Module
import Panic
import LazyUniqFM
import UniqFM
import Maybes
import ErrUtils
import Util
......
......@@ -48,7 +48,7 @@ import Name ( Name, nameIsLocalOrFrom, mkInternalName, isWiredInName,
nameSrcLoc, nameSrcSpan, nameOccName, nameModule, isExternalName )
import NameSet
import NameEnv
import LazyUniqFM
import UniqFM
import DataCon ( dataConFieldLabels )
import OccName
import Module ( Module, ModuleName )
......
......@@ -78,7 +78,7 @@ import qualified ErrUtils as Err
import Bag
import Maybes
import UniqSupply
import LazyUniqFM ( UniqFM, mapUFM, filterUFM )
import UniqFM ( UniqFM, mapUFM, filterUFM )
import FiniteMap
import Util ( split )
......
......@@ -47,7 +47,6 @@ import UniqSupply
import Outputable
import FastString
import UniqFM
import qualified LazyUniqFM as L
import MonadUtils
import Control.Monad ( zipWithM )
import Data.List
......@@ -555,7 +554,7 @@ data ScEnv = SCE { sc_size :: Maybe Int, -- Size threshold
-- Domain is OutIds (*after* applying the substitution)
-- Used even for top-level bindings (but not imported ones)
sc_annotations :: L.UniqFM SpecConstrAnnotation
sc_annotations :: UniqFM SpecConstrAnnotation
}
---------------------
......@@ -580,7 +579,7 @@ instance Outputable Value where
ppr LambdaVal = ptext (sLit "<Lambda>")
---------------------
initScEnv :: DynFlags -> L.UniqFM SpecConstrAnnotation -> ScEnv
initScEnv :: DynFlags -> UniqFM SpecConstrAnnotation -> ScEnv
initScEnv dflags anns
= SCE { sc_size = specConstrThreshold dflags,
sc_count = specConstrCount dflags,
......@@ -689,7 +688,7 @@ extendCaseBndrs env case_bndr con alt_bndrs
ignoreTyCon :: ScEnv -> TyCon -> Bool
ignoreTyCon env tycon
= L.lookupUFM (sc_annotations env) tycon == Just NoSpecConstr
= lookupUFM (sc_annotations env) tycon == Just NoSpecConstr
ignoreType :: ScEnv -> Type -> Bool
ignoreType env ty
......@@ -715,7 +714,7 @@ forceSpecArgTy env ty
forceSpecArgTy env ty
| Just (tycon, tys) <- splitTyConApp_maybe ty
, tycon /= funTyCon
= L.lookupUFM (sc_annotations env) tycon == Just ForceSpecConstr
= lookupUFM (sc_annotations env) tycon == Just ForceSpecConstr
|| any (forceSpecArgTy env) tys
forceSpecArgTy _ _ = False
......
......@@ -15,7 +15,7 @@ import Name
import Module
import SrcLoc
import Outputable
import LazyUniqFM
import UniqFM
import FiniteMap
import FastString
......
......@@ -59,7 +59,7 @@ import Id
import VarEnv
import Var
import Module
import LazyUniqFM
import UniqFM
import Name
import NameEnv
import NameSet
......
......@@ -35,7 +35,7 @@ import Bag
import Outputable
import UniqSupply
import Unique
import LazyUniqFM
import UniqFM
import DynFlags
import StaticFlags
import FastString
......
......@@ -56,7 +56,7 @@ import NameSet
import Var
import VarEnv
import Module
import LazyUniqFM
import UniqFM
import SrcLoc
import VarSet
import ErrUtils
......
%
% (c) The University of Glasgow 2006
% (c) The AQUA Project, Glasgow University, 1994-1998
%
LazyUniqFM: Specialised lazy finite maps, for things with @Uniques@
Based on @UniqFM@.
Basically, the things need to be in class @Uniquable@, and we use the
@getUnique@ method to grab their @Uniques@.
\begin{code}
module LazyUniqFM (
-- * Lazy unique-keyed mappings
UniqFM, -- abstract type
-- ** Manipulating those mappings
emptyUFM,
unitUFM,
unitDirectlyUFM,
listToUFM,
listToUFM_Directly,
addToUFM,addToUFM_C,addToUFM_Acc,
addListToUFM,addListToUFM_C,
addToUFM_Directly,
addListToUFM_Directly,
delFromUFM,
delFromUFM_Directly,
delListFromUFM,
plusUFM,
plusUFM_C,
minusUFM,
intersectsUFM,
intersectUFM,
intersectUFM_C,
foldUFM, foldUFM_Directly,
mapUFM,
elemUFM, elemUFM_Directly,
filterUFM, filterUFM_Directly,
sizeUFM,
hashUFM,
isNullUFM,
lookupUFM, lookupUFM_Directly,
lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
eltsUFM, keysUFM,
ufmToList
) where
import qualified UniqFM as S
import Unique
import Outputable
\end{code}
%************************************************************************
%* *
\subsection{The @UniqFM@ type, and signatures for the functions}
%* *
%************************************************************************
We use @FiniteMaps@, with a (@getUnique@-able) @Unique@ as ``key''.
\begin{code}
emptyUFM :: UniqFM elt
isNullUFM :: UniqFM elt -> Bool
unitUFM :: Uniquable key => key -> elt -> UniqFM elt
unitDirectlyUFM -- got the Unique already
:: Unique -> elt -> UniqFM elt
listToUFM :: Uniquable key => [(key,elt)] -> UniqFM elt
listToUFM_Directly
:: [(Unique, elt)] -> UniqFM elt
addToUFM :: Uniquable key => UniqFM elt -> key -> elt -> UniqFM elt
addListToUFM :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt
addListToUFM_Directly :: UniqFM elt -> [(Unique,elt)] -> UniqFM elt
addToUFM_Directly
:: UniqFM elt -> Unique -> elt -> UniqFM elt
addToUFM_C :: Uniquable key => (elt -> elt -> elt) -- old -> new -> result
-> UniqFM elt -- old
-> key -> elt -- new
-> UniqFM elt -- result
addToUFM_Acc :: Uniquable key =>
(elt -> elts -> elts) -- Add to existing
-> (elt -> elts) -- New element
-> UniqFM elts -- old
-> key -> elt -- new
-> UniqFM elts -- result
addListToUFM_C :: Uniquable key => (elt -> elt -> elt)
-> UniqFM elt -> [(key,elt)]
-> UniqFM elt
delFromUFM :: Uniquable key => UniqFM elt -> key -> UniqFM elt
delListFromUFM :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt
delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt
plusUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
plusUFM_C :: (elt -> elt -> elt)
-> UniqFM elt -> UniqFM elt -> UniqFM elt
minusUFM :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
intersectUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
intersectUFM_C :: (elt1 -> elt2 -> elt3)
-> UniqFM elt1 -> UniqFM elt2 -> UniqFM elt3
intersectsUFM :: UniqFM elt1 -> UniqFM elt2 -> Bool
foldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
foldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a
mapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
filterUFM :: (elt -> Bool) -> UniqFM elt -> UniqFM elt
filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt
sizeUFM :: UniqFM elt -> Int
hashUFM :: UniqFM elt -> Int
elemUFM :: Uniquable key => key -> UniqFM elt -> Bool
elemUFM_Directly:: Unique -> UniqFM elt -> Bool
lookupUFM :: Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM_Directly -- when you've got the Unique already
:: UniqFM elt -> Unique -> Maybe elt
lookupWithDefaultUFM
:: Uniquable key => UniqFM elt -> elt -> key -> elt
lookupWithDefaultUFM_Directly
:: UniqFM elt -> elt -> Unique -> elt
keysUFM :: UniqFM elt -> [Unique] -- Get the keys
eltsUFM :: UniqFM elt -> [elt]
ufmToList :: UniqFM elt -> [(Unique, elt)]
\end{code}
%************************************************************************
%* *
\subsection{The @IdFinMap@ and @TyVarFinMap@ specialisations for Ids/TyVars}
%* *
%************************************************************************
\begin{code}
-- Turn off for now, these need to be updated (SDM 4/98)
#if 0
#ifdef __GLASGOW_HASKELL__
-- I don't think HBC was too happy about this (WDP 94/10)
{-# SPECIALIZE
addListToUFM :: UniqFM elt -> [(Name, elt)] -> UniqFM elt
#-}
{-# SPECIALIZE
addListToUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> [(Name, elt)] -> UniqFM elt
#-}
{-# SPECIALIZE
addToUFM :: UniqFM elt -> Unique -> elt -> UniqFM elt
#-}
{-# SPECIALIZE
listToUFM :: [(Unique, elt)] -> UniqFM elt
#-}
{-# SPECIALIZE
lookupUFM :: UniqFM elt -> Name -> Maybe elt
, UniqFM elt -> Unique -> Maybe elt
#-}
#endif /* __GLASGOW_HASKELL__ */
#endif
\end{code}
%************************************************************************
%* *
\subsubsection{The @UniqFM@ type, and signatures for the functions}
%* *
%************************************************************************
@UniqFM a@ is a mapping from Unique to a.
\begin{code}
data Lazy a = Lazy { fromLazy :: a }
-- | @UniqFM a@ is a mapping from Unique to @a@ where the element @a@ is evaluated lazily.
newtype UniqFM ele = MkUniqFM (S.UniqFM (Lazy ele))
instance Outputable a => Outputable (UniqFM a) where
ppr (MkUniqFM fm) = ppr fm
instance Outputable a => Outputable (Lazy a) where
ppr (Lazy x) = ppr x
\end{code}
%************************************************************************
%* *
\subsubsection{The @UniqFM@ functions}
%* *
%************************************************************************
First the ways of building a UniqFM.
\begin{code}
emptyUFM = MkUniqFM $ S.EmptyUFM
unitUFM key elt = MkUniqFM $ S.unitUFM key (Lazy elt)
unitDirectlyUFM key elt = MkUniqFM $ S.unitDirectlyUFM key (Lazy elt)
listToUFM key_elt_pairs
= MkUniqFM $ S.listToUFM [ (k, Lazy v) | (k, v) <- key_elt_pairs ]
listToUFM_Directly uniq_elt_pairs
= MkUniqFM
$ S.listToUFM_Directly [ (k, Lazy v) | (k, v) <- uniq_elt_pairs ]
\end{code}
Now ways of adding things to UniqFMs.
There is an alternative version of @addListToUFM_C@, that uses @plusUFM@,
but the semantics of this operation demands a linear insertion;
perhaps the version without the combinator function
could be optimised using it.
\begin{code}
addToUFM (MkUniqFM fm) key elt = MkUniqFM $ S.addToUFM fm key (Lazy elt)
addToUFM_Directly (MkUniqFM fm) u elt
= MkUniqFM $ S.addToUFM_Directly fm u (Lazy elt)
addToUFM_C combiner (MkUniqFM fm) key elt
= MkUniqFM $ S.addToUFM_C combiner' fm key (Lazy elt)
where combiner' (Lazy l) (Lazy r) = Lazy (combiner l r)
addToUFM_Acc add unit (MkUniqFM fm) key item
= MkUniqFM $ S.addToUFM_Acc add' unit' fm key item
where add' elt (Lazy elts) = Lazy (add elt elts)
unit' elt = Lazy (unit elt)
addListToUFM (MkUniqFM fm) key_elt_pairs
= MkUniqFM $ S.addListToUFM fm [ (k, Lazy v) | (k, v) <- key_elt_pairs ]
addListToUFM_Directly (MkUniqFM fm) uniq_elt_pairs
= MkUniqFM
$ S.addListToUFM_Directly fm [ (k, Lazy v) | (k, v) <- uniq_elt_pairs ]
addListToUFM_C combiner (MkUniqFM fm) key_elt_pairs
= MkUniqFM
$ S.addListToUFM_C combiner' fm [ (k, Lazy v) | (k, v) <- key_elt_pairs ]
where combiner' (Lazy l) (Lazy r) = Lazy (combiner l r)
\end{code}
Now ways of removing things from UniqFM.
\begin{code}
delListFromUFM (MkUniqFM fm) lst = MkUniqFM $ S.delListFromUFM fm lst
delFromUFM (MkUniqFM fm) key = MkUniqFM $ S.delFromUFM fm key
delFromUFM_Directly (MkUniqFM fm) u = MkUniqFM $ S.delFromUFM_Directly fm u
\end{code}
Now ways of adding two UniqFM's together.
\begin{code}
plusUFM (MkUniqFM tr1) (MkUniqFM tr2) = MkUniqFM $ S.plusUFM tr1 tr2
plusUFM_C f (MkUniqFM tr1) (MkUniqFM tr2) = MkUniqFM $ S.plusUFM_C f' tr1 tr2
where f' (Lazy l) (Lazy r) = Lazy $ f l r
\end{code}
And ways of subtracting them. First the base cases,
then the full D&C approach.
\begin{code}
minusUFM (MkUniqFM fm1) (MkUniqFM fm2) = MkUniqFM $ S.minusUFM fm1 fm2
\end{code}
And taking the intersection of two UniqFM's.
\begin{code}
intersectUFM (MkUniqFM t1) (MkUniqFM t2) = MkUniqFM $ S.intersectUFM t1 t2
intersectsUFM (MkUniqFM t1) (MkUniqFM t2) = S.intersectsUFM t1 t2
intersectUFM_C f (MkUniqFM fm1) (MkUniqFM fm2)
= MkUniqFM $ S.intersectUFM_C f' fm1 fm2
where f' (Lazy l) (Lazy r) = Lazy $ f l r
\end{code}
Now the usual set of `collection' operators, like map, fold, etc.
\begin{code}
foldUFM f a (MkUniqFM ufm) = S.foldUFM f' a ufm
where f' (Lazy elt) x = f elt x
\end{code}
\begin{code}
mapUFM fn (MkUniqFM fm) = MkUniqFM (S.mapUFM fn' fm)
where fn' (Lazy elt) = Lazy (fn elt)
filterUFM fn (MkUniqFM fm) = MkUniqFM (S.filterUFM fn' fm)
where fn' (Lazy elt) = fn elt
filterUFM_Directly fn (MkUniqFM fm) = MkUniqFM $ S.filterUFM_Directly fn' fm
where fn' u (Lazy elt) = fn u elt
\end{code}
Note, this takes a long time, O(n), but
because we dont want to do this very often, we put up with this.
O'rable, but how often do we look at the size of
a finite map?
\begin{code}
sizeUFM (MkUniqFM fm) = S.sizeUFM fm
isNullUFM (MkUniqFM fm) = S.isNullUFM fm
-- hashing is used in VarSet.uniqAway, and should be fast
-- We use a cheap and cheerful method for now
hashUFM (MkUniqFM fm) = S.hashUFM fm
\end{code}
looking up in a hurry is the {\em whole point} of this binary tree lark.
Lookup up a binary tree is easy (and fast).
\begin{code}
elemUFM key (MkUniqFM fm) = S.elemUFM key fm
elemUFM_Directly key (MkUniqFM fm) = S.elemUFM_Directly key fm
lookupUFM (MkUniqFM fm) key = fmap fromLazy $ S.lookupUFM fm key
lookupUFM_Directly (MkUniqFM fm) key
= fmap fromLazy $ S.lookupUFM_Directly fm key
lookupWithDefaultUFM (MkUniqFM fm) deflt key
= fromLazy $ S.lookupWithDefaultUFM fm (Lazy deflt) key
lookupWithDefaultUFM_Directly (MkUniqFM fm) deflt key
= fromLazy $ S.lookupWithDefaultUFM_Directly fm (Lazy deflt) key
\end{code}
folds are *wonderful* things.
\begin{code}
eltsUFM (MkUniqFM fm) = map fromLazy $ S.eltsUFM fm
keysUFM (MkUniqFM fm) = S.keysUFM fm
ufmToList (MkUniqFM fm) = [ (k, v) | (k, Lazy v) <- S.ufmToList fm ]
foldUFM_Directly f elt (MkUniqFM fm)
= S.foldUFM_Directly f' elt fm
where f' u (Lazy elt') x = f u elt' x
\end{code}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment