module GLL.Types.DataSets where

import GLL.Types.Grammar
import GLL.Types.BSR

import qualified Data.IntMap as IM
import qualified Data.Map as M
import qualified Data.Set as S
import Data.List (nub)

type Descr t    = (Slot t, Int, Int)
type Comm t     = (Nt, Int)
data Cont t c   = Cont (Slot t, Int) c
data State t c  = State { forall t c. State t c -> USet t
uset        :: USet t
                        , forall t c. State t c -> GRel t c
grel        :: GRel t c
                        , forall t c. State t c -> PRel t
prel        :: PRel t
                        , forall t c. State t c -> BSRs t
bsrs        :: BSRs t
                        , forall t c. State t c -> IntMap Int
successes   :: IM.IntMap Int {- maps index to counter -}
                        }

instance (Ord t) => Ord (Cont t c) where
  (Cont (Slot t, Int)
c c
_) compare :: Cont t c -> Cont t c -> Ordering
`compare` (Cont (Slot t, Int)
c' c
_) = (Slot t, Int)
c forall a. Ord a => a -> a -> Ordering
`compare` (Slot t, Int)
c'

instance (Eq t) => Eq (Cont t c) where
  (Cont (Slot t, Int)
c c
_) == :: Cont t c -> Cont t c -> Bool
== (Cont (Slot t, Int)
c' c
_) = (Slot t, Int)
c forall a. Eq a => a -> a -> Bool
== (Slot t, Int)
c'

emptyUSet       :: USet t
addDescr        :: (Ord t) => Descr t  -> USet t   -> USet t
hasDescr        :: (Ord t) => Descr t  -> USet t   -> Bool

emptyG         :: GRel t c
addCont         :: (Ord t) => Comm t -> (Slot t, Int, c) -> GRel t c -> GRel t c
conts           :: Comm t -> GRel t c -> [(Slot t, Int, c)]

emptyP         :: PRel t
addExtent       :: Comm t -> Int -> PRel t -> PRel t
extents         :: Comm t -> PRel t -> [Int]

emptyState :: (Ord t) => State t c
emptyState :: forall t c. Ord t => State t c
emptyState = forall t c.
USet t -> GRel t c -> PRel t -> BSRs t -> IntMap Int -> State t c
State forall t. USet t
emptyUSet forall t c. GRel t c
emptyG forall t. PRel t
emptyP forall t. Ord t => BSRs t
emptyBSRs forall a. IntMap a
IM.empty

type RList t    =   [Descr t]
type USet t     =   IM.IntMap (IM.IntMap (S.Set (Slot t)))
type GRel t c   =   IM.IntMap (M.Map Nt (S.Set (Cont t c)))
type PRel t     =   IM.IntMap (M.Map Nt [Int])

descrs2list :: USet t -> [(Slot t, Int, Int)]
descrs2list :: forall t. USet t -> [(Slot t, Int, Int)]
descrs2list USet t
uset =  [ (Slot t
g,Int
l,Int
k)
                    | (Int
l, IntMap (Set (Slot t))
k2m)  <- forall a. IntMap a -> [(Int, a)]
IM.assocs USet t
uset
                    , (Int
k, Set (Slot t)
g2m)  <- forall a. IntMap a -> [(Int, a)]
IM.assocs IntMap (Set (Slot t))
k2m
                    , Slot t
g         <- forall a. Set a -> [a]
S.toList Set (Slot t)
g2m ]

printDescrs :: (Show t) => USet t -> IO ()
printDescrs :: forall t. Show t => USet t -> IO ()
printDescrs = String -> IO ()
putStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. USet t -> [(Slot t, Int, Int)]
descrs2list

emptyRList :: [a]
emptyRList = []
popRList :: [a] -> (a, [a])
popRList (a
x:[a]
xs)  = (a
x,[a]
xs) 
popRList [a]
_       = forall a. HasCallStack => String -> a
error String
"popRList"
unionRList :: [a] -> [a] -> [a]
unionRList       = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. [a] -> [a] -> [a]
(++)
singletonRList :: a -> [a]
singletonRList   = (forall a. a -> [a] -> [a]
:[])
fromListRList    :: Ord t => [Descr t]  -> USet t   -> RList t
fromListRList :: forall t. Ord t => [Descr t] -> USet t -> [Descr t]
fromListRList [Descr t]
ds USet t
uset = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Descr t -> [Descr t] -> [Descr t]
op forall a. [a]
emptyRList (forall a. Eq a => [a] -> [a]
nub [Descr t]
ds)
  where op :: Descr t -> [Descr t] -> [Descr t]
op Descr t
d [Descr t]
rset   | forall t. Ord t => Descr t -> USet t -> Bool
hasDescr Descr t
d USet t
uset   = [Descr t]
rset
                    | Bool
otherwise         = forall a. [a] -> [a] -> [a]
unionRList (forall {a}. a -> [a]
singletonRList Descr t
d) [Descr t]
rset


emptyUSet :: forall t. USet t
emptyUSet = forall a. IntMap a
IM.empty

