module GLL.Combinators.Memoisation where

import              Data.IORef
import qualified    Data.IntMap     as IM
import System.IO.Unsafe

-- | 
-- A 'MemoTable' maps left-extent /l/ to right-extent /r/ to some results /a/
-- indicating the the substring ranging from /l/ to /r/ is derived with parse result /a/.
type MemoTable a = IM.IntMap (IM.IntMap a)

-- | An impure reference to a 'MemoTable'.
type MemoRef a   = IORef (MemoTable a)

memLookup :: (Int, Int) -> MemoTable a -> Maybe a
memLookup :: forall a. (Int, Int) -> MemoTable a -> Maybe a
memLookup (Int
l,Int
r) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing forall {a}. IntMap a -> Maybe a
look' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
l
 where  look' :: IntMap a -> Maybe a
look' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
r 

memInsert :: (Int, Int) -> a -> MemoTable a -> MemoTable a
memInsert :: forall a. (Int, Int) -> a -> MemoTable a -> MemoTable a
memInsert (Int
l,Int
r) a
as = forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IM.alter Maybe (IntMap a) -> Maybe (IntMap a)
add' Int
l
 where  add' :: Maybe (IntMap a) -> Maybe (IntMap a)
add' Maybe (IntMap a)
mm = case Maybe (IntMap a)
mm of
                    Maybe (IntMap a)
Nothing -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> IntMap a
IM.singleton Int
r a
as
                    Just IntMap a
m  -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
r a
as IntMap a
m

-- |
-- Clears the 'MemoTable' to which the given reference refers.
memClear :: MemoRef a -> IO ()
memClear :: forall a. MemoRef a -> IO ()
memClear MemoRef a
ref = forall a. IORef a -> (a -> a) -> IO ()
modifyIORef MemoRef a
ref (forall a b. a -> b -> a
const forall a. IntMap a
IM.empty)

-- | 
-- Create a reference to a fresh 'MemoTable'.
newMemoTable :: MemoRef a
newMemoTable :: forall a. MemoRef a
newMemoTable = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. IntMap a
IM.empty