fungll-combinators 0.1.0.1 → 0.4.1.1

raw patch · 11 files changed

+211/−142 lines, 11 filesdep −TypeComposedep ~gllsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies removed: TypeCompose

Dependency ranges changed: gll

API changes (from Hackage documentation)

Files

• Setup.hs +0/−2
• changelog.txt +2/−70
• fungll-combinators.cabal +6/−5
• src/GLL/Combinators/Interface.hs +29/−13
• src/GLL/Combinators/Visit/FUNGLL.hs +90/−28
• src/GLL/Combinators/Visit/Join.hs +13/−4
• src/GLL/Combinators/Visit/Sem.hs +11/−5
• src/GLL/Types/BSR.hs +1/−7
• src/GLL/Types/DataSets.hs +6/−8
• src/GLL/Types/Input.hs +32/−0
• src/GLL/Types/TypeCompose.hs +21/−0

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -1,70 +1,2 @@-0.3.0.7 -> 0.3.0.8-  + export maximumPivots and maximumPivotAtNt-0.3.0.8 -> 0.3.0.9-  + include bit of the input string when showing an error message (without whitespace)-  + exporting <multiple/some/many>SepBy2-  + exporting within, parens, braces, brackets, angles, quotes and dquotes-  + added character literals to Token type-  + exporting <:=-  + <<<**> and <**>>> for shortest and longest match, respectively-    defined some/many and variants using <**>>> and <<<**>-    disambiguation remains very experimental -0.3.0.9 -> 0.3.0.10-  + exporting chooses-0.3.0.10 -> 0.3.0.11-  + parse option for disabling select test (lookahead)--0.3.0.11 -> 0.4.0.1-  + replaced parser by reduced descriptor GLL (RGLL)-  + renamed GLL.Types.Grammar to GLL.Types.Derivations-  + renamed GLL.Types.Abstract to GLL.Types.Grammar-  + exporting GLL.Types.Grammar, GLL.Types.Derivations, GLL.Combinators.Options, GLL.Combinators.Memoisation, GLL.Flags--0.4.0.1 -> 0.4.0.2-  + generalised `within`-  + different whitespace and comment handling in predefined lexer-  + predefined lexer handles (nested) comment-blocks--0.4.0.2 -> 0.4.0.3-  M added hex, octal and binary representation to integer literals-  + added float literals-  + exporting `preferably` and `reluctantly`-  M renamed `rassoc` to shortest_match-  M renamed `lassoc` to longest_match-  - removed `assoc`-  + version of `chooses` that is left-biased (w.r.t. alternatives)-  + generalised arguments of longest_match and shortest_match to IsAltExpr -  + exporting `optionalWithDef`--0.4.0.3 -> 0.4.0.4-  + `chooses` cannot be given an empty list (runtime error)-  + updated `base` dependency--0.4.0.4 -> 0.4.0.5-  + relaxed cabal version constraint--0.4.0.5 -> 0.4.0.6-  + generalised the definition of `within` combinator with respect to token type--0.4.0.6 -> 0.4.0.7-  + simplified Ridge's "parsing context" in the semantic phase--0.4.0.7 -> 0.4.0.8-  + unified usage of input in both parser and combinators, speeding up initialisation of large files-  + fixed 'noSelectTest' 'ParseOption'--0.4.0.8 -> 0.4.0.9-  + reinstated a "binarised version" of the interface -  + count number of successes in ParseResult, not just True/False--0.4.0.9 -> 0.4.0.10-  + build expression grammars from operator tables--0.4.0.10 -> 0.4.0.11-  + integer literals are now by default considered as natural numbers only, the 'signed_int_lits' flag of 'LexerSettings' can be used to turn on signed integers, restoring the behaviour of previous versions--0.4.0.11 -> 0.4.0.12-  + export 'grammarOf'-  + let 'parse' throw errors by default-  + changed priorities of operator tables to doubles -  + removed need to specify associativity of prefix operators in operator table+0.4.1.1+~ updated package and interface of GLL.ParserCombinators to 0.4.1.1 version of `gll` package

