{-# LANGUAGE BangPatterns, RankNTypes, FlexibleContexts #-}
module PGF.Parse
          ( ParseState
          , ErrorState
          , initState
          , nextState
          , getCompletions
          , recoveryStates
          , ParseInput(..),  simpleParseInput, mkParseInput
          , ParseOutput(..), getParseOutput
          , parse
          , parseWithRecovery
          , getContinuationInfo
          ) where

import Data.Array.IArray
import Data.Array.Base (unsafeAt)
import Data.List (isPrefixOf, foldl', intercalate)
import Data.Maybe (fromMaybe, maybeToList)
import qualified Data.Map as Map
import qualified PGF.TrieMap as TrieMap
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
import qualified Data.Set as Set
import Control.Monad

import PGF.CId
import PGF.Data
import PGF.Expr(Tree)
import PGF.Macros
import PGF.TypeCheck
import PGF.Forest(Forest(Forest), linearizeWithBrackets, getAbsTrees)

-- | The input to the parser is a pair of predicates. The first one

-- 'piToken' selects a token from a list of suggestions from the grammar,

-- actually appears at the current position in the input string.

-- The second one 'piLiteral' recognizes whether a literal with forest id 'FId'

-- could be matched at the current position.

data ParseInput
  = ParseInput
      { ParseInput -> forall a. Map Token a -> Maybe a
piToken   :: forall a . Map.Map Token a -> Maybe a
      , ParseInput -> FId -> Maybe (CId, Tree, [Token])
piLiteral :: FId -> Maybe (CId,Tree,[Token])
      }

-- | This data type encodes the different outcomes which you could get from the parser.

data ParseOutput
  = ParseFailed Int                -- ^ The integer is the position in number of tokens where the parser failed.

  | TypeError   [(FId,TcError)]    -- ^ The parsing was successful but none of the trees is type correct. 

                                   -- The forest id ('FId') points to the bracketed string from the parser

                                   -- where the type checking failed. More than one error is returned

                                   -- if there are many analizes for some phrase but they all are not type correct.

  | ParseOk [Tree]                 -- ^ If the parsing and the type checking are successful we get a list of abstract syntax trees.

                                   -- The list should be non-empty.

  | ParseIncomplete                -- ^ The sentence is not complete. Only partial output is produced


parse :: PGF -> Language -> Type -> Maybe Int -> [Token] -> (ParseOutput,BracketedString)
parse :: PGF
-> CId
-> Type
-> Maybe FId
-> [Token]
-> (ParseOutput, BracketedString)
parse PGF
pgf CId
lang Type
typ Maybe FId
dp [Token]
toks = ParseState -> [Token] -> (ParseOutput, BracketedString)
loop (PGF -> CId -> Type -> ParseState
initState PGF
pgf CId
lang Type
typ) [Token]
toks
  where
    loop :: ParseState -> [Token] -> (ParseOutput, BracketedString)
loop ParseState
ps []     = ParseState -> Type -> Maybe FId -> (ParseOutput, BracketedString)
getParseOutput ParseState
ps Type
typ Maybe FId
dp
    loop ParseState
ps (Token
t:[Token]
ts) = case ParseState -> ParseInput -> Either ErrorState ParseState
nextState ParseState
ps (Token -> ParseInput
simpleParseInput Token
t) of
                       Left  ErrorState
es -> case ErrorState
es of
                                     EState Abstr
_ Concr
_ Chart
chart -> (FId -> ParseOutput
ParseFailed (Chart -> FId
offset Chart
chart),(ParseOutput, BracketedString) -> BracketedString
forall a b. (a, b) -> b
snd (ParseState -> Type -> Maybe FId -> (ParseOutput, BracketedString)
getParseOutput ParseState
ps Type
typ Maybe FId
dp))
                       Right ParseState
ps -> ParseState -> [Token] -> (ParseOutput, BracketedString)
loop ParseState
ps [Token]
ts

parseWithRecovery :: PGF -> Language -> Type -> [Type] -> Maybe Int -> [String] -> (ParseOutput,BracketedString)
parseWithRecovery :: PGF
-> CId
-> Type
-> [Type]
-> Maybe FId
-> [Token]
-> (ParseOutput, BracketedString)
parseWithRecovery PGF
pgf CId
lang Type
typ [Type]
open_typs Maybe FId
dp [Token]
toks = ParseState -> [Token] -> (ParseOutput, BracketedString)
accept (PGF -> CId -> Type -> ParseState
initState PGF
pgf CId
lang Type
typ) [Token]
toks
  where
    accept :: ParseState -> [Token] -> (ParseOutput, BracketedString)
accept ParseState
ps []     = ParseState -> Type -> Maybe FId -> (ParseOutput, BracketedString)
getParseOutput ParseState
ps Type
typ Maybe FId
dp
    accept ParseState
ps (Token
t:[Token]
ts) =
      case ParseState -> ParseInput -> Either ErrorState ParseState
nextState ParseState
ps (Token -> ParseInput
simpleParseInput Token
t) of
        Right ParseState
ps -> ParseState -> [Token] -> (ParseOutput, BracketedString)
accept ParseState
ps [Token]
ts
        Left  ErrorState
es -> (ParseState, Map Token ParseState)
-> [Token] -> (ParseOutput, BracketedString)
skip ([Type] -> ErrorState -> (ParseState, Map Token ParseState)
recoveryStates [Type]
open_typs ErrorState
es) [Token]
ts

    skip :: (ParseState, Map Token ParseState)
-> [Token] -> (ParseOutput, BracketedString)
skip (ParseState, Map Token ParseState)
ps_map []     = ParseState -> Type -> Maybe FId -> (ParseOutput, BracketedString)
getParseOutput ((ParseState, Map Token ParseState) -> ParseState
forall a b. (a, b) -> a
fst (ParseState, Map Token ParseState)
ps_map) Type
typ Maybe FId
dp
    skip (ParseState, Map Token ParseState)
ps_map (Token
t:[Token]
ts) =
      case Token -> Map Token ParseState -> Maybe ParseState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Token
t ((ParseState, Map Token ParseState) -> Map Token ParseState
forall a b. (a, b) -> b
snd (ParseState, Map Token ParseState)
ps_map) of
        Just ParseState
ps -> ParseState -> [Token] -> (ParseOutput, BracketedString)
accept ParseState
ps [Token]
ts
        Maybe ParseState
Nothing -> (ParseState, Map Token ParseState)
-> [Token] -> (ParseOutput, BracketedString)
skip (ParseState, Map Token ParseState)
ps_map [Token]
ts


-- | Creates an initial parsing state for a given language and

-- startup category.

initState :: PGF -> Language -> Type -> ParseState
initState :: PGF -> CId -> Type -> ParseState
initState PGF
pgf CId
lang (DTyp [Hypo]
_ CId
start [Tree]
_) = 
  let items :: [Active]
items = case CId -> Map CId CncCat -> Maybe CncCat
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CId
start (Concr -> Map CId CncCat
cnccats Concr
cnc) of
                Just (CncCat FId
s FId
e Array FId Token
labels) -> 
                        do FId
fid <- (FId, FId) -> [FId]
forall a. Ix a => (a, a) -> [a]
range (FId
s,FId
e)
                           FId
funid <- [FId] -> Maybe [FId] -> [FId]
forall a. a -> Maybe a -> a
fromMaybe [] (FId -> IntMap [FId] -> Maybe [FId]
forall a. FId -> IntMap a -> Maybe a
IntMap.lookup FId
fid (Concr -> IntMap [FId]
linrefs Concr
cnc))
                           let lbl :: FId
lbl           = FId
0
                               CncFun CId
_ UArray FId FId
lins = Array FId CncFun -> FId -> CncFun
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> FId -> e
unsafeAt (Concr -> Array FId CncFun
cncfuns Concr
cnc) FId
funid
                           Active -> [Active]
forall (m :: * -> *) a. Monad m => a -> m a
return (FId -> FId -> FId -> FId -> [PArg] -> ActiveKey -> Active
Active FId
0 FId
0 FId
funid (UArray FId FId -> FId -> FId
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> FId -> e
unsafeAt UArray FId FId
lins FId
lbl) [[(FId, FId)] -> FId -> PArg
PArg [] FId
fid] (FId -> FId -> ActiveKey
AK FId
fidStart FId
lbl))
                Maybe CncCat
Nothing -> []
  in Abstr -> Concr -> Chart -> Continuation -> ParseState
PState Abstr
abs
            Concr
cnc
            (ActiveChart
-> [ActiveChart]
-> PassiveChart
-> IntMap (Set Production)
-> FId
-> FId
-> Chart
Chart ActiveChart
emptyAC [] PassiveChart
emptyPC (Concr -> IntMap (Set Production)
pproductions Concr
cnc) (Concr -> FId
totalCats Concr
cnc) FId
0)
            (Maybe (Set Active) -> Map Token Continuation -> Continuation
forall v k. Maybe v -> Map k (TrieMap k v) -> TrieMap k v
TrieMap.compose (Set Active -> Maybe (Set Active)
forall a. a -> Maybe a
Just ([Active] -> Set Active
forall a. Ord a => [a] -> Set a
Set.fromList [Active]
items)) Map Token Continuation
forall k a. Map k a
Map.empty)
  where
    abs :: Abstr
abs = PGF -> Abstr
abstract PGF
pgf
    cnc :: Concr
cnc = PGF -> CId -> Concr
lookConcrComplete PGF
pgf CId
lang


-- | This function constructs the simplest possible parser input. 

-- It checks the tokens for exact matching and recognizes only @String@, @Int@ and @Float@ literals.

-- The @Int@ and @Float@ literals match only if the token passed is some number.

-- The @String@ literal always match but the length of the literal could be only one token.

simpleParseInput :: Token -> ParseInput
simpleParseInput :: Token -> ParseInput
simpleParseInput Token
t = (forall a. Map Token a -> Maybe a)
-> (FId -> Maybe (CId, Tree, [Token])) -> ParseInput
ParseInput (Token -> Map Token a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Token
t) (Token -> FId -> Maybe (CId, Tree, [Token])
matchLit Token
t)
  where
    matchLit :: Token -> FId -> Maybe (CId, Tree, [Token])
matchLit Token
t FId
fid
      | FId
fid FId -> FId -> Bool
forall a. Eq a => a -> a -> Bool
== FId
fidString = (CId, Tree, [Token]) -> Maybe (CId, Tree, [Token])
forall a. a -> Maybe a
Just (CId
cidString,Literal -> Tree
ELit (Token -> Literal
LStr Token
t),[Token
t])
      | FId
fid FId -> FId -> Bool
forall a. Eq a => a -> a -> Bool
== FId
fidInt    = case ReadS FId
forall a. Read a => ReadS a
reads Token
t of {[(FId
n,Token
"")] -> (CId, Tree, [Token]) -> Maybe (CId, Tree, [Token])
forall a. a -> Maybe a
Just (CId
cidInt,Literal -> Tree
ELit (FId -> Literal
LInt FId
n),[Token
t]);
                                            [(FId, Token)]
_        -> Maybe (CId, Tree, [Token])
forall a. Maybe a
Nothing }
      | FId
fid FId -> FId -> Bool
forall a. Eq a => a -> a -> Bool
== FId
fidFloat  = case ReadS Double
forall a. Read a => ReadS a
reads Token
t of {[(Double
d,Token
"")] -> (CId, Tree, [Token]) -> Maybe (CId, Tree, [Token])
forall a. a -> Maybe a
Just (CId
cidFloat,Literal -> Tree
ELit (Double -> Literal
LFlt Double
d),[Token
t]);
                                            [(Double, Token)]
_        -> Maybe (CId, Tree, [Token])
forall a. Maybe a
Nothing }
      | FId
fid FId -> FId -> Bool
forall a. Eq a => a -> a -> Bool
== FId
fidVar    = (CId, Tree, [Token]) -> Maybe (CId, Tree, [Token])
forall a. a -> Maybe a
Just (CId
wildCId,CId -> Tree
EFun (Token -> CId
mkCId Token
t),[Token
t])
      | Bool
otherwise        = Maybe (CId, Tree, [Token])
forall a. Maybe a
Nothing

mkParseInput :: PGF -> Language 
             -> (forall a . b -> Map.Map Token a -> Maybe a)
             -> [(CId,b -> Maybe (Tree,[Token]))]
             -> (b -> ParseInput)
mkParseInput :: PGF
-> CId
-> (forall a. b -> Map Token a -> Maybe a)
-> [(CId, b -> Maybe (Tree, [Token]))]
-> b
-> ParseInput
mkParseInput PGF
pgf CId
lang forall a. b -> Map Token a -> Maybe a
ftok [(CId, b -> Maybe (Tree, [Token]))]
flits = \b
x -> (forall a. Map Token a -> Maybe a)
-> (FId -> Maybe (CId, Tree, [Token])) -> ParseInput
ParseInput (b -> Map Token a -> Maybe a
forall a. b -> Map Token a -> Maybe a
ftok b
x) (b -> FId -> Maybe (CId, Tree, [Token])
flit b
x)
  where
    flit :: b -> FId -> Maybe (CId, Tree, [Token])
flit = [(CId, b -> Maybe (Tree, [Token]))]
-> b -> FId -> Maybe (CId, Tree, [Token])
forall t b c.
[(CId, t -> Maybe (b, c))] -> t -> FId -> Maybe (CId, b, c)
mk [(CId, b -> Maybe (Tree, [Token]))]
flits
    
    cnc :: Concr
cnc = PGF -> CId -> Concr
lookConcr PGF
pgf CId
lang

    mk :: [(CId, t -> Maybe (b, c))] -> t -> FId -> Maybe (CId, b, c)
mk []               = \t
x FId
fid -> Maybe (CId, b, c)
forall a. Maybe a
Nothing
    mk ((CId
c,t -> Maybe (b, c)
flit):[(CId, t -> Maybe (b, c))]
flits) = \t
x FId
fid -> case CId -> Map CId CncCat -> Maybe CncCat
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CId
c (Concr -> Map CId CncCat
cnccats Concr
cnc) of
                                      Just (CncCat FId
s FId
e Array FId Token
_) | (FId, FId) -> FId -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (FId
s,FId
e) FId
fid 
                                              -> ((b, c) -> (CId, b, c)) -> Maybe (b, c) -> Maybe (CId, b, c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(b
tree,c
toks) -> (CId
c,b
tree,c
toks)) (t -> Maybe (b, c)
flit t
x)
                                      Maybe CncCat
_       -> [(CId, t -> Maybe (b, c))] -> t -> FId -> Maybe (CId, b, c)
mk [(CId, t -> Maybe (b, c))]
flits t
x FId
fid

-- | From the current state and the next token

-- 'nextState' computes a new state, where the token

-- is consumed and the current position is shifted by one.

-- If the new token cannot be accepted then an error state 

-- is returned.

nextState :: ParseState -> ParseInput -> Either ErrorState ParseState
nextState :: ParseState -> ParseInput -> Either ErrorState ParseState
nextState (PState Abstr
abs Concr
cnc Chart
chart Continuation
cnt0) ParseInput
input =
  let (Maybe (Set Active)
mb_agenda,Map Token Continuation
map_items) = Continuation -> (Maybe (Set Active), Map Token Continuation)
forall k v. TrieMap k v -> (Maybe v, Map k (TrieMap k v))
TrieMap.decompose Continuation
cnt0
      agenda :: [Active]
agenda = [Active]
-> (Set Active -> [Active]) -> Maybe (Set Active) -> [Active]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Set Active -> [Active]
forall a. Set a -> [a]
Set.toList Maybe (Set Active)
mb_agenda
      cnt :: Continuation
cnt    = Continuation -> Maybe Continuation -> Continuation
forall a. a -> Maybe a -> a
fromMaybe Continuation
forall k v. TrieMap k v
TrieMap.empty (ParseInput -> Map Token Continuation -> Maybe Continuation
ParseInput -> forall a. Map Token a -> Maybe a
piToken ParseInput
input Map Token Continuation
map_items)
      (Continuation
cnt1,Chart
chart1) = (FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> Continuation -> Continuation)
-> Concr
-> [Active]
-> Continuation
-> Chart
-> (Continuation, Chart)
forall t.
(FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
flit Map Token Continuation -> Continuation -> Continuation
forall k a.
(Ord k, Ord a) =>
Map Token (TrieMap k (Set a))
-> TrieMap k (Set a) -> TrieMap k (Set a)
ftok Concr
cnc [Active]
agenda Continuation
cnt Chart
chart
      chart2 :: Chart
chart2 = Chart
chart1{ active :: ActiveChart
active =ActiveChart
emptyAC
                     , actives :: [ActiveChart]
actives=Chart -> ActiveChart
active Chart
chart1 ActiveChart -> [ActiveChart] -> [ActiveChart]
forall a. a -> [a] -> [a]
: Chart -> [ActiveChart]
actives Chart
chart1
                     , passive :: PassiveChart
passive=PassiveChart
emptyPC
                     , offset :: FId
offset =Chart -> FId
offset Chart
chart1FId -> FId -> FId
forall a. Num a => a -> a -> a
+FId
1
                     }
  in if Continuation -> Bool
forall k v. TrieMap k v -> Bool
TrieMap.null Continuation
cnt1
       then ErrorState -> Either ErrorState ParseState
forall a b. a -> Either a b
Left  (Abstr -> Concr -> Chart -> ErrorState
EState Abstr
abs Concr
cnc Chart
chart2)
       else ParseState -> Either ErrorState ParseState
forall a b. b -> Either a b
Right (Abstr -> Concr -> Chart -> Continuation -> ParseState
PState Abstr
abs Concr
cnc Chart
chart2 Continuation
cnt1)
  where
    flit :: FId -> Maybe (CId, Tree, [Token])
flit = ParseInput -> FId -> Maybe (CId, Tree, [Token])
piLiteral ParseInput
input

    ftok :: Map Token (TrieMap k (Set a))
-> TrieMap k (Set a) -> TrieMap k (Set a)
ftok Map Token (TrieMap k (Set a))
choices TrieMap k (Set a)
cnt =
      case ParseInput
-> Map Token (TrieMap k (Set a)) -> Maybe (TrieMap k (Set a))
ParseInput -> forall a. Map Token a -> Maybe a
piToken ParseInput
input Map Token (TrieMap k (Set a))
choices of
        Just TrieMap k (Set a)
cnt' -> (Set a -> Set a -> Set a)
-> TrieMap k (Set a) -> TrieMap k (Set a) -> TrieMap k (Set a)
forall k v.
Ord k =>
(v -> v -> v) -> TrieMap k v -> TrieMap k v -> TrieMap k v
TrieMap.unionWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union TrieMap k (Set a)
cnt' TrieMap k (Set a)
cnt
        Maybe (TrieMap k (Set a))
Nothing   -> TrieMap k (Set a)
cnt

-- | If the next token is not known but only its prefix (possible empty prefix)

-- then the 'getCompletions' function can be used to calculate the possible

-- next words and the consequent states. This is used for word completions in

-- the GF interpreter.

getCompletions :: ParseState -> String -> Map.Map Token ParseState
getCompletions :: ParseState -> Token -> Map Token ParseState
getCompletions (PState Abstr
abs Concr
cnc Chart
chart Continuation
cnt0) Token
w =
  let (Maybe (Set Active)
mb_agenda,Map Token Continuation
map_items) = Continuation -> (Maybe (Set Active), Map Token Continuation)
forall k v. TrieMap k v -> (Maybe v, Map k (TrieMap k v))
TrieMap.decompose Continuation
cnt0
      agenda :: [Active]
agenda = [Active]
-> (Set Active -> [Active]) -> Maybe (Set Active) -> [Active]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Set Active -> [Active]
forall a. Set a -> [a]
Set.toList Maybe (Set Active)
mb_agenda
      acc :: Map Token Continuation
acc    = (Token -> Continuation -> Bool)
-> Map Token Continuation -> Map Token Continuation
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\Token
tok Continuation
_ -> Token -> Token -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf Token
w Token
tok) Map Token Continuation
map_items
      (Map Token Continuation
acc',Chart
chart1) = (FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation
    -> Map Token Continuation -> Map Token Continuation)
-> Concr
-> [Active]
-> Map Token Continuation
-> Chart
-> (Map Token Continuation, Chart)
forall t.
(FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
forall p a. p -> Maybe a
flit Map Token Continuation
-> Map Token Continuation -> Map Token Continuation
forall k a.
(Ord k, Ord a) =>
Map Token (TrieMap k (Set a))
-> Map Token (TrieMap k (Set a)) -> Map Token (TrieMap k (Set a))
ftok Concr
cnc [Active]
agenda Map Token Continuation
acc Chart
chart
      chart2 :: Chart
chart2 = Chart
chart1{ active :: ActiveChart
active =ActiveChart
emptyAC
                     , actives :: [ActiveChart]
actives=Chart -> ActiveChart
active Chart
chart1 ActiveChart -> [ActiveChart] -> [ActiveChart]
forall a. a -> [a] -> [a]
: Chart -> [ActiveChart]
actives Chart
chart1
                     , passive :: PassiveChart
passive=PassiveChart
emptyPC
                     , offset :: FId
offset =Chart -> FId
offset Chart
chart1FId -> FId -> FId
forall a. Num a => a -> a -> a
+FId
1
                     }
  in (Continuation -> ParseState)
-> Map Token Continuation -> Map Token ParseState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Abstr -> Concr -> Chart -> Continuation -> ParseState
PState Abstr
abs Concr
cnc Chart
chart2) Map Token Continuation
acc'
  where
    flit :: p -> Maybe a
flit p
_ = Maybe a
forall a. Maybe a
Nothing

    ftok :: Map Token (TrieMap k (Set a))
-> Map Token (TrieMap k (Set a)) -> Map Token (TrieMap k (Set a))
ftok Map Token (TrieMap k (Set a))
choices =
      (TrieMap k (Set a) -> TrieMap k (Set a) -> TrieMap k (Set a))
-> Map Token (TrieMap k (Set a))
-> Map Token (TrieMap k (Set a))
-> Map Token (TrieMap k (Set a))
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith ((Set a -> Set a -> Set a)
-> TrieMap k (Set a) -> TrieMap k (Set a) -> TrieMap k (Set a)
forall k v.
Ord k =>
(v -> v -> v) -> TrieMap k v -> TrieMap k v -> TrieMap k v
TrieMap.unionWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union)
                    ((Token -> TrieMap k (Set a) -> Bool)
-> Map Token (TrieMap k (Set a)) -> Map Token (TrieMap k (Set a))
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\Token
tok TrieMap k (Set a)
_ -> Token -> Token -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf Token
w Token
tok) Map Token (TrieMap k (Set a))
choices)

recoveryStates :: [Type] -> ErrorState -> (ParseState, Map.Map Token ParseState)
recoveryStates :: [Type] -> ErrorState -> (ParseState, Map Token ParseState)
recoveryStates [Type]
open_types (EState Abstr
abs Concr
cnc Chart
chart) =
  let open_fcats :: [FId]
open_fcats = (Type -> [FId]) -> [Type] -> [FId]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Type -> [FId]
type2fcats [Type]
open_types
      agenda :: [Active]
agenda = ([Active] -> ActiveChart -> [Active])
-> [Active] -> [ActiveChart] -> [Active]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ([FId] -> [Active] -> ActiveChart -> [Active]
complete [FId]
open_fcats) [] (Chart -> [ActiveChart]
actives Chart
chart)
      (Map Token Continuation
acc,Chart
chart1) = (FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation
    -> Map Token Continuation -> Map Token Continuation)
-> Concr
-> [Active]
-> Map Token Continuation
-> Chart
-> (Map Token Continuation, Chart)
forall t.
(FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
forall p a. p -> Maybe a
flit Map Token Continuation
-> Map Token Continuation -> Map Token Continuation
forall k k a.
(Ord k, Ord k, Ord a) =>
Map k (TrieMap k (Set a))
-> Map k (TrieMap k (Set a)) -> Map k (TrieMap k (Set a))
ftok Concr
cnc [Active]
agenda Map Token Continuation
forall k a. Map k a
Map.empty Chart
chart
      chart2 :: Chart
chart2 = Chart
chart1{ active :: ActiveChart
active =ActiveChart
emptyAC
                     , actives :: [ActiveChart]
actives=Chart -> ActiveChart
active Chart
chart1 ActiveChart -> [ActiveChart] -> [ActiveChart]
forall a. a -> [a] -> [a]
: Chart -> [ActiveChart]
actives Chart
chart1
                     , passive :: PassiveChart
passive=PassiveChart
emptyPC
                     , offset :: FId
offset =Chart -> FId
offset Chart
chart1FId -> FId -> FId
forall a. Num a => a -> a -> a
+FId
1
                     }
  in (Abstr -> Concr -> Chart -> Continuation -> ParseState
PState Abstr
abs Concr
cnc Chart
chart ([Token] -> Set Active -> Continuation
forall k a. [k] -> a -> TrieMap k a
TrieMap.singleton [] ([Active] -> Set Active
forall a. Ord a => [a] -> Set a
Set.fromList [Active]
agenda)), (Continuation -> ParseState)
-> Map Token Continuation -> Map Token ParseState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Abstr -> Concr -> Chart -> Continuation -> ParseState
PState Abstr
abs Concr
cnc Chart
chart2) Map Token Continuation
acc)
  where
    type2fcats :: Type -> [FId]
type2fcats (DTyp [Hypo]
_ CId
cat [Tree]
_) = case CId -> Map CId CncCat -> Maybe CncCat
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CId
cat (Concr -> Map CId CncCat
cnccats Concr
cnc) of
                                  Just (CncCat FId
s FId
e Array FId Token
labels) -> (FId, FId) -> [FId]
forall a. Ix a => (a, a) -> [a]
range (FId
s,FId
e)
                                  Maybe CncCat
Nothing                  -> []

    complete :: [FId] -> [Active] -> ActiveChart -> [Active]
complete [FId]
open_fcats [Active]
items ActiveChart
ac = 
      ([Active] -> Set Active -> [Active])
-> [Active] -> [Set Active] -> [Active]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((Active -> [Active] -> [Active])
-> [Active] -> Set Active -> [Active]
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr (\(Active FId
j' FId
ppos FId
funid FId
seqid [PArg]
args ActiveKey
keyc) -> 
                           (:) (FId -> FId -> FId -> FId -> [PArg] -> ActiveKey -> Active
Active FId
j' (FId
pposFId -> FId -> FId
forall a. Num a => a -> a -> a
+FId
1) FId
funid FId
seqid [PArg]
args ActiveKey
keyc)))
            [Active]