addDescr :: forall t. Ord t => Descr t -> USet t -> USet t
addDescr alt :: Descr t
alt@(Slot t
slot,Int
i,Int
l) = forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IM.alter Maybe (IntMap (Set (Slot t))) -> Maybe (IntMap (Set (Slot t)))
inner Int
i 
  where inner :: Maybe (IntMap (Set (Slot t))) -> Maybe (IntMap (Set (Slot t)))
inner Maybe (IntMap (Set (Slot t)))
mm = case Maybe (IntMap (Set (Slot t)))
mm of 
                      Maybe (IntMap (Set (Slot t)))
Nothing -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> IntMap a
IM.singleton Int
l Set (Slot t)
single 
                      Just IntMap (Set (Slot t))
m  -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith (forall a. Ord a => Set a -> Set a -> Set a
S.union) Int
l Set (Slot t)
single IntMap (Set (Slot t))
m
        single :: Set (Slot t)
single = forall a. a -> Set a
S.singleton Slot t
slot

hasDescr :: forall t. Ord t => Descr t -> USet t -> Bool
hasDescr alt :: Descr t
alt@(Slot t
slot,Int
i,Int
l) = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True IntMap (Set (Slot t)) -> Bool
inner forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
i
  where inner :: IntMap (Set (Slot t)) -> Bool
inner IntMap (Set (Slot t))
m = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Slot t
slot forall a. Ord a => a -> Set a -> Bool
`S.member`)) forall a b. (a -> b) -> a -> b
$ forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
l IntMap (Set (Slot t))
m

emptyG :: forall t c. GRel t c
emptyG = forall a. IntMap a
IM.empty
singleCG :: Comm t -> (Slot t, Int, c) -> GRel t c
singleCG Comm t
k (Slot t, Int, c)
v = forall t c.
Ord t =>
Comm t -> (Slot t, Int, c) -> GRel t c -> GRel t c
addCont Comm t
k (Slot t, Int, c)
v forall t c. GRel t c
emptyG
addCont :: forall t c.
Ord t =>
Comm t -> (Slot t, Int, c) -> GRel t c -> GRel t c
addCont (Nt
n,Int
i) (Slot t
gs,Int
l,c
c) = forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IM.alter Maybe (Map Nt (Set (Cont t c))) -> Maybe (Map Nt (Set (Cont t c)))
inner Int
i
 where inner :: Maybe (Map Nt (Set (Cont t c))) -> Maybe (Map Nt (Set (Cont t c)))
inner Maybe (Map Nt (Set (Cont t c)))
mm = case Maybe (Map Nt (Set (Cont t c)))
mm of 
                    Maybe (Map Nt (Set (Cont t c)))
Nothing -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
M.singleton Nt
n Set (Cont t c)
single 
                    Just Map Nt (Set (Cont t c))
m  -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. Ord a => Set a -> Set a -> Set a
S.union Nt
n Set (Cont t c)
single Map Nt (Set (Cont t c))
m
       single :: Set (Cont t c)
single = forall a. a -> Set a
S.singleton (forall t c. (Slot t, Int) -> c -> Cont t c
Cont (Slot t
gs,Int
l) c
c)
conts :: forall t c. Comm t -> GRel t c -> [(Slot t, Int, c)]
conts (Nt
n,Int
l) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall {t} {c}. Map Nt (Set (Cont t c)) -> [(Slot t, Int, c)]
inner forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
l
         where inner :: Map Nt (Set (Cont t c)) -> [(Slot t, Int, c)]
inner Map Nt (Set (Cont t c))
m = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a b. (a -> b) -> [a] -> [b]
map forall {t} {c}. Cont t c -> (Slot t, Int, c)
unCont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
S.toList) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Nt
n Map Nt (Set (Cont t c))
m
               unCont :: Cont t c -> (Slot t, Int, c)
unCont (Cont (Slot t
gs,Int
l') c
cf) = (Slot t
gs,Int
l',c
cf)

emptyP :: forall t. PRel t
emptyP = forall a. IntMap a
IM.empty
addExtent :: forall t. Comm t -> Int -> PRel t -> PRel t
addExtent (Nt
gs,Int
l) Int
i = forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IM.alter Maybe (Map Nt [Int]) -> Maybe (Map Nt [Int])
inner Int
l
 where inner :: Maybe (Map Nt [Int]) -> Maybe (Map Nt [Int])
inner Maybe (Map Nt [Int])
mm = case Maybe (Map Nt [Int])
mm of 
                    Maybe (Map Nt [Int])
Nothing -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
M.singleton Nt
gs [Int
i]
                    Just Map Nt [Int]
m  -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. [a] -> [a] -> [a]
(++) Nt
gs [Int
i] Map Nt [Int]
m

extents :: forall t. Comm t -> PRel t -> [Int]
extents (Nt
gs,Int
l) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall {a}. Map Nt [a] -> [a]
inner forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
l 
         where inner :: Map Nt [a] -> [a]
inner = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Nt
gs