--- We define a local version of ReadS here,
--- because its "real" definition site is in GHC.Read
-type ReadS a = String -> [(a,String)]
+-- Monad, MonadPlus
+
+instance Monad P where
+ return x = Result x Fail
+
+ (Get f) >>= k = Get (\c -> f c >>= k)
+ (Look f) >>= k = Look (\s -> f s >>= k)
+ Fail >>= k = Fail
+ (Result x p) >>= k = k x `mplus` (p >>= k)
+ (Final r) >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s]
+
+ fail _ = Fail
+
+instance MonadPlus P where
+ mzero = Fail
+
+ -- most common case: two gets are combined
+ Get f1 `mplus` Get f2 = Get (\c -> f1 c `mplus` f2 c)
+
+ -- results are delivered as soon as possible
+ Result x p `mplus` q = Result x (p `mplus` q)
+ p `mplus` Result x q = Result x (p `mplus` q)
+
+ -- fail disappears
+ Fail `mplus` p = p
+ p `mplus` Fail = p
+
+ -- two finals are combined
+ -- final + look becomes one look and one final (=optimization)
+ -- final + sthg else becomes one look and one final
+ Final r `mplus` Final t = Final (r ++ t)
+ Final r `mplus` Look f = Look (\s -> Final (r ++ run (f s) s))
+ Final r `mplus` p = Look (\s -> Final (r ++ run p s))
+ Look f `mplus` Final r = Look (\s -> Final (run (f s) s ++ r))
+ p `mplus` Final r = Look (\s -> Final (run p s ++ r))
+
+ -- two looks are combined (=optimization)
+ -- look + sthg else floats upwards
+ Look f `mplus` Look g = Look (\s -> f s `mplus` g s)
+ Look f `mplus` p = Look (\s -> f s `mplus` p)
+ p `mplus` Look f = Look (\s -> p `mplus` f s)
+
+-- ---------------------------------------------------------------------------
+-- The ReadP type
+
+newtype ReadP a = R (forall b . (a -> P b) -> P b)