    {-# LANGUAGE  MagicHash,
                  UnboxedTuples #-}

    module UU.Parsing.MachineInterface where
    import GHC.Prim

    -- | The 'InputState' class contains the interface that the AnaParser
    -- parsers expect for the input. A minimal complete instance definition
    -- consists of 'splitStateE', 'splitState' and 'getPosition'.
    class InputState state s pos | state -> s, state -> pos where
     -- | Splits the state in a strict variant of 'Either', with 'Left'' if a symbol
     --   can be split off and 'Right'' if none can
     splitStateE :: state             -> Either' state s
     -- | Splits the state in the first symbol and the remaining state
     splitState  :: state             -> (# s, state #)
     -- | Gets the current position in the input
     getPosition :: state             -> pos
     -- | Reports an error
     reportError :: Message s pos     -> state -> state
     reportError _ = state -> state
    forall a. a -> a
    id
     -- | Modify the state as the result of inserting a symbol 's' in the input.
     -- The symbol that has already been considered as having been inserted
     -- is passed. It should normally not be added to the state.
     insertSymbol :: s                -> state -> state
     insertSymbol _ = state -> state
    forall a. a -> a
    id
     -- | Modify the state as the result of deleting a symbol 's' from the input.
     -- The symbol that has already been deleted from the input state is passed.
     -- It should normally not be deleted from the state.
     deleteSymbol :: s                -> state -> state
     deleteSymbol _ = state -> state
    forall a. a -> a
    id
     {-
    {-# INLINE splitStateE #-}
     {-# INLINE splitState  #-}
     {-# INLINE insertSymbol  #-}
     {-# INLINE deleteSymbol  #-}
    -}

    class OutputState r  where
      acceptR      ::                     v                   -> rest        -> r v rest
      nextR        ::  (a -> rest  -> rest') -> (b -> a)      -> (r b rest)  -> rest'
    {-
    {-# INLINE acceptR #-}
      {-# INLINE nextR   #-}
    -}
    class Symbol s where
     deleteCost :: s -> Int#
     symBefore  :: s -> s
     symAfter   :: s -> s
     deleteCost b :: s
    b = 5#
     symBefore  = [Char] -> s -> s
    forall a. HasCallStack => [Char] -> a
    error "You should have made your token type an instance of the Class Symbol. eg by defining symBefore = pred"
     symAfter   = [Char] -> s -> s
    forall a. HasCallStack => [Char] -> a
    error "You should have made your token type an instance of the Class Symbol. eg by defining symAfter  = succ"

    data Either' state s = Left' !s (state )
                         | Right' (state )

    -- =======================================================================================
    -- ===== STEPS ===========================================================================
    -- =======================================================================================
    data Steps val s p
                 = forall a . OkVal           (a -> val)                                (Steps a   s p)
                 |            Ok         {                                       Steps val s p -> Steps val s p
    rest :: Steps val s p}
                 |            Cost       {Steps val s p -> Int#
    costing::Int#                        , rest :: Steps val s p}
                 |            StRepair   {costing::Int#  , Steps val s p -> Message s p
    m :: !(Message s p) , rest :: Steps val s p}
                 |            Best       (Steps val s p) (Steps val s p) ( Steps val s p)
                 |            NoMoreSteps val
    data Action s  =  Insert s
                   |  Delete s
                   |  Other  String

    val :: (a -> b) -> Steps a s p -> Steps b s p

    val :: (a -> b) -> Steps a s p -> Steps b s p
    val f :: a -> b
    f (OkVal a :: a -> a
    a rest :: Steps a s p
    rest) = (a -> b) -> Steps a s p -> Steps b s p
    forall val s p a. (a -> val) -> Steps a s p -> Steps val s p
    OkVal (a -> b
    f(a -> b) -> (a -> a) -> a -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .a -> a
    a) Steps a s p
    rest
    val f :: a -> b
    f (Ok      rest :: Steps a s p
    rest) = (a -> b) -> Steps a s p -> Steps b s p
    forall val s p a. (a -> val) -> Steps a s p -> Steps val s p
    OkVal  a -> b
    f Steps a s p
    rest
    val f :: a -> b
    f (Cost i :: Int#
    i  rest :: Steps a s p
    rest) = Int# -> Steps b s p -> Steps b s p
    forall val s p. Int# -> Steps val s p -> Steps val s p
    Cost Int#
    i ((a -> b) -> Steps a s p -> Steps b s p
    forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
    val a -> b
    f Steps a s p
    rest)
    val f :: a -> b
    f (StRepair c :: Int#
    c m :: Message s p
    m r :: Steps a s p
    r) = Int# -> Message s p -> Steps b s p -> Steps b s p
    forall val s p.
    Int# -> Message s p -> Steps val s p -> Steps val s p
    StRepair Int#
    c Message s p
    m ((a -> b) -> Steps a s p -> Steps b s p
    forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
    val a -> b
    f Steps a s p
    r)
    val f :: a -> b
    f (Best l :: Steps a s p
    l s :: Steps a s p
    s     r :: Steps a s p
    r) = Steps b s p -> Steps b s p -> Steps b s p -> Steps b s p
    forall val s p.
    Steps val s p -> Steps val s p -> Steps val s p -> Steps val s p
    Best ((a -> b) -> Steps a s p -> Steps b s p
    forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
    val a -> b
    f Steps a s p
    l) ((a -> b) -> Steps a s p -> Steps b s p
    forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
    val a -> b
    f Steps a s p
    s) ((a -> b) -> Steps a s p -> Steps b s p
    forall a b s p. (a -> b) -> Steps a s p -> Steps b s p
    val a -> b
    f Steps a s p
    r)
    val f :: a -> b
    f (NoMoreSteps v :: a
    v)  = b -> Steps b s p
    forall val s p. val -> Steps val s p
    NoMoreSteps (a -> b
    f a
    v)

    evalSteps :: Steps a s p -> a
    evalSteps :: Steps a s p -> a
    evalSteps (OkVal v :: a -> a
    v  rest :: Steps a s p
    rest    ) = a -> a
    v (Steps a s p -> a
    forall a s p. Steps a s p -> a
    evalSteps Steps a s p
    rest)
    evalSteps (Ok       rest :: Steps a s p
    rest    ) =    Steps a s p -> a
    forall a s p. Steps a s p -> a
    evalSteps Steps a s p
    rest
    evalSteps (Cost  _  rest :: Steps a s p
    rest    ) =    Steps a s p -> a
    forall a s p. Steps a s p -> a
    evalSteps Steps a s p
    rest
    evalSteps (StRepair _ msg :: Message s p
    msg rest :: Steps a s p
    rest    ) =    Steps a s p -> a
    forall a s p. Steps a s p -> a
    evalSteps Steps a s p
    rest
    evalSteps (Best _   rest :: Steps a s p
    rest  _) =  Steps a s p -> a
    forall a s p. Steps a s p -> a
    evalSteps Steps a s p
    rest
    evalSteps (NoMoreSteps v :: a
    v    ) =  a
    v

    getMsgs :: Steps a s p -> [Message s p]
    getMsgs :: Steps a s p -> [Message s p]
    getMsgs (OkVal _        rest :: Steps a s p
    rest) = Steps a s p -> [Message s p]
    forall a s p. Steps a s p -> [Message s p]
    getMsgs Steps a s p
    rest
    getMsgs (Ok             rest :: Steps a s p
    rest) = Steps a s p -> [Message s p]
    forall a s p. Steps a s p -> [Message s p]
    getMsgs Steps a s p
    rest
    getMsgs (Cost _         rest :: Steps a s p
    rest) = Steps a s p -> [Message s p]
    forall a s p. Steps a s p -> [Message s p]
    getMsgs Steps a s p
    rest
    getMsgs (StRepair _ m :: Message s p
    m   rest :: Steps a s p
    rest) = Message s p
    mMessage s p -> [Message s p] -> [Message s p]
    forall a. a -> [a] -> [a]
    :Steps a s p -> [Message s p]
    forall a s p. Steps a s p -> [Message s p]
    getMsgs Steps a s p
    rest
    getMsgs (Best _ m :: Steps a s p
    m   _)        = Steps a s p -> [Message s p]
    forall a s p. Steps a s p -> [Message s p]
    getMsgs Steps a s p
    m
    getMsgs (NoMoreSteps _      ) = []

    data Message sym pos = Msg (Expecting sym) !pos (Action sym)
    -- Msg (String, String, Expecting s) -- action, position, expecting
    instance (Eq s, Show s) => Show (Expecting s) where
     show :: Expecting s -> [Char]
    show (ESym     s :: SymbolR s
    s)   = SymbolR s -> [Char]
    forall a. Show a => a -> [Char]
    show SymbolR s
    s
     show (EStr   str :: [Char]
    str)   = [Char]
    str
     show (EOr     [])   = "Nothing expected "
     show (EOr    [e :: Expecting s
    e])   = Expecting s -> [Char]
    forall a. Show a => a -> [Char]
    show Expecting s
    e
     show (EOr  (e :: Expecting s
    e:ee :: [Expecting s]
    ee))  = Expecting s -> [Char]
    forall a. Show a => a -> [Char]
    show Expecting s
    e [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " or " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Expecting s -> [Char]
    forall a. Show a => a -> [Char]
    show ([Expecting s] -> Expecting s
    forall s. [Expecting s] -> Expecting s
    EOr [Expecting s]
    ee)
     show (ESeq  seq :: [Expecting s]
    seq)    = [[Char]] -> [Char]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ((Expecting s -> [Char]) -> [Expecting s] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map Expecting s -> [Char]
    forall a. Show a => a -> [Char]
    show [Expecting s]
    seq)

    instance (Eq s, Show s, Show p) => Show (Message s p) where
     show :: Message s p -> [Char]
    show (Msg expecting :: Expecting s
    expecting position :: p
    position action :: Action s
    action)
       =  "\n?? Error      : " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ p -> [Char]
    forall a. Show a => a -> [Char]
    show p
    position [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
          "\n?? Expecting  : " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Expecting s -> [Char]
    forall a. Show a => a -> [Char]
    show Expecting s
    expecting [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
          "\n?? Repaired by: "  [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Action s -> [Char]
    forall a. Show a => a -> [Char]
    show Action s
    action [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++"\n"

    instance Show s => Show (Action s) where
      show :: Action s -> [Char]
    show (Insert s :: s
    s) = "inserting: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ s -> [Char]
    forall a. Show a => a -> [Char]
    show s
    s
      show (Delete s :: s
    s) = "deleting: "  [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ s -> [Char]
    forall a. Show a => a -> [Char]
    show s
    s
      show (Other s :: [Char]
    s)  = [Char]
    s
    data Expecting s = ESym (SymbolR s)
                     | EStr String
                     | EOr  [Expecting s]
                     | ESeq [Expecting s]
                     deriving (Eq (Expecting s)
    Eq (Expecting s) =>
    (Expecting s -> Expecting s -> Ordering)
    -> (Expecting s -> Expecting s -> Bool)
    -> (Expecting s -> Expecting s -> Bool)
    -> (Expecting s -> Expecting s -> Bool)
    -> (Expecting s -> Expecting s -> Bool)
    -> (Expecting s -> Expecting s -> Expecting s)
    -> (Expecting s -> Expecting s -> Expecting s)
    -> Ord (Expecting s)
    Expecting s -> Expecting s -> Bool
    Expecting s -> Expecting s -> Ordering
    Expecting s -> Expecting s -> Expecting s
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    forall s. Ord s => Eq (Expecting s)
    forall s. Ord s => Expecting s -> Expecting s -> Bool
    forall s. Ord s => Expecting s -> Expecting s -> Ordering
    forall s. Ord s => Expecting s -> Expecting s -> Expecting s
    min :: Expecting s -> Expecting s -> Expecting s
    $cmin :: forall s. Ord s => Expecting s -> Expecting s -> Expecting s
    max :: Expecting s -> Expecting s -> Expecting s
    $cmax :: forall s. Ord s => Expecting s -> Expecting s -> Expecting s
    >= :: Expecting s -> Expecting s -> Bool
    $c>= :: forall s. Ord s => Expecting s -> Expecting s -> Bool
    > :: Expecting s -> Expecting s -> Bool
    $c> :: forall s. Ord s => Expecting s -> Expecting s -> Bool
    <= :: Expecting s -> Expecting s -> Bool
    $c<= :: forall s. Ord s => Expecting s -> Expecting s -> Bool
    < :: Expecting s -> Expecting s -> Bool
    $c< :: forall s. Ord s => Expecting s -> Expecting s -> Bool
    compare :: Expecting s -> Expecting s -> Ordering
    $ccompare :: forall s. Ord s => Expecting s -> Expecting s -> Ordering
    $cp1Ord :: forall s. Ord s => Eq (Expecting s)
    Ord, Expecting s -> Expecting s -> Bool
    (Expecting s -> Expecting s -> Bool)
    -> (Expecting s -> Expecting s -> Bool) -> Eq (Expecting s)
    forall s. Eq s => Expecting s -> Expecting s -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Expecting s -> Expecting s -> Bool
    $c/= :: forall s. Eq s => Expecting s -> Expecting s -> Bool
    == :: Expecting s -> Expecting s -> Bool
    $c== :: forall s. Eq s => Expecting s -> Expecting s -> Bool
    Eq)
    -- =======================================================================================
    -- ===== SYMBOLS and RANGES ==============================================================
    -- =======================================================================================

    data  SymbolR s  =  Range !s !s | EmptyR deriving (SymbolR s -> SymbolR s -> Bool
    (SymbolR s -> SymbolR s -> Bool)
    -> (SymbolR s -> SymbolR s -> Bool) -> Eq (SymbolR s)
    forall s. Eq s => SymbolR s -> SymbolR s -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: SymbolR s -> SymbolR s -> Bool
    $c/= :: forall s. Eq s => SymbolR s -> SymbolR s -> Bool
    == :: SymbolR s -> SymbolR s -> Bool
    $c== :: forall s. Eq s => SymbolR s -> SymbolR s -> Bool
    Eq,Eq (SymbolR s)
    Eq (SymbolR s) =>
    (SymbolR s -> SymbolR s -> Ordering)
    -> (SymbolR s -> SymbolR s -> Bool)
    -> (SymbolR s -> SymbolR s -> Bool)
    -> (SymbolR s -> SymbolR s -> Bool)
    -> (SymbolR s -> SymbolR s -> Bool)
    -> (SymbolR s -> SymbolR s -> SymbolR s)
    -> (SymbolR s -> SymbolR s -> SymbolR s)
    -> Ord (SymbolR s)
    SymbolR s -> SymbolR s -> Bool
    SymbolR s -> SymbolR s -> Ordering
    SymbolR s -> SymbolR s -> SymbolR s
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    forall s. Ord s => Eq (SymbolR s)
    forall s. Ord s => SymbolR s -> SymbolR s -> Bool
    forall s. Ord s => SymbolR s -> SymbolR s -> Ordering
    forall s. Ord s => SymbolR s -> SymbolR s -> SymbolR s
    min :: SymbolR s -> SymbolR s -> SymbolR s
    $cmin :: forall s. Ord s => SymbolR s -> SymbolR s -> SymbolR s
    max :: SymbolR s -> SymbolR s -> SymbolR s
    $cmax :: forall s. Ord s => SymbolR s -> SymbolR s -> SymbolR s
    >= :: SymbolR s -> SymbolR s -> Bool
    $c>= :: forall s. Ord s => SymbolR s -> SymbolR s -> Bool
    > :: SymbolR s -> SymbolR s -> Bool
    $c> :: forall s. Ord s => SymbolR s -> SymbolR s -> Bool
    <= :: SymbolR s -> SymbolR s -> Bool
    $c<= :: forall s. Ord s => SymbolR s -> SymbolR s -> Bool
    < :: SymbolR s -> SymbolR s -> Bool
    $c< :: forall s. Ord s => SymbolR s -> SymbolR s -> Bool
    compare :: SymbolR s -> SymbolR s -> Ordering
    $ccompare :: forall s. Ord s => SymbolR s -> SymbolR s -> Ordering
    $cp1Ord :: forall s. Ord s => Eq (SymbolR s)
    Ord)

    instance (Eq s,Show s) => Show (SymbolR s) where
     show :: SymbolR s -> [Char]
    show EmptyR      = "the empty range"
     show (Range a :: s
    a b :: s
    b) = if s
    a s -> s -> Bool
    forall a. Eq a => a -> a -> Bool
    == s
    b then s -> [Char]
    forall a. Show a => a -> [Char]
    show s
    a else s -> [Char]
    forall a. Show a => a -> [Char]
    show s
    a [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ".." [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ s -> [Char]
    forall a. Show a => a -> [Char]
    show s
    b

    mk_range :: s -> s -> SymbolR s
    mk_range             l :: s
    l    r :: s
    r =  if s
    l s -> s -> Bool
    forall a. Ord a => a -> a -> Bool
    > s
    r then SymbolR s
    forall s. SymbolR s
    EmptyR else s -> s -> SymbolR s
    forall s. s -> s -> SymbolR s
    Range s
    l s
    r

    symInRange :: SymbolR a -> a -> Bool
    symInRange (Range l :: a
    l r :: a
    r) = if a
    l a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    r then (a
    la -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    ==)
                                       else (\ s :: a
    s ->  a
    s a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= a
    l Bool -> Bool -> Bool
    && a
    s a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    r)

    symRS :: SymbolR a -> a -> Ordering
    symRS (Range l :: a
    l r :: a
    r)
      = if a
    l a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    r then (a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare a
    l)
        else (\ s :: a
    s -> if      a
    s a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    < a
    l then Ordering
    GT
                     else if a
    s a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    > a
    r then Ordering
    LT
                     else               Ordering
    EQ)

    range :: SymbolR s
    range except :: SymbolR s -> t s -> [SymbolR s]
    `except` elems :: t s
    elems
     = (s -> [SymbolR s] -> [SymbolR s])
    -> [SymbolR s] -> t s -> [SymbolR s]
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr s -> [SymbolR s] -> [SymbolR s]
    forall s. (Ord s, Symbol s) => s -> [SymbolR s] -> [SymbolR s]
    removeelem [SymbolR s
    range] t s
    elems
       where removeelem :: s -> [SymbolR s] -> [SymbolR s]
    removeelem elem :: s
    elem ranges :: [SymbolR s]
    ranges = [SymbolR s
    r | SymbolR s
    ran <- [SymbolR s]
    ranges, SymbolR s
    r <- SymbolR s
    ran SymbolR s -> s -> [SymbolR s]
    forall s. (Ord s, Symbol s) => SymbolR s -> s -> [SymbolR s]
    `minus` s
    elem]
             EmptyR          minus :: SymbolR s -> s -> [SymbolR s]
    `minus` _    = []
             ran :: SymbolR s
    ran@(Range l :: s
    l r :: s
    r) `minus` elem :: s
    elem = if SymbolR s -> s -> Bool
    forall a. Ord a => SymbolR a -> a -> Bool
    symInRange SymbolR s
    ran s
    elem
                                            then [s -> s -> SymbolR s
    forall s. Ord s => s -> s -> SymbolR s
    mk_range s
    l (s -> s
    forall s. Symbol s => s -> s
    symBefore s
    elem), s -> s -> SymbolR s
    forall s. Ord s => s -> s -> SymbolR s
    mk_range (s -> s
    forall s. Symbol s => s -> s
    symAfter s
    elem) s
    r]
                                            else [SymbolR s
    ran]
    -- =======================================================================================
    -- ===== TRACING  and ERRORS  and MISC ===================================================
    -- =======================================================================================
    usererror :: [Char] -> a
    usererror   m :: [Char]
    m = [Char] -> a
    forall a. HasCallStack => [Char] -> a
    error ("Your grammar contains a problem:\n" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    m)
    systemerror :: [Char] -> [Char] -> a
    systemerror modname :: [Char]
    modname m :: [Char]
    m
      = [Char] -> a
    forall a. HasCallStack => [Char] -> a
    error ("I apologise: I made a mistake in my design. This should not have happened.\n"
                           [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
               " Please report: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    modname [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++": " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    m [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " to doaitse@cs.uu.nl\n")