{-# LANGUAGE  RankNTypes, 
              GADTs,
              MultiParamTypeClasses,
              FunctionalDependencies,
              FlexibleInstances,  
              KindSignatures,
              CPP #-}
-- | The module `Core` contains the basic functionality of the parser library.
--   It defines the types and implementations of the elementary  parsers and  recognisers involved.  

module Text.ParserCombinators.UU.Core 
  ( -- * Classes
    IsParser,
    ExtAlternative (..),
--    Provides (..),
    Eof (..),
    IsLocationUpdatedBy (..),
    StoresErrors (..),
    HasPosition (..),
    -- * Types
    -- ** The parser descriptor
    P (..),
    -- ** The progress information
    Steps (..),
    Cost,
    Progress,
    -- ** Auxiliary types
    Nat (..),
    Strings,
    -- * Functions
    -- ** Basic Parsers
    micro,
    amb,
    pErrors,
    pPos,
    pState,
    pEnd,
    pSwitch,
    pSymExt,
--     pSym,
    -- ** Calling Parsers
    parse, parse_h,
    -- ** Acessing and updating various components    
    getZeroP,
    getOneP,
    addLength,
    -- ** Evaluating the online result
    eval,
    -- ** Re-exported modules
    module Control.Applicative,
    module Control.Monad
  ) where

import Control.Applicative
import Control.Monad 
import Data.Char
-- import Debug.Trace
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 710
import Prelude hiding ((.), traverse)
#else
import Prelude hiding ((.))
#endif
import Data.Maybe

t -> t
f . :: (t -> t) -> (t -> t) -> t -> t
. t -> t
g = \t
x ->  t -> t
f ( t -> t
g t
x)

{-# INLINE (.) #-}

-- | In the class `IsParser` we assemble the basic properties we expect parsers to have. The class itself does not have any methods. 
--   Most properties  come directly from the standard 
--   "Control.Applicative" module. The class `ExtAlternative` contains some extra methods we expect our parsers to have.

class (Alternative p, Applicative p, ExtAlternative p) => IsParser p

instance  MonadPlus (P st) where
  mzero :: P st a
mzero = P st a
forall (f :: * -> *) a. Alternative f => f a
empty
  mplus :: P st a -> P st a -> P st a
mplus = P st a -> P st a -> P st a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) 

class (Alternative p) => ExtAlternative p where
   -- | `<<|>` is the greedy version of `<|>`. If its left hand side parser can
   --   make any progress then it commits to that alternative. Can be used to make
   --   parsers faster, and even get a complete Parsec equivalent behaviour, with
   --   all its (dis)advantages. Intended use @p \<\<\|> q \<\<\|> r \<\|> x \<\|> y \<?> \"string\"@. Use with care!   
   (<<|>)  :: p a -> p a -> p a
   -- | The parsers build a list of symbols which are expected at a specific point. 
   --   This list is used to report errors.
   --   Quite often it is more informative to get e.g. the name of the non-terminal . 
   --   The `<?>` combinator replaces this list of symbols by the string argument.   
   (<?>)   :: p a -> String -> p a
   -- |  `must_be_non_empty` checks whether its second argument
   --    is a parser which can recognise the empty input. If so, an error message is
   --    given using the  String parameter. If not, then the third argument is
   --    returned. This is useful in testing for illogical combinations. For its use see
   --    the module "Text.ParserCombinators.UU.Derived".
   must_be_non_empty   :: String -> p a ->        c -> c
   --
   -- |  `must_be_non_empties` is similar to `must_be_non_empty`, but can be 
   --    used in situations where we recognise a sequence of elements separated by 
   --    other elements. This does not make sense if both parsers can recognise the 
   --    empty string. Your grammar is then highly ambiguous.
   must_be_non_empties :: String -> p a -> p b -> c -> c 
   -- | If 'p' can be recognized, the return value of 'p' is used. Otherwise,
   --   the value 'v' is used. Note that `opt` by default is greedy. If you do not want
   --   this use @...\<\|> pure v@  instead. Furthermore, 'p' should not
   --   recognise the empty string, since this would make the parser ambiguous!!
   opt     :: p a ->   a -> p a
   opt p a
p a
v = String -> p a -> p a -> p a
forall (p :: * -> *) a c.
ExtAlternative p =>
String -> p a -> c -> c
must_be_non_empty String
"opt" p a
p (p a
p p a -> p a -> p a
forall (p :: * -> *) a. ExtAlternative p => p a -> p a -> p a
<<|> a -> p a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v)   

infix   2  <?>    
infixl  3  <<|>     
infixl  2 `opt`

-- | The class `Eof` contains a function `eof` which is used to check whether we have reached the end of the input and `deletAtEnd` 
--   should discard any unconsumed input at the end of a successful parse.
class Eof state where
       eof          ::  state   -> Bool
       deleteAtEnd  ::  state   -> Maybe (Cost, state)

-- | The input state may maintain a location which can be used in generating error messages. 
--   Since we do not want to fix our input to be just a @String@ we provide an interface
--   which can be used to advance this location by passing  information about the part recognised. This function is typically
--   called in the `splitState` functions.

class Show loc => loc `IsLocationUpdatedBy` str where
    advance :: loc -- ^ The current position
            -> str -- ^ The part which has been removed from the input
            -> loc

-- | The class `StoresErrors` is used by the function `pErrors` which retrieves the generated 
--  correction steps since the last time it was called.
--

class state `StoresErrors`  error | state -> error where
  -- | `getErrors` retrieves the correcting steps made since the last time the function was called. The result can, 
  --    by using it in a monad, be used to control how to proceed with the parsing process.
  getErrors :: state -> ([error], state)

class state `HasPosition`  pos | state -> pos where
  -- | `getPos` retrieves the correcting steps made since the last time the function was called. The result can, 
  --   by using it as the left hand side of a monadic bind, be used to control how to proceed with the parsing process.
  getPos  ::  state -> pos

-- | The data type `T` contains three components, all being some form of primitive parser. 
--   These components are used in various combinations,
--   depending on whether you are in the right and side operand of a monad, 
--   whether you are interested in a result (if not, we use recognisers), 
--   and whether you want to have the results in an online way (future parsers), or just prefer to be a bit faster (history parsers)

data T st a  = T  (forall r . (a  -> st -> Steps r)  -> st -> Steps       r  )  --   history parser
                  (forall r . (      st -> Steps r)  -> st -> Steps   (a, r) )  --   future parser
                  (forall r . (      st -> Steps r)  -> st -> Steps       r  )  --   recogniser 

instance Functor (T st) where
  fmap :: (a -> b) -> T st a -> T st b
fmap a -> b
f (T forall r. (a -> st -> Steps r) -> st -> Steps r
ph forall r. (st -> Steps r) -> st -> Steps (a, r)
pf forall r. (st -> Steps r) -> st -> Steps r
pr) = (forall r. (b -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (b, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st b
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T  ( \  b -> st -> Steps r
k -> (a -> st -> Steps r) -> st -> Steps r
forall r. (a -> st -> Steps r) -> st -> Steps r
ph ( b -> st -> Steps r
k (b -> st -> Steps r) -> (a -> b) -> a -> st -> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
.a -> b
f ))
                           ( \  st -> Steps r
k ->  (a -> b) -> Steps (a, r) -> Steps (b, r)
forall b a r. (b -> a) -> Steps (b, r) -> Steps (a, r)
apply2fst a -> b
f (Steps (a, r) -> Steps (b, r))
-> (st -> Steps (a, r)) -> st -> Steps (b, r)
forall t t t. (t -> t) -> (t -> t) -> t -> t
. (st -> Steps r) -> st -> Steps (a, r)
forall r. (st -> Steps r) -> st -> Steps (a, r)
pf st -> Steps r
k) -- pure f <*> pf
                           forall r. (st -> Steps r) -> st -> Steps r
pr
  a
f <$ :: a -> T st b -> T st a
<$ (T forall r. (b -> st -> Steps r) -> st -> Steps r
_ forall r. (st -> Steps r) -> st -> Steps (b, r)
_ forall r. (st -> Steps r) -> st -> Steps r
pr)     = (forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T  ( (st -> Steps r) -> st -> Steps r
forall r. (st -> Steps r) -> st -> Steps r
pr ((st -> Steps r) -> st -> Steps r)
-> ((a -> st -> Steps r) -> st -> Steps r)
-> (a -> st -> Steps r)
-> st
-> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
. ((a -> st -> Steps r) -> a -> st -> Steps r
forall a b. (a -> b) -> a -> b
$a
f)) 
                           ( \ st -> Steps r
k st
st -> a -> Steps r -> Steps (a, r)
forall v r. v -> Steps r -> Steps (v, r)
push a
f ( (st -> Steps r) -> st -> Steps r
forall r. (st -> Steps r) -> st -> Steps r
pr st -> Steps r
k st
st)) 
                           forall r. (st -> Steps r) -> st -> Steps r
pr

instance   Applicative (T  state) where
  T forall r. ((a -> b) -> state -> Steps r) -> state -> Steps r
ph forall r. (state -> Steps r) -> state -> Steps (a -> b, r)
pf forall r. (state -> Steps r) -> state -> Steps r
pr  <*> :: T state (a -> b) -> T state a -> T state b
<*> ~(T forall r. (a -> state -> Steps r) -> state -> Steps r
qh forall r. (state -> Steps r) -> state -> Steps (a, r)
qf forall r. (state -> Steps r) -> state -> Steps r
qr)  =  (forall r. (b -> state -> Steps r) -> state -> Steps r)
-> (forall r. (state -> Steps r) -> state -> Steps (b, r))
-> (forall r. (state -> Steps r) -> state -> Steps r)
-> T state b
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( \  b -> state -> Steps r
k -> ((a -> b) -> state -> Steps r) -> state -> Steps r
forall r. ((a -> b) -> state -> Steps r) -> state -> Steps r
ph (\ a -> b
pr -> (a -> state -> Steps r) -> state -> Steps r
forall r. (a -> state -> Steps r) -> state -> Steps r
qh (\ a
qr -> b -> state -> Steps r
k (a -> b
pr a
qr))))
                                      ((Steps (a -> b, (a, r)) -> Steps (b, r)
forall b a r. Steps (b -> a, (b, r)) -> Steps (a, r)
apply (Steps (a -> b, (a, r)) -> Steps (b, r))
-> (state -> Steps (a -> b, (a, r))) -> state -> Steps (b, r)
forall t t t. (t -> t) -> (t -> t) -> t -> t
.) ((state -> Steps (a -> b, (a, r))) -> state -> Steps (b, r))
-> ((state -> Steps r) -> state -> Steps (a -> b, (a, r)))
-> (state -> Steps r)
-> state
-> Steps (b, r)
forall t t t. (t -> t) -> (t -> t) -> t -> t
. ((state -> Steps (a, r)) -> state -> Steps (a -> b, (a, r))
forall r. (state -> Steps r) -> state -> Steps (a -> b, r)
pf ((state -> Steps (a, r)) -> state -> Steps (a -> b, (a, r)))
-> ((state -> Steps r) -> state -> Steps (a, r))
-> (state -> Steps r)
-> state
-> Steps (a -> b, (a, r))
forall t t t. (t -> t) -> (t -> t) -> t -> t
.(state -> Steps r) -> state -> Steps (a, r)
forall r. (state -> Steps r) -> state -> Steps (a, r)
qf))
                                      ( (state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
pr ((state -> Steps r) -> state -> Steps r)
-> ((state -> Steps r) -> state -> Steps r)
-> (state -> Steps r)
-> state
-> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
. (state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
qr)
  T forall r. (a -> state -> Steps r) -> state -> Steps r
ph forall r. (state -> Steps r) -> state -> Steps (a, r)
pf forall r. (state -> Steps r) -> state -> Steps r
pr  <* :: T state a -> T state b -> T state a
<*  ~(T forall r. (b -> state -> Steps r) -> state -> Steps r
_  forall r. (state -> Steps r) -> state -> Steps (b, r)
_  forall r. (state -> Steps r) -> state -> Steps r
qr)   = (forall r. (a -> state -> Steps r) -> state -> Steps r)
-> (forall r. (state -> Steps r) -> state -> Steps (a, r))
-> (forall r. (state -> Steps r) -> state -> Steps r)
-> T state a
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( (a -> state -> Steps r) -> state -> Steps r
forall r. (a -> state -> Steps r) -> state -> Steps r
ph((a -> state -> Steps r) -> state -> Steps r)
-> ((a -> state -> Steps r) -> a -> state -> Steps r)
-> (a -> state -> Steps r)
-> state
-> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
. ((state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
qr((state -> Steps r) -> state -> Steps r)
-> (a -> state -> Steps r) -> a -> state -> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
.))  ((state -> Steps r) -> state -> Steps (a, r)
forall r. (state -> Steps r) -> state -> Steps (a, r)
pf((state -> Steps r) -> state -> Steps (a, r))
-> ((state -> Steps r) -> state -> Steps r)
-> (state -> Steps r)
-> state
-> Steps (a, r)
forall t t t. (t -> t) -> (t -> t) -> t -> t
. (state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
qr)   ((state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
pr ((state -> Steps r) -> state -> Steps r)
-> ((state -> Steps r) -> state -> Steps r)
-> (state -> Steps r)
-> state
-> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
. (state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
qr)
  T forall r. (a -> state -> Steps r) -> state -> Steps r
_  forall r. (state -> Steps r) -> state -> Steps (a, r)
_  forall r. (state -> Steps r) -> state -> Steps r
pr  *> :: T state a -> T state b -> T state b
*>  ~(T forall r. (b -> state -> Steps r) -> state -> Steps r
qh forall r. (state -> Steps r) -> state -> Steps (b, r)
qf forall r. (state -> Steps r) -> state -> Steps r
qr )  = (forall r. (b -> state -> Steps r) -> state -> Steps r)
-> (forall r. (state -> Steps r) -> state -> Steps (b, r))
-> (forall r. (state -> Steps r) -> state -> Steps r)
-> T state b
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( (state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
pr ((state -> Steps r) -> state -> Steps r)
-> ((b -> state -> Steps r) -> state -> Steps r)
-> (b -> state -> Steps r)
-> state
-> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
. (b -> state -> Steps r) -> state -> Steps r
forall r. (b -> state -> Steps r) -> state -> Steps r
qh  )  ((state -> Steps (b, r)) -> state -> Steps (b, r)
forall r. (state -> Steps r) -> state -> Steps r
pr((state -> Steps (b, r)) -> state -> Steps (b, r))
-> ((state -> Steps r) -> state -> Steps (b, r))
-> (state -> Steps r)
-> state
-> Steps (b, r)
forall t t t. (t -> t) -> (t -> t) -> t -> t
. (state -> Steps r) -> state -> Steps (b, r)
forall r. (state -> Steps r) -> state -> Steps (b, r)
qf)    ((state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
pr ((state -> Steps r) -> state -> Steps r)
-> ((state -> Steps r) -> state -> Steps r)
-> (state -> Steps r)
-> state
-> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
. (state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
qr)            
  pure :: a -> T state a
pure a
a                          = (forall r. (a -> state -> Steps r) -> state -> Steps r)
-> (forall r. (state -> Steps r) -> state -> Steps (a, r))
-> (forall r. (state -> Steps r) -> state -> Steps r)
-> T state a
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ((a -> state -> Steps r) -> a -> state -> Steps r
forall a b. (a -> b) -> a -> b
$a
a) ((a -> Steps r -> Steps (a, r)
forall v r. v -> Steps r -> Steps (v, r)
push a
a)(Steps r -> Steps (a, r))
-> (state -> Steps r) -> state -> Steps (a, r)
forall t t t. (t -> t) -> (t -> t) -> t -> t
.) forall a. a -> a
forall r. (state -> Steps r) -> state -> Steps r
id 

instance   Alternative (T  state) where 
  T forall r. (a -> state -> Steps r) -> state -> Steps r
ph forall r. (state -> Steps r) -> state -> Steps (a, r)
pf forall r. (state -> Steps r) -> state -> Steps r
pr  <|> :: T state a -> T state a -> T state a
<|> T forall r. (a -> state -> Steps r) -> state -> Steps r
qh forall r. (state -> Steps r) -> state -> Steps (a, r)
qf forall r. (state -> Steps r) -> state -> Steps r
qr  =   (forall r. (a -> state -> Steps r) -> state -> Steps r)
-> (forall r. (state -> Steps r) -> state -> Steps (a, r))
-> (forall r. (state -> Steps r) -> state -> Steps r)
-> T state a
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T (\  a -> state -> Steps r
k state
inp  -> (a -> state -> Steps r) -> state -> Steps r
forall r. (a -> state -> Steps r) -> state -> Steps r
ph a -> state -> Steps r
k state
inp Steps r -> Steps r -> Steps r
forall a. Steps a -> Steps a -> Steps a
`best` (a -> state -> Steps r) -> state -> Steps r
forall r. (a -> state -> Steps r) -> state -> Steps r
qh a -> state -> Steps r
k state
inp)
                                    (\  state -> Steps r
k state
inp  -> (state -> Steps r) -> state -> Steps (a, r)
forall r. (state -> Steps r) -> state -> Steps (a, r)
pf state -> Steps r
k state
inp Steps (a, r) -> Steps (a, r) -> Steps (a, r)
forall a. Steps a -> Steps a -> Steps a
`best` (state -> Steps r) -> state -> Steps (a, r)
forall r. (state -> Steps r) -> state -> Steps (a, r)
qf state -> Steps r
k state
inp)
                                    (\  state -> Steps r
k state
inp  -> (state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
pr state -> Steps r
k state
inp Steps r -> Steps r -> Steps r
forall a. Steps a -> Steps a -> Steps a
`best` (state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
qr state -> Steps r
k state
inp)
  empty :: T state a
empty                =  (forall r. (a -> state -> Steps r) -> state -> Steps r)
-> (forall r. (state -> Steps r) -> state -> Steps (a, r))
-> (forall r. (state -> Steps r) -> state -> Steps r)
-> T state a
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T  ( \  a -> state -> Steps r
k state
inp  ->  Steps r
forall a. Steps a
noAlts) ( \  state -> Steps r
k state
inp  ->  Steps (a, r)
forall a. Steps a
noAlts) ( \  state -> Steps r
k state
inp  ->  Steps r
forall a. Steps a
noAlts)


data  P   st  a =  P  (T  st a)         --   actual parsers
                      (Maybe (T st a))  --   non-empty parsers; Nothing if  they are absent
                      (Maybe a)         --   the possibly  empty alternative with its value 
                      Nat               --   minimal number of symbols accepted by  the non-empty part


instance Show (P st a) where
  show :: P st a -> String
show (P T st a
_ Maybe (T st a)
nt Maybe a
e Nat
n) = String
"P _ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> (T st a -> String) -> Maybe (T st a) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"Nothing" (String -> T st a -> String
forall a b. a -> b -> a
const String
"(Just _)") Maybe (T st a)
nt  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> (a -> String) -> Maybe a -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"Nothing" (String -> a -> String
forall a b. a -> b -> a
const String
"(Just _)") Maybe a
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Nat -> String
forall a. Show a => a -> String
show Nat
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") "

-- | `getOneP` retrieves the non-zero part from a descriptor.
getOneP :: P a b -> Maybe (P a b)
-- getOneP (P _ (Just _)  (Zero Unspecified) _  )  =  error "The element is a special parser which cannot be combined"
getOneP :: P a b -> Maybe (P a b)
getOneP (P T a b
_ Maybe (T a b)
Nothing  Maybe b
_  Nat
l)  =  Maybe (P a b)
forall a. Maybe a
Nothing
getOneP (P T a b
_ Maybe (T a b)
onep     Maybe b
ep Nat
l)  =  P a b -> Maybe (P a b)
forall a. a -> Maybe a
Just( Maybe (T a b) -> Maybe b -> Nat -> P a b
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T a b)
onep Maybe b
forall a. Maybe a
Nothing  Nat
l)

-- | `getZeroP` retrieves the possibly empty part from a descriptor.
getZeroP :: P t a -> Maybe a
getZeroP :: P t a -> Maybe a
getZeroP (P T t a
_ Maybe (T t a)
_ Maybe a
z Nat
_)  =  Maybe a
z

-- | `mkParser` combines the non-empty descriptor part and the empty descriptor part into a descriptor tupled with the parser triple
mkParser :: Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser :: Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T st a)
np Maybe a
ne  Nat
l  =  T st a -> Maybe (T st a) -> Maybe a -> Nat -> P st a
forall st a. T st a -> Maybe (T st a) -> Maybe a -> Nat -> P st a
P (Maybe (T st a) -> Maybe a -> T st a
forall (f :: * -> *) a.
Alternative f =>
Maybe (f a) -> Maybe a -> f a
mkParser'  Maybe (T st a)
np Maybe a
ne)  Maybe (T st a)
np  Maybe a
ne Nat
l
  where  mkParser' :: Maybe (f a) -> Maybe a -> f a
mkParser' np :: Maybe (f a)
np@(Just f a
nt)  ne :: Maybe a
ne@Maybe a
Nothing    =  f a
nt               
         mkParser' np :: Maybe (f a)
np@Maybe (f a)
Nothing    ne :: Maybe a
ne@(Just a
a)   =  a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a       
         mkParser' np :: Maybe (f a)
np@(Just f a
nt)  ne :: Maybe a
ne@(Just a
a)   =  a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a
nt
         mkParser' np :: Maybe (f a)
np@(Maybe (f a)
Nothing)  ne :: Maybe a
ne@(Maybe a
Nothing)  =  f a
forall (f :: * -> *) a. Alternative f => f a
empty

-- ! `combine` creates the non-empty parser 
combine :: (Alternative f) => Maybe t1 -> Maybe t2 -> t -> Maybe t3
        -> (t1 -> t -> f a) -> (t2 -> t3 -> f a) -> Maybe (f a)
combine :: Maybe t1
-> Maybe t2
-> t
-> Maybe t3
-> (t1 -> t -> f a)
-> (t2 -> t3 -> f a)
-> Maybe (f a)
combine Maybe t1
Nothing   Maybe t2
Nothing  t
_  Maybe t3
_     t1 -> t -> f a
_   t2 -> t3 -> f a
_   = Maybe (f a)
forall a. Maybe a
Nothing      -- this Parser always fails
combine (Just t1
p)  Maybe t2
Nothing  t
aq Maybe t3
_     t1 -> t -> f a
op1 t2 -> t3 -> f a
op2 = f a -> Maybe (f a)
forall a. a -> Maybe a
Just (t1
p t1 -> t -> f a
`op1` t
aq) 
combine (Just t1
p)  (Just t2
v) t
aq Maybe t3
nq    t1 -> t -> f a
op1 t2 -> t3 -> f a
op2 = f a -> Maybe (f a)
forall a. a -> Maybe a
Just (case Maybe t3
nq of
                                                   Just t3
nnq -> t1
p t1 -> t -> f a
`op1` t
aq f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> t2
v t2 -> t3 -> f a
`op2` t3
nnq
                                                   Maybe t3
Nothing  -> t1
p t1 -> t -> f a
`op1` t
aq  -- rhs contribution is just from empty alt
                                                   )
combine Maybe t1
Nothing   (Just t2
v) t
_  Maybe t3
nq    t1 -> t -> f a
_   t2 -> t3 -> f a
op2 = case Maybe t3
nq of
                                              Just t3
nnq -> f a -> Maybe (f a)
forall a. a -> Maybe a
Just (t2
v t2 -> t3 -> f a
`op2` t3
nnq)  -- right hand side has non-empty part
                                              Maybe t3
Nothing  -> Maybe (f a)
forall a. Maybe a
Nothing             -- neither side has non-empty part

instance   Functor (P  state) where 
  fmap :: (a -> b) -> P state a -> P state b
fmap a -> b
f   (P  T state a
ap Maybe (T state a)
np Maybe a
me Nat
l)   =  T state b -> Maybe (T state b) -> Maybe b -> Nat -> P state b
forall st a. T st a -> Maybe (T st a) -> Maybe a -> Nat -> P st a
P ((a -> b) -> T state a -> T state b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f T state a
ap) ((T state a -> T state b) -> Maybe (T state a) -> Maybe (T state b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> T state a -> T state b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)  Maybe (T state a)
np)  (a -> b
f (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
me)  Nat
l 
  a
f <$ :: a -> P state b -> P state a
<$     (P  T state b
ap Maybe (T state b)
np Maybe b
me Nat
l)   =  T state a -> Maybe (T state a) -> Maybe a -> Nat -> P state a
forall st a. T st a -> Maybe (T st a) -> Maybe a -> Nat -> P st a
P (a
f a -> T state b -> T state a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ T state b
ap)   ((T state b -> T state a) -> Maybe (T state b) -> Maybe (T state a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
f a -> T state b -> T state a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$)    Maybe (T state b)
np)  (a
f a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$  Maybe b
me)  Nat
l 

instance   Applicative (P  state) where
  P T state (a -> b)
ap Maybe (T state (a -> b))
np Maybe (a -> b)
pe Nat
pl  <*> :: P state (a -> b) -> P state a -> P state b
<*> ~(P T state a
aq Maybe (T state a)
nq  Maybe a
qe Nat
ql)  = String -> P state b -> P state b
forall b. String -> b -> b
trace'' String
"<*>"  (Maybe (T state b) -> Maybe b -> Nat -> P state b
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser (Maybe (T state (a -> b))
-> Maybe (a -> b)
-> T state a
-> Maybe (T state a)
-> (T state (a -> b) -> T state a -> T state b)
-> ((a -> b) -> T state a -> T state b)
-> Maybe (T state b)
forall (f :: * -> *) t1 t2 t t3 a.
Alternative f =>
Maybe t1
-> Maybe t2
-> t
-> Maybe t3
-> (t1 -> t -> f a)
-> (t2 -> t3 -> f a)
-> Maybe (f a)
combine Maybe (T state (a -> b))
np Maybe (a -> b)
pe T state a
aq Maybe (T state a)
nq T state (a -> b) -> T state a -> T state b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (a -> b) -> T state a -> T state b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>))       (Maybe (a -> b)
pe Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe a
qe)  (Nat -> Nat -> Nat
nat_add Nat
pl Nat
ql))
  P T state a
ap Maybe (T state a)
np Maybe a
pe Nat
pl  <* :: P state a -> P state b -> P state a
<*  ~(P T state b
aq Maybe (T state b)
nq  Maybe b
qe Nat
ql)  = String -> P state a -> P state a
forall b. String -> b -> b
trace'' String
"<* "  (Maybe (T state a) -> Maybe a -> Nat -> P state a
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser (Maybe (T state a)
-> Maybe a
-> T state b
-> Maybe (T state b)
-> (T state a -> T state b -> T state a)
-> (a -> T state b -> T state a)
-> Maybe (T state a)
forall (f :: * -> *) t1 t2 t t3 a.
Alternative f =>
Maybe t1
-> Maybe t2
-> t
-> Maybe t3
-> (t1 -> t -> f a)
-> (t2 -> t3 -> f a)
-> Maybe (f a)
combine Maybe (T state a)
np Maybe a
pe T state b
aq Maybe (T state b)
nq T state a -> T state b -> T state a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*)  a -> T state b -> T state a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
(<$))        (Maybe a
pe Maybe a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Maybe b
qe )  (Nat -> Nat -> Nat
nat_add Nat
pl Nat
ql))
  P T state a
ap Maybe (T state a)
np Maybe a
pe Nat
pl  *> :: P state a -> P state b -> P state b
*>  ~(P T state b
aq Maybe (T state b)
nq  Maybe b
qe Nat
ql)  = String -> P state b -> P state b
forall b. String -> b -> b
trace'' String
" *>"  (Maybe (T state b) -> Maybe b -> Nat -> P state b
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser (Maybe (T state a)
-> Maybe a
-> T state b
-> Maybe (T state b)
-> (T state a -> T state b -> T state b)
-> (a -> T state b -> T state b)
-> Maybe (T state b)
forall (f :: * -> *) t1 t2 t t3 a.
Alternative f =>
Maybe t1
-> Maybe t2
-> t
-> Maybe t3
-> (t1 -> t -> f a)
-> (t2 -> t3 -> f a)
-> Maybe (f a)
combine Maybe (T state a)
np Maybe a
pe T state b
aq Maybe (T state b)
nq T state a -> T state b -> T state b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>) ((T state b -> a -> T state b) -> a -> T state b -> T state b
forall a b c. (a -> b -> c) -> b -> a -> c
flip T state b -> a -> T state b
forall a b. a -> b -> a
const)) (Maybe a
pe Maybe a -> Maybe b -> Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe b
qe )  (Nat -> Nat -> Nat
nat_add Nat
pl Nat
ql)) 
  pure :: a -> P state a
pure a
a                                = String -> P state a -> P state a
forall b. String -> b -> b
trace'' String
"pure" (Maybe (T state a) -> Maybe a -> Nat -> P state a
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T state a)
forall a. Maybe a
Nothing (a -> Maybe a
forall a. a -> Maybe a
Just a
a)  Nat
Zero)

instance Alternative (P   state) where 
  (P T state a
ap Maybe (T state a)
np  Maybe a
pe Nat
pl) <|> :: P state a -> P state a -> P state a
<|> (P T state a
aq Maybe (T state a)
nq Maybe a
qe Nat
ql) 
    =  let pl' :: Nat
pl' = Nat -> (a -> Nat) -> Maybe a -> Nat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Nat
pl (Nat -> a -> Nat
forall a b. a -> b -> a
const Nat
Zero) Maybe a
pe
           ql' :: Nat
ql' = Nat -> (a -> Nat) -> Maybe a -> Nat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Nat
ql (Nat -> a -> Nat
forall a b. a -> b -> a
const Nat
Zero) Maybe a
qe
           (Nat
rl', Bool
b) = String -> (Nat, Bool) -> (Nat, Bool)
forall b. String -> b -> b
trace' String
"calling natMin from <|>" (Nat -> Nat -> Int -> (Nat, Bool)
nat_min Nat
pl' Nat
ql' Int
0)
           (Nat
rl, Bool
_)  = Nat -> Nat -> Int -> (Nat, Bool)
nat_min Nat
pl Nat
ql Int
0
           Maybe (f a)
Nothing alt :: Maybe (f a) -> Maybe (f a) -> Maybe (f a)
`alt` Maybe (f a)
q  = Maybe (f a)
q
           Maybe (f a)
p       `alt` Maybe (f a)
Nothing = Maybe (f a)
p
           Just f a
p  `alt` Just f a
q  = f a -> Maybe (f a)
forall a. a -> Maybe a
Just (f a
p f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a
q)
       in  Maybe (T state a) -> Maybe a -> Nat -> P state a
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser ((if Bool
b then  (Maybe (T state a) -> Maybe (T state a) -> Maybe (T state a))
-> Maybe (T state a) -> Maybe (T state a) -> Maybe (T state a)
forall a. a -> a
id  else (Maybe (T state a) -> Maybe (T state a) -> Maybe (T state a))
-> Maybe (T state a) -> Maybe (T state a) -> Maybe (T state a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip) Maybe (T state a) -> Maybe (T state a) -> Maybe (T state a)
forall (f :: * -> *) a.
Alternative f =>
Maybe (f a) -> Maybe (f a) -> Maybe (f a)
alt Maybe (T state a)
np Maybe (T state a)
nq) (Maybe a
pe Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe a
qe) Nat
rl
  empty :: P state a
empty  = Maybe (T state a) -> Maybe a -> Nat -> P state a
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T state a)
forall (f :: * -> *) a. Alternative f => f a
empty Maybe a
forall (f :: * -> *) a. Alternative f => f a
empty  Nat
Infinite 

instance ExtAlternative (P st) where
  ~(P T st a
ap Maybe (T st a)
np Maybe a
pe Nat
pl) <<|> :: P st a -> P st a -> P st a
<<|> ~(P T st a
aq Maybe (T st a)
nq Maybe a
qe Nat
ql) 
    = let pl' :: Nat
pl' = Nat -> (a -> Nat) -> Maybe a -> Nat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Nat
pl (Nat -> a -> Nat
forall a b. a -> b -> a
const Nat
Zero) Maybe a
pe
          ql' :: Nat
ql' = Nat -> (a -> Nat) -> Maybe a -> Nat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Nat
ql (Nat -> a -> Nat
forall a b. a -> b -> a
const Nat
Zero) Maybe a
qe
          (Nat
rl', Bool
b) = Nat -> Nat -> Int -> (Nat, Bool)
nat_min Nat
pl' Nat
ql' Int
0
          (Nat
rl, Bool
_)  = Nat -> Nat -> Int -> (Nat, Bool)
nat_min  Nat
pl  Nat
ql  Int
0
          bestx :: Steps a -> Steps a -> Steps a
          bestx :: Steps a -> Steps a -> Steps a
bestx = (if Bool
b then (Steps a -> Steps a -> Steps a) -> Steps a -> Steps a -> Steps a
forall a. a -> a
id else (Steps a -> Steps a -> Steps a) -> Steps a -> Steps a -> Steps a
forall a b c. (a -> b -> c) -> b -> a -> c
flip) Steps a -> Steps a -> Steps a
forall a. Steps a -> Steps a -> Steps a
best
          choose:: T st a -> T st a -> T st a
          choose :: T st a -> T st a -> T st a
choose  (T forall r. (a -> st -> Steps r) -> st -> Steps r
ph forall r. (st -> Steps r) -> st -> Steps (a, r)
pf forall r. (st -> Steps r) -> st -> Steps r
pr)  (T forall r. (a -> st -> Steps r) -> st -> Steps r
qh forall r. (st -> Steps r) -> st -> Steps (a, r)
qf forall r. (st -> Steps r) -> st -> Steps r
qr) 
             = (forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T  (\ a -> st -> Steps r
k st
st -> let left :: Steps r
left  = Steps r -> Steps r
forall a. Steps a -> Steps a
norm ((a -> st -> Steps r) -> st -> Steps r
forall r. (a -> st -> Steps r) -> st -> Steps r
ph a -> st -> Steps r
k st
st)
                             in if Steps r -> Bool
forall t. Steps t -> Bool
has_success Steps r
left then Steps r
left else Steps r
left Steps r -> Steps r -> Steps r
forall a. Steps a -> Steps a -> Steps a
`bestx` (a -> st -> Steps r) -> st -> Steps r
forall r. (a -> st -> Steps r) -> st -> Steps r
qh a -> st -> Steps r
k st
st)
                  (\ st -> Steps r
k st
st -> let left :: Steps (a, r)
left  = Steps (a, r) -> Steps (a, r)
forall a. Steps a -> Steps a
norm ((st -> Steps r) -> st -> Steps (a, r)
forall r. (st -> Steps r) -> st -> Steps (a, r)
pf st -> Steps r
k st
st)
                             in if Steps (a, r) -> Bool
forall t. Steps t -> Bool
has_success Steps (a, r)
left then Steps (a, r)
left else Steps (a, r)
left Steps (a, r) -> Steps (a, r) -> Steps (a, r)
forall a. Steps a -> Steps a -> Steps a
`bestx` (st -> Steps r) -> st -> Steps (a, r)
forall r. (st -> Steps r) -> st -> Steps (a, r)
qf st -> Steps r
k st
st) 
                  (\ st -> Steps r
k st
st -> let left :: Steps r
left  = Steps r -> Steps r
forall a. Steps a -> Steps a
norm ((st -> Steps r) -> st -> Steps r
forall r. (st -> Steps r) -> st -> Steps r
pr st -> Steps r
k st
st)
                             in if Steps r -> Bool
forall t. Steps t -> Bool
has_success Steps r
left then Steps r
left else Steps r
left  Steps r -> Steps r -> Steps r
forall a. Steps a -> Steps a -> Steps a
`bestx` (st -> Steps r) -> st -> Steps r
forall r. (st -> Steps r) -> st -> Steps r
qr st -> Steps r
k st
st)
      in   T st a -> Maybe (T st a) -> Maybe a -> Nat -> P st a
forall st a. T st a -> Maybe (T st a) -> Maybe a -> Nat -> P st a
P (T st a -> T st a -> T st a
forall state a. T state a -> T state a -> T state a
choose  T st a
ap T st a
aq )
             (Maybe (T st a)
-> (T st a -> Maybe (T st a)) -> Maybe (T st a) -> Maybe (T st a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe (T st a)
np (\T st a
nqq -> Maybe (T st a)
-> (T st a -> Maybe (T st a)) -> Maybe (T st a) -> Maybe (T st a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe (T st a)
nq (\T st a
npp -> T st a -> Maybe (T st a)
forall (m :: * -> *) a. Monad m => a -> m a
return( T st a -> T st a -> T st a
forall state a. T state a -> T state a -> T state a
choose  T st a
npp T st a
nqq)) Maybe (T st a)
np) Maybe (T st a)
nq)
             (Maybe a
pe Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe a
qe) -- due to the way Maybe is instance of Alternative  the left hand operator gets priority
             Nat
rl
  P  T st a
_  Maybe (T st a)
np  Maybe a
pe Nat
pl <?> :: P st a -> String -> P st a
<?> String
label = let replaceExpected :: Steps a -> Steps a
                                  replaceExpected :: Steps a -> Steps a
replaceExpected (Fail Strings
_ [Strings -> (Int, Steps a)]
c) = (Strings -> [Strings -> (Int, Steps a)] -> Steps a
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail [String
label] [Strings -> (Int, Steps a)]
c)
                                  replaceExpected Steps a
others     = Steps a
others
                                  nnp :: Maybe (T st a)
nnp = case Maybe (T st a)
np of Maybe (T st a)
Nothing -> Maybe (T st a)
forall a. Maybe a
Nothing
                                                   Just ((T forall r. (a -> st -> Steps r) -> st -> Steps r
ph forall r. (st -> Steps r) -> st -> Steps (a, r)
pf  forall r. (st -> Steps r) -> st -> Steps r
pr)) -> T st a -> Maybe (T st a)
forall a. a -> Maybe a
Just((forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( \ a -> st -> Steps r
k st
inp -> Steps r -> Steps r
forall a. Steps a -> Steps a
replaceExpected (Steps r -> Steps r
forall a. Steps a -> Steps a
norm  ( (a -> st -> Steps r) -> st -> Steps r
forall r. (a -> st -> Steps r) -> st -> Steps r
ph a -> st -> Steps r
k st
inp)))
                                                                                  ( \ st -> Steps r
k st
inp -> Steps (a, r) -> Steps (a, r)
forall a. Steps a -> Steps a
replaceExpected (Steps (a, r) -> Steps (a, r)
forall a. Steps a -> Steps a
norm  ( (st -> Steps r) -> st -> Steps (a, r)
forall r. (st -> Steps r) -> st -> Steps (a, r)
pf st -> Steps r
k st
inp)))
                                                                                  ( \ st -> Steps r
k st
inp -> Steps r -> Steps r
forall a. Steps a -> Steps a
replaceExpected (Steps r -> Steps r
forall a. Steps a -> Steps a
norm  ( (st -> Steps r) -> st -> Steps r
forall r. (st -> Steps r) -> st -> Steps r
pr st -> Steps r
k st
inp))))
                                in Maybe (T st a) -> Maybe a -> Nat -> P st a
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T st a)
nnp Maybe a
pe Nat
pl
  must_be_non_empty :: String -> P st a -> c -> c
must_be_non_empty String
msg p :: P st a
p@(P T st a
_ Maybe (T st a)
_ (Just a
_)  Nat
_) c
_ 
            = String -> c
forall a. HasCallStack => String -> a
error (String
"The combinator " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++  String
" requires that its argument cannot recognise the empty string\n")
  must_be_non_empty String
_ P st a
_      c
q  = c
q
  must_be_non_empties :: String -> P st a -> P st b -> c -> c
must_be_non_empties  String
msg (P T st a
_ Maybe (T st a)
_ (Just a
_) Nat
_) (P T st b
_ Maybe (T st b)
_ (Just b
_) Nat
_) c
_ 
            = String -> c
forall a. HasCallStack => String -> a
error (String
"The combinator " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++  String
" requires that not both arguments can recognise the empty string\n")
  must_be_non_empties  String
_ P st a
_ P st b
_ c
q  = c
q

instance IsParser (P st) 

-- !! do not move the P constructor behind choices/patern matches
instance  Monad (P st) where
       p :: P st a
p@(P  T st a
ap Maybe (T st a)
np Maybe a
pe Nat
pl ) >>= :: P st a -> (a -> P st b) -> P st b
>>=  a -> P st b
a2q = 
          (T st b -> Maybe (T st b) -> Maybe b -> Nat -> P st b
forall st a. T st a -> Maybe (T st a) -> Maybe a -> Nat -> P st a
P T st b
newap Maybe (T st b)
newnp  Maybe b
newep (Nat -> Nat -> Nat
nat_add Nat
pl Nat
Hole))
          where (Maybe b
newep, Maybe (T st b)
newnp, T st b
newap) = case Maybe a
pe of
                                 Maybe a
Nothing -> (Maybe b
forall a. Maybe a
Nothing, Maybe (T st b)
t, T st b -> (T st b -> T st b) -> Maybe (T st b) -> T st b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe T st b
forall (f :: * -> *) a. Alternative f => f a
empty T st b -> T st b
forall a. a -> a
id Maybe (T st b)
t) 
                                 Just a
a  -> let  P T st b
aq Maybe (T st b)
nq  Maybe b
eq Nat
lq = a -> P st b
a2q a
a 
                                            in  (Maybe b
eq, Maybe (T st b) -> Maybe (T st b) -> Maybe (T st b)
forall (f :: * -> *) a.
Alternative f =>
Maybe (f a) -> Maybe (f a) -> Maybe (f a)
combine Maybe (T st b)
t Maybe (T st b)
nq , Maybe (T st b)
t Maybe (T st b) -> T st b -> T st b
forall (f :: * -> *) a. Alternative f => Maybe (f a) -> f a -> f a
`alt` T st b
aq)
                Maybe (f a)
Nothing  alt :: Maybe (f a) -> f a -> f a
`alt` f a
q    = f a
q
                Just f a
p   `alt` f a
q    = f a
p f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a
q
                t :: Maybe (T st b)
t = (T st a -> T st b) -> Maybe (T st a) -> Maybe (T st b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\  (T forall r. (a -> st -> Steps r) -> st -> Steps r
h forall r. (st -> Steps r) -> st -> Steps (a, r)
_ forall r. (st -> Steps r) -> st -> Steps r
_  ) ->      ((forall r. (b -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (b, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st b
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T  (  \b -> st -> Steps r
k -> (a -> st -> Steps r) -> st -> Steps r
forall r. (a -> st -> Steps r) -> st -> Steps r
h (\ a
a -> P st b -> (b -> st -> Steps r) -> st -> Steps r
forall b a r. P b a -> (a -> b -> Steps r) -> b -> Steps r
unParser_h (a -> P st b
a2q a
a) b -> st -> Steps r
k))
                                                     (  \st -> Steps r
k -> (a -> st -> Steps (b, r)) -> st -> Steps (b, r)
forall r. (a -> st -> Steps r) -> st -> Steps r
h (\ a
a -> P st b -> (st -> Steps r) -> st -> Steps (b, r)
forall b a r. P b a -> (b -> Steps r) -> b -> Steps (a, r)
unParser_f (a -> P st b
a2q a
a) st -> Steps r
k))
                                                     (  \st -> Steps r
k -> (a -> st -> Steps r) -> st -> Steps r
forall r. (a -> st -> Steps r) -> st -> Steps r
h (\ a
a -> P st b -> (st -> Steps r) -> st -> Steps r
forall b a r. P b a -> (b -> Steps r) -> b -> Steps r
unParser_r (a -> P st b
a2q a
a) st -> Steps r
k))) ) Maybe (T st a)
np
                combine :: Maybe (f a) -> Maybe (f a) -> Maybe (f a)
combine Maybe (f a)
Nothing     Maybe (f a)
Nothing     = Maybe (f a)
forall a. Maybe a
Nothing
                combine l :: Maybe (f a)
l@(Just f a
_ ) Maybe (f a)
Nothing     =  Maybe (f a)
l
                combine Maybe (f a)
Nothing     r :: Maybe (f a)
r@(Just f a
_ ) =  Maybe (f a)
r
                combine (Just f a
l)    (Just f a
r)    = f a -> Maybe (f a)
forall a. a -> Maybe a
Just (f a
l f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a
r)
                -- | `unParser_h` retreives the history parser from the descriptor
                unParser_h :: P b a -> (a -> b -> Steps r) -> b -> Steps r
                unParser_h :: P b a -> (a -> b -> Steps r) -> b -> Steps r
unParser_h (P (T  forall r. (a -> b -> Steps r) -> b -> Steps r
h   forall r. (b -> Steps r) -> b -> Steps (a, r)
_  forall r. (b -> Steps r) -> b -> Steps r
_ ) Maybe (T b a)
_ Maybe a
_ Nat
_ )  =  (a -> b -> Steps r) -> b -> Steps r
forall r. (a -> b -> Steps r) -> b -> Steps r
h
                -- | `unParser_f` retreives the future parser from the descriptor
                unParser_f :: P b a -> (b -> Steps r) -> b -> Steps (a, r)
                unParser_f :: P b a -> (b -> Steps r) -> b -> Steps (a, r)
unParser_f (P (T  forall r. (a -> b -> Steps r) -> b -> Steps r
_   forall r. (b -> Steps r) -> b -> Steps (a, r)
f  forall r. (b -> Steps r) -> b -> Steps r
_ ) Maybe (T b a)
_ Maybe a
_ Nat
_ )  =  (b -> Steps r) -> b -> Steps (a, r)
forall r. (b -> Steps r) -> b -> Steps (a, r)
f
                -- | `unParser_r` retreives therecogniser from the descriptor
                unParser_r :: P b a -> (b -> Steps r) -> b -> Steps r
                unParser_r :: P b a -> (b -> Steps r) -> b -> Steps r
unParser_r (P (T  forall r. (a -> b -> Steps r) -> b -> Steps r
_   forall r. (b -> Steps r) -> b -> Steps (a, r)
_  forall r. (b -> Steps r) -> b -> Steps r
r ) Maybe (T b a)
_ Maybe a
_ Nat
_ )  =  (b -> Steps r) -> b -> Steps r
forall r. (b -> Steps r) -> b -> Steps r
r
       return :: a -> P st a
return  = a -> P st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 

-- |  The basic recognisers are written elsewhere (e.g. in our module "Text.ParserCombinataors.UU.BasicInstances"; 
--    they (i.e. the parameter `splitState`) are lifted to our`P`  descriptors by the function `pSymExt` which also takes
--    the minimal number of tokens recognised by the parameter `splitState`  and an  @Maybe@ value describing the possibly empty value.
pSymExt ::  (forall a. (token -> state  -> Steps a) -> state -> Steps a) -> Nat -> Maybe token -> P state token
pSymExt :: (forall a. (token -> state -> Steps a) -> state -> Steps a)
-> Nat -> Maybe token -> P state token
pSymExt forall a. (token -> state -> Steps a) -> state -> Steps a
splitState Nat
l Maybe token
e   = Maybe (T state token) -> Maybe token -> Nat -> P state token
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser (T state token -> Maybe (T state token)
forall a. a -> Maybe a
Just T state token
t)  Maybe token
e Nat
l
                 where t :: T state token
t = (forall a. (token -> state -> Steps a) -> state -> Steps a)
-> (forall r. (state -> Steps r) -> state -> Steps (token, r))
-> (forall r. (state -> Steps r) -> state -> Steps r)
-> T state token
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T (        (token -> state -> Steps r) -> state -> Steps r
forall a. (token -> state -> Steps a) -> state -> Steps a
splitState                       )
                             ( \ state -> Steps r
k -> (token -> state -> Steps (token, r)) -> state -> Steps (token, r)
forall a. (token -> state -> Steps a) -> state -> Steps a
splitState  (\ token
t -> token -> Steps r -> Steps (token, r)
forall v r. v -> Steps r -> Steps (v, r)
push token
t (Steps r -> Steps (token, r))
-> (state -> Steps r) -> state -> Steps (token, r)
forall t t t. (t -> t) -> (t -> t) -> t -> t
. state -> Steps r
k)  )
                             ( \ state -> Steps r
k -> (token -> state -> Steps r) -> state -> Steps r
forall a. (token -> state -> Steps a) -> state -> Steps a
splitState  (\ token
_ -> state -> Steps r
k )          )

-- | `micro` inserts a `Cost` step into the sequence representing the progress the parser is making; 
--   for its use see `"Text.ParserCombinators.UU.Demos.Examples"`
micro :: P state a -> Int -> P state a
P T state a
_  Maybe (T state a)
np  Maybe a
pe Nat
pl micro :: P state a -> Int -> P state a
`micro` Int
i  
  = let nnp :: Maybe (T state a)
nnp = (T state a -> T state a) -> Maybe (T state a) -> Maybe (T state a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (T forall r. (a -> state -> Steps r) -> state -> Steps r
ph forall r. (state -> Steps r) -> state -> Steps (a, r)
pf  forall r. (state -> Steps r) -> state -> Steps r
pr) -> ((forall r. (a -> state -> Steps r) -> state -> Steps r)
-> (forall r. (state -> Steps r) -> state -> Steps (a, r))
-> (forall r. (state -> Steps r) -> state -> Steps r)
-> T state a
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( \ a -> state -> Steps r
k state
st -> (a -> state -> Steps r) -> state -> Steps r
forall r. (a -> state -> Steps r) -> state -> Steps r
ph (\ a
a state
st -> Int -> Steps r -> Steps r
forall a. Int -> Steps a -> Steps a
Micro Int
i (a -> state -> Steps r
k a
a state
st)) state
st)
                                          ( \ state -> Steps r
k state
st -> (state -> Steps r) -> state -> Steps (a, r)
forall r. (state -> Steps r) -> state -> Steps (a, r)
pf (Int -> Steps r -> Steps r
forall a. Int -> Steps a -> Steps a
Micro Int
i (Steps r -> Steps r) -> (state -> Steps r) -> state -> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
.state -> Steps r
k) state
st)
                                          ( \ state -> Steps r
k state
st -> (state -> Steps r) -> state -> Steps r
forall r. (state -> Steps r) -> state -> Steps r
pr (Int -> Steps r -> Steps r
forall a. Int -> Steps a -> Steps a
Micro Int
i (Steps r -> Steps r) -> (state -> Steps r) -> state -> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
.state -> Steps r
k) state
st))) Maybe (T state a)
np
    in Maybe (T state a) -> Maybe a -> Nat -> P state a
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T state a)
nnp Maybe a
pe Nat
pl

-- |  For the precise functioning of the `amb` combinators see the paper cited in the "Text.ParserCombinators.UU.README";
--    it converts an ambiguous parser into a parser which returns a list of all possible recognitions,
amb :: P st a -> P st [a]
amb :: P st a -> P st [a]
amb (P T st a
_  Maybe (T st a)
np  Maybe a
pe Nat
pl) 
 = let  combinevalues  :: Steps [(a,r)] -> Steps ([a],r)
        combinevalues :: Steps [(a, r)] -> Steps ([a], r)
combinevalues Steps [(a, r)]
lar  =   ([(a, r)] -> ([a], r)) -> Steps [(a, r)] -> Steps ([a], r)
forall a b. (b -> a) -> Steps b -> Steps a
Apply (\ [(a, r)]
lar -> (((a, r) -> a) -> [(a, r)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, r) -> a
forall a b. (a, b) -> a
fst [(a, r)]
lar, (a, r) -> r
forall a b. (a, b) -> b
snd ([(a, r)] -> (a, r)
forall a. [a] -> a
head [(a, r)]
lar))) Steps [(a, r)]
lar
        nnp :: Maybe (T st [a])
nnp = case Maybe (T st a)
np of
              Maybe (T st a)
Nothing -> Maybe (T st [a])
forall a. Maybe a
Nothing
              Just ((T forall r. (a -> st -> Steps r) -> st -> Steps r
ph forall r. (st -> Steps r) -> st -> Steps (a, r)
pf  forall r. (st -> Steps r) -> st -> Steps r
pr)) -> T st [a] -> Maybe (T st [a])
forall a. a -> Maybe a
Just((forall r. ([a] -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps ([a], r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st [a]
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( \[a] -> st -> Steps r
k     ->  Steps (a, r) -> Steps r
forall a r. Steps (a, r) -> Steps r
removeEnd_h (Steps (a, r) -> Steps r) -> (st -> Steps (a, r)) -> st -> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
. (a -> st -> Steps (a, r)) -> st -> Steps (a, r)
forall r. (a -> st -> Steps r) -> st -> Steps r
ph (\ a
a st
st' -> ([a], [a] -> Steps r) -> Steps (a, r) -> Steps (a, r)
forall a r. ([a], [a] -> Steps r) -> Steps (a, r) -> Steps (a, r)
End_h ([a
a], \ [a]
as -> [a] -> st -> Steps r
k [a]
as st
st') Steps (a, r)
forall a. Steps a
noAlts))
                                             ( \st -> Steps r
k st
inp ->  Steps [(a, r)] -> Steps ([a], r)
forall a r. Steps [(a, r)] -> Steps ([a], r)
combinevalues (Steps [(a, r)] -> Steps ([a], r))
-> (Steps (a, r) -> Steps [(a, r)])
-> Steps (a, r)
-> Steps ([a], r)
forall t t t. (t -> t) -> (t -> t) -> t -> t
. Steps (a, r) -> Steps [(a, r)]
forall r. Steps r -> Steps [r]
removeEnd_f (Steps (a, r) -> Steps ([a], r)) -> Steps (a, r) -> Steps ([a], r)
forall a b. (a -> b) -> a -> b
$ (st -> Steps r) -> st -> Steps (a, r)
forall r. (st -> Steps r) -> st -> Steps (a, r)
pf (\st
st -> [Steps r] -> Steps r -> Steps r
forall a. [Steps a] -> Steps a -> Steps a
End_f [st -> Steps r
k st
st] Steps r
forall a. Steps a
noAlts) st
inp)
                                             ( \st -> Steps r
k     ->  Steps (Any, r) -> Steps r
forall a r. Steps (a, r) -> Steps r
removeEnd_h (Steps (Any, r) -> Steps r)
-> (st -> Steps (Any, r)) -> st -> Steps r
forall t t t. (t -> t) -> (t -> t) -> t -> t
. (st -> Steps (Any, r)) -> st -> Steps (Any, r)
forall r. (st -> Steps r) -> st -> Steps r
pr (\ st
st' -> ([Any], [Any] -> Steps r) -> Steps (Any, r) -> Steps (Any, r)
forall a r. ([a], [a] -> Steps r) -> Steps (a, r) -> Steps (a, r)
End_h ([Any
forall a. HasCallStack => a
undefined], \ [Any]
_ -> st -> Steps r
k  st
st') Steps (Any, r)
forall a. Steps a
noAlts)))
        nep :: Maybe [a]
nep = ((a -> [a]) -> Maybe a -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
pe)
    in  Maybe (T st [a]) -> Maybe [a] -> Nat -> P st [a]
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T st [a])
nnp Maybe [a]
nep Nat
pl

-- | `pErrors` returns the error messages that were generated since its last call.
pErrors :: StoresErrors st error => P st [error]
pErrors :: P st [error]
pErrors = let nnp :: Maybe (T st [error])
nnp = T st [error] -> Maybe (T st [error])
forall a. a -> Maybe a
Just ((forall r. ([error] -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps ([error], r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st [error]
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( \ [error] -> st -> Steps r
k st
inp -> let ([error]
errs, st
inp') = st -> ([error], st)
forall state error.
StoresErrors state error =>
state -> ([error], state)
getErrors st
inp in [error] -> st -> Steps r
k    [error]
errs    st
inp' )
                            ( \ st -> Steps r
k st
inp -> let ([error]
errs, st
inp') = st -> ([error], st)
forall state error.
StoresErrors state error =>
state -> ([error], state)
getErrors st
inp in [error] -> Steps r -> Steps ([error], r)
forall v r. v -> Steps r -> Steps (v, r)
push [error]
errs (st -> Steps r
k st
inp'))
                            ( \ st -> Steps r
k st
inp -> let ([error]
errs, st
inp') = st -> ([error], st)
forall state error.
StoresErrors state error =>
state -> ([error], state)
getErrors st
inp in            st -> Steps r
k st
inp' ))
          in Maybe (T st [error]) -> Maybe [error] -> Nat -> P st [error]
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T st [error])
nnp  Maybe [error]
forall a. Maybe a
Nothing Nat
Zero

-- | `pPos` returns the current input position.
pPos :: HasPosition st pos => P st pos
pPos :: P st pos
pPos =  let nnp :: Maybe (T st pos)
nnp = T st pos -> Maybe (T st pos)
forall a. a -> Maybe a
Just ( (forall r. (pos -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (pos, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st pos
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( \ pos -> st -> Steps r
k st
inp -> let pos :: pos
pos = st -> pos
forall state pos. HasPosition state pos => state -> pos
getPos st
inp in pos -> st -> Steps r
k    pos
pos    st
inp )
                           ( \ st -> Steps r
k st
inp -> let pos :: pos
pos = st -> pos
forall state pos. HasPosition state pos => state -> pos
getPos st
inp in pos -> Steps r -> Steps (pos, r)
forall v r. v -> Steps r -> Steps (v, r)
push pos
pos (st -> Steps r
k st
inp))
                           ( \ st -> Steps r
k st
inp ->                                   st -> Steps r
k st
inp ))
        in Maybe (T st pos) -> Maybe pos -> Nat -> P st pos
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T st pos)
nnp Maybe pos
forall a. Maybe a
Nothing Nat
Zero

-- | `pState` returns the current input state
pState :: P st st
pState :: P st st
pState =   let nnp :: Maybe (T a a)
nnp = T a a -> Maybe (T a a)
forall a. a -> Maybe a
Just ( (forall r. (a -> a -> Steps r) -> a -> Steps r)
-> (forall r. (a -> Steps r) -> a -> Steps (a, r))
-> (forall r. (a -> Steps r) -> a -> Steps r)
-> T a a
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( \ a -> a -> Steps r
k a
inp -> a -> a -> Steps r
k a
inp a
inp)
                          ( \ a -> Steps r
k a
inp -> a -> Steps r -> Steps (a, r)
forall v r. v -> Steps r -> Steps (v, r)
push a
inp (a -> Steps r
k a
inp))
                          forall r. (a -> Steps r) -> a -> Steps r
forall a b. (a -> b) -> a -> b
($))
           in Maybe (T st st) -> Maybe st -> Nat -> P st st
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T st st)
forall a. Maybe (T a a)
nnp Maybe st
forall a. Maybe a
Nothing Nat
Zero 

-- | The function `pEnd` should be called at the end of the parsing process. It deletes any unconsumed input, turning it into error messages.

pEnd    :: (StoresErrors st error, Eof st) => P st [error]
pEnd :: P st [error]
pEnd    = let nnp :: Maybe (T st [error])
nnp = T st [error] -> Maybe (T st [error])
forall a. a -> Maybe a
Just ( (forall r. ([error] -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps ([error], r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st [error]
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T ( \ [error] -> st -> Steps r
k st
inp ->   let deleterest :: st -> Steps r
deleterest st
inp =  case st -> Maybe (Int, st)
forall state. Eof state => state -> Maybe (Int, state)
deleteAtEnd st
inp of
                                                  Maybe (Int, st)
Nothing -> let ([error]
finalerrors, st
finalstate) = st -> ([error], st)
forall state error.
StoresErrors state error =>
state -> ([error], state)
getErrors st
inp
                                                             in [error] -> st -> Steps r
k  [error]
finalerrors st
finalstate
                                                  Just (Int
i, st
inp') -> Strings -> [Strings -> (Int, Steps r)] -> Steps r
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail []  [(Int, Steps r) -> Strings -> (Int, Steps r)
forall a b. a -> b -> a
const (Int
i,  st -> Steps r
deleterest st
inp')]
                                            in st -> Steps r
deleterest st
inp)
                             ( \ st -> Steps r
k   st
inp -> let deleterest :: st -> Steps ([error], r)
deleterest st
inp =  case st -> Maybe (Int, st)
forall state. Eof state => state -> Maybe (Int, state)
deleteAtEnd st
inp of
                                                  Maybe (Int, st)
Nothing -> let ([error]
finalerrors, st
finalstate) = st -> ([error], st)
forall state error.
StoresErrors state error =>
state -> ([error], state)
getErrors st
inp
                                                             in [error] -> Steps r -> Steps ([error], r)
forall v r. v -> Steps r -> Steps (v, r)
push [error]
finalerrors (st -> Steps r
k st
finalstate)
                                                  Just (Int
i, st
inp') -> Strings
-> [Strings -> (Int, Steps ([error], r))] -> Steps ([error], r)
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail [] [(Int, Steps ([error], r)) -> Strings -> (Int, Steps ([error], r))
forall a b. a -> b -> a
const ((Int
i, st -> Steps ([error], r)
deleterest st
inp'))]
                                            in st -> Steps ([error], r)
deleterest st
inp)
                             ( \ st -> Steps r
k   st
inp -> let deleterest :: st -> Steps r
deleterest st
inp =  case st -> Maybe (Int, st)
forall state. Eof state => state -> Maybe (Int, state)
deleteAtEnd st
inp of
                                                  Maybe (Int, st)
Nothing -> let ([error]
finalerrors, st
finalstate) = st -> ([error], st)
forall state error.
StoresErrors state error =>
state -> ([error], state)
getErrors st
inp
                                                             in  (st -> Steps r
k st
finalstate)
                                                  Just (Int
i, st
inp') -> Strings -> [Strings -> (Int, Steps r)] -> Steps r
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail [] [(Int, Steps r) -> Strings -> (Int, Steps r)
forall a b. a -> b -> a
const (Int
i, st -> Steps r
deleterest st
inp')]
                                            in st -> Steps r
deleterest st
inp))
         in Maybe (T st [error]) -> Maybe [error] -> Nat -> P st [error]
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T st [error])
nnp  Maybe [error]
forall a. Maybe a
Nothing Nat
Zero
           
-- | @`pSwitch`@ takes the current state and modifies it to a different type of state to which its argument parser is applied. 
--   The second component of the result is a function which  converts the remaining state of this parser back into a value of the original type.
--   For the second argument to @`pSwitch`@  (say split) we expect the following to hold:
--   
-- >  let (n,f) = split st in f n == st

pSwitch :: (st1 -> (st2, st2 -> st1)) -> P st2 a -> P st1 a -- we require let (n,f) = split st in f n to be equal to st
pSwitch :: (st1 -> (st2, st2 -> st1)) -> P st2 a -> P st1 a
pSwitch st1 -> (st2, st2 -> st1)
split (P T st2 a
_ Maybe (T st2 a)
np Maybe a
pe Nat
pl)    
   = let nnp :: Maybe (T st1 a)
nnp = (T st2 a -> T st1 a) -> Maybe (T st2 a) -> Maybe (T st1 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (T forall r. (a -> st2 -> Steps r) -> st2 -> Steps r
ph forall r. (st2 -> Steps r) -> st2 -> Steps (a, r)
pf forall r. (st2 -> Steps r) -> st2 -> Steps r
pr) ->(forall r. (a -> st1 -> Steps r) -> st1 -> Steps r)
-> (forall r. (st1 -> Steps r) -> st1 -> Steps (a, r))
-> (forall r. (st1 -> Steps r) -> st1 -> Steps r)
-> T st1 a
forall st a.
(forall r. (a -> st -> Steps r) -> st -> Steps r)
-> (forall r. (st -> Steps r) -> st -> Steps (a, r))
-> (forall r. (st -> Steps r) -> st -> Steps r)
-> T st a
T (\ a -> st1 -> Steps r
k st1
st1 ->  let (st2
st2, st2 -> st1
back) = st1 -> (st2, st2 -> st1)
split st1
st1
                                                     in (a -> st2 -> Steps r) -> st2 -> Steps r
forall r. (a -> st2 -> Steps r) -> st2 -> Steps r
ph (\ a
a st2
st2' -> a -> st1 -> Steps r
k a
a (st2 -> st1
back st2
st2')) st2
st2)
                                        (\ st1 -> Steps r
k st1
st1 ->  let (st2
st2, st2 -> st1
back) = st1 -> (st2, st2 -> st1)
split st1
st1
                                                     in (st2 -> Steps r) -> st2 -> Steps (a, r)
forall r. (st2 -> Steps r) -> st2 -> Steps (a, r)
pf (\st2
st2' -> st1 -> Steps r
k (st2 -> st1
back st2
st2')) st2
st2)
                                        (\ st1 -> Steps r
k st1
st1 ->  let (st2
st2, st2 -> st1
back) = st1 -> (st2, st2 -> st1)
split st1
st1
                                                     in (st2 -> Steps r) -> st2 -> Steps r
forall r. (st2 -> Steps r) -> st2 -> Steps r
pr (\st2
st2' -> st1 -> Steps r
k (st2 -> st1
back st2
st2')) st2
st2)) Maybe (T st2 a)
np
     in Maybe (T st1 a) -> Maybe a -> Nat -> P st1 a
forall st a. Maybe (T st a) -> Maybe a -> Nat -> P st a
mkParser Maybe (T st1 a)
nnp Maybe a
pe Nat
pl


-- | The function @`parse`@ shows the prototypical way of running a parser on
-- some specific input.
-- By default we use the future parser, since this gives us access to partial
-- result; future parsers are expected to run in less space.
parse :: (Eof t) => P t a -> t -> a
parse :: P t a -> t -> a
parse   (P (T forall r. (a -> t -> Steps r) -> t -> Steps r
_  forall r. (t -> Steps r) -> t -> Steps (a, r)
pf forall r. (t -> Steps r) -> t -> Steps r
_) Maybe (T t a)
_ Maybe a
_ Nat
_)  t
state = (a, ()) -> a
forall a b. (a, b) -> a
fst ((a, ()) -> a) -> (Steps (a, ()) -> (a, ())) -> Steps (a, ()) -> a
forall t t t. (t -> t) -> (t -> t) -> t -> t
. Steps (a, ()) -> (a, ())
forall a. Steps a -> a
eval (Steps (a, ()) -> a) -> Steps (a, ()) -> a
forall a b. (a -> b) -> a -> b
$   (t -> Steps ()) -> t -> Steps (a, ())
forall r. (t -> Steps r) -> t -> Steps (a, r)
pf (\ t
rest   -> if t -> Bool
forall state. Eof state => state -> Bool
eof t
rest then  () -> Steps ()
forall a. a -> Steps a
Done ()
                                                                                   else String -> Steps ()
forall a. HasCallStack => String -> a
error String
"pEnd missing?") t
state
-- | The function @`parse_h`@ behaves like @`parse`@ but using the history
-- parser. This parser does not give online results, but might run faster.
parse_h :: (Eof t) => P t a -> t -> a
parse_h :: P t a -> t -> a
parse_h (P (T forall r. (a -> t -> Steps r) -> t -> Steps r
ph forall r. (t -> Steps r) -> t -> Steps (a, r)
_  forall r. (t -> Steps r) -> t -> Steps r
_) Maybe (T t a)
_ Maybe a
_ Nat
_) t
state  = Steps a -> a
forall a. Steps a -> a
eval (Steps a -> a) -> Steps a -> a
forall a b. (a -> b) -> a -> b
$  (a -> t -> Steps a) -> t -> Steps a
forall r. (a -> t -> Steps r) -> t -> Steps r
ph  (\ a
a t
rest -> if t -> Bool
forall state. Eof state => state -> Bool
eof t
rest then  a -> Steps a
forall a. a -> Steps a
Done a
a
                                                                      else String -> Steps a
forall a. HasCallStack => String -> a
error String
"pEnd missing?") t
state

-- | The data type `Steps` is the core data type around which the parsers are constructed.
--   It describes a tree structure of streams containing (in an interleaved way) both the online result of the parsing process,
--   and progress information. Recognising an input token should correspond to a certain amount of @`Progress`@, 
--   which tells how much of the input state was consumed. 
--   The @`Progress`@ is used to implement the breadth-first search process, in which alternatives are
--   examined in a more-or-less synchronised way. The meaning of the various @`Step`@ constructors is as follows:
--
--   [`Step`] A token was succesfully recognised, and as a result the input was 'advanced' by the distance  @`Progress`@
--
--   [`Apply`] The type of value represented by the `Steps` changes by applying the function parameter.
--
--   [`Fail`] A correcting step has to be made to the input; the first parameter contains information about what was expected in the input, 
--   and the second parameter describes the various corrected alternatives, each with an associated `Cost`
--
--   [`Micro`] A small cost is inserted in the sequence, which is used to disambiguate. Use with care!
--
--   The last two alternatives play a role in recognising ambigous non-terminals. For a full description see the technical report referred to from 
--   "Text.ParserCombinators.UU.README".



data  Steps :: * -> *  where
      Step   ::                 Progress       ->  Steps a                             -> Steps   a
      Apply  ::  forall a b.    (b -> a)       ->  Steps   b                           -> Steps   a
      Fail   ::                 Strings        ->  [Strings   ->  (Cost , Steps   a)]  -> Steps   a
      Micro  ::                 Int            ->  Steps a                             -> Steps   a
      Done   ::                 a                                                      -> Steps   a
      End_h  ::                 ([a] , [a]     ->  Steps r)    ->  Steps   (a,r)       -> Steps   (a, r)
      End_f  ::                 [Steps   a]    ->  Steps   a                           -> Steps   a

instance Show (Steps a) where
  show :: Steps a -> String
show (Step Int
_ Steps a
_)   = String
"Step"
  show (Apply b -> a
_ Steps b
_)  = String
"Apply"
  show (Fail Strings
_ [Strings -> (Int, Steps a)]
_)   = String
"Fail"
  show (Micro Int
_ Steps a
_)  = String
"Micro"
  show (Done a
_)     = String
"Done"
  show (End_h ([a], [a] -> Steps r)
_ Steps (a, r)
_ ) = String
"End_h"
  show (End_f [Steps a]
_ Steps a
_ ) = String
"End_f"

type Cost     = Int
type Progress = Int
type Strings  = [String]

apply       :: Steps (b -> a, (b, r)) -> Steps (a, r)
apply :: Steps (b -> a, (b, r)) -> Steps (a, r)
apply       =  ((b -> a, (b, r)) -> (a, r))
-> Steps (b -> a, (b, r)) -> Steps (a, r)
forall a b. (b -> a) -> Steps b -> Steps a
Apply (\(b -> a
b2a, (b, r)
br) -> let (b
b, r
r) = (b, r)
br in (b -> a
b2a b
b, r
r)) 

push        :: v -> Steps   r -> Steps   (v, r)
push :: v -> Steps r -> Steps (v, r)
push v
v      =  (r -> (v, r)) -> Steps r -> Steps (v, r)
forall a b. (b -> a) -> Steps b -> Steps a
Apply (\ r
r -> (v
v, r
r))

apply2fst   :: (b -> a) -> Steps (b, r) -> Steps (a, r)
apply2fst :: (b -> a) -> Steps (b, r) -> Steps (a, r)
apply2fst b -> a
f = ((b, r) -> (a, r)) -> Steps (b, r) -> Steps (a, r)
forall a b. (b -> a) -> Steps b -> Steps a
Apply (\ (b, r)
br -> let (b
b, r
r) = (b, r)
br in (b -> a
f b
b, r
r)) 

noAlts :: Steps a
noAlts :: Steps a
noAlts      =  Strings -> [Strings -> (Int, Steps a)] -> Steps a
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail [] []

has_success :: Steps t -> Bool
has_success :: Steps t -> Bool
has_success (Step Int
_ Steps t
_) = Bool
True
has_success (Done t
_)   = Bool
True
has_success Steps t
_          = Bool
False 

-- | @`eval`@ removes the progress information from a sequence of steps, 
--   and constructs the value embedded in it.
--   If you are really desparate to see how your parsers are making progress
--   (e.g. when you have written an ambiguous parser, and you cannot find 
--   the cause of the exponential blow-up of your parsing process), 
--   you may switch on the trace in the function @`eval`@ (you will need to edit the library source code).
-- 
eval :: Steps   a      ->  a
eval :: Steps a -> a
eval (Step  Int
n    Steps a
l)     =   String -> a -> a
forall b. String -> b -> b
trace' (String
"Step " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") (Steps a -> a
forall a. Steps a -> a
eval Steps a
l)
eval (Micro  Int
_    Steps a
l)    =   Steps a -> a
forall a. Steps a -> a
eval Steps a
l
eval (Fail   Strings
ss  [Strings -> (Int, Steps a)]
ls  )  =   String -> a -> a
forall b. String -> b -> b
trace' (String
"expecting: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Strings -> String
forall a. Show a => a -> String
show Strings
ss) (Steps a -> a
forall a. Steps a -> a
eval (Int -> [(Int, Steps a)] -> Steps a
forall a. Int -> [(Int, Steps a)] -> Steps a
getCheapest Int
5 (((Strings -> (Int, Steps a)) -> (Int, Steps a))
-> [Strings -> (Int, Steps a)] -> [(Int, Steps a)]
forall a b. (a -> b) -> [a] -> [b]
map ((Strings -> (Int, Steps a)) -> Strings -> (Int, Steps a)
forall a b. (a -> b) -> a -> b
$Strings
ss) [Strings -> (Int, Steps a)]
ls))) 
eval (Apply  b -> a
f   Steps b
l   )  =   b -> a
f (Steps b -> b
forall a. Steps a -> a
eval Steps b
l)
eval (End_f   [Steps a]
_  Steps a
_   )  =   String -> a
forall a. HasCallStack => String -> a
error String
"dangling End_f constructor"
eval (End_h   ([a], [a] -> Steps r)
_  Steps (a, r)
_   )  =   String -> a
forall a. HasCallStack => String -> a
error String
"dangling End_h constructor"
eval (Done  a
a        )  =   a
a

-- | `norm` makes sure that the head of the sequence contains progress information. 
--   It does so by pushing information about the result (i.e. the `Apply` steps) backwards.
--
norm ::  Steps a ->  Steps   a
norm :: Steps a -> Steps a
norm     (Apply b -> a
f (Step   Int
p    Steps b
l  ))   =   Int -> Steps a -> Steps a
forall a. Int -> Steps a -> Steps a
Step  Int
p ((b -> a) -> Steps b -> Steps a
forall a b. (b -> a) -> Steps b -> Steps a
Apply b -> a
f Steps b
l)
norm     (Apply b -> a
f (Micro  Int
c    Steps b
l  ))   =   Int -> Steps a -> Steps a
forall a. Int -> Steps a -> Steps a
Micro Int
c ((b -> a) -> Steps b -> Steps a
forall a b. (b -> a) -> Steps b -> Steps a
Apply b -> a
f Steps b
l)
norm     (Apply b -> a
f (Fail   Strings
ss   [Strings -> (Int, Steps b)]
ls ))   =   Strings -> [Strings -> (Int, Steps a)] -> Steps a
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail Strings
ss ((Steps b -> Steps a)
-> [Strings -> (Int, Steps b)] -> [Strings -> (Int, Steps a)]
forall c d a b. (c -> d) -> [a -> (b, c)] -> [a -> (b, d)]
applyFail ((b -> a) -> Steps b -> Steps a
forall a b. (b -> a) -> Steps b -> Steps a
Apply b -> a
f) [Strings -> (Int, Steps b)]
ls)
norm     (Apply b -> a
f (Apply  b -> b
g    Steps b
l  ))   =   Steps a -> Steps a
forall a. Steps a -> Steps a
norm ((b -> a) -> Steps b -> Steps a
forall a b. (b -> a) -> Steps b -> Steps a
Apply (b -> a
f(b -> a) -> (b -> b) -> b -> a
forall t t t. (t -> t) -> (t -> t) -> t -> t
.b -> b
g) Steps b
l)
norm     (Apply b -> a
f (End_f  [Steps b]
ss   Steps b
l  ))   =   [Steps a] -> Steps a -> Steps a
forall a. [Steps a] -> Steps a -> Steps a
End_f ((Steps b -> Steps a) -> [Steps b] -> [Steps a]
forall a b. (a -> b) -> [a] -> [b]
map ((b -> a) -> Steps b -> Steps a
forall a b. (b -> a) -> Steps b -> Steps a
Apply b -> a
f) [Steps b]
ss) ((b -> a) -> Steps b -> Steps a
forall a b. (b -> a) -> Steps b -> Steps a
Apply b -> a
f Steps b
l)
norm     (Apply b -> a
f (End_h  ([a], [a] -> Steps r)
_    Steps (a, r)
_  ))   =   String -> Steps a
forall a. HasCallStack => String -> a
error String
"Apply before End_h"
norm     (Apply b -> a
f (Done  b
a        ))   =   a -> Steps a
forall a. a -> Steps a
Done (b -> a
f b
a)
norm     Steps a
steps                         =   Steps a
steps

applyFail :: (c -> d) -> [a -> (b, c)] -> [a -> (b, d)]
applyFail :: (c -> d) -> [a -> (b, c)] -> [a -> (b, d)]
applyFail c -> d
f  = ((a -> (b, c)) -> a -> (b, d)) -> [a -> (b, c)] -> [a -> (b, d)]
forall a b. (a -> b) -> [a] -> [b]
map (\ a -> (b, c)
g -> \ a
ex -> let (b
c, c
l) =  a -> (b, c)
g a
ex in  (b
c, c -> d
f c
l))

-- | The function @best@ compares two streams
best :: Steps a -> Steps a -> Steps a
Steps a
x best :: Steps a -> Steps a -> Steps a
`best` Steps a
y =   Steps a -> Steps a
forall a. Steps a -> Steps a
norm Steps a
x Steps a -> Steps a -> Steps a
forall a. Steps a -> Steps a -> Steps a
`best'` Steps a -> Steps a
forall a. Steps a -> Steps a
norm Steps a
y

best' :: Steps   b -> Steps   b -> Steps   b
(Done  b
_)               best' :: Steps b -> Steps b -> Steps b
`best'`   (Done  b
_)           =   String -> Steps b
forall a. HasCallStack => String -> a
error String
"ambiguous parsers"
l :: Steps b
l@(Done b
_)              `best'`   Steps b
r                   =   Steps b
l
Steps b
l                       `best'`   r :: Steps b
r@(Done b
_)          =   Steps b
r
End_f  [Steps b]
as  Steps b
l            `best'`  End_f  [Steps b]
bs Steps b
r          =   [Steps b] -> Steps b -> Steps b
forall a. [Steps a] -> Steps a -> Steps a
End_f ([Steps b]
as[Steps b] -> [Steps b] -> [Steps b]
forall a. [a] -> [a] -> [a]
++[Steps b]
bs)  (Steps b
l Steps b -> Steps b -> Steps b
forall a. Steps a -> Steps a -> Steps a
`best` Steps b
r)
End_f  [Steps b]
as  Steps b
l            `best'`  Steps b
r                    =   [Steps b] -> Steps b -> Steps b
forall a. [Steps a] -> Steps a -> Steps a
End_f [Steps b]
as        (Steps b
l Steps b -> Steps b -> Steps b
forall a. Steps a -> Steps a -> Steps a
`best` Steps b
r)
Steps b
l                       `best'`  End_f  [Steps b]
bs Steps b
r          =   [Steps b] -> Steps b -> Steps b
forall a. [Steps a] -> Steps a -> Steps a
End_f [Steps b]
bs        (Steps b
l Steps b -> Steps b -> Steps b
forall a. Steps a -> Steps a -> Steps a
`best` Steps b
r)
End_h  ([a]
as, [a] -> Steps r
k_h_st)  Steps (a, r)
l  `best'`  End_h  ([a]
bs, [a] -> Steps r
_) Steps (a, r)
r     =   ([a], [a] -> Steps r) -> Steps (a, r) -> Steps (a, r)
forall a r. ([a], [a] -> Steps r) -> Steps (a, r) -> Steps (a, r)
End_h ([a]
as[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
[a]
bs, [a] -> Steps r
k_h_st)  (Steps (a, r)
l Steps (a, r) -> Steps (a, r) -> Steps (a, r)
forall a. Steps a -> Steps a -> Steps a
`best` Steps (a, r)
Steps (a, r)
r)
End_h  ([a], [a] -> Steps r)
as  Steps (a, r)
l            `best'`  Steps b
r                    =   ([a], [a] -> Steps r) -> Steps (a, r) -> Steps (a, r)
forall a r. ([a], [a] -> Steps r) -> Steps (a, r) -> Steps (a, r)
End_h ([a], [a] -> Steps r)
as (Steps (a, r)
l Steps (a, r) -> Steps (a, r) -> Steps (a, r)
forall a. Steps a -> Steps a -> Steps a
`best` Steps b
Steps (a, r)
r)
Steps b
l                       `best'`  End_h  ([a], [a] -> Steps r)
bs Steps (a, r)
r          =   ([a], [a] -> Steps r) -> Steps (a, r) -> Steps (a, r)
forall a r. ([a], [a] -> Steps r) -> Steps (a, r) -> Steps (a, r)
End_h ([a], [a] -> Steps r)
bs (Steps b
l Steps b -> Steps b -> Steps b
forall a. Steps a -> Steps a -> Steps a
`best` Steps b
Steps (a, r)
r)
Fail  Strings
sl  [Strings -> (Int, Steps b)]
ll     `best'`  Fail  Strings
sr [Strings -> (Int, Steps b)]
rr     =   Strings -> [Strings -> (Int, Steps b)] -> Steps b
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail (Strings
sl Strings -> Strings -> Strings
forall a. [a] -> [a] -> [a]
++ Strings
sr) ([Strings -> (Int, Steps b)]
ll[Strings -> (Int, Steps b)]
-> [Strings -> (Int, Steps b)] -> [Strings -> (Int, Steps b)]
forall a. [a] -> [a] -> [a]
++[Strings -> (Int, Steps b)]
rr)
Fail  Strings
_   [Strings -> (Int, Steps b)]
_      `best'`  Steps b
r               =   Steps b
r   -- <----------------------------- to be refined
Steps b
l                `best'`  Fail  Strings
_  [Strings -> (Int, Steps b)]
_      =   Steps b
l
Step  Int
n   Steps b
l      `best'`  Step  Int
m  Steps b
r
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
m                              =   Int -> Steps b -> Steps b
forall a. Int -> Steps a -> Steps a
Step Int
n (Steps b
l  Steps b -> Steps b -> Steps b
forall a. Steps a -> Steps a -> Steps a
`best` Steps b
r)     
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
m                               =   Int -> Steps b -> Steps b
forall a. Int -> Steps a -> Steps a
Step Int
n (Steps b
l  Steps b -> Steps b -> Steps b
forall a. Steps a -> Steps a -> Steps a
`best`  Int -> Steps b -> Steps b
forall a. Int -> Steps a -> Steps a
Step (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)  Steps b
r)
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
m                               =   Int -> Steps b -> Steps b
forall a. Int -> Steps a -> Steps a
Step Int
m (Int -> Steps b -> Steps b
forall a. Int -> Steps a -> Steps a
Step (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m)  Steps b
l  Steps b -> Steps b -> Steps b
forall a. Steps a -> Steps a -> Steps a
`best` Steps b
r)
ls :: Steps b
ls@(Step Int
_  Steps b
_)    `best'`  Micro Int
_ Steps b
_        =  Steps b
ls
Micro Int
_    Steps b
_      `best'`  rs :: Steps b
rs@(Step  Int
_ Steps b
_)   =  Steps b
rs
ls :: Steps b
ls@(Micro Int
i Steps b
l)    `best'`  rs :: Steps b
rs@(Micro Int
j Steps b
r)  
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j                               =   Int -> Steps b -> Steps b
forall a. Int -> Steps a -> Steps a
Micro Int
i (Steps b
l Steps b -> Steps b -> Steps b
forall a. Steps a -> Steps a -> Steps a
`best` Steps b
r)
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
j                                =   Steps b
ls
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
j                                =   Steps b
rs
Steps b
l                       `best'`  Steps b
r         =   String -> Steps b
forall a. HasCallStack => String -> a
error (String
"missing alternative in best': " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Steps b -> String
forall a. Show a => a -> String
show Steps b
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Steps b -> String
forall a. Show a => a -> String
show Steps b
r) 

-- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-- %%%%%%%%%%%%% getCheapest  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

getCheapest :: Int -> [(Int, Steps a)] -> Steps a 
getCheapest :: Int -> [(Int, Steps a)] -> Steps a
getCheapest Int
_ [] = String -> Steps a
forall a. HasCallStack => String -> a
error String
"no correcting alternative found"
getCheapest Int
n [(Int, Steps a)]
l  =  (Int, Steps a) -> Steps a
forall a b. (a, b) -> b
snd ((Int, Steps a) -> Steps a) -> (Int, Steps a) -> Steps a
forall a b. (a -> b) -> a -> b
$  ((Int, Steps a) -> (Int, Steps a) -> (Int, Steps a))
-> (Int, Steps a) -> [(Int, Steps a)] -> (Int, Steps a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Int
w,Steps a
ll) btf :: (Int, Steps a)
btf@(Int
c, Steps a
l)
                               ->    if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
c   -- c is the best cost estimate thus far, and w total costs on this path
                                     then let new :: Int
new = (Int -> Steps a -> Int -> Int -> Int
forall a. Int -> Steps a -> Int -> Int -> Int
traverse Int
n Steps a
ll Int
w Int
c) 
                                          in if Int
new Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
c then (Int
new, Steps a
ll) else (Int, Steps a)
btf
                                     else (Int, Steps a)
btf 
                               )   (Int
forall a. Bounded a => a
maxBound, String -> Steps a
forall a. HasCallStack => String -> a
error String
"getCheapest") [(Int, Steps a)]
l


traverse :: Int -> Steps a -> Int -> Int  -> Int
traverse :: Int -> Steps a -> Int -> Int -> Int
traverse Int
0  Steps a
_            Int
v Int
c  =  String -> Int -> Int
forall b. String -> b -> b
trace' (String
"traverse        " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> Int -> Int -> String
forall a b c. (Show a, Show b, Show c) => a -> b -> c -> String
show' Integer
0 Int
v Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" choosing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
  Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
100 -- uncertainty cost
traverse Int
n (Step Int
_   Steps a
l)  Int
v Int
c  =  String -> Int -> Int
forall b. String -> b -> b
trace' (String
"traverse Step   " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Int -> Int -> String
forall a b c. (Show a, Show b, Show c) => a -> b -> c -> String
show' Int
n Int
v Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
  Int -> Steps a -> Int -> Int -> Int
forall a. Int -> Steps a -> Int -> Int -> Int
traverse (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Steps a
l Int
v Int
c
traverse Int
n (Micro Int
x  Steps a
l)  Int
v Int
c  =  String -> Int -> Int
forall b. String -> b -> b
trace' (String
"traverse Micro  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Int -> Int -> String
forall a b c. (Show a, Show b, Show c) => a -> b -> c -> String
show' Int
n Int
v Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
  Int -> Steps a -> Int -> Int -> Int
forall a. Int -> Steps a -> Int -> Int -> Int
traverse Int
n         Steps a
l Int
v Int
c
traverse Int
n (Apply b -> a
_  Steps b
l)  Int
v Int
c  =  String -> Int -> Int
forall b. String -> b -> b
trace' (String
"traverse Apply  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
  Int -> Steps b -> Int -> Int -> Int
forall a. Int -> Steps a -> Int -> Int -> Int
traverse Int
n         Steps b
l  Int
v      Int
c
traverse Int
n (Fail Strings
m [Strings -> (Int, Steps a)]
m2ls) Int
v Int
c  =  String -> Int -> Int
forall b. String -> b -> b
trace' (String
"traverse Fail   " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Strings -> String
forall a. Show a => a -> String
show Strings
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Int -> Int -> String
forall a b c. (Show a, Show b, Show c) => a -> b -> c -> String
show' Int
n Int
v Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" length m2ls = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Strings -> (Int, Steps a)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Strings -> (Int, Steps a)]
m2ls) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
  ((Strings -> (Int, Steps a)) -> Int -> Int)
-> Int -> [Strings -> (Int, Steps a)] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((\ (Int
w,Steps a
l) Int
c' -> if Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
c' then Int -> Steps a -> Int -> Int -> Int
forall a. Int -> Steps a -> Int -> Int -> Int
traverse (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
-  Int
1 ) Steps a
l (Int
vInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w) Int
c'
                        else Int
c') ((Int, Steps a) -> Int -> Int)
-> ((Strings -> (Int, Steps a)) -> (Int, Steps a))
-> (Strings -> (Int, Steps a))
-> Int
-> Int
forall t t t. (t -> t) -> (t -> t) -> t -> t
. ((Strings -> (Int, Steps a)) -> Strings -> (Int, Steps a)
forall a b. (a -> b) -> a -> b
$Strings
m)) Int
c [Strings -> (Int, Steps a)]
m2ls
traverse Int
n (End_h ([a]
a, [a] -> Steps r
lf)    Steps (a, r)
r)  Int
v Int
c =  String -> Int -> Int
forall b. String -> b -> b
trace' (String
"traverse End_h  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Int -> Int -> String
forall a b c. (Show a, Show b, Show c) => a -> b -> c -> String
show' Int
n Int
v Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
  Int -> Steps r -> Int -> Int -> Int
forall a. Int -> Steps a -> Int -> Int -> Int
traverse Int
n ([a] -> Steps r
lf [a]
a Steps r -> Steps r -> Steps r
forall a. Steps a -> Steps a -> Steps a
`best` Steps (a, r) -> Steps r
forall a r. Steps (a, r) -> Steps r
removeEnd_h Steps (a, r)
r) Int
v Int
c
traverse Int
n (End_f (Steps a
l      :[Steps a]
_)  Steps a
r)  Int
v Int
c =  String -> Int -> Int
forall b. String -> b -> b
trace' (String
"traverse End_f  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Int -> Int -> String
forall a b c. (Show a, Show b, Show c) => a -> b -> c -> String
show' Int
n Int
v Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n") (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
  Int -> Steps a -> Int -> Int -> Int
forall a. Int -> Steps a -> Int -> Int -> Int
traverse Int
n (Steps a
l Steps a -> Steps a -> Steps a
forall a. Steps a -> Steps a -> Steps a
`best` Steps a
r) Int
v Int
c
traverse Int
n (End_f []  Steps a
r)  Int
v Int
c =  String -> Int
forall a. HasCallStack => String -> a
error String
"Cannot traverse End_f with empty list"
traverse Int
n (Done a
_               )  Int
v Int
c =  String -> Int -> Int
forall b. String -> b -> b
trace' (String
"traverse Done   " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Int -> Int -> String
forall a b c. (Show a, Show b, Show c) => a -> b -> c -> String
show' Int
n Int
v Int
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" choosing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n")
  Int
v

show' :: (Show a, Show b, Show c) => a -> b -> c -> String
show' :: a -> b -> c -> String
show' a
n b
v c
c = String
"n: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" v: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show b
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" c: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ c -> String
forall a. Show a => a -> String
show c
c


-- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-- %%%%%%%%%%%%% Handling ambiguous paths             %%%%%%%%%%%%%%%%%%%
-- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

removeEnd_h     :: Steps (a, r) -> Steps r
removeEnd_h :: Steps (a, r) -> Steps r
removeEnd_h (Fail  Strings
m [Strings -> (Int, Steps (a, r))]
ls             )  =   Strings -> [Strings -> (Int, Steps r)] -> Steps r
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail Strings
m ((Steps (a, r) -> Steps r)
-> [Strings -> (Int, Steps (a, r))] -> [Strings -> (Int, Steps r)]
forall c d a b. (c -> d) -> [a -> (b, c)] -> [a -> (b, d)]
applyFail Steps (a, r) -> Steps r
forall a r. Steps (a, r) -> Steps r
removeEnd_h [Strings -> (Int, Steps (a, r))]
ls)
removeEnd_h (Step  Int
ps Steps (a, r)
l             )  =   Int -> Steps r -> Steps r
forall a. Int -> Steps a -> Steps a
Step  Int
ps (Steps (a, r) -> Steps r
forall a r. Steps (a, r) -> Steps r
removeEnd_h Steps (a, r)
l)
removeEnd_h (Apply b -> (a, r)
f Steps b
l              )  =   String -> Steps r
forall a. HasCallStack => String -> a
error String
"not in history parsers"
removeEnd_h (Micro Int
c Steps (a, r)
l              )  =   Int -> Steps r -> Steps r
forall a. Int -> Steps a -> Steps a
Micro Int
c (Steps (a, r) -> Steps r
forall a r. Steps (a, r) -> Steps r
removeEnd_h Steps (a, r)
l)
removeEnd_h (End_h  ([a]
as, [a] -> Steps r
k_st  ) Steps (a, r)
r  )  =   [a] -> Steps r
k_st [a]
as Steps r -> Steps r -> Steps r
forall a. Steps a -> Steps a -> Steps a
`best` Steps (a, r) -> Steps r
forall a r. Steps (a, r) -> Steps r
removeEnd_h Steps (a, r)
r 
removeEnd_h (Done  (a, r)
_)                  =   String -> Steps r
forall a. HasCallStack => String -> a
error String
"spurious End_h at Done"

removeEnd_f      :: Steps r -> Steps [r]
removeEnd_f :: Steps r -> Steps [r]
removeEnd_f (Fail Strings
m [Strings -> (Int, Steps r)]
ls)        =   Strings -> [Strings -> (Int, Steps [r])] -> Steps [r]
forall a. Strings -> [Strings -> (Int, Steps a)] -> Steps a
Fail Strings
m ((Steps r -> Steps [r])
-> [Strings -> (Int, Steps r)] -> [Strings -> (Int, Steps [r])]
forall c d a b. (c -> d) -> [a -> (b, c)] -> [a -> (b, d)]
applyFail Steps r -> Steps [r]
forall r. Steps r -> Steps [r]
removeEnd_f [Strings -> (Int, Steps r)]
ls)
removeEnd_f (Step Int
ps Steps r
l)        =   Int -> Steps [r] -> Steps [r]
forall a. Int -> Steps a -> Steps a
Step Int
ps (Steps r -> Steps [r]
forall r. Steps r -> Steps [r]
removeEnd_f Steps r
l)
removeEnd_f (Apply b -> r
f Steps b
l)        =   ([b] -> [r]) -> Steps [b] -> Steps [r]
forall a b. (b -> a) -> Steps b -> Steps a
Apply ((b -> r) -> [b] -> [r]
forall a b. (a -> b) -> [a] -> [b]
map' b -> r
f) (Steps b -> Steps [b]
forall r. Steps r -> Steps [r]
removeEnd_f Steps b
l) 
                                   where map' :: (t -> b) -> [t] -> [b]
map' t -> b
f ~(t
x:[t]
xs)  =  t -> b
f t
x b -> [b] -> [b]
forall a. a -> [a] -> [a]
: (t -> b) -> [t] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map t -> b
f [t]
xs
removeEnd_f (Micro Int
c Steps r
l      )  =   Int -> Steps [r] -> Steps [r]
forall a. Int -> Steps a -> Steps a
Micro Int
c (Steps r -> Steps [r]
forall r. Steps r -> Steps [r]
removeEnd_f Steps r
l)
removeEnd_f (End_f(Steps r
s:[Steps r]
ss) Steps r
r)    =   (r -> [r]) -> Steps r -> Steps [r]
forall a b. (b -> a) -> Steps b -> Steps a
Apply  (r -> [r] -> [r]
forall a. a -> [a] -> [a]
:((Steps r -> r) -> [Steps r] -> [r]
forall a b. (a -> b) -> [a] -> [b]
map  Steps r -> r
forall a. Steps a -> a
eval [Steps r]
ss)) Steps r
s 
                                                 Steps [r] -> Steps [r] -> Steps [r]
forall a. Steps a -> Steps a -> Steps a
`best`
                                          Steps r -> Steps [r]
forall r. Steps r -> Steps [r]
removeEnd_f Steps r
r
removeEnd_f (Done  r
_)          =    String -> Steps [r]
forall a. HasCallStack => String -> a
error String
"spurious End_f at Done"  

-- ** The type @`Nat`@ for describing the minimal number of tokens consumed
-- | The data type @`Nat`@ is used to represent the minimal length of a parser.
--   Care should be taken in order to not evaluate the right hand side of the binary function @`nat-add`@ more than necesssary.

data Nat = Zero 
         | Succ Nat
         | Infinite
         | Unspecified
         | Hole
         deriving  Int -> Nat -> ShowS
[Nat] -> ShowS
Nat -> String
(Int -> Nat -> ShowS)
-> (Nat -> String) -> ([Nat] -> ShowS) -> Show Nat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Nat] -> ShowS
$cshowList :: [Nat] -> ShowS
show :: Nat -> String
$cshow :: Nat -> String
showsPrec :: Int -> Nat -> ShowS
$cshowsPrec :: Int -> Nat -> ShowS
Show

{-
-- | `getlength` retrieves the length of the non-empty part of a parser
getLength :: Nat -> Nat
getLength (Zero  l)    = l
getLength l            = l
-}

addLength :: Int -> P st a -> P st a
addLength Int
n  (P T st a
t Maybe (T st a)
nep Maybe a
e Nat
l) = T st a -> Maybe (T st a) -> Maybe a -> Nat -> P st a
forall st a. T st a -> Maybe (T st a) -> Maybe a -> Nat -> P st a
P T st a
t Maybe (T st a)
nep Maybe a
e (Int -> Nat -> Nat
addLength' Int
n Nat
l)  
addLength' :: Int -> Nat -> Nat
addLength' :: Int -> Nat -> Nat
addLength' Int
n Nat
Zero            = Int -> Nat
fromInt Int
n
addLength' Int
n (Succ Nat
m)        = Nat -> Nat
Succ (Int -> Nat -> Nat
addLength' Int
n Nat
m)
addLength' Int
n Nat
Infinite        = Nat
Infinite
addLength' Int
n Nat
Unspecified     = Nat
Unspecified
addLength' Int
n Nat
Hole            = Int -> Nat
fromInt Int
n

fromInt :: Int -> Nat
fromInt Int
n = if Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then (Int
n Int -> (Nat -> Nat) -> Nat -> Nat
`times` Nat -> Nat
Succ) Nat
Zero else String -> Nat
forall a. HasCallStack => String -> a
error String
"error: negative argument passed to addlength"
            where times :: Int -> (Nat -> Nat) -> Nat -> Nat
                  times :: Int -> (Nat -> Nat) -> Nat -> Nat
times Int
0 Nat -> Nat
_ Nat
v = Nat
v
                  times Int
n Nat -> Nat
f Nat
v = Int -> (Nat -> Nat) -> Nat -> Nat
times (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Nat -> Nat
f (Nat -> Nat
f Nat
v)

-- | `nat_min` compares two minmal length and returns the shorter length. The second component indicates whether the left
--   operand is the smaller one; we cannot use @Either@ since the first component may already be inspected 
--   before we know which operand is finally chosen
nat_min :: Nat -> Nat -> Int -> ( Nat  --  the actual minimum length
                                , Bool --  whether alternatives should be swapped
                                ) 
nat_min :: Nat -> Nat -> Int -> (Nat, Bool)
nat_min Nat
Zero       Nat
Zero          Int
n  = String -> (Nat, Bool) -> (Nat, Bool)
forall b. String -> b -> b
trace' String
"Both Zero in nat_min\n" (Nat
Zero , Bool
False) 
nat_min Nat
l          rr :: Nat
rr@Nat
Zero       Int
n  = String -> (Nat, Bool) -> (Nat, Bool)
forall b. String -> b -> b
trace' String
"Right Zero in nat_min\n"  (Nat
Zero , Bool
True)
nat_min ll :: Nat
ll@Nat
Zero    Nat
r             Int
n  = String -> (Nat, Bool) -> (Nat, Bool)
forall b. String -> b -> b
trace' String
"Left Zero in nat_min\n"   (Nat
Zero, Bool
False)
nat_min (Succ Nat
ll)  (Succ Nat
rr)     Int
n  = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1000 then String -> (Nat, Bool)
forall a. HasCallStack => String -> a
error String
"problem with comparing lengths" 
                                      else String -> (Nat, Bool) -> (Nat, Bool)
forall b. String -> b -> b
trace' (String
"Succ in nat_min " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n")         
                                                  (let (Nat
v, Bool
b) = Nat -> Nat -> Int -> (Nat, Bool)
nat_min Nat
ll  Nat
rr (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) in (Nat -> Nat
Succ Nat
v, Bool
b))
nat_min Nat
Infinite      Nat
r           Int
_  = String -> (Nat, Bool) -> (Nat, Bool)
forall b. String -> b -> b
trace' String
"Left Infinite in nat_min\n"  (Nat
r, Bool
True) 
nat_min Nat
l             Nat
Infinite    Int
_  = String -> (Nat, Bool) -> (Nat, Bool)
forall b. String -> b -> b
trace' String
"Right Infinite in nat_min\n" (Nat
l, Bool
False) 
nat_min  Nat
Hole         Nat
r           Int
_  = String -> (Nat, Bool)
forall a. HasCallStack => String -> a
error String
"canot compute minmal length of a parser due to occurrence of a moadic bind, use addLength to override"
nat_min  Nat
l            Nat
Hole        Int
_  = String -> (Nat, Bool)
forall a. HasCallStack => String -> a
error String
"canot compute minmal length of a parser due to occurrence of a moadic bind, use addLength to override"
nat_min  Nat
l            Nat
Unspecified Int
_  = (Nat
l          , Bool
False)
nat_min  Nat
Unspecified  Nat
r           Int
_  = (Nat
r          , Bool
False)


nat_add :: Nat -> Nat -> Nat
nat_add :: Nat -> Nat -> Nat
nat_add Nat
Zero            Nat
r           = String -> Nat -> Nat
forall b. String -> b -> b
trace' String
"Zero in add\n"        Nat
r
nat_add (Succ Nat
l)        Nat
r           = String -> Nat -> Nat
forall b. String -> b -> b
trace' String
"Succ in add\n"        (Nat -> Nat
Succ (Nat -> Nat -> Nat
nat_add Nat
l Nat
r))
nat_add Nat
Infinite        Nat
_           = String -> Nat -> Nat
forall b. String -> b -> b
trace' String
"Infinite in add\n"    Nat
Infinite
nat_add Nat
Hole            Nat
_           = Nat
Hole
nat_add Nat
Unspecified     Nat
r           = String -> Nat -> Nat
forall b. String -> b -> b
trace' String
"Unspecified in add\n" Nat
Unspecified
 


trace' :: String -> b -> b
trace' :: String -> b -> b
trace' String
m b
v =   b
v
-- trace' m v = trace m  v

trace'' :: String -> b -> b
trace'' :: String -> b -> b
trace'' String
m b
v =   b
v
--trace'' m v = trace m  v