module NumericPrelude.Condition where {- some routines that are copied from Henning's Useful.hs -} {- | Returns 'Just' if the precondition is fulfilled. -} {-# INLINE toMaybe #-} toMaybe :: Bool -> a -> Maybe a toMaybe False _ = Nothing toMaybe True x = Just x {- | A purely functional implementation of @if@. Very useful in connection with 'zipWith3'. -} {-# INLINE if' #-} if' :: Bool {-^ condition -} -> a {-^ then -} -> a {-^ else -} -> a if' True x _ = x if' False _ y = y {- | From a list of expressions choose the one, whose condition is true. > select "zero" > [(x>0, "positive"), > (x<0, "negative")] -} {-# INLINE select #-} select :: a -> [(Bool, a)] -> a select = foldr (uncurry if') -- precedence below (||) and (&&) infix 1 `implies` {- | Logical operator for implication. Funnily because of the ordering of 'Bool' it holds @implies == (<=)@. -} {-# INLINE implies #-} implies :: Bool -> Bool -> Bool implies prerequisite conclusion = not prerequisite || conclusion