{-# OPTIONS_GHC -fglasgow-exts -fno-full-laziness -fno-cse #-}

-- A module for generating new prompt names using a name supply.
-- P is the type of computations that might generate new prompts
-- Prompt is the abstract type of prompts
-- runP performs the computation giving a pure answer
-- eqPrompt uses an unsafe coercion

-- Transformer

module Pugs.Cont.PromptTR (
  P, Prompt, runP,
  newPrompt, eqPrompt
) where

import GHC.IOBase
import System.IO.Unsafe

import Control.Monad.State

------------------------------------------------------------------------

type P r m a = StateT Int m a
data Prompt r a = Prompt Int 


runP :: Monad m => (forall r. P r m a) -> m a
runP pe = evalStateT pe 0

newPrompt :: Monad m => P r m (Prompt r a)
newPrompt = do
            n <- get
            put (n+1)
            return $ Prompt n

eqPrompt :: Prompt r a -> Prompt r b -> Maybe (a -> b, b -> a)
eqPrompt (Prompt p1) (Prompt p2)  
    | p1 == p2 = Just (coerce id, coerce id)
    | otherwise = Nothing

globalRef :: IORef a 
globalRef = unsafePerformIO $ newIORef undefined

coerce :: a -> b
coerce e = 
    unsafePerformIO $ 
      do writeIORef globalRef e
         readIORef globalRef

------------------------------------------------------------------------