items
            [Set Active
set | FId
fcat <- [FId]
open_fcats, (Set Active
set,IntMap (Set Production)
_) <- FId -> ActiveChart -> [(Set Active, IntMap (Set Production))]
lookupACByFCat FId
fcat ActiveChart
ac]

    flit :: p -> Maybe a
flit p
_ = Maybe a
forall a. Maybe a
Nothing
    ftok :: Map k (TrieMap k (Set a))
-> Map k (TrieMap k (Set a)) -> Map k (TrieMap k (Set a))
ftok Map k (TrieMap k (Set a))
toks = (TrieMap k (Set a) -> TrieMap k (Set a) -> TrieMap k (Set a))
-> Map k (TrieMap k (Set a))
-> Map k (TrieMap k (Set a))
-> Map k (TrieMap k (Set a))
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith ((Set a -> Set a -> Set a)
-> TrieMap k (Set a) -> TrieMap k (Set a) -> TrieMap k (Set a)
forall k v.
Ord k =>
(v -> v -> v) -> TrieMap k v -> TrieMap k v -> TrieMap k v
TrieMap.unionWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union) Map k (TrieMap k (Set a))
toks

-- | This function extracts the list of all completed parse trees

-- that spans the whole input consumed so far. The trees are also

-- limited by the category specified, which is usually

