Author: Chris Warburton <chriswarbo@gmail.com>
Date: Wed Jan 29 12:47:01 AM UTC 2020
Parent: 7ab77f5e77ebfe95a86f4a105de8219e6da74910
Log message:
Bumps for Monad changes
1: diff --git a/Control/Monad/Partial.hs b/Control/Monad/Partial.hs
2: index ee3e366..f98beed 100644
3: --- a/Control/Monad/Partial.hs
4: +++ b/Control/Monad/Partial.hs
5: @@ -6,12 +6,15 @@
6:
7: module Control.Monad.Partial where
8:
9: -import Data.Data
10: -import Data.Maybe
11: -import Data.Nat
12: -import Data.Typeable
13: -import Test.LazySmallCheck2012 hiding (Nat, Term, Const)
14: -import Test.LazySmallCheck2012.Core hiding (Term, C)
15: +import Control.Monad
16: +import qualified Control.Monad.Fail as Fail
17: +import Control.Monad.Fix
18: +import Data.Data
19: +import Data.Maybe
20: +import Data.Nat
21: +import Data.Typeable
22: +import Test.LazySmallCheck2012 hiding (Nat, Term, Const)
23: +import Test.LazySmallCheck2012.Core hiding (Term, C)
24:
25: -- Partial results are either a value (Now) or a partial result (Later).
26: data Partial a = Now a
27: @@ -35,6 +38,27 @@ instance Monad Partial where
28: (Now x) >>= f = f x
29: (Later x) >>= f = Later (x >>= f)
30:
31: + -- Backwards compatibility
32: + fail = Fail.fail
33: +
34: +-- Failure (e.g. a failed pattern-match) is an infinite loop
35: +instance Fail.MonadFail Partial where
36: + fail _ = fix Later
37: +
38: +-- Choose between values by picking whichever halts first. This is like the
39: +-- 'min' function on Nat, and hence associative; likewise infinite loops are the
40: +-- identity. If it's a tie, the first argument is returned (arbitrarily), which
41: +-- breaks commutativity.
42: +instance Alternative Partial where
43: + empty = Fail.fail "empty"
44: + Now x <|> _ = Now x
45: + _ <|> Now y = Now y
46: + Later x <|> Later y = Later (x <|> y)
47: +
48: +-- Inherit mzero and mplus from Alternative
49: +instance MonadPlus Partial where
50: +
51: +-- Generate arbitrary delayed values
52: instance Serial a => Serial (Partial a) where
53: series = cons1 Now \/ cons1 Later
54:
55: @@ -57,9 +81,5 @@ trueIn n x = fromMaybe False (force n x)
56: -- Lax decision procedure
57: notFalseIn n x = fromMaybe True (force n x)
58:
59: --- We can use infinite proofs to get around type constraints
60: -undefined' :: Partial a
61: -undefined' = Later undefined'
62: -
63: cast' :: (Typeable a, Typeable b) => a -> Partial b
64: -cast' x = fromMaybe undefined' (cast x)
65: +cast' x = fromMaybe mzero (cast x)