{-# LANGUAGE MagicHash, UnboxedTuples #-}

module Data.RangeMin.LCA.IndexM (Index, IndexM, getIndex, execIndexM) where

import GHC.Exts (Int#, Int(..), (+#))

-- | 'Index' is used as a node identifier, so that the user can refer to tree nodes 
-- in a random-access fashion.
type Index = Int

newtype IndexM a = IndexM {runIndexM :: Int# -> (# Int#, a #)}

instance Monad IndexM where
	return a = IndexM $ \ i# -> (# i#, a #)
	m >>= k = IndexM $ \ i# -> case runIndexM m i# of
		(# i'#, x #) -> runIndexM (k x) i'#

getIndex :: IndexM Index
getIndex = IndexM $ \ i# -> (# i# +# 1#, I# i# #)

execIndexM :: IndexM a -> (a, Int)
execIndexM m = case runIndexM m 0# of
	(# n#, a #) -> (a, I# n#)