-- the same as the startup category.

getParseOutput :: ParseState -> Type -> Maybe Int -> (ParseOutput,BracketedString)
getParseOutput :: ParseState -> Type -> Maybe FId -> (ParseOutput, BracketedString)
getParseOutput (PState Abstr
abs Concr
cnc Chart
chart Continuation
cnt) Type
ty Maybe FId
dp =
  let froots :: [([Symbol], [PArg])]
froots | [ActiveKey] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ActiveKey]
roots = Array FId (Array FId Symbol)
-> [ActiveChart]
-> [(FId, [Symbol], [PArg], ActiveKey)]
-> [([Symbol], [PArg])]
forall (a :: * -> * -> *) (a :: * -> * -> *) i i.
(IArray a Symbol, IArray a (a i Symbol), Ix i, Ix i) =>
a i (a i Symbol)
-> [ActiveChart]
-> [(FId, [Symbol], [PArg], ActiveKey)]
-> [([Symbol], [PArg])]
getPartialSeq (Concr -> Array FId (Array FId Symbol)
sequences Concr
cnc) ([ActiveChart] -> [ActiveChart]
forall a. [a] -> [a]
reverse (Chart -> ActiveChart
active Chart
chart1 ActiveChart -> [ActiveChart] -> [ActiveChart]
forall a. a -> [a] -> [a]
: Chart -> [ActiveChart]
actives Chart
chart1)) [(FId, [Symbol], [PArg], ActiveKey)]
seq
             | Bool
otherwise  = [([FId -> FId -> Symbol
SymCat FId
0 FId
lbl],[[(FId, FId)] -> FId -> PArg
PArg [] FId
fid]) | AK FId
fid FId
lbl <- [ActiveKey]
roots]

      f :: Forest
f     = Abstr
-> Concr
-> IntMap (Set Production)
-> [([Symbol], [PArg])]
-> Forest
Forest Abstr
abs Concr
cnc (Chart -> IntMap (Set Production)
forest Chart
chart1) [([Symbol], [PArg])]
froots
      
      bs :: BracketedString
bs    = Maybe FId -> Forest -> BracketedString
linearizeWithBrackets Maybe FId
dp Forest
f
                
      res :: ParseOutput
res   | Bool -> Bool
not ([Tree] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tree]
es)   = [Tree] -> ParseOutput
ParseOk [Tree]
es
            | Bool -> Bool
not ([(FId, TcError)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FId, TcError)]
errs) = [(FId, TcError)] -> ParseOutput
TypeError [(FId, TcError)]
errs
            | Bool
otherwise       = ParseOutput
ParseIncomplete
            where xs :: [Either [(FId, TcError)] [Tree]]
xs   = [Forest
-> PArg
-> Maybe Type
-> Maybe FId
-> Either [(FId, TcError)] [Tree]
getAbsTrees Forest
f ([(FId, FId)] -> FId -> PArg
PArg [] FId
fid) (Type -> Maybe Type
forall a. a -> Maybe a
Just Type
ty) Maybe FId
dp | (AK FId
fid FId
lbl) <- [ActiveKey]
roots]
                  es :: [Tree]
es   = [[Tree]] -> [Tree]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Tree]
es   | Right [Tree]
es   <- [Either [(FId, TcError)] [Tree]]
xs]
                  errs :: [(FId, TcError)]
errs = [[(FId, TcError)]] -> [(FId, TcError)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(FId, TcError)]
errs | Left  [(FId, TcError)]
errs <- [Either [(FId, TcError)] [Tree]]
xs]

  in (ParseOutput
res,BracketedString
bs)
  where
    (Maybe (Set Active)
mb_agenda,Map Token Continuation
acc) = Continuation -> (Maybe (Set Active), Map Token Continuation)
forall k v. TrieMap k v -> (Maybe v, Map k (TrieMap k v))
TrieMap.decompose Continuation
cnt
    agenda :: [Active]
agenda = [Active]
-> (Set Active -> [Active]) -> Maybe (Set Active) -> [Active]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Set Active -> [Active]
forall a. Set a -> [a]
Set.toList Maybe (Set Active)
mb_agenda
    (Continuation
acc',Chart
chart1) = (FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> Continuation -> Continuation)
-> Concr
-> [Active]
-> Continuation
-> Chart
-> (Continuation, Chart)
forall t.
(FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
forall p a. p -> Maybe a
flit Map Token Continuation -> Continuation -> Continuation
forall k a.
(Ord k, Ord a) =>
Map k (TrieMap k (Set a)) -> TrieMap k (Set a) -> TrieMap k (Set a)
ftok Concr
cnc [Active]
agenda (Maybe (Set Active) -> Map Token Continuation -> Continuation
forall v k. Maybe v -> Map k (TrieMap k v) -> TrieMap k v
TrieMap.compose Maybe (Set Active)
forall a. Maybe a
Nothing Map Token Continuation
acc) Chart
chart
    seq :: [(FId, [Symbol], [PArg], ActiveKey)]
seq = [(FId
j,FId -> [Token] -> FId -> [Symbol]
forall (t :: * -> *) a. Foldable t => FId -> t a -> FId -> [Symbol]
cutAt FId
ppos [Token]
toks FId
seqid,[PArg]
args,ActiveKey
key) | ([Token]
toks,Set Active
set) <- Continuation -> [([Token], Set Active)]
forall k v. TrieMap k v -> [([k], v)]
TrieMap.toList Continuation
acc'
                                              , Active FId
j FId
ppos FId
funid FId
seqid [PArg]
args ActiveKey
key <- Set Active -> [Active]
forall a. Set a -> [a]
Set.toList Set Active
set]

    flit :: p -> Maybe a
flit p
_    = Maybe a
forall a. Maybe a
Nothing
    ftok :: Map k (TrieMap k (Set a)) -> TrieMap k (Set a) -> TrieMap k (Set a)
ftok Map k (TrieMap k (Set a))
toks = (Set a -> Set a -> Set a)
-> TrieMap k (Set a) -> TrieMap k (Set a) -> TrieMap k (Set a)
forall k v.
Ord k =>
(v -> v -> v) -> TrieMap k v -> TrieMap k v -> TrieMap k v
TrieMap.unionWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Maybe (Set a) -> Map k (TrieMap k (Set a)) -> TrieMap k (Set a)
forall v k. Maybe v -> Map k (TrieMap k v) -> TrieMap k v
TrieMap.compose Maybe (Set a)
forall a. Maybe a
Nothing Map k (TrieMap k (Set a))
toks)

    cutAt :: FId -> t a -> FId -> [Symbol]
cutAt FId
ppos t a
toks FId
seqid =
      let seq :: Array FId Symbol
seq  = Array FId (Array FId Symbol) -> FId -> Array FId Symbol
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> FId -> e
unsafeAt (Concr -> Array FId (Array FId Symbol)
sequences Concr
cnc) FId
seqid
          init :: [Symbol]
init = FId -> [Symbol] -> [Symbol]
forall a. FId -> [a] -> [a]
take (FId
pposFId -> FId -> FId
forall a. Num a => a -> a -> a
-FId
1) (Array FId Symbol -> [Symbol]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems Array FId Symbol
seq)
          tail :: [Symbol]
