{-# LANGUAGE StandaloneDeriving #-}
module GLL.Types.BSR where
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import GLL.Types.Grammar
type SlotL t = (Slot t, Int)
type PrL t = (Prod t, Int)
type NtL = (Nt, Int)
type BSRs t = IM.IntMap (IM.IntMap (IM.IntMap (M.Map (Prod t) IS.IntSet)))
type BSR t = (Slot t, Int, Int, Int)
emptyBSRs :: (Ord t) => BSRs t
emptyBSRs :: forall t. Ord t => BSRs t
emptyBSRs = forall a. IntMap a
IM.empty
pNodeLookup :: (Ord t) => BSRs t -> (Slot t, Int, Int) -> Maybe [Int]
pNodeLookup :: forall t. Ord t => BSRs t -> (Slot t, Int, Int) -> Maybe [Int]
pNodeLookup BSRs t
bsrs (Slot Nt
x [Symbol t]
alpha [Symbol t]
beta,Int
l,Int
r)= forall t.
Ord t =>
BSRs t -> ((Prod t, Int), Int, Int) -> Maybe [Int]
pNodeLookup' BSRs t
bsrs ((forall t. Nt -> Symbols t -> Prod t
Prod Nt
x ([Symbol t]
alphaforall a. [a] -> [a] -> [a]
++[Symbol t]
beta),forall (t :: * -> *) a. Foldable t => t a -> Int
length [Symbol t]
alpha),Int
l,Int
r)
pNodeLookup' :: (Ord t) => BSRs t -> ((Prod t, Int), Int, Int) -> Maybe [Int]
pNodeLookup' :: forall t.
Ord t =>
BSRs t -> ((Prod t, Int), Int, Int) -> Maybe [Int]
pNodeLookup' BSRs t
pMap ((Prod t
alt,Int
j),Int
l,Int
r) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing IntMap (IntMap (Map (Prod t) IntSet)) -> Maybe [Int]
inner forall a b. (a -> b) -> a -> b
$ forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
l BSRs t
pMap
where inner :: IntMap (IntMap (Map (Prod t) IntSet)) -> Maybe [Int]
inner = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing IntMap (Map (Prod t) IntSet) -> Maybe [Int]
inner2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
r
inner2 :: IntMap (Map (Prod t) IntSet) -> Maybe [Int]
inner2 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing Map (Prod t) IntSet -> Maybe [Int]
inner3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
j
inner3 :: Map (Prod t) IntSet -> Maybe [Int]
inner3 = 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
. IntSet -> [Int]
IS.toList) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Prod t
alt
addBSR :: forall t. Ord t => BSR t -> BSRs t -> BSRs t
addBSR = forall t. Ord t => BSR t -> BSRs t -> BSRs t
pMapInsert
addBSR, pMapInsert :: (Ord t) => BSR t -> BSRs t -> BSRs t
pMapInsert :: forall t. Ord t => BSR t -> BSRs t -> BSRs t
pMapInsert f :: BSR t
f@((Slot Nt
x [Symbol t]
alpha [Symbol t]
beta), Int
l, Int
k, Int
r) BSRs t
pMap =
Prod t -> Int -> Int -> Int -> Int -> BSRs t
add (forall t. Nt -> Symbols t -> Prod t
Prod Nt
x ([Symbol t]
alphaforall a. [a] -> [a] -> [a]
++[Symbol t]
beta)) (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Symbol t]
alpha) Int
l Int
r Int
k
where add :: Prod t -> Int -> Int -> Int -> Int -> BSRs t
add Prod t
alt Int
j Int
l Int
r Int
k = forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IM.alter Maybe (IntMap (IntMap (Map (Prod t) IntSet)))
-> Maybe (IntMap (IntMap (Map (Prod t) IntSet)))
addInnerL Int
l BSRs t
pMap
where addInnerL :: Maybe (IntMap (IntMap (Map (Prod t) IntSet)))
-> Maybe (IntMap (IntMap (Map (Prod t) IntSet)))
addInnerL Maybe (IntMap (IntMap (Map (Prod t) IntSet)))
mm = case Maybe (IntMap (IntMap (Map (Prod t) IntSet)))
mm of
Maybe (IntMap (IntMap (Map (Prod t) IntSet)))
Nothing -> forall a. a -> Maybe a
Just IntMap (IntMap (Map (Prod t) IntSet))
singleRJAK
Just IntMap (IntMap (Map (Prod t) IntSet))
m -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IM.alter Maybe (IntMap (Map (Prod t) IntSet))
-> Maybe (IntMap (Map (Prod t) IntSet))
addInnerR Int
r IntMap (IntMap (Map (Prod t) IntSet))
m
addInnerR :: Maybe (IntMap (Map (Prod t) IntSet))
-> Maybe (IntMap (Map (Prod t) IntSet))
addInnerR Maybe (IntMap (Map (Prod t) IntSet))
mm = case Maybe (IntMap (Map (Prod t) IntSet))
mm of
Maybe (IntMap (Map (Prod t) IntSet))
Nothing -> forall a. a -> Maybe a
Just IntMap (Map (Prod t) IntSet)
singleJAK
Just IntMap (Map (Prod t) IntSet)
m -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IM.alter Maybe (Map (Prod t) IntSet) -> Maybe (Map (Prod t) IntSet)
addInnerJ Int
j IntMap (Map (Prod t) IntSet)
m
addInnerJ :: Maybe (Map (Prod t) IntSet) -> Maybe (Map (Prod t) IntSet)
addInnerJ Maybe (Map (Prod t) IntSet)
mm = case Maybe (Map (Prod t) IntSet)
mm of
Maybe (Map (Prod t) IntSet)
Nothing -> forall a. a -> Maybe a
Just Map (Prod t) IntSet
singleAK
Just Map (Prod t) IntSet
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 IntSet -> IntSet -> IntSet
IS.union Prod t
alt IntSet
singleK Map (Prod t) IntSet
m
singleRJAK :: IntMap (IntMap (Map (Prod t) IntSet))
singleRJAK= forall a. [(Int, a)] -> IntMap a
IM.fromList [(Int
r, IntMap (Map (Prod t) IntSet)
singleJAK)]
singleJAK :: IntMap (Map (Prod t) IntSet)
singleJAK = forall a. [(Int, a)] -> IntMap a
IM.fromList [(Int
j, Map (Prod t) IntSet
singleAK)]
singleAK :: Map (Prod t) IntSet
singleAK = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Prod t
alt, IntSet
singleK)]
singleK :: IntSet
singleK = Int -> IntSet
IS.singleton Int
k
showBSRs :: IntMap (IntMap (IntMap (Map a a))) -> String
showBSRs IntMap (IntMap (IntMap (Map a a)))
pMap = [String] -> String
unlines [ forall a. Show a => a -> String
show ((a
a,Int
j),Int
l,Int
r) forall a. [a] -> [a] -> [a]
++ String
" --> " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
kset
| (Int
l,IntMap (IntMap (Map a a))
r2j) <- forall a. IntMap a -> [(Int, a)]
IM.assocs IntMap (IntMap (IntMap (Map a a)))
pMap, (Int
r,IntMap (Map a a)
j2a) <- forall a. IntMap a -> [(Int, a)]
IM.assocs IntMap (IntMap (Map a a))
r2j
, (Int
j,Map a a
a2k) <- forall a. IntMap a -> [(Int, a)]
IM.assocs IntMap (Map a a)
j2a, (a
a,a
kset) <- forall k a. Map k a -> [(k, a)]
M.assocs Map a a
a2k ]