@@ -1,17 +1,17 @@+cabal-version:       3.0 -- Initial haskell-gll.cabal generated by cabal init.  For further  -- documentation, see http://haskell.org/cabal/users-guide/  -- The name of the package. name:                fungll-combinators-version:             0.1.0.1+version:             0.4.1.1  synopsis:            GLL parser with simple combinator interface -license:             BSD3+license:             BSD-3-Clause license-file:        LICENSE author:              L. Thomas van Binsbergen maintainer:          L. Thomas van Binsbergen <ltvanbinsbergen@acm.org> category:            Compilers build-type:          Simple -cabal-version:       >=1.22 tested-with:         GHC == 8.2.1 copyright:           Copyright (C) 2019 L. Thomas van Binsbergen stability:           experimental@@ -30,20 +30,21 @@     build-depends   :     base >=4.3.1.0 && <= 5                          , containers >= 0.4                         , array-                        , TypeCompose                         , pretty                         , text                         , regex-applicative >= 0.3                         , time >= 1.8-                        , gll >= 0.4.0.12+                        , gll >= 0.4.1.1     exposed-modules :     GLL.ParserCombinators                         , GLL.Types.BSR                         , GLL.Types.DataSets+                        , GLL.Types.Input      other-modules   :     GLL.Combinators.Visit.FUNGLL                         , GLL.Combinators.Visit.Sem                         , GLL.Combinators.Visit.Join                         , GLL.Combinators.Interface+                        , GLL.Types.TypeCompose     ghc-options:         -fwarn-incomplete-patterns -fwarn-monomorphism-restriction -fwarn-unused-imports     default-language:    Haskell2010     default-extensions:  TypeOperators, FlexibleInstances, ScopedTypeVariables, TypeSynonymInstances

@@ -186,9 +186,11 @@     -- *** Choice     (<||>),     -- *** Semantic actions-    (<$$>),+    (<$$>), (<$$$>),     -- *** Nonterminal introduction     (<:=>),(<::=>),chooses,chooses_prec,+    -- *** Difference+    (<\\>),     -- * Types     -- ** Grammar (combinator expression) types     BNF, SymbExpr, AltExpr, AltExprs,@@ -211,7 +213,7 @@     -- ** Builtin lexers.     default_lexer,      -- *** Lexer settings-        lexer, LexerSettings(..), emptyLanguage,+        lexer, lexerEither, LexerSettings(..), emptyLanguage,     -- * Derived combinators     mkNt,      -- *** Ignoring semantic results@@ -233,6 +235,8 @@     HasAlts(..), IsSymbExpr(..), IsAltExpr(..),      -- * Memoisation     memo, newMemoTable, memClear, MemoTable, MemoRef, useMemoisation,+     -- * Scannerless parsing, using `RawParser`s+    RawParser, lexical,     ) where  import GLL.Combinators.Options@@ -241,21 +245,17 @@ import GLL.Combinators.Visit.Sem import GLL.Combinators.Memoisation import GLL.Combinators.Lexer+import GLL.Types.Input import GLL.Types.Grammar-import GLL.Types.DataSets-import GLL.Types.BSR+import GLL.Types.TypeCompose import GLL.Flags hiding (runOptions)-import GLL.Parseable.Char+import GLL.Parseable.Char ()  import Control.Monad (when)-import Control.Compose (OO(..)) import Control.Arrow import qualified Data.Array as A-import qualified Data.IntMap as IM import qualified Data.Map as M-import qualified Data.Set as S import Data.Text (pack)-import qualified Data.Text import Data.IORef  import Data.Time.Clock import System.IO.Unsafe@@ -286,7 +286,7 @@         start       = pack "__Start"         parse_res   = parser_for start vpa2 arr         arr         = mkInput input -        (_,m)       = A.bounds arr+        m           = inputLength arr     in do startTime <- getCurrentTime           putStrLn $ "#tokens:              " ++ (show m)           putStrLn $ "#successes:           " ++ (show $ res_successes parse_res)@@ -309,7 +309,7 @@         start       = pack "__Start"         parse_res   = parser_for start vpa2 arr         arr         = mkInput input -        (_,m)       = A.bounds arr+        m           = inputLength arr     in unsafePerformIO $ do            startTime <- getCurrentTime           putStrLn $ "#tokens:              " ++ (show m)@@ -415,8 +415,16 @@ -- Form an 'AltExpr' by mapping some semantic action overy the result -- of the second argument. (<$$>) :: (Show t, Ord t, IsSymbExpr s) => (a -> b) -> s t a -> AltExpr t b-f <$$> p' = join_apply f p'+f <$$> p' = join_apply ((:[]) . f) p' +infixl 4 <$$$>+-- | +-- Variant of `<$$>` that gives access to the underlying ambiguity representation+-- The semantic action can be used to disambiguate, for example using `guard`.+(<$$$>) :: (Show t, Ord t, IsSymbExpr s, Foldable f) => (a -> f b) -> s t a -> AltExpr t b+f <$$$> p' = join_apply f p'++ infixl 4 <**>,<<<**>,<**>>> -- |  -- Add a 'SymbExpr' to the right-hand side represented by an 'AltExpr'@@ -438,6 +446,10 @@ pl' <<<**> pr' = join_seq [minimumPivot] pl' pr'  +infixr 5 <\\>+(<\\>) :: (Show t) => SymbExpr t a -> SymbExpr t b -> SymbExpr t a+p <\\> q = p `join_andNot` q+ infixr 3 <||> -- | -- Add an 'AltExpr' to a list of 'AltExpr'@@ -465,7 +477,11 @@ --  * The 'Parseable' token represented by the terminal. --  * A function from that 'Parseable' to a semantic result. term_parser :: Parseable t => t -> (t -> a) -> SymbExpr t a -term_parser t f = SymbExpr (Term t, parse_term t,\_ _ _ arr l _ -> return [f (arr A.! l)])+term_parser t f = SymbExpr (Term t, parse_term t,\_ _ _ inp l _ -> return [f (fst inp A.! l)])++-- | Create a symbol given a `RawParser` (see `GLL.Types.Input`)+lexical :: String -> RawParser t -> SymbExpr t [t]+lexical nt regex = join_lexical (pack nt) regex  -- | Parse a single character. --