tail = case Array FId Symbol -> FId -> Symbol
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> FId -> e
unsafeAt Array FId Symbol
seq (FId
pposFId -> FId -> FId
forall a. Num a => a -> a -> a
-FId
1) of
                   SymKS Token
t    -> FId -> [Symbol] -> [Symbol]
forall a. FId -> [a] -> [a]
drop (t a -> FId
forall (t :: * -> *) a. Foldable t => t a -> FId
length t a
toks) [Token -> Symbol
SymKS Token
t]
                   SymKP [Symbol]
ts [([Symbol], [Token])]
_ -> [Symbol] -> [Symbol]
forall a. [a] -> [a]
reverse (FId -> [Symbol] -> [Symbol]
forall a. FId -> [a] -> [a]
drop (t a -> FId
forall (t :: * -> *) a. Foldable t => t a -> FId
length t a
toks) ([Symbol] -> [Symbol]
forall a. [a] -> [a]
reverse [Symbol]
ts))
                   Symbol
sym        -> []
      in [Symbol]
init [Symbol] -> [Symbol] -> [Symbol]
forall a. [a] -> [a] -> [a]
++ [Symbol]
tail

    roots :: [ActiveKey]
roots = do let lbl :: FId
lbl = FId
0
               FId
fid <- Maybe FId -> [FId]
forall a. Maybe a -> [a]
maybeToList (PassiveKey -> PassiveChart -> Maybe FId
lookupPC (FId -> FId -> FId -> PassiveKey
PK FId
fidStart FId
lbl FId
0) (Chart -> PassiveChart
passive Chart
chart1))
               PApply FId
_ [PArg [(FId, FId)]
_ FId
fid] <- [Production]
-> (Set Production -> [Production])
-> Maybe (Set Production)
-> [Production]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Set Production -> [Production]
forall a. Set a -> [a]
Set.toList (FId -> IntMap (Set Production) -> Maybe (Set Production)
forall a. FId -> IntMap a -> Maybe a
IntMap.lookup FId
fid (Chart -> IntMap (Set Production)
forest Chart
chart1))
               ActiveKey -> [ActiveKey]
forall (m :: * -> *) a. Monad m => a -> m a
return (FId -> FId -> ActiveKey
AK FId
fid FId
lbl)


getPartialSeq :: a i (a i Symbol)
-> [ActiveChart]
-> [(FId, [Symbol], [PArg], ActiveKey)]
-> [([Symbol], [PArg])]
getPartialSeq a i (a i Symbol)
seqs [ActiveChart]
actives = Set (FId, [Symbol], [PArg], ActiveKey)
-> [(FId, [Symbol], [PArg], ActiveKey)] -> [([Symbol], [PArg])]
expand Set (FId, [Symbol], [PArg], ActiveKey)
forall a. Set a
Set.empty
  where
    expand :: Set (FId, [Symbol], [PArg], ActiveKey)
-> [(FId, [Symbol], [PArg], ActiveKey)] -> [([Symbol], [PArg])]
expand Set (FId, [Symbol], [PArg], ActiveKey)
acc [] = 
      [([Symbol]
lin,[PArg]
args) | (FId
j,[Symbol]
lin,[PArg]
args,ActiveKey
key) <- Set (FId, [Symbol], [PArg], ActiveKey)
-> [(FId, [Symbol], [PArg], ActiveKey)]
forall a. Set a -> [a]
Set.toList Set (FId, [Symbol], [PArg], ActiveKey)
acc, FId
j FId -> FId -> Bool
forall a. Eq a => a -> a -> Bool
== FId
0]
    expand Set (FId, [Symbol], [PArg], ActiveKey)
acc (item :: (FId, [Symbol], [PArg], ActiveKey)
item@(FId
j,[Symbol]
lin,[PArg]
args,ActiveKey
key) : [(FId, [Symbol], [PArg], ActiveKey)]
items)
      | (FId, [Symbol], [PArg], ActiveKey)
item (FId, [Symbol], [PArg], ActiveKey)
-> Set (FId, [Symbol], [PArg], ActiveKey) -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set (FId, [Symbol], [PArg], ActiveKey)
acc = Set (FId, [Symbol], [PArg], ActiveKey)
-> [(FId, [Symbol], [PArg], ActiveKey)] -> [([Symbol], [PArg])]
expand Set (FId, [Symbol], [PArg], ActiveKey)
acc  [(FId, [Symbol], [PArg], ActiveKey)]
items
      | Bool
otherwise             = Set (FId, [Symbol], [PArg], ActiveKey)
-> [(FId, [Symbol], [PArg], ActiveKey)] -> [([Symbol], [PArg])]
expand Set (FId, [Symbol], [PArg], ActiveKey)
acc' [(FId, [Symbol], [PArg], ActiveKey)]
items'
      where
        acc' :: Set (FId, [Symbol], [PArg], ActiveKey)
acc'   = (FId, [Symbol], [PArg], ActiveKey)
-> Set (FId, [Symbol], [PArg], ActiveKey)
-> Set (FId, [Symbol], [PArg], ActiveKey)
forall a. Ord a => a -> Set a -> Set a
Set.insert (FId, [Symbol], [PArg], ActiveKey)
item Set (FId, [Symbol], [PArg], ActiveKey)
acc
        items' :: [(FId, [Symbol], [PArg], ActiveKey)]
items' = case ActiveKey
-> ActiveChart -> Maybe (Set Active, IntMap (Set Production))
lookupAC ActiveKey
key ([ActiveChart]
actives [ActiveChart] -> FId -> ActiveChart
forall a. [a] -> FId -> a
!! FId
j) of
                   Maybe (Set Active, IntMap (Set Production))
