import Monad
import Char

-- >>= je asociovany na spatnou stranu (doleva), coz muze vest ke kvadratickemu chovani
-- reseni -- standardni trik s continuation passing

data P s a = SEofBind (s->P s a) (P s a)
             | Fail
             | ReturnPlus a (P s a)

oldmplus::P s a->P s a->P s a
oldmplus Fail a = a
oldmplus a Fail = a
oldmplus (ReturnPlus x p) q = ReturnPlus x (p `oldmplus` q)
oldmplus p (ReturnPlus x q) = ReturnPlus x (p `oldmplus` q)
oldmplus (SEofBind f fe) (SEofBind g ge) = SEofBind (\c -> f c `oldmplus` g c) (fe `oldmplus` ge)
oldmzero = Fail

oldparse::P s a -> [s]->[(a,[s])]
oldparse (SEofBind _ e) [] = oldparse e []
oldparse (SEofBind f _) (c:s) = oldparse (f c) s
oldparse Fail _ = []
oldparse (ReturnPlus x p) s = (x,s) : oldparse p s

oldreturn x = ReturnPlus x Fail

type Context s a b = a -> P s b
data CPSP s a = CPSP (forall b . Context s a b -> P s b)

unCPSP::CPSP s a->Context s a b->P s b
unCPSP (CPSP f) k = f k

onEof::a -> CPSP s a
onEof x = CPSP (\k -> SEofBind (\_->Fail) (k x))

symbol::CPSP s s
symbol = CPSP (\k -> SEofBind k Fail)

instance Monad (CPSP s) where
  CPSP p >>= f = CPSP (\k -> p (\x -> unCPSP (f x) k))
  return x = CPSP (\k -> k x)

instance MonadPlus (CPSP s) where
  mplus p q = CPSP (\k -> unCPSP p k `oldmplus` unCPSP q k)
  mzero = CPSP (\_->Fail)

parse::CPSP s a->[s]->[(a,[s])]
parse (CPSP p) = oldparse (p oldreturn)

-- test wdig -- (1.50 secs, 98 066 048 bytes)
-- test1 word 1000 -- (0.43 secs, 28 681 104 bytes)
-- test1 word 3000 -- (4.17 secs, 253 530 376 bytes)

-- zhruba stejne efektivni jako verze s primym skladanim,
-- ale navic je flexibilnejsi -- ruzne verze parse:
          -- vracet jen vysledky, ktere zpracovaly cely vystup
	  -- hlasit pozici, kde doslo k chybe
	  -- cist vstupy primo ze souboru
	  -- ...