summaryrefslogtreecommitdiff
path: root/ghc/compiler/utils/UniqFM.lhs
diff options
context:
space:
mode:
authorsimonpj <unknown>2004-09-30 10:40:21 +0000
committersimonpj <unknown>2004-09-30 10:40:21 +0000
commit23f40f0e9be6d4aa5cf9ea31d73f4013f8e7b4bd (patch)
treea4b1953b8d2f49d06a05a9d0cc49485990649cd8 /ghc/compiler/utils/UniqFM.lhs
parent9b6858cb53438a2651ab00202582b13f95036058 (diff)
downloadhaskell-23f40f0e9be6d4aa5cf9ea31d73f4013f8e7b4bd.tar.gz
[project @ 2004-09-30 10:35:15 by simonpj]
------------------------------------ Add Generalised Algebraic Data Types ------------------------------------ This rather big commit adds support for GADTs. For example, data Term a where Lit :: Int -> Term Int App :: Term (a->b) -> Term a -> Term b If :: Term Bool -> Term a -> Term a ..etc.. eval :: Term a -> a eval (Lit i) = i eval (App a b) = eval a (eval b) eval (If p q r) | eval p = eval q | otherwise = eval r Lots and lots of of related changes throughout the compiler to make this fit nicely. One important change, only loosely related to GADTs, is that skolem constants in the typechecker are genuinely immutable and constant, so we often get better error messages from the type checker. See TcType.TcTyVarDetails. There's a new module types/Unify.lhs, which has purely-functional unification and matching for Type. This is used both in the typechecker (for type refinement of GADTs) and in Core Lint (also for type refinement).
Diffstat (limited to 'ghc/compiler/utils/UniqFM.lhs')
-rw-r--r--ghc/compiler/utils/UniqFM.lhs18
1 files changed, 14 insertions, 4 deletions
diff --git a/ghc/compiler/utils/UniqFM.lhs b/ghc/compiler/utils/UniqFM.lhs
index 2d244259f5..aa357b8740 100644
--- a/ghc/compiler/utils/UniqFM.lhs
+++ b/ghc/compiler/utils/UniqFM.lhs
@@ -1,4 +1,4 @@
-%
+%ilter
% (c) The AQUA Project, Glasgow University, 1994-1998
%
\section[UniqFM]{Specialised finite maps, for things with @Uniques@}
@@ -34,7 +34,7 @@ module UniqFM (
foldUFM,
mapUFM,
elemUFM,
- filterUFM,
+ filterUFM, filterUFM_Directly,
sizeUFM,
hashUFM,
isNullUFM,
@@ -103,6 +103,7 @@ intersectUFM_C :: (elt1 -> elt2 -> elt3)
foldUFM :: (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
@@ -192,6 +193,7 @@ data UniqFM ele
FastInt -- the delta
(UniqFM ele)
(UniqFM ele)
+-- INVARIANT: the children of a NodeUFM are never EmptyUFMs
{-
-- for debugging only :-)
@@ -512,7 +514,14 @@ mapUFM fn EmptyUFM = EmptyUFM
mapUFM fn fm = map_tree fn fm
filterUFM fn EmptyUFM = EmptyUFM
-filterUFM fn fm = filter_tree fn fm
+filterUFM fn fm = filter_tree pred fm
+ where
+ pred (i::FastInt) e = fn e
+
+filterUFM_Directly fn EmptyUFM = EmptyUFM
+filterUFM_Directly fn fm = filter_tree pred fm
+ where
+ pred i e = fn (mkUniqueGrimily (iBox i)) e
\end{code}
Note, this takes a long time, O(n), but
@@ -704,11 +713,12 @@ map_tree f _ = panic "map_tree failed"
\end{code}
\begin{code}
+filter_tree :: (FastInt -> a -> Bool) -> UniqFM a -> UniqFM a
filter_tree f nd@(NodeUFM j p t1 t2)
= mkSSNodeUFM (NodeUFMData j p) (filter_tree f t1) (filter_tree f t2)
filter_tree f lf@(LeafUFM i obj)
- | f obj = lf
+ | f i obj = lf
| otherwise = EmptyUFM
filter_tree f _ = panic "filter_tree failed"
\end{code}