Nothing      -> [(FId, [Symbol], [PArg], ActiveKey)]
items
                   Just (Set Active
set,IntMap (Set Production)
_) -> [if FId
j' FId -> FId -> Bool
forall a. Ord a => a -> a -> Bool
< FId
j
                                      then let lin' :: [Symbol]
lin' = FId -> [Symbol] -> [Symbol]
forall a. FId -> [a] -> [a]
take FId
ppos (a i Symbol -> [Symbol]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems (a i (a i Symbol) -> FId -> a i Symbol
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> FId -> e
unsafeAt a i (a i Symbol)
seqs FId
seqid))
                                           in (FId
j',[Symbol]
lin'[Symbol] -> [Symbol] -> [Symbol]
forall a. [a] -> [a] -> [a]
++(Symbol -> Symbol) -> [Symbol] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map (FId -> Symbol -> Symbol
inc ([PArg] -> FId
forall (t :: * -> *) a. Foldable t => t a -> FId
length [PArg]
args')) [Symbol]
lin,[PArg]
args'[PArg] -> [PArg] -> [PArg]
forall a. [a] -> [a] -> [a]
++[PArg]
args,ActiveKey
key')
                                      else (FId
j',[Symbol]
lin,[PArg]
args,ActiveKey
key') | Active FId
j' FId
ppos FId
funid FId
seqid [PArg]
args' ActiveKey
key' <- Set Active -> [Active]
forall a. Set a -> [a]
Set.toList Set Active
set] [(FId, [Symbol], [PArg], ActiveKey)]
-> [(FId, [Symbol], [PArg], ActiveKey)]
-> [(FId, [Symbol], [PArg], ActiveKey)]
forall a. [a] -> [a] -> [a]
++ [(FId, [Symbol], [PArg], ActiveKey)]
items

    inc :: FId -> Symbol -> Symbol
inc FId
n (SymCat FId
d FId
r) = FId -> FId -> Symbol
SymCat (FId
nFId -> FId -> FId
forall a. Num a => a -> a -> a
+FId
d) FId
r
    inc FId
n (SymVar FId
d FId
r) = FId -> FId -> Symbol
SymVar (FId
nFId -> FId -> FId
forall a. Num a => a -> a -> a
+FId
d) FId
r
    inc FId
n (SymLit FId
d FId
r) = FId -> FId -> Symbol
SymLit (FId
nFId -> FId -> FId
forall a. Num a => a -> a -> a
+FId
d) FId
r
    inc FId
n Symbol
s            = Symbol
s

process :: (FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
flit Map Token Continuation -> t -> t
ftok Concr
cnc []                                                 t
acc Chart
chart = (t
acc,Chart
chart)
process FId -> Maybe (CId, Tree, [Token])
flit Map Token Continuation -> t -> t
ftok Concr
cnc (item :: Active
item@(Active FId
j FId
ppos FId
funid FId
seqid [PArg]
args ActiveKey
key0):[Active]
items) t
acc Chart
chart
  | (FId, FId) -> FId -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Array FId Symbol -> (FId, FId)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds Array FId Symbol
lin) FId
ppos =
      case Array FId Symbol -> FId -> Symbol
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> FId -> e
unsafeAt Array FId Symbol
lin FId
ppos of
        SymCat FId
d FId
r -> let PArg [(FId, FId)]
hypos !FId
fid = [PArg]
args [PArg] -> FId -> PArg
forall a. [a] -> FId -> a
!! FId
d
                          key :: ActiveKey
key  = FId -> FId -> ActiveKey
AK FId
fid FId
r

                          items2 :: [Active]
items2 = case PassiveKey -> PassiveChart -> Maybe FId
lookupPC (ActiveKey -> FId -> PassiveKey
mkPK ActiveKey
key FId
k) (Chart -> PassiveChart
passive Chart
chart) of
                                     Maybe FId
Nothing -> [Active]
items
                                     Just FId
id -> (FId -> FId -> FId -> FId -> [PArg] -> ActiveKey -> Active
Active FId
j (FId
pposFId -> FId -> FId
forall a. Num a => a -> a -> a
+FId
1) FId
funid FId
seqid (FId -> PArg -> [PArg] -> [PArg]
forall a. FId -> a -> [a] -> [a]
updateAt FId
d ([(FId, FId)] -> FId -> PArg
PArg [(FId, FId)]
hypos FId
id) [PArg]
args) ActiveKey
key0) Active -> [Active] -> [Active]
forall a. a -> [a] -> [a]
: [Active]
items
                          (t
acc',[Active]
items4) = (FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> IntMap (Set Production)
-> ActiveKey
-> ActiveKey
-> FId
-> t
-> [Active]
-> (t, [Active])
forall p a.
p
-> (Map Token Continuation -> a -> a)
-> Concr
-> IntMap (Set Production)
-> ActiveKey
-> ActiveKey
-> FId
-> a
-> [Active]
-> (a, [Active])
predict FId -> Maybe (CId, Tree, [Token])
flit Map Token Continuation -> t -> t
ftok Concr
cnc
                                                  ((Set Production -> Set Production -> Set Production)
-> IntMap (Set Production)
-> IntMap (Set Production)
-> IntMap (Set Production)
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith Set Production -> Set Production -> Set Production
forall a. Ord a => Set a -> Set a -> Set a
Set.union IntMap (Set Production)
new_sc (Chart -> IntMap (Set Production)
forest Chart
chart))
                                                  ActiveKey
key ActiveKey
key FId
k
                                                  t
acc [Active]
items2

                          new_sc :: IntMap (Set Production)
new_sc    = (IntMap (Set Production) -> (FId, FId) -> IntMap (Set Production))
-> IntMap (Set Production)
-> [(FId, FId)]
-> IntMap (Set Production)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl IntMap (Set Production) -> (FId, FId) -> IntMap (Set Production)
uu IntMap (Set Production)
parent_sc [(FId, FId)]
hypos
                          parent_sc :: IntMap (Set Production)
parent_sc = case ActiveKey
-> ActiveChart -> Maybe (Set Active, IntMap (Set Production))
lookupAC ActiveKey
key0 ((Chart -> ActiveChart
active Chart
chart ActiveChart -> [ActiveChart] -> [ActiveChart]
forall a. a -> [a] -> [a]
: Chart -> [ActiveChart]
actives Chart
chart) [ActiveChart] -> FId -> ActiveChart
forall a. [a] -> FId -> a
!! (FId
kFId -> FId -> FId
forall a. Num a => a -> a -> a
-FId
j)) of
                                        Maybe (Set Active, IntMap (Set Production))
Nothing       -> IntMap (Set Production)
forall a. IntMap a
IntMap.empty
                                        Just (Set Active
set,IntMap (Set Production)
sc) -> IntMap (Set Production)
sc

                      in case ActiveKey
-> ActiveChart -> Maybe (Set Active, IntMap (Set Production))
lookupAC ActiveKey
key (Chart -> ActiveChart
active Chart
chart) of
                           Maybe (Set Active, IntMap (Set Production))
Nothing                             -> (FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
flit Map Token Continuation -> t -> t
ftok Concr
cnc [Active]
items4 t
acc' Chart
chart{active :: ActiveChart
active=ActiveKey
-> (Set Active, IntMap (Set Production))
-> ActiveChart
-> ActiveChart
insertAC ActiveKey
key (Active -> Set Active
forall a. a -> Set a
Set.singleton Active
item,IntMap (Set Production)
new_sc) (Chart -> ActiveChart
active Chart
chart)}
                           Just (Set Active
set,IntMap (Set Production)
sc) | Active -> Set Active -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Active
item Set Active
set -> (FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
flit Map Token Continuation -> t -> t
ftok Concr
cnc [Active]
items  t
acc  Chart
chart
                                         | Bool
otherwise           -> (FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
flit Map Token Continuation -> t -> t
ftok Concr
cnc [Active]
items2 t
acc  Chart
chart{active :: ActiveChart
active=ActiveKey
-> (Set Active, IntMap (Set Production))
-> ActiveChart
-> ActiveChart
insertAC ActiveKey
key (Active -> Set Active -> Set Active
forall a. Ord a => a -> Set a -> Set a
Set.insert Active
item Set Active
set,(Set Production -> Set Production -> Set Production)
-> IntMap (Set Production)
-> IntMap (Set Production)
-> IntMap (Set Production)
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith Set Production -> Set Production -> Set Production
forall a. Ord a => Set a -> Set a -> Set a
Set.union IntMap (Set Production)
new_sc IntMap (Set Production)
sc) (Chart -> ActiveChart
active Chart
chart)}
        SymKS Token
tok  -> let !acc' :: t
acc' = [Token] -> Active -> t -> t
ftok_ [Token
tok] (FId -> FId -> FId -> FId -> [PArg] -> ActiveKey -> Active
Active FId
j (FId
pposFId -> FId -> FId
forall a. Num a => a -> a -> a
+FId
1) FId
funid FId
seqid [PArg]
args ActiveKey
key0) t
acc
                      in (FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
flit Map Token Continuation -> t -> t
ftok Concr
cnc [Active]
items t
acc' Chart
chart
        Symbol
SymNE      -> (FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
flit Map Token Continuation -> t -> t
ftok Concr
cnc [Active]
items t
acc Chart
chart
        Symbol
SymBIND    -> let !acc' :: t
acc' = [Token] -> Active -> t -> t
ftok_ [Token
"&+"] (FId -> FId -> FId -> FId -> [PArg] -> ActiveKey -> Active
Active FId
j (FId
pposFId -> FId -> FId
forall a. Num a => a -> a -> a
+FId
1) FId
funid FId
seqid [PArg]
args ActiveKey
key0) t
acc
                      in (FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
flit Map Token Continuation -> t -> t
ftok Concr
cnc [Active]
items t
acc' Chart
chart
        Symbol
SymSOFT_BIND->(FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
flit Map Token Continuation -> t -> t
ftok Concr
cnc ((FId -> FId -> FId -> FId -> [PArg] -> ActiveKey -> Active
Active FId
j (FId
pposFId -> FId -> FId
forall a. Num a => a -> a -> a
+FId
1) FId
funid FId
seqid [PArg]
args ActiveKey
key0)Active -> [Active] -> [Active]
forall a. a -> [a] -> [a]
:[Active]
items) t
acc Chart
chart
        Symbol
SymSOFT_SPACE->(FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
flit Map Token Continuation -> t -> t
ftok Concr
cnc ((FId -> FId -> FId -> FId -> [PArg] -> ActiveKey -> Active
Active FId
j (FId
pposFId -> FId -> FId
forall a. Num a => a -> a -> a
+FId
1) FId
funid FId
seqid [PArg]
args ActiveKey
key0)Active -> [Active] -> [Active]
forall a. a -> [a] -> [a]
:[Active]
items) t
acc Chart
chart
        Symbol
SymCAPIT   -> let !acc' :: t
acc' = [Token] -> Active -> t -> t
ftok_ [Token
"&|"] (FId -> FId -> FId -> FId -> [PArg] -> ActiveKey -> Active
Active FId
j (FId
pposFId -> FId -> FId
forall a. Num a => a -> a -> a
+FId
1) FId
funid FId
seqid [PArg]
args ActiveKey
key0) t
acc
                      in (FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
flit Map Token Continuation -> t -> t
ftok Concr
cnc [Active]
items t
acc' Chart
chart
        Symbol
SymALL_CAPIT->let !acc' :: t
acc' = [Token] -> Active -> t -> t
ftok_ [Token
"&|"] (FId -> FId -> FId -> FId -> [PArg] -> ActiveKey -> Active
Active FId
j (FId
pposFId -> FId -> FId
forall a. Num a => a -> a -> a
+FId
1) FId
funid FId
seqid [PArg]
args ActiveKey
key0) t
acc
                      in (FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
flit Map Token Continuation -> t -> t
ftok Concr
cnc [Active]
items t
acc' Chart
chart
        SymKP [Symbol]
syms [([Symbol], [Token])]
vars
                   -> let to_tok :: Symbol -> [Token]
to_tok (SymKS Token
t)    = [Token
t]
                          to_tok Symbol
SymBIND      = [Token
"&+"]
                          to_tok Symbol
SymSOFT_BIND = []
                          to_tok Symbol
SymSOFT_SPACE= []
                          to_tok Symbol
SymCAPIT     = [Token
"&|"]
                          to_tok Symbol
SymALL_CAPIT = [Token
"&|"]
                          to_tok Symbol
_            = []

                          !acc' :: t
acc' = (t -> [Symbol] -> t) -> t -> [[Symbol]] -> t
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\t
acc [Symbol]
syms -> [Token] -> Active -> t -> t
ftok_ ((Symbol -> [Token]) -> [Symbol] -> [Token]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Symbol -> [Token]
to_tok [Symbol]
syms) (FId -> FId -> FId -> FId -> [PArg] -> ActiveKey -> Active
Active FId
j (FId
pposFId -> FId -> FId
forall a. Num a => a -> a -> a
+FId
1) FId
funid FId
seqid [PArg]
args ActiveKey
key0) t
acc) t
acc
                                        ([Symbol]
syms[Symbol] -> [[Symbol]] -> [[Symbol]]
forall a. a -> [a] -> [a]
:[[Symbol]
syms' | ([Symbol]
syms',[Token]
_) <- [([Symbol], [Token])]
vars])
                      in (FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
flit Map Token Continuation -> t -> t
ftok Concr
cnc [Active]
items t
acc' Chart
chart
        SymLit FId
d FId
r -> let PArg [(FId, FId)]
hypos FId
fid = [PArg]
args [PArg] -> FId -> PArg
forall a. [a] -> FId -> a
!! FId
d
                          key :: ActiveKey
key   = FId -> FId -> ActiveKey
AK FId
fid FId
r
                          !fid' :: FId
fid' = case PassiveKey -> PassiveChart -> Maybe FId
lookupPC (ActiveKey -> FId -> PassiveKey
mkPK ActiveKey
key FId
k) (Chart -> PassiveChart
passive Chart
chart) of
                                    Maybe FId
Nothing  -> FId
fid
                                    Just FId
fid -> FId
fid

                      in case [[Token]
ts | PConst CId
_ Tree
_ [Token]
ts <- [Production]
-> (Set Production -> [Production])
-> Maybe (Set Production)
-> [Production]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Set Production -> [Production]
forall a. Set a -> [a]
Set.toList (FId -> IntMap (Set Production) -> Maybe (Set Production)
forall a. FId -> IntMap a -> Maybe a
IntMap.lookup FId
fid' (Chart -> IntMap (Set Production)
forest Chart
chart))] of
                           ([Token]
toks:[[Token]]
_) -> let !acc' :: t
acc' = [Token] -> Active -> t -> t
ftok_ [Token]
toks (FId -> FId -> FId -> FId -> [PArg] -> ActiveKey -> Active
Active FId
j (FId
pposFId -> FId -> FId
forall a. Num a => a -> a -> a
+FId
1) FId
funid FId
seqid (FId -> PArg -> [PArg] -> [PArg]
forall a. FId -> a -> [a] -> [a]
updateAt FId
d ([(FId, FId)] -> FId -> PArg
PArg [(FId, FId)]
hypos FId
fid') [PArg]
args) ActiveKey
key0) t
acc
                                       in (FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
flit Map Token Continuation -> t -> t
ftok Concr
cnc [Active]
items t
acc' Chart
chart
                           []       -> case FId -> Maybe (CId, Tree, [Token])
flit FId
fid of
                                         Just (CId
cat,Tree
lit,[Token]
toks) 
                                                     -> let fid' :: FId
fid'  = Chart -> FId
nextId Chart
chart
                                                            !acc' :: t
acc' = [Token] -> Active -> t -> t
ftok_ [Token]
toks (FId -> FId -> FId -> FId -> [PArg] -> ActiveKey -> Active
Active FId
j (FId
pposFId -> FId -> FId
forall a. Num a => a -> a -> a
+FId
1) FId
funid FId
seqid (FId -> PArg -> [PArg] -> [PArg]
forall a. FId -> a -> [a] -> [a]
updateAt FId
d ([(FId, FId)] -> FId -> PArg
PArg [(FId, FId)]
hypos FId
fid') [PArg]
args) ActiveKey
key0) t
acc
                                                        in (FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
flit Map Token Continuation -> t -> t
ftok Concr
cnc [Active]
items t
acc' Chart
chart{passive :: PassiveChart
passive=PassiveKey -> FId -> PassiveChart -> PassiveChart
insertPC (ActiveKey -> FId -> PassiveKey
mkPK ActiveKey
key FId
k) FId
fid' (Chart -> PassiveChart
passive Chart
chart)
                                                                                                 ,forest :: IntMap (Set Production)
forest =FId
-> Set Production
-> IntMap (Set Production)
-> IntMap (Set Production)
forall a. FId -> a -> IntMap a -> IntMap a
IntMap.insert FId
fid' (Production -> Set Production
forall a. a -> Set a
Set.singleton (CId -> Tree -> [Token] -> Production
PConst CId
cat Tree
lit [Token]
toks)) (Chart -> IntMap (Set Production)
forest Chart
chart)
                                                                                                 ,nextId :: FId
nextId =Chart -> FId
nextId Chart
chartFId -> FId -> FId
forall a. Num a => a -> a -> a
+FId
1
                                                                                                 }
                                         Maybe (CId, Tree, [Token])
Nothing     -> (FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
flit Map Token Continuation -> t -> t
ftok Concr
cnc [Active]
items t
acc Chart
chart
        SymVar FId
d FId
r -> let PArg [(FId, FId)]
hypos FId
fid0 = [PArg]
args [PArg] -> FId -> PArg
forall a. [a] -> FId -> a
!! FId
d
                          (FId
fid1,FId
fid2)     = [(FId, FId)]
hypos [(FId, FId)] -> FId -> (FId, FId)
forall a. [a] -> FId -> a
!! FId
r
                          key :: ActiveKey
key   = FId -> FId -> ActiveKey
AK FId
fid1 FId
0
                          !fid' :: FId
fid' = case PassiveKey -> PassiveChart -> Maybe FId
lookupPC (ActiveKey -> FId -> PassiveKey
mkPK ActiveKey
key FId
k) (Chart -> PassiveChart
passive Chart
chart) of
                                    Maybe FId
Nothing  -> FId
fid1
                                    Just FId
fid -> FId
fid

                      in case [[Token]
ts | PConst CId
_ Tree
_ [Token]
ts <- [Production]
-> (Set Production -> [Production])
-> Maybe (Set Production)
-> [Production]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Set Production -> [Production]
forall a. Set a -> [a]
Set.toList (FId -> IntMap (Set Production) -> Maybe (Set Production)
forall a. FId -> IntMap a -> Maybe a
IntMap.lookup FId
fid' (Chart -> IntMap (Set Production)
forest Chart
chart))] of
                           ([Token]
toks:[[Token]]
_) -> let !acc' :: t
acc' = [Token] -> Active -> t -> t
ftok_ [Token]
toks (FId -> FId -> FId -> FId -> [PArg] -> ActiveKey -> Active
Active FId
j (FId
pposFId -> FId -> FId
forall a. Num a => a -> a -> a
+FId
1) FId
funid FId
seqid (FId -> PArg -> [PArg] -> [PArg]
forall a. FId -> a -> [a] -> [a]
updateAt FId
d ([(FId, FId)] -> FId -> PArg
PArg (FId -> (FId, FId) -> [(FId, FId)] -> [(FId, FId)]
forall a. FId -> a -> [a] -> [a]
updateAt FId
r (FId
fid',FId
fid2) [(FId, FId)]
hypos) FId
fid0) [PArg]
args) ActiveKey
key0) t
acc
                                       in (FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
flit Map Token Continuation -> t -> t
ftok Concr
cnc [Active]
items t
acc' Chart
chart
                           []       -> case FId -> Maybe (CId, Tree, [Token])
flit FId
fid1 of
                                         Just (CId
cat,Tree
lit,[Token]
toks) 
                                                 -> let fid' :: FId
fid'  = Chart -> FId
nextId Chart
chart
                                                        !acc' :: t
acc' = [Token] -> Active -> t -> t
ftok_ [Token]
toks (FId -> FId -> FId -> FId -> [PArg] -> ActiveKey -> Active
Active FId
j (FId
pposFId -> FId -> FId
forall a. Num a => a -> a -> a
+FId
1) FId
funid FId
seqid (FId -> PArg -> [PArg] -> [PArg]
forall a. FId -> a -> [a] -> [a]
updateAt FId
d ([(FId, FId)] -> FId -> PArg
PArg (FId -> (FId, FId) -> [(FId, FId)] -> [(FId, FId)]
forall a. FId -> a -> [a] -> [a]
updateAt FId
r (FId
fid',FId
fid2) [(FId, FId)]
hypos) FId
fid0) [PArg]
args) ActiveKey
key0) t
acc
                                                    in (FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
flit Map Token Continuation -> t -> t
ftok Concr
cnc [Active]
items t
acc' Chart
chart{passive :: PassiveChart
passive=PassiveKey -> FId -> PassiveChart -> PassiveChart
insertPC (ActiveKey -> FId -> PassiveKey
mkPK ActiveKey
key FId
k) FId
fid' (Chart -> PassiveChart
passive Chart
chart)
                                                                                             ,forest :: IntMap (Set Production)
forest =FId
-> Set Production
-> IntMap (Set Production)
-> IntMap (Set Production)
forall a. FId -> a -> IntMap a -> IntMap a
IntMap.insert FId
fid' (Production -> Set Production
forall a. a -> Set a
Set.singleton (CId -> Tree -> [Token] -> Production
PConst CId
cat Tree
lit [Token]
toks)) (Chart -> IntMap (Set Production)
forest Chart
chart)
                                                                                             ,nextId :: FId
nextId =Chart -> FId
nextId Chart
chartFId -> FId -> FId
forall a. Num a => a -> a -> a
+FId
1
                                                                                             }
                                         Maybe (CId, Tree, [Token])
Nothing -> (FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
flit Map Token Continuation -> t -> t
ftok Concr
cnc [Active]
items t
acc Chart
chart
  | Bool
otherwise =
      case PassiveKey -> PassiveChart -> Maybe FId
lookupPC (ActiveKey -> FId -> PassiveKey
mkPK ActiveKey
key0 FId
j) (Chart -> PassiveChart
passive Chart
chart) of
        Maybe FId
Nothing -> let fid :: FId
fid = Chart -> FId
nextId Chart
chart
                       
                       items2 :: [Active]
items2 = case ActiveKey
-> ActiveChart -> Maybe (Set Active, IntMap (Set Production))
lookupAC ActiveKey
key0 ((Chart -> ActiveChart
active Chart
chartActiveChart -> [ActiveChart] -> [ActiveChart]
forall a. a -> [a] -> [a]
:Chart -> [ActiveChart]
actives Chart
chart) [ActiveChart] -> FId -> ActiveChart
forall a. [a] -> FId -> a
!! (FId
kFId -> FId -> FId
forall a. Num a => a -> a -> a
-FId
j)) of
                                  Maybe (Set Active, IntMap (Set Production))
Nothing       -> [Active]
items
                                  Just (Set Active
set,IntMap (Set Production)
sc) -> (Active -> [Active] -> [Active])
-> [Active] -> Set Active -> [Active]
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr (\(Active FId
j' FId
ppos FId
funid FId
seqid [PArg]
args ActiveKey
keyc) -> 
                                                                let SymCat FId
d FId
_ = Array FId Symbol -> FId -> Symbol
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> FId -> e
unsafeAt (Array FId (Array FId Symbol) -> FId -> Array FId Symbol
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> FId -> e
unsafeAt (Concr -> Array FId (Array FId Symbol)
sequences Concr
cnc) FId
seqid) FId
ppos
                                                                    PArg [(FId, FId)]
hypos FId
_ = [PArg]
args [PArg] -> FId -> PArg
forall a. [a] -> FId -> a
!! FId
d
                                                                in (:) (FId -> FId -> FId -> FId -> [PArg] -> ActiveKey -> Active
Active FId
j' (FId
pposFId -> FId -> FId
forall a. Num a => a -> a -> a
+FId
1) FId
funid FId
seqid (FId -> PArg -> [PArg] -> [PArg]
forall a. FId -> a -> [a] -> [a]
updateAt FId
d ([(FId, FId)] -> FId -> PArg
PArg [(FId, FId)]
hypos FId
fid) [PArg]
args) ActiveKey
keyc)) [Active]
items Set Active
set
                   in (FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
flit Map Token Continuation -> t -> t
ftok Concr
cnc [Active]
items2 t
acc Chart
chart{passive :: PassiveChart
passive=PassiveKey -> FId -> PassiveChart -> PassiveChart
insertPC (ActiveKey -> FId -> PassiveKey
mkPK ActiveKey
key0 FId
j) FId
fid (Chart -> PassiveChart
passive Chart
chart)
                                                            ,forest :: IntMap (Set Production)
forest =FId
-> Set Production
-> IntMap (Set Production)
-> IntMap (Set Production)
forall a. FId -> a -> IntMap a -> IntMap a
IntMap.insert FId
fid (Production -> Set Production
forall a. a -> Set a
Set.singleton (FId -> [PArg] -> Production
PApply FId
funid [PArg]
args)) (Chart -> IntMap (Set Production)
forest Chart
chart)
                                                            ,nextId :: FId
nextId =Chart -> FId
nextId Chart
chartFId -> FId -> FId
forall a. Num a => a -> a -> a
+FId
1
                                                            }
        Just FId
id -> let items2 :: [Active]
items2 = [FId -> FId -> FId -> FId -> [PArg] -> ActiveKey -> Active
Active FId
k FId
0 FId
funid (FId -> FId -> FId
rhs FId
funid FId
r) [PArg]
args (FId -> FId -> ActiveKey
AK FId
id FId
r) | FId
r <- FId -> ActiveChart -> [FId]
labelsAC FId
id (Chart -> ActiveChart
active Chart
chart)] [Active] -> [Active] -> [Active]
forall a. [a] -> [a] -> [a]
++ [Active]
items
                   in (FId -> Maybe (CId, Tree, [Token]))
-> (Map Token Continuation -> t -> t)
-> Concr
-> [Active]
-> t
-> Chart
-> (t, Chart)
process FId -> Maybe (CId, Tree, [Token])
flit Map Token Continuation -> t -> t
ftok Concr
cnc [Active]
items2 t
acc Chart
chart{forest :: IntMap (Set Production)
forest = (Set Production -> Set Production -> Set Production)
-> FId
-> Set Production
-> IntMap (Set Production)
-> IntMap (Set Production)
forall a. (a -> a -> a) -> FId -> a -> IntMap a -> IntMap a
IntMap.insertWith Set Production -> Set Production -> Set Production
forall a. Ord a => Set a -> Set a -> Set a
Set.union FId
id (Production -> Set Production
forall a. a -> Set a
Set.singleton (FId -> [PArg] -> Production
PApply FId
funid [PArg]
args)) (Chart -> IntMap (Set Production)
forest Chart
chart)}
  where
    !lin :: Array FId Symbol
lin = Array FId (Array FId Symbol) -> FId -> Array FId Symbol
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> FId -> e
unsafeAt (Concr -> Array FId (Array FId Symbol)
sequences Concr
cnc) FId
seqid
    !k :: FId
k   = Chart -> FId
offset Chart
chart

    mkPK :: ActiveKey -> FId -> PassiveKey
mkPK (AK FId
fid FId
lbl) FId
j = FId -> FId -> FId -> PassiveKey
PK FId
fid FId
lbl FId
j
    
    rhs :: FId -> FId -> FId
rhs FId
funid FId
lbl = UArray FId FId -> FId -> FId
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> FId -> e
unsafeAt UArray FId FId
lins FId
lbl
      where
        CncFun CId
_ UArray FId FId
lins = Array FId CncFun -> FId -> CncFun
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> FId -> e
unsafeAt (Concr -> Array FId CncFun
cncfuns Concr
cnc) FId
funid

    uu :: IntMap (Set Production) -> (FId, FId) -> IntMap (Set Production)
uu IntMap (Set Production)
forest (FId
fid1,FId
fid2) =
      case FId -> IntMap [FId] -> Maybe [FId]
forall a. FId -> IntMap a -> Maybe a
IntMap.lookup FId
fid2 (Concr -> IntMap [FId]
lindefs Concr
cnc) of
        Just [FId]
funs -> (IntMap (Set Production) -> FId -> IntMap (Set Production))
-> IntMap (Set Production) -> [FId] -> IntMap (Set Production)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\IntMap (Set Production)
forest FId
funid -> (Set Production -> Set Production -> Set Production)
-> FId
-> Set Production
-> IntMap (Set Production)
-> IntMap (Set Production)
forall a. (a -> a -> a) -> FId -> a -> IntMap a -> IntMap a
IntMap.insertWith Set Production -> Set Production -> Set Production
forall a. Ord a => Set a -> Set a -> Set a
Set.union FId
fid2 (Production -> Set Production
forall a. a -> Set a
Set.singleton (FId -> [PArg] -> Production
PApply FId
funid [[(FId, FId)] -> FId -> PArg
PArg [] FId
fid1])) IntMap (Set Production)
forest) IntMap (Set Production)
forest [FId]
funs
        Maybe [FId]
Nothing   -> IntMap (Set Production)
forest
        
    ftok_ :: [Token] -> Active -> t -> t
ftok_ [] Active
item t
cnt         = Map Token Continuation -> t -> t
ftok Map Token Continuation
forall k a. Map k a
Map.empty t
cnt
    ftok_ (Token
tok:[Token]
toks) Active
item t
cnt =
      Map Token Continuation -> t -> t
ftok (Token -> Continuation -> Map Token Continuation
forall k a. k -> a -> Map k a
Map.singleton Token
tok ([Token] -> Set Active -> Continuation
forall k a. [k] -> a -> TrieMap k a
TrieMap.singleton [Token]
toks (Active -> Set Active
forall a. a -> Set a
Set.singleton Active
item))) t
cnt

    predict :: p
-> (Map Token Continuation -> a -> a)
-> Concr
-> IntMap (Set Production)
-> ActiveKey
-> ActiveKey
-> FId
-> a
-> [Active]
-> (a, [Active])
predict p
flit Map Token Continuation -> a -> a
ftok Concr
cnc IntMap (Set Production)
forest ActiveKey
key0 key :: ActiveKey
key@(AK FId
fid FId
lbl) FId
k a
acc [Active]
items =
      let (a
acc1,[Active]
items1) = case FId -> IntMap (Set Production) -> Maybe (Set Production)
forall a. FId -> IntMap a -> Maybe a
IntMap.lookup FId
fid IntMap (Set Production)
forest of
                            Maybe (Set Production)
Nothing  -> (a
acc,[Active]
items)
                            Just Set Production
set -> (Production -> (a, [Active]) -> (a, [Active]))
-> (a, [Active]) -> Set Production -> (a, [Active])
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr Production -> (a, [Active]) -> (a, [Active])
foldProd (a
acc,[Active]
items) Set Production
set

          (a
acc2,[Active]
items2) = case FId
-> IntMap (IntMap (TrieMap Token IntSet))
-> Maybe (IntMap (TrieMap Token IntSet))
forall a. FId -> IntMap a -> Maybe a
IntMap.lookup FId
fid (Concr -> IntMap (IntMap (TrieMap Token IntSet))
lexicon Concr
cnc) Maybe (IntMap (TrieMap Token IntSet))
-> (IntMap (TrieMap Token IntSet) -> Maybe (TrieMap Token IntSet))
-> Maybe (TrieMap Token IntSet)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FId
-> IntMap (TrieMap Token IntSet) -> Maybe (TrieMap Token IntSet)
forall a. FId -> IntMap a -> Maybe a
IntMap.lookup FId
lbl of
                            Just TrieMap Token IntSet
tmap -> let (Maybe (Set Active)
mb_v,Map Token Continuation
toks) = Continuation -> (Maybe (Set Active), Map Token Continuation)
forall k v. TrieMap k v -> (Maybe v, Map k (TrieMap k v))
TrieMap.decompose ((IntSet -> Set Active) -> TrieMap Token IntSet -> Continuation
forall a b k. (a -> b) -> TrieMap k a -> TrieMap k b
TrieMap.map (ActiveKey -> FId -> IntSet -> Set Active
toItems ActiveKey
key0 FId
k) TrieMap Token IntSet
tmap)
                                             acc1' :: a
acc1'   = Map Token Continuation -> a -> a
ftok Map Token Continuation
toks a
acc1
                                             items1' :: [Active]
items1' = [Active]
-> (Set Active -> [Active]) -> Maybe (Set Active) -> [Active]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Set Active -> [Active]
forall a. Set a -> [a]
Set.toList Maybe (Set Active)
mb_v [Active] -> [Active] -> [Active]
forall a. [a] -> [a] -> [a]
++ [Active]
items1
                                         in (a
acc1',[Active]
items1')
                            Maybe (TrieMap Token IntSet)
Nothing   -> (a
acc1,[Active]
items1)
      in (a
acc2,[Active]
items2)
      where
        foldProd :: Production -> (a, [Active]) -> (a, [Active])
foldProd (PCoerce FId
fid)         (a
acc,[Active]
items) = p
-> (Map Token Continuation -> a -> a)
-> Concr
-> IntMap (Set Production)
-> ActiveKey
-> ActiveKey
-> FId
-> a
-> [Active]
-> (a, [Active])
predict p
flit Map Token Continuation -> a -> a
ftok Concr
cnc IntMap (Set Production)
forest ActiveKey
key0 (FId -> FId -> ActiveKey
AK FId
fid FId
lbl) FId
k a
acc [Active]
items
        foldProd (PApply FId
funid [PArg]
args)   (a
acc,[Active]
items) = (a
acc,FId -> FId -> FId -> FId -> [PArg] -> ActiveKey -> Active
Active FId
k FId
0 FId
funid (FId -> FId -> FId
rhs FId
funid FId
lbl) [PArg]
args ActiveKey
key0 Active -> [Active] -> [Active]
forall a. a -> [a] -> [a]
: [Active]
items)
        foldProd (PConst CId
_ Tree
const [Token]
toks) (a
acc,[Active]
items) = (a
acc,[Active]
items)

        toItems :: ActiveKey -> FId -> IntSet -> Set Active
toItems key :: ActiveKey
key@(AK FId
fid FId
lbl) FId
k IntSet
funids =
          [Active] -> Set Active
forall a. Ord a => [a] -> Set a
Set.fromList [FId -> FId -> FId -> FId -> [PArg] -> ActiveKey -> Active
Active FId
k FId
1 FId
funid (FId -> FId -> FId
rhs FId
funid FId
lbl) [] ActiveKey
key | FId
funid <- IntSet -> [FId]
IntSet.toList IntSet
funids]


updateAt :: Int -> a -> [a] -> [a]
updateAt :: FId -> a -> [a] -> [a]
updateAt FId
nr a
x [a]
xs = [if FId
i FId -> FId -> Bool
forall a. Eq a => a -> a -> Bool
== FId
nr then a
x else a
y | (FId
i,a
y) <- [FId] -> [a] -> [(FId, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FId
0..] [a]
xs]

----------------------------------------------------------------

-- Active Chart

----------------------------------------------------------------


data Active
  = Active {-# UNPACK #-} !Int
           {-# UNPACK #-} !DotPos
           {-# UNPACK #-} !FunId
           {-# UNPACK #-} !SeqId
                          [PArg]
           {-# UNPACK #-} !ActiveKey
  deriving (Active -> Active -> Bool
(Active -> Active -> Bool)
-> (Active -> Active -> Bool) -> Eq Active
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Active -> Active -> Bool
$c/= :: Active -> Active -> Bool
== :: Active -> Active -> Bool
$c== :: Active -> Active -> Bool
Eq,FId -> Active -> ShowS
[Active] -> ShowS
Active -> Token
(FId -> Active -> ShowS)
-> (Active -> Token) -> ([Active] -> ShowS) -> Show Active
forall a.
(FId -> a -> ShowS) -> (a -> Token) -> ([a] -> ShowS) -> Show a
showList :: [Active] -> ShowS
$cshowList :: [Active] -> ShowS
show :: Active -> Token
$cshow :: Active -> Token
showsPrec :: FId -> Active -> ShowS
$cshowsPrec :: FId -> Active -> ShowS
Show,Eq Active
Eq Active
-> (Active -> Active -> Ordering)
-> (Active -> Active -> Bool)
-> (Active -> Active -> Bool)
-> (Active -> Active -> Bool)
-> (Active -> Active -> Bool)
-> (Active -> Active -> Active)
-> (Active -> Active -> Active)
-> Ord Active
Active -> Active -> Bool
Active -> Active -> Ordering
Active -> Active -> Active
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Active -> Active -> Active
$cmin :: Active -> Active -> Active
max :: Active -> Active -> Active
$cmax :: Active -> Active -> Active
>= :: Active -> Active -> Bool
$c>= :: Active -> Active -> Bool
> :: Active -> Active -> Bool
$c> :: Active -> Active -> Bool
<= :: Active -> Active -> Bool
$c<= :: Active -> Active -> Bool
< :: Active -> Active -> Bool
$c< :: Active -> Active -> Bool
compare :: Active -> Active -> Ordering
$ccompare :: Active -> Active -> Ordering
$cp1Ord :: Eq Active
Ord)
data ActiveKey
  = AK {-# UNPACK #-} !FId
       {-# UNPACK #-} !LIndex
  deriving (ActiveKey -> ActiveKey -> Bool
(ActiveKey -> ActiveKey -> Bool)
-> (ActiveKey -> ActiveKey -> Bool) -> Eq ActiveKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActiveKey -> ActiveKey -> Bool
$c/= :: ActiveKey -> ActiveKey -> Bool
== :: ActiveKey -> ActiveKey -> Bool
$c== :: ActiveKey -> ActiveKey -> Bool
Eq,Eq ActiveKey
Eq ActiveKey
-> (ActiveKey -> ActiveKey -> Ordering)
-> (ActiveKey -> ActiveKey -> Bool)
-> (ActiveKey -> ActiveKey -> Bool)
-> (ActiveKey -> ActiveKey -> Bool)
-> (ActiveKey -> ActiveKey -> Bool)
-> (ActiveKey -> ActiveKey -> ActiveKey)
-> (ActiveKey -> ActiveKey -> ActiveKey)
-> Ord ActiveKey
ActiveKey -> ActiveKey -> Bool
ActiveKey -> ActiveKey -> Ordering
ActiveKey -> ActiveKey -> ActiveKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ActiveKey -> ActiveKey -> ActiveKey
$cmin :: ActiveKey -> ActiveKey -> ActiveKey
max :: ActiveKey -> ActiveKey -> ActiveKey
$cmax :: ActiveKey -> ActiveKey -> ActiveKey
>= :: ActiveKey -> ActiveKey -> Bool
$c>= :: ActiveKey -> ActiveKey -> Bool
> :: ActiveKey -> ActiveKey -> Bool
$c> :: ActiveKey -> ActiveKey -> Bool
<= :: ActiveKey -> ActiveKey -> Bool
$c<= :: ActiveKey -> ActiveKey -> Bool
< :: ActiveKey -> ActiveKey -> Bool
$c< :: ActiveKey -> ActiveKey -> Bool
compare :: ActiveKey -> ActiveKey -> Ordering
$ccompare :: ActiveKey -> ActiveKey -> Ordering
$cp1Ord :: Eq ActiveKey
Ord,FId -> ActiveKey -> ShowS
[ActiveKey] -> ShowS
ActiveKey -> Token
(FId -> ActiveKey -> ShowS)
-> (ActiveKey -> Token) -> ([ActiveKey] -> ShowS) -> Show ActiveKey
forall a.
(FId -> a -> ShowS) -> (a -> Token) -> ([a] -> ShowS) -> Show a
showList :: [ActiveKey] -> ShowS
$cshowList :: [ActiveKey] -> ShowS
show :: ActiveKey -> Token
$cshow :: ActiveKey -> Token
showsPrec :: FId -> ActiveKey -> ShowS
$cshowsPrec :: FId -> ActiveKey -> ShowS
Show)
type ActiveSet   = Set.Set Active
type ActiveChart = IntMap.IntMap (IntMap.IntMap (ActiveSet, IntMap.IntMap (Set.Set Production)))

emptyAC :: ActiveChart
emptyAC :: ActiveChart
emptyAC = ActiveChart
forall a. IntMap a
IntMap.empty

lookupAC :: ActiveKey -> ActiveChart -> Maybe (ActiveSet, IntMap.IntMap (Set.Set Production))
lookupAC :: ActiveKey
-> ActiveChart -> Maybe (Set Active, IntMap (Set Production))
lookupAC (AK FId
fid FId
lbl) ActiveChart
chart = FId
-> ActiveChart
-> Maybe (IntMap (Set Active, IntMap (Set Production)))
forall a. FId -> IntMap a -> Maybe a
IntMap.lookup FId
fid ActiveChart
chart Maybe (IntMap (Set Active, IntMap (Set Production)))
-> (IntMap (Set Active, IntMap (Set Production))
    -> Maybe (Set Active, IntMap (Set Production)))
-> Maybe (Set Active, IntMap (Set Production))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FId
-> IntMap (Set Active, IntMap (Set Production))
-> Maybe (Set Active, IntMap (Set Production))
forall a. FId -> IntMap a -> Maybe a
IntMap.lookup FId
lbl

lookupACByFCat :: FId -> ActiveChart -> [(ActiveSet, IntMap.IntMap (Set.Set Production))]
lookupACByFCat :: FId -> ActiveChart -> [(Set Active, IntMap (Set Production))]
lookupACByFCat FId
fcat ActiveChart
chart =
  case FId
-> ActiveChart
-> Maybe (IntMap (Set Active, IntMap (Set Production)))
forall a. FId -> IntMap a -> Maybe a
IntMap.lookup FId
fcat ActiveChart
chart of
    Maybe (IntMap (Set Active, IntMap (Set Production)))
Nothing  -> []
    Just IntMap (Set Active, IntMap (Set Production))
map -> IntMap (Set Active, IntMap (Set Production))
-> [(Set Active, IntMap (Set Production))]
forall a. IntMap a -> [a]
IntMap.elems IntMap (Set Active, IntMap (Set Production))
map

labelsAC :: FId -> ActiveChart -> [LIndex]
labelsAC :: FId -> ActiveChart -> [FId]
labelsAC FId
fcat ActiveChart
chart = 
  case FId
-> ActiveChart
-> Maybe (IntMap (Set Active, IntMap (Set Production)))
forall a. FId -> IntMap a -> Maybe a
IntMap.lookup FId
fcat ActiveChart
chart of
    Maybe (IntMap (Set Active, IntMap (Set Production)))
Nothing  -> []
    Just IntMap (Set Active, IntMap (Set Production))
map -> IntMap (Set Active, IntMap (Set Production)) -> [FId]
forall a. IntMap a -> [FId]
IntMap.keys IntMap (Set Active, IntMap (Set Production))
map

insertAC :: ActiveKey -> (ActiveSet, IntMap.IntMap (Set.Set Production)) -> ActiveChart -> ActiveChart
insertAC :: ActiveKey
-> (Set Active, IntMap (Set Production))
-> ActiveChart
-> ActiveChart
insertAC (AK FId
fcat FId
l) (Set Active, IntMap (Set Production))
set ActiveChart
chart = (IntMap (Set Active, IntMap (Set Production))
 -> IntMap (Set Active, IntMap (Set Production))
 -> IntMap (Set Active, IntMap (Set Production)))
-> FId
-> IntMap (Set Active, IntMap (Set Production))
-> ActiveChart
-> ActiveChart
forall a. (a -> a -> a) -> FId -> a -> IntMap a -> IntMap a
IntMap.insertWith IntMap (Set Active, IntMap (Set Production))
-> IntMap (Set Active, IntMap (Set Production))
-> IntMap (Set Active, IntMap (Set Production))
forall a. IntMap a -> IntMap a -> IntMap a
IntMap.union FId
fcat (FId
-> (Set Active, IntMap (Set Production))
-> IntMap (Set Active, IntMap (Set Production))
forall a. FId -> a -> IntMap a
IntMap.singleton FId
l (Set Active, IntMap (Set Production))
set) ActiveChart
chart


----------------------------------------------------------------

-- Passive Chart

----------------------------------------------------------------


data PassiveKey
  = PK {-# UNPACK #-} !FId
       {-# UNPACK #-} !LIndex
       {-# UNPACK #-} !Int
  deriving (PassiveKey -> PassiveKey -> Bool
(PassiveKey -> PassiveKey -> Bool)
-> (PassiveKey -> PassiveKey -> Bool) -> Eq PassiveKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PassiveKey -> PassiveKey -> Bool
$c/= :: PassiveKey -> PassiveKey -> Bool
== :: PassiveKey -> PassiveKey -> Bool
$c== :: PassiveKey -> PassiveKey -> Bool
Eq,Eq PassiveKey
Eq PassiveKey
-> (PassiveKey -> PassiveKey -> Ordering)
-> (PassiveKey -> PassiveKey -> Bool)
-> (PassiveKey -> PassiveKey -> Bool)
-> (PassiveKey -> PassiveKey -> Bool)
-> (PassiveKey -> PassiveKey -> Bool)
-> (PassiveKey -> PassiveKey -> PassiveKey)
-> (PassiveKey -> PassiveKey -> PassiveKey)
-> Ord PassiveKey
PassiveKey -> PassiveKey -> Bool
PassiveKey -> PassiveKey -> Ordering
PassiveKey -> PassiveKey -> PassiveKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PassiveKey -> PassiveKey -> PassiveKey
$cmin :: PassiveKey -> PassiveKey -> PassiveKey
max :: PassiveKey -> PassiveKey -> PassiveKey
$cmax :: PassiveKey -> PassiveKey -> PassiveKey
>= :: PassiveKey -> PassiveKey -> Bool
$c>= :: PassiveKey -> PassiveKey -> Bool
> :: PassiveKey -> PassiveKey -> Bool
$c> :: PassiveKey -> PassiveKey -> Bool
<= :: PassiveKey -> PassiveKey -> Bool
$c<= :: PassiveKey -> PassiveKey -> Bool
< :: PassiveKey -> PassiveKey -> Bool
$c< :: PassiveKey -> PassiveKey -> Bool
compare :: PassiveKey -> PassiveKey -> Ordering
$ccompare :: PassiveKey -> PassiveKey -> Ordering
$cp1Ord :: Eq PassiveKey
Ord,FId -> PassiveKey -> ShowS
[PassiveKey] -> ShowS
PassiveKey -> Token
(FId -> PassiveKey -> ShowS)
-> (PassiveKey -> Token)
-> ([PassiveKey] -> ShowS)
-> Show PassiveKey
forall a.
(FId -> a -> ShowS) -> (a -> Token) -> ([a] -> ShowS) -> Show a
showList :: [PassiveKey] -> ShowS
$cshowList :: [PassiveKey] -> ShowS
show :: PassiveKey -> Token
$cshow :: PassiveKey -> Token
showsPrec :: FId -> PassiveKey -> ShowS
$cshowsPrec :: FId -> PassiveKey -> ShowS
Show)

type PassiveChart = Map.Map PassiveKey FId 

emptyPC :: PassiveChart
emptyPC :: PassiveChart
emptyPC = PassiveChart
forall k a. Map k a
Map.empty

lookupPC :: PassiveKey -> PassiveChart -> Maybe FId
lookupPC :: PassiveKey -> PassiveChart -> Maybe FId
lookupPC PassiveKey
key PassiveChart
chart = PassiveKey -> PassiveChart -> Maybe FId
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PassiveKey
key PassiveChart
chart

insertPC :: PassiveKey -> FId -> PassiveChart -> PassiveChart
insertPC :: PassiveKey -> FId -> PassiveChart -> PassiveChart
insertPC PassiveKey
key FId
fcat PassiveChart
chart = PassiveKey -> FId -> PassiveChart -> PassiveChart
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert PassiveKey
key FId
fcat PassiveChart
chart


----------------------------------------------------------------

-- Parse State

----------------------------------------------------------------


-- | An abstract data type whose values represent

-- the current state in an incremental parser.

data ParseState = PState Abstr Concr Chart Continuation

data Chart
  = Chart
      { Chart -> ActiveChart
active  :: ActiveChart
      , Chart -> [ActiveChart]
actives :: [ActiveChart]
      , Chart -> PassiveChart
passive :: PassiveChart
      , Chart -> IntMap (Set Production)
forest  :: IntMap.IntMap (Set.Set Production)
      , Chart -> FId
nextId  :: {-# UNPACK #-} !FId
      , Chart -> FId
offset  :: {-# UNPACK #-} !Int
      }
      deriving FId -> Chart -> ShowS
[Chart] -> ShowS
Chart -> Token
(FId -> Chart -> ShowS)
-> (Chart -> Token) -> ([Chart] -> ShowS) -> Show Chart
forall a.
(FId -> a -> ShowS) -> (a -> Token) -> ([a] -> ShowS) -> Show a
showList :: [Chart] -> ShowS
$cshowList :: [Chart] -> ShowS
show :: Chart -> Token
$cshow :: Chart -> Token
showsPrec :: FId -> Chart -> ShowS
$cshowsPrec :: FId -> Chart -> ShowS
Show

type Continuation = TrieMap.TrieMap Token ActiveSet

-- | Return the Continuation of a Parsestate with exportable types

--   Used by PGFService

getContinuationInfo :: ParseState -> Map.Map [Token] [(FunId, CId, String)]
getContinuationInfo :: ParseState -> Map [Token] [(FId, CId, Token)]
getContinuationInfo ParseState
pstate = (Set Active -> [(FId, CId, Token)])
-> Map [Token] (Set Active) -> Map [Token] [(FId, CId, Token)]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((Active -> (FId, CId, Token)) -> [Active] -> [(FId, CId, Token)]
forall a b. (a -> b) -> [a] -> [b]
map Active -> (FId, CId, Token)
f ([Active] -> [(FId, CId, Token)])
-> (Set Active -> [Active]) -> Set Active -> [(FId, CId, Token)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Active -> [Active]
forall a. Set a -> [a]
Set.toList) Map [Token] (Set Active)
contMap
  where
    PState Abstr
_abstr Concr
concr Chart
_chart Continuation
cont = ParseState
pstate
    contMap :: Map [Token] (Set Active)
contMap = [([Token], Set Active)] -> Map [Token] (Set Active)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (Continuation -> [([Token], Set Active)]
forall k v. TrieMap k v -> [([k], v)]
TrieMap.toList Continuation
cont) -- always get [([], _::ActiveSet)]

    f :: Active -> (FunId,CId,String)
    f :: Active -> (FId, CId, Token)
f (Active FId
int FId
dotpos FId
funid FId
seqid [PArg]
pargs ActiveKey
ak) = (FId
funid, CId
cid, Token
seq)
      where
        CncFun CId
cid UArray FId FId
_ = Concr -> Array FId CncFun
cncfuns Concr
concr Array FId CncFun -> FId -> CncFun
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! FId
funid
        seq :: Token
seq = FId -> Array FId Symbol -> Token
showSeq FId
dotpos (Concr -> Array FId (Array FId Symbol)
sequences Concr
concr Array FId (Array FId Symbol) -> FId -> Array FId Symbol
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! FId
seqid)
        
    showSeq :: DotPos -> Sequence -> String
    showSeq :: FId -> Array FId Symbol -> Token
showSeq FId
pos Array FId Symbol
seq = Token -> [Token] -> Token
forall a. [a] -> [[a]] -> [a]
intercalate Token
" " ([Token] -> Token) -> [Token] -> Token
forall a b. (a -> b) -> a -> b
$ [Symbol] -> [Token]
scan (FId -> [Symbol] -> [Symbol]
forall a. FId -> [a] -> [a]
drop (FId
posFId -> FId -> FId
forall a. Num a => a -> a -> a
-FId
1) (Array FId Symbol -> [Symbol]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems Array FId Symbol
seq))
      where
        -- Scan left-to-right, stop at first non-token

        scan :: [Symbol] -> [String]
        scan :: [Symbol] -> [Token]
scan [] = []
        scan (Symbol
sym:[Symbol]
syms) = case Symbol
sym of
          SymKS Token
token -> Token
token Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Symbol] -> [Token]
scan [Symbol]
syms
          Symbol
_           -> []

----------------------------------------------------------------

-- Error State

----------------------------------------------------------------


-- | An abstract data type whose values represent

-- the state in an incremental parser after an error.

data ErrorState = EState Abstr Concr Chart