X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FMaybes.lhs;h=3c9bd693e6d944f8bfe23f7c59f728bb60ee090b;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=5ed4ac316f492165b8993789408350ad3b5df691;hpb=26741ec416bae2c502ef00a2ba0e79050a32cb67;p=ghc-hetmet.git diff --git a/ghc/compiler/utils/Maybes.lhs b/ghc/compiler/utils/Maybes.lhs index 5ed4ac3..3c9bd69 100644 --- a/ghc/compiler/utils/Maybes.lhs +++ b/ghc/compiler/utils/Maybes.lhs @@ -1,50 +1,33 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996 +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \section[Maybes]{The `Maybe' types and associated utility functions} \begin{code} -#if defined(COMPILING_GHC) -#include "HsVersions.h" -#endif - module Maybes ( --- Maybe(..), -- no, it's in 1.3 - MaybeErr(..), + module Maybe, -- Re-export all of Maybe + + MaybeErr(..), -- Instance of Monad + failME, + orElse, + mapCatMaybes, allMaybes, - catMaybes, firstJust, expectJust, maybeToBool, - assocMaybe, - mkLookupFun, mkLookupFunDef, - - failMaB, - failMaybe, - seqMaybe, - returnMaB, - returnMaybe, - thenMaB - -#if ! defined(COMPILING_GHC) - , findJust - , foldlMaybeErrs - , listMaybeErrs -#endif + thenMaybe, seqMaybe, returnMaybe, failMaybe ) where -#if defined(COMPILING_GHC) +#include "HsVersions.h" -CHK_Ubiq() -- debugging consistency check +import Maybe -import Unique (Unique) -- only for specialising -#endif +infixr 4 `orElse` \end{code} - %************************************************************************ %* * \subsection[Maybe type]{The @Maybe@ type} @@ -63,17 +46,13 @@ 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 @@ -87,20 +66,20 @@ firstJust (Nothing : ms) = firstJust ms \end{code} \begin{code} -findJust :: (a -> Maybe b) -> [a] -> Maybe b -findJust f [] = Nothing -findJust f (a:as) = case f a of - Nothing -> findJust f as - 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} +\begin{code} +mapCatMaybes :: (a -> Maybe b) -> [a] -> [b] +mapCatMaybes f [] = [] +mapCatMaybes f (x:xs) = case f x of + Just y -> y : mapCatMaybes f xs + Nothing -> mapCatMaybes f xs +\end{code} + The Maybe monad ~~~~~~~~~~~~~~~ \begin{code} @@ -108,65 +87,22 @@ seqMaybe :: Maybe a -> Maybe a -> Maybe a seqMaybe (Just x) _ = Just x seqMaybe Nothing my = my +thenMaybe :: Maybe a -> (a -> Maybe b) -> Maybe b +thenMaybe ma mb = case ma of + Just x -> mb x + Nothing -> Nothing + 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. -\begin{code} -assocMaybe :: (Eq a) => [(a,b)] -> a -> Maybe b - -assocMaybe alist key - = lookup alist - where - lookup [] = Nothing - lookup ((tv,ty):rest) = if key == tv then Just ty else lookup rest - -#if defined(COMPILING_GHC) -{-# SPECIALIZE assocMaybe - :: [(FAST_STRING, b)] -> FAST_STRING -> Maybe b - , [(Int, b)] -> Int -> Maybe b - , [(Unique, b)] -> Unique -> Maybe b - , [(RdrName, b)] -> RdrName -> Maybe b - #-} -#endif +orElse :: Maybe a -> a -> a +(Just x) `orElse` y = x +Nothing `orElse` y = y \end{code} -@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 - -> [(key,val)] -- The assoc list - -> key -- The key - -> Maybe val -- The corresponding value - -mkLookupFun eq alist s - = case [a | (s',a) <- alist, s' `eq` s] of - [] -> Nothing - (a:_) -> Just a - -mkLookupFunDef :: (key -> key -> Bool) -- Equality predicate - -> [(key,val)] -- The assoc list - -> val -- Value to return on failure - -> key -- The key - -> val -- The corresponding value - -mkLookupFunDef eq alist deflt s - = case [a | (s',a) <- alist, s' `eq` s] of - [] -> deflt - (a:_) -> a -\end{code} %************************************************************************ %* * @@ -175,54 +111,13 @@ mkLookupFunDef eq alist deflt s %************************************************************************ \begin{code} -data MaybeErr val err = Succeeded val | Failed err -\end{code} - -\begin{code} -thenMaB :: MaybeErr val1 err -> (val1 -> MaybeErr val2 err) -> MaybeErr val2 err -thenMaB m k - = case m of - Succeeded v -> k v - Failed e -> Failed e - -returnMaB :: val -> MaybeErr val err -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} +data MaybeErr err val = Succeeded val | Failed err -@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. +instance Monad (MaybeErr err) where + return v = Succeeded v + Succeeded v >>= k = k v + Failed e >>= k = Failed e -\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 +failME :: err -> MaybeErr err val +failME e = Failed e \end{code}