{-# OPTIONS_GHC -fglasgow-exts #-}

module Test where

import Control.Monad.State
import Control.Monad.Reader
import Control.Monad.Writer

import DelCont
import Prompt (Prompt)

test n l = runDelCont (runStateT (newPrompt >>= \p -> pushPrompt p (loop n p)) l)

test2 n l = runState (runDelContT (newPrompt >>= \p -> pushPrompt p (loop n p))) l

pop :: MonadState [a] m => m a
pop = do (h:t) <- get
         put t
         return h

abortP p e = withSubCont p (\_ -> e)

loop 0 _ = return 1
loop n p = do i <- pop
              if i == 0
                then abortP p (return 0)
                else do r <- loop (n-1) p
                        return (i*r)

{-
*Test> test 5 [1..10]
(120,[6,7,8,9,10])
*Test> test 5 [0..10]
(0,[1,2,3,4,5,6,7,8,9,10])
*Test> test 10 [1..10]
(3628800,[])
*Test> test 100 ([1..10] ++ [0,0] ++ [1..])
(0,[0,1,2,3,4,5,6..
-}

type Continue r b a = ReaderT (Prompt.Prompt r b) (DelCont r) a

runContinue :: (forall r. Continue r b b) -> b
runContinue ct = runDelCont (newPrompt >>= \p -> pushPrompt p (runReaderT ct p))

callCC' f = withCont (\k -> pushSubCont k (f (reify k)))
 where
 reify k v = abort (pushSubCont k (return v))
 abort e = withCont (\_ -> e)
 withCont e = ask >>= \p -> withSubCont p (\k -> pushPrompt p (e k))

loop2 l = callCC' (\k -> loop' k l 1)
 where
 loop' _ [] n = return (show n)
 loop' k (0:_) _ = k "The answer must be 0."
 loop' k (i:t) n = loop' k t (i*n)

{-
*Test> runContinue (loop2 [1..10])
"3628800"
*Test> runContinue (loop2 $ [1..10] ++ [0] ++ [1..10])
"The answer must be 0."
*Test> runContinue (loop2 $ [1..10] ++ [1..10])
"13168189440000"
-}

loop3 l = callCC' (\k -> loop' k l 1)
 where
 loop' _ []    n = return n
 loop' k (0:_) _ = k 0
 loop' k (i:t) n = tell [n] >> loop' k t (i*n)

test3 l = runDelCont
            (runReaderT
                (runWriterT 
                    (newPrompt >>= \p -> 
                        pushPrompt p (local (const p) $ loop3 l))) undefined)

{-
*Test> test3 [1..10]
(3628800,[1,1,2,6,24,120,720,5040,40320,362880])
*Test> test3 ([1..10] ++ [0] ++ [1..10])
(0,[])
*Test>
-}