@@ -4,15 +4,16 @@ import GLL.Types.Grammar import GLL.Types.BSR import GLL.Types.DataSets+import GLL.Types.Input  import qualified Data.IntMap as IM import qualified Data.Map as M import qualified Data.Set as S import qualified Data.IntSet as IS-import qualified Data.Array as A+import Data.Text (pack)  type Command t  = State t (ContF t) -> State t (ContF t)-data ContF t    = ContF (Descr t -> Command t)+data ContF t    = ContF (Input t -> Descr t -> Command t)  type Parse_Symb t   = (Symbol t, Input t -> Slot t -> Int -> Int -> ContF t -> Command t) type Parse_Choice t = Input t -> Nt -> Int -> ContF t -> Command t @@ -20,13 +21,17 @@ type Parse_Alt t    = Parse_Seq t  parser_for :: (Parseable t) => Nt -> Parse_Symb t -> Input t -> ParseResult t-parser_for x (Term t,p) inp = error "assert: terminal given to parser_for"-parser_for x (Nt s,p) inp = resultFromState inp (-  p inp (Slot x [Nt s] []) 0 0 cont0 emptyState) (s,0,0)-  where cont0 = ContF cf-          where cf (_,_,r) s | r == snd (A.bounds inp) = s { successes = successes s + 1 } -                             | otherwise = s+parser_for x p inp = resultFromState inp (run_parse x p inp 0 emptyState) +run_parse :: Nt -> Parse_Symb t -> Input t -> Int -> +                                State t (ContF t) -> State t (ContF t)+run_parse x p@(y,pf) inp l = pf inp (Slot x [y] []) l l counter_cont ++counter_cont :: ContF t+counter_cont = ContF cf+  where cf _ (_,_,r) s = s { successes = IM.alter updater r (successes s) } +          where updater = maybe (Just 1) (Just . (1+))+ parse_nterm :: (Ord t) => Nt -> [Parse_Seq t] -> Parse_Symb t parse_nterm n = nterm n . foldl altOp altStart  @@ -43,52 +48,105 @@ nterm n p = (Nt n, parser)   where parser inp g l k c s            | null rs   = p inp n k cont_for s'-          | otherwise = compAll [ applyCF c (g,l,r) | r <- rs ] s'+          | otherwise = compAll [ applyCF c (removePrefix len inp) (g,l,r) +                                | r <- rs, let len = r - k ] s'           where s' = s { grel = addCont (n,k) (g,l,c) (grel s) }                  rs = extents (n,k) (prel s)           cont_for = ContF cf -         where cf (_,k,r) s = -                compAll [ applyCF c (g,l',r) | (g,l',c) <- conts (n,k) (grel s) ] s'+         where cf inp (_,k,r) s = +                compAll [ applyCF c inp (g,l',r) +                        | (g,l',c) <- conts (n,k) (grel s) ] s'                 where s' = s { prel = addExtent (n,k) r (prel s) }  term :: Parseable t => t -> Parse_Symb t-term t = (Term t, parser)-  where parser inp g l k c s-          | lb <= k, k <= ub, matches (inp A.! k) t = applyCF c (g, l, k+1) s-          | otherwise                               = s-         where (lb,ub) = A.bounds inp+term t = (Term t, snd (predicate (pack (show t)) (matches t)))   seqStart :: Ord t => Parse_Seq t-seqStart inp x beta l c = continue (Slot x [] beta, l, l, l) c+seqStart inp x beta l c = continue inp (Slot x [] beta, l, l, l) c  seqOp :: Ord t => Parse_Seq t -> Parse_Symb t -> Parse_Seq t seqOp p (s,q) inp x beta l c0 = p inp x (s:beta) l c1   where c1 = ContF c1f-         where c1f ((Slot _ alpha _),l,k) = q inp (Slot x (alpha++[s]) beta) l k c2+         where c1f inp ((Slot _ alpha _),l,k) = q inp (Slot x (alpha++[s]) beta) l k c2                 where c2 = ContF c2f-                       where c2f (g,l,r) = continue (g,l,k,r) c0+                       where c2f inp (g,l,r) = continue inp (g,l,k,r) c0 -continue :: (Ord t) => BSR t -> ContF t -> Command t-continue bsr@(g@(Slot x alpha beta),l,k,r) c s +continue :: (Ord t) => Input t -> BSR t -> ContF t -> Command t+continue inp bsr@(g@(Slot x alpha beta),l,k,r) c s    | hasDescr descr (uset s) = s'-  | otherwise               = applyCF c descr s''+  | otherwise               = applyCF c inp descr s''   where descr = (g,l,r)         s'  | not (null alpha) || null beta = s { bsrs = addBSR bsr (bsrs s) }             | otherwise                     = s-        s'' = s'  { uset = addDescr descr (uset s') }+        s'' = s' { uset = addDescr descr (uset s') }  altStart :: Parse_Choice t altStart inp n l c s = s  altOp :: Parse_Choice t -> Parse_Seq t -> Parse_Choice t altOp p q inp n l c = p inp n l c . q inp n [] l c+{- MUCH SLOWER ?+altOp p q inp n l c s = +  let s1 = p inp n l counter_cont s+      s2 = q inp n [] l counter_cont s1+  in compAll [ applyCF c (error "cont_for assert", l, r) +             | r <- IS.toList (IS.union (IM.keysSet (successes s1)) +                                        (IM.keysSet (successes s2))) ] s2+-}  compAll :: [Command t] -> Command t compAll = foldr (.) id -applyCF (ContF cf) a = cf a+applyCF (ContF cf) inp a = cf inp a +{- EXTENSIONS -}++parse_lexical :: Nt -> RawParser t -> Parse_Symb t+parse_lexical n scanner = (Nt n, parser)+  where parser inp g l k c s = +          compAll [ applyCF c (removePrefix len inp) (g, l, k + len) +                  | prefix <- apply_scanner scanner inp +                  , let len = length prefix ] s++{- EXPERIMENTAL -}++andNot :: (Show t) => Parse_Symb t -> Parse_Symb t -> Parse_Symb t+andNot (lnt,p) (rnt,q) = (Nt lhs_symb,parser)+  where lhs_symb = pack ("__andNot(" ++ show lnt ++","++ show rnt ++ ")")+        parser inp g l k c s = compAll [ applyCF c (removePrefix len inp) (g, l, r) +                                       | r <- rs, let len = r - k ] +                                       s2{successes = successes s}+          where s1 = run_parse lhs_symb (lnt,p) inp k s{successes = IM.empty}+                s2 = run_parse lhs_symb (rnt,q) inp k s1{successes = IM.empty}+                rs = IS.toList $ IS.difference (IM.keysSet (successes s1))+                                               (IM.keysSet (successes s2))+++ands :: (Show t) => [Parse_Symb t] -> Parse_Symb t+ands = foldr andOp andStart++andOp :: (Show t) => Parse_Symb t -> Parse_Symb t -> Parse_Symb t+andOp (lnt,p) (rnt,q) = (Nt lhs_symb,parser)+  where lhs_symb = pack ("__and(" ++ show lnt ++","++ show rnt ++ ")")+        parser inp g l k c s = compAll [ applyCF c (removePrefix len inp) (g, l, r) +                                       | r <- rs, let len = r - k ] s2+          where s1 = run_parse lhs_symb (lnt,p) inp k s +                s2 = run_parse lhs_symb (rnt,q) inp k s1+                rs = IS.toList $ IS.intersection (IM.keysSet (successes s1))+                                                 (IM.keysSet (successes s2))++andStart :: Parse_Symb t+andStart = (Nt (pack "__and_unit"), parser)+  where parser inp g l k c s = applyCF c inp (g, l, k) s++predicate :: Parseable t => Nt -> (t -> Bool) -> Parse_Symb t+predicate nt p = (Nt nt, parser)+  where parser inp g l k c s =+          compAll [ applyCF c (removePrefix len inp) (g, l, k + len)   +                  | prefix <- apply_scanner (scanner_from_predicate p) inp+                  , let len = length prefix ] s+ -- |  -- The "ParseResult" datatype contains some information about a parse: --@@ -97,21 +155,25 @@ --  * The number of BSR elements  data ParseResult t = ParseResult{ bsrs_result               :: BSRs t                                 , res_success               :: Bool-                                , res_successes             :: Int+                                , res_successes             :: IM.IntMap Int                                 , nr_descriptors            :: Int                                 , nr_bsrs                   :: Int                                 , error_message             :: String                                 } -resultFromState :: Parseable t => Input t -> State t c -> (Nt, Int, Int) -> ParseResult t-resultFromState inp (State uset _ _ pMap cs) (s, l, m) =+matchedUpTo :: IM.IntMap Int -> Int -> Bool+matchedUpTo res r = maybe False (const True) (IM.lookup r res)++resultFromState :: Parseable t => Input t -> State t c -> ParseResult t+resultFromState inp (State uset _ _ pMap cs) =     let usize       = sum  [ S.size s   | (l, r2s) <- IM.assocs uset                                         , (r,s) <- IM.assocs r2s ]         p_nodes     = sum [ IS.size ks  | (l, r2j) <- IM.assocs pMap                                         , (r, j2s) <- IM.assocs r2j                                         , (j, s2k) <- IM.assocs j2s                                         , (s, ks)  <- M.assocs s2k ]-    in ParseResult pMap (cs > 0) cs usize p_nodes "no errors to report" +        succs = maybe 0 id (IM.lookup (inputLength inp) cs)+    in ParseResult pMap (succs > 0) cs usize p_nodes "no errors to report"   instance Show (ParseResult t) where     show res | res_success res = result_string

@@ -2,13 +2,13 @@  module GLL.Combinators.Visit.Join where -import GLL.Types.BSR import GLL.Types.Grammar+import GLL.Types.Input+import GLL.Types.TypeCompose import GLL.Combinators.Visit.Sem import GLL.Combinators.Visit.FUNGLL import GLL.Combinators.Options -import Control.Compose (OO(..),unOO) import Data.List (intercalate) import Data.Text (pack) @@ -40,7 +40,8 @@         x     = pack x'     in SymbExpr (Nt x, parse_nterm x vas2, sem_nterm use_ctx left_biased x alts vas3) -join_apply :: (Show t, Ord t, IsSymbExpr s) => (a -> b) -> s t a -> AltExpr t b+join_apply :: (Show t, Ord t, IsSymbExpr s, Foldable f) => +                (a -> f b) -> s t a -> AltExpr t b join_apply f p' =      let SymbExpr (vpa1,vpa2,vpa3) = mkRule p' in AltExpr           ([vpa1],parse_apply vpa2, sem_apply f vpa3)@@ -52,6 +53,14 @@       SymbExpr (vpa1,vpa2,vpa3)  = mkRule pr' in AltExpr   (vimp1++[vpa1], parse_seq vimp2 vpa2, sem_seq local_opts vimp3 vpa3) +join_lexical :: Nt -> RawParser t -> SymbExpr t [t]+join_lexical nt regex = SymbExpr (Nt nt, parse_lexical nt regex, sem_slice regex)++join_andNot :: (Show t) => SymbExpr t a -> SymbExpr t b -> SymbExpr t a+join_andNot (SymbExpr (_,p_parser,p_sem)) (SymbExpr (_, q_parser, q_sem)) = +  SymbExpr (s, parser, p_sem)+  where parser@(s, _) = andNot p_parser q_parser+ -- |  -- Class for lifting to 'SymbExpr'. class IsSymbExpr a where@@ -95,7 +104,7 @@     toAlt = id  instance IsAltExpr SymbExpr where-    toAlt p = join_apply id p+    toAlt p = join_apply (:[]) p  instance IsAltExpr AltExprs where     toAlt = toAlt . mkRule

@@ -2,12 +2,12 @@ module GLL.Combinators.Visit.Sem where  import GLL.Combinators.Options+import GLL.Types.Input import GLL.Types.Grammar import GLL.Types.BSR  import Control.Monad (forM)-import qualified Data.Array as A-import qualified Data.IntMap as IM+import Data.Foldable (toList) import qualified Data.Set as S  type Sem_Symb t a = PCOptions -> Ancestors t @@ -16,7 +16,8 @@                         -> BSRs t -> Input t -> Int -> Int -> IO [(Int,a)]  evaluator_for :: (Ord t) => Nt -> Sem_Symb t a -> PCOptions -> BSRs t -> Input t -> IO [a]-evaluator_for start sem opts bsrs inp = sem opts emptyAncestors bsrs inp 0 (snd (A.bounds inp))+evaluator_for start sem opts bsrs inp = +  sem opts emptyAncestors bsrs inp 0 (inputLength inp)  sem_nterm :: Bool -> Bool -> Nt -> [Prod t] -> [Sem_Alt t a] -> Sem_Symb t a sem_nterm use_ctx left_biased x alts ps opts ctx sppf arr l r =@@ -41,11 +42,13 @@             firstRes ([]:ress)  = firstRes ress             firstRes (res:_)    = res -sem_apply :: Ord t => (a -> b) -> Sem_Symb t a -> Sem_Alt t b+sem_apply :: (Foldable f, Ord t) => (a -> f b) -> Sem_Symb t a -> Sem_Alt t b sem_apply f p opts (alt,j) ctx sppf arr l r =          let op f a = (r,f a)         in do   as <- p opts ctx sppf arr l r-                return (maybe [] (const (map (op f) as)) $ sppf `pNodeLookup'` ((alt,1),l,r))+                case sppf `pNodeLookup'` ((alt,1),l,r) of+                  Nothing -> return []+                  _       -> return [ (r, res) | a <- as, res <- toList (f a)]   sem_seq :: Ord t => CombinatorOptions -> Sem_Alt t (a -> b) -> Sem_Symb t a -> Sem_Alt t b  sem_seq local_opts p q opts (alt@(Prod x rhs),j) ctx sppf arr l r = @@ -62,6 +65,9 @@                       | otherwise   = ctx     in do   ass <- forM choices seq             return (concat ass)++sem_slice :: RawParser t -> Sem_Symb t [t]+sem_slice regex opts ctx bsr inp l r = return [slice inp l r]  --- contexts type Ancestors t = S.Set Nt

@@ -2,16 +2,12 @@  module GLL.Types.BSR where -import qualified    Data.Array as A import qualified    Data.Map as M import qualified    Data.IntMap as IM-import qualified    Data.Set as S  import qualified    Data.IntSet as IS -import              Data.List (elemIndices, findIndices)  import GLL.Types.Grammar -type Input t    = A.Array Int t -- make sure that tokens are equal independent of their character level value type SlotL t    = (Slot t, Int)                   -- slot with left extent type PrL t      = (Prod t, Int)                     -- Production rule with left extent@@ -62,6 +58,4 @@                         | (l,r2j) <- IM.assocs pMap, (r,j2a) <- IM.assocs r2j                         , (j,a2k) <- IM.assocs j2a, (a,kset) <- M.assocs a2k ] -mkInput :: (Parseable t) => [t] -> Input t-mkInput input = A.listArray (0,m) (input++[eos])-  where m = length input+

@@ -12,11 +12,11 @@ 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 { uset       :: USet t-                        , grel       :: GRel t c-                        , prel       :: PRel t-                        , bsrs       :: BSRs t-                        , successes  :: Int+data State t c  = State { uset        :: USet t+                        , grel        :: GRel t c+                        , prel        :: PRel t+                        , bsrs        :: BSRs t+                        , successes   :: IM.IntMap Int {- maps index to counter -}                         }  instance (Ord t) => Ord (Cont t c) where@@ -38,7 +38,7 @@ extents         :: Comm t -> PRel t -> [Int]  emptyState :: (Ord t) => State t c-emptyState = State emptyUSet emptyG emptyP emptyBSRs 0+emptyState = State emptyUSet emptyG emptyP emptyBSRs IM.empty  type RList t    =   [Descr t] type USet t     =   IM.IntMap (IM.IntMap (S.Set (Slot t)))@@ -95,5 +95,3 @@  extents (gs,l) = maybe [] inner . IM.lookup l           where inner = maybe [] id .  M.lookup gs--

@@ -0,0 +1,32 @@++module GLL.Types.Input (+  module GLL.Types.Input) where++import GLL.Types.Grammar+import qualified    Data.Array as A++type Input t      = (A.Array Int t, [t])+type RawParser t  = [t] -> [[t]]  -- input to list of prefixes++mkInput :: (Parseable t) => [t] -> Input t+mkInput input = (A.listArray (0,m) (input++[eos]), input)+  where m = length input++inputLength :: Input t -> Int+inputLength = snd . A.bounds . fst++scanner_from_predicate :: (t -> Bool) -> RawParser t+scanner_from_predicate p (t:ts) | p t = [[t]]+scanner_from_predicate p _ = []++apply_scanner :: RawParser t -> Input t -> [[t]]+apply_scanner scanner (_,str) = scanner str++slice :: Input t -> Int -> Int -> [t]+slice (arr, str) l r +  | lb <= l && r <= ub  = map (arr A.!) [l..r-1] +  | otherwise           = []+  where (lb,ub) = A.bounds arr++removePrefix :: Int -> Input t -> Input t+removePrefix l (arr, str) = (arr, drop l str)

@@ -0,0 +1,21 @@++-- | Definition copied from TypeCompose-0.9.14: https://hackage.haskell.org/package/TypeCompose-0.9.14+module GLL.Types.TypeCompose where++import Prelude hiding ((.),id)++import Control.Arrow (Arrow(..))+import Control.Category (Category(..))+import Control.Applicative (liftA, liftA2)++-- | Composition of type constructors: unary with binary.  Called+-- "StaticArrow" in [1].+newtype OO f j a b = OO { unOO :: f (a `j` b) }++instance (Applicative f, Category cat) => Category (OO f cat) where+  id          = OO (pure id)+  OO g . OO h = OO (liftA2 (.) g h)++instance (Applicative f, Arrow arr) => Arrow (OO f arr) where+  arr           = OO . pure . arr+  first (OO g)  = OO (liftA first g)