diff options
author | simonpj <unknown> | 2004-09-30 10:40:21 +0000 |
---|---|---|
committer | simonpj <unknown> | 2004-09-30 10:40:21 +0000 |
commit | 23f40f0e9be6d4aa5cf9ea31d73f4013f8e7b4bd (patch) | |
tree | a4b1953b8d2f49d06a05a9d0cc49485990649cd8 /ghc/compiler/utils | |
parent | 9b6858cb53438a2651ab00202582b13f95036058 (diff) | |
download | haskell-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')
-rw-r--r-- | ghc/compiler/utils/Outputable.lhs | 17 | ||||
-rw-r--r-- | ghc/compiler/utils/Panic.lhs | 8 | ||||
-rw-r--r-- | ghc/compiler/utils/UniqFM.lhs | 18 |
3 files changed, 28 insertions, 15 deletions
diff --git a/ghc/compiler/utils/Outputable.lhs b/ghc/compiler/utils/Outputable.lhs index 22856f1a28..8b52867677 100644 --- a/ghc/compiler/utils/Outputable.lhs +++ b/ghc/compiler/utils/Outputable.lhs @@ -42,10 +42,10 @@ module Outputable ( showSDocUnqual, showsPrecSDoc, pprHsChar, pprHsString, - -- error handling - pprPanic, pprPanic#, pprError, pprTrace, assertPprPanic, warnPprTrace, - trace, panic, panic#, assertPanic + pprPanic, assertPprPanic, pprPanic#, pprPgmError, + pprTrace, warnPprTrace, + trace, pgmError, panic, panic#, assertPanic ) where #include "HsVersions.h" @@ -470,12 +470,13 @@ speakNTimes t | t == 1 = ptext SLIT("once") %************************************************************************ \begin{code} -pprPanic :: String -> SDoc -> a -pprError :: String -> SDoc -> a +pprPanic, pprPgmError :: String -> SDoc -> a pprTrace :: String -> SDoc -> a -> a -pprPanic = pprAndThen panic -pprError = pprAndThen error -pprTrace = pprAndThen trace +pprPanic = pprAndThen panic -- Throw an exn saying "bug in GHC" + +pprPgmError = pprAndThen pgmError -- Throw an exn saying "bug in pgm being compiled" + -- (used for unusual pgm errors) +pprTrace = pprAndThen trace pprPanic# heading pretty_msg = panic# (show (doc PprDebug)) where diff --git a/ghc/compiler/utils/Panic.lhs b/ghc/compiler/utils/Panic.lhs index 2a5d3a4174..60393b581f 100644 --- a/ghc/compiler/utils/Panic.lhs +++ b/ghc/compiler/utils/Panic.lhs @@ -12,9 +12,10 @@ some unnecessary loops in the module dependency graph. module Panic ( GhcException(..), ghcError, progName, + pgmError, panic, panic#, assertPanic, trace, showException, showGhcException, tryMost, - installSignalHandlers, + installSignalHandlers, catchJust, tryJust, ioErrors, throwTo, ) where @@ -136,8 +137,9 @@ instance Typeable GhcException where Panics and asserts. \begin{code} -panic :: String -> a -panic x = Exception.throwDyn (Panic x) +panic, pgmError :: String -> a +panic x = Exception.throwDyn (Panic x) +pgmError x = Exception.throwDyn (ProgramError x) -- #-versions because panic can't return an unboxed int, and that's -- what TAG_ is with GHC at the moment. Ugh. (Simon) 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} |