{-# LANGUAGE InstanceSigs #-}
module Primitives
( Globals(..)
, PrologIO(..)
, newGlobals
, newVarPrim, unnewVarPrim, getVarPrim, setVarPrim, errorPrim
) where
import Classes
import qualified Data.IntMap.Strict as M
import Data.IORef 
import Terms

newtype PrologIO a = PrologIO { runPrologIO :: Globals -> IO a }
data Globals = Globals 
  { values :: IORef (M.IntMap Term)
  , names :: IORef (M.IntMap Name)
  , nextSlot :: IORef Int
  }

instance LiftIO PrologIO where
  liftIO :: IO a -> PrologIO a
  liftIO io = PrologIO (\_ -> io)

instance Functor PrologIO where
  fmap :: (a -> b) -> PrologIO a -> PrologIO b
  fmap f (PrologIO a) = PrologIO (\globals -> fmap f (a globals))

instance Applicative PrologIO where
  pure :: a -> PrologIO a
  pure x = PrologIO (\_ -> pure x)

  (<*>) :: PrologIO (a -> b) -> PrologIO a -> PrologIO b
  (PrologIO f) <*> (PrologIO x) = PrologIO (
    \globals -> do
      f' <- f globals
      x' <- x globals
      return (f' x')
    )

instance Monad PrologIO where
  return :: a -> PrologIO a
  return = pure

  (>>=) :: PrologIO a -> (a -> PrologIO b) -> PrologIO b
  (PrologIO a) >>= f = PrologIO (
    \globals -> do
      a' <- a globals
      let PrologIO b' = f a'
      b' globals
    )

newGlobals :: IO Globals
newGlobals = do
  vs <- newIORef M.empty
  ns <- newIORef M.empty
  next <- newIORef 0
  return Globals { values=vs, names=ns, nextSlot=next }

newVarPrim :: Name -> PrologIO Slot
newVarPrim name = PrologIO $ \globals -> do
  slot <- readIORef (nextSlot globals)
  modifyIORef (names globals) (M.insert slot name)
  modifyIORef (nextSlot globals) (\s -> s + 1)
  return (Slot slot)

unnewVarPrim :: PrologIO ()
unnewVarPrim = PrologIO $ \globals -> do
  modifyIORef (nextSlot globals) (\s -> s - 1)
  slot <- readIORef (nextSlot globals)
  modifyIORef (names globals) (M.delete slot)

getVarPrim :: Slot -> PrologIO (Maybe Term)
getVarPrim (Slot slot) = PrologIO $ \globals ->
  fmap (M.lookup slot) (readIORef (values globals))

setVarPrim :: Slot -> Maybe Term -> PrologIO ()
setVarPrim (Slot slot) term = PrologIO $ \globals ->
  modifyIORef (values globals) (M.alter (\_ -> term) slot)

errorPrim :: String -> PrologIO a
errorPrim message = error message