X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FMaybes.lhs;h=3c9bd693e6d944f8bfe23f7c59f728bb60ee090b;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=66c12797bc42cb638d7956dc46453f5128097a98;hpb=e7d21ee4f8ac907665a7e170c71d59e13a01da09;p=ghc-hetmet.git diff --git a/ghc/compiler/utils/Maybes.lhs b/ghc/compiler/utils/Maybes.lhs index 66c1279..3c9bd69 100644 --- a/ghc/compiler/utils/Maybes.lhs +++ b/ghc/compiler/utils/Maybes.lhs @@ -1,49 +1,32 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995 +% (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(..), MaybeErr(..), + module Maybe, -- Re-export all of Maybe - allMaybes, -- GHCI only - assocMaybe, - catMaybes, - failMaB, - failMaybe, + MaybeErr(..), -- Instance of Monad + failME, + + orElse, + mapCatMaybes, + allMaybes, firstJust, - mapMaybe, -- GHCI only + expectJust, maybeToBool, - mkLookupFun, - returnMaB, - returnMaybe, -- GHCI only - thenMaB, - thenMaybe -- GHCI only - -#if ! defined(COMPILING_GHC) - , findJust - , foldlMaybeErrs - , listMaybeErrs -#endif + + thenMaybe, seqMaybe, returnMaybe, failMaybe ) where -#if defined(COMPILING_GHC) -import AbsUniType -import Id -import IdInfo -import Name -import Outputable -#if USE_ATTACK_PRAGMAS -import Util -#endif -#endif -\end{code} +#include "HsVersions.h" + +import Maybe + +infixr 4 `orElse` +\end{code} %************************************************************************ %* * @@ -52,36 +35,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 @@ -95,73 +66,44 @@ 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 +expectJust :: String -> Maybe a -> a +{-# INLINE expectJust #-} +expectJust err (Just x) = x +expectJust err Nothing = error ("expectJust " ++ err) \end{code} -@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 - :: [(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 +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} -@mkLookupFun alist s@ is a function which looks up -@s@ in the association list @alist@, returning a Maybe type. - +The Maybe monad +~~~~~~~~~~~~~~~ \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 -\end{code} +seqMaybe :: Maybe a -> Maybe a -> Maybe a +seqMaybe (Just x) _ = Just x +seqMaybe Nothing my = my -\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 +thenMaybe ma mb = case ma of + Just x -> mb x + Nothing -> Nothing + returnMaybe :: a -> Maybe a -returnMaybe = Just +returnMaybe = Just failMaybe :: Maybe a failMaybe = Nothing -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') )) +orElse :: Maybe a -> a -> a +(Just x) `orElse` y = x +Nothing `orElse` y = y \end{code} + %************************************************************************ %* * \subsection[MaybeErr type]{The @MaybeErr@ type} @@ -169,54 +111,13 @@ mapMaybe f (x:xs) = f x `thenMaybe` (\ x' -> %************************************************************************ \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}