X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FMaybes.lhs;h=ce92316d6ce7dc14759bee51980d620209b008ca;hb=53fed288e7cd88ed972e8077a5c90e66b0c572d6;hp=66c12797bc42cb638d7956dc46453f5128097a98;hpb=e7d21ee4f8ac907665a7e170c71d59e13a01da09;p=ghc-hetmet.git diff --git a/ghc/compiler/utils/Maybes.lhs b/ghc/compiler/utils/Maybes.lhs index 66c1279..ce92316 100644 --- a/ghc/compiler/utils/Maybes.lhs +++ b/ghc/compiler/utils/Maybes.lhs @@ -1,47 +1,34 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995 +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996 % \section[Maybes]{The `Maybe' types and associated utility functions} \begin{code} -#if defined(COMPILING_GHC) -#include "HsVersions.h" -#endif - module Maybes ( - Maybe(..), MaybeErr(..), +-- Maybe(..), -- no, it's in 1.3 + MaybeErr(..), + + mapMaybe, + allMaybes, + firstJust, + expectJust, + maybeToBool, - allMaybes, -- GHCI only assocMaybe, - catMaybes, + mkLookupFun, mkLookupFunDef, + failMaB, failMaybe, - firstJust, - mapMaybe, -- GHCI only - maybeToBool, - mkLookupFun, + seqMaybe, returnMaB, - returnMaybe, -- GHCI only + returnMaybe, thenMaB, - thenMaybe -- GHCI only - -#if ! defined(COMPILING_GHC) - , findJust - , foldlMaybeErrs - , listMaybeErrs -#endif + catMaybes ) where -#if defined(COMPILING_GHC) -import AbsUniType -import Id -import IdInfo -import Name -import Outputable -#if USE_ATTACK_PRAGMAS -import Util -#endif -#endif +#include "HsVersions.h" + +import Maybe( catMaybes, mapMaybe ) \end{code} @@ -52,36 +39,24 @@ import Util %************************************************************************ \begin{code} -#if __HASKELL1__ < 3 -data Maybe a - = Nothing - | Just a -#endif -\end{code} - -\begin{code} maybeToBool :: Maybe a -> Bool maybeToBool Nothing = False maybeToBool (Just x) = True \end{code} -@catMaybes@ takes a list of @Maybe@s and returns a list of +@catMaybes@ takes a list of @Maybe@s and returns a list of the contents of all the @Just@s in it. @allMaybes@ collects a list of @Justs@ into a single @Just@, returning @Nothing@ if there are any @Nothings@. \begin{code} -catMaybes :: [Maybe a] -> [a] -catMaybes [] = [] -catMaybes (Nothing : xs) = catMaybes xs -catMaybes (Just x : xs) = (x : catMaybes xs) - allMaybes :: [Maybe a] -> Maybe [a] allMaybes [] = Just [] allMaybes (Nothing : ms) = Nothing allMaybes (Just x : ms) = case (allMaybes ms) of Nothing -> Nothing Just xs -> Just (x:xs) + \end{code} @firstJust@ takes a list of @Maybes@ and returns the @@ -102,6 +77,30 @@ findJust f (a:as) = case f a of b -> b \end{code} +\begin{code} +expectJust :: String -> Maybe a -> a +{-# INLINE expectJust #-} +expectJust err (Just x) = x +expectJust err Nothing = error ("expectJust " ++ err) +\end{code} + +The Maybe monad +~~~~~~~~~~~~~~~ +\begin{code} +seqMaybe :: Maybe a -> Maybe a -> Maybe a +seqMaybe (Just x) _ = Just x +seqMaybe Nothing my = my + +returnMaybe :: a -> Maybe a +returnMaybe = Just + +failMaybe :: Maybe a +failMaybe = Nothing +\end{code} + +Lookup functions +~~~~~~~~~~~~~~~~ + @assocMaybe@ looks up in an assocation list, returning @Nothing@ if it fails. @@ -113,22 +112,12 @@ assocMaybe alist key where lookup [] = Nothing lookup ((tv,ty):rest) = if key == tv then Just ty else lookup rest - -#if defined(COMPILING_GHC) -{-# SPECIALIZE assocMaybe - :: [(String, b)] -> String -> Maybe b, - [(Id, b)] -> Id -> Maybe b, - [(Class, b)] -> Class -> Maybe b, - [(Int, b)] -> Int -> Maybe b, - [(Name, b)] -> Name -> Maybe b, - [(TyVar, b)] -> TyVar -> Maybe b, - [(TyVarTemplate, b)] -> TyVarTemplate -> Maybe b - #-} -#endif \end{code} -@mkLookupFun alist s@ is a function which looks up -@s@ in the association list @alist@, returning a Maybe type. +@mkLookupFun eq alist@ is a function which looks up +its argument in the association list @alist@, returning a Maybe type. +@mkLookupFunDef@ is similar except that it is given a value to return +on failure. \begin{code} mkLookupFun :: (key -> key -> Bool) -- Equality predicate @@ -140,26 +129,17 @@ mkLookupFun eq alist s = case [a | (s',a) <- alist, s' `eq` s] of [] -> Nothing (a:_) -> Just a -\end{code} -\begin{code} -#if __HASKELL1__ < 3 -thenMaybe :: Maybe a -> (a -> Maybe b) -> Maybe b -m `thenMaybe` k = case m of - Nothing -> Nothing - Just a -> k a -#endif -returnMaybe :: a -> Maybe a -returnMaybe = Just - -failMaybe :: Maybe a -failMaybe = Nothing +mkLookupFunDef :: (key -> key -> Bool) -- Equality predicate + -> [(key,val)] -- The assoc list + -> val -- Value to return on failure + -> key -- The key + -> val -- The corresponding value -mapMaybe :: (a -> Maybe b) -> [a] -> Maybe [b] -mapMaybe f [] = returnMaybe [] -mapMaybe f (x:xs) = f x `thenMaybe` (\ x' -> - mapMaybe f xs `thenMaybe` (\ xs' -> - returnMaybe (x':xs') )) +mkLookupFunDef eq alist deflt s + = case [a | (s',a) <- alist, s' `eq` s] of + [] -> deflt + (a:_) -> a \end{code} %************************************************************************ @@ -185,38 +165,3 @@ returnMaB v = Succeeded v failMaB :: err -> MaybeErr val err failMaB e = Failed e \end{code} - - -@listMaybeErrs@ takes a list of @MaybeErrs@ and, if they all succeed, returns -a @Succeeded@ of a list of their values. If any fail, it returns a -@Failed@ of the list of all the errors in the list. - -\begin{code} -listMaybeErrs :: [MaybeErr val err] -> MaybeErr [val] [err] -listMaybeErrs - = foldr combine (Succeeded []) - where - combine (Succeeded v) (Succeeded vs) = Succeeded (v:vs) - combine (Failed err) (Succeeded _) = Failed [err] - combine (Succeeded v) (Failed errs) = Failed errs - combine (Failed err) (Failed errs) = Failed (err:errs) -\end{code} - -@foldlMaybeErrs@ works along a list, carrying an accumulator; it -applies the given function to the accumulator and the next list item, -accumulating any errors that occur. - -\begin{code} -foldlMaybeErrs :: (acc -> input -> MaybeErr acc err) - -> acc - -> [input] - -> MaybeErr acc [err] - -foldlMaybeErrs k accum ins = do_it [] accum ins - where - do_it [] acc [] = Succeeded acc - do_it errs acc [] = Failed errs - do_it errs acc (v:vs) = case (k acc v) of - Succeeded acc' -> do_it errs acc' vs - Failed err -> do_it (err:errs) acc vs -\end{code}