step table sh@(S tt@(t@(Atom x):ts) st@(s@(Part y):ss) oo@(os:oss) ru) =
  case findBoth table x st of
    BContinue pt1 -> go pt1
    BBegin pt1 -> go pt1
    BMissingBegin ps -> rule sh (failure $ ps `MissingBefore` x)
    BNothing -> error "can't happen" -- x is in the table for sure
    BAmbiguous amb -> rule sh (failure $ Ambiguity amb)
  where
    go pt1
      | rightHole y == Just SExpression && pt1 `continue` y && stackedOp ru =
      let ([]:h:oss') = oo
      in S ts (Part pt1:ss) ((List []:h):oss') ContinueOp
      | rightHole y == Just SExpression && pt1 `continue` y =
      let os':h:oss' = oo
          ap = List (reverse os')
      in S ts (Part pt1:ss) ((ap:h):oss') ContinueOp
      | rightHole pt1 == Just Distfix && rightHole y == Just SExpression =
      S ts (Part pt1:st) oo StackL
      | rightHole pt1 == Just SExpression =
      S ts (Part pt1:st) ([]:oo) StackL
      | rightHole y == Just SExpression =
      S ts st ((t:os):oss) SExpr

      | rightOpen y && leftOpen pt1 && stackedOp ru =
      rule sh (failure $ symbol y `MissingSubBetween` x)

      | pt1 `continue` y = S ts (Part pt1:ss) oo ContinueOp

      | not (leftOpen pt1) && begin pt1 = S ts (Part pt1:st) oo StackL

      | otherwise = case pt1 `priority` y of
        Lower -> S tt ss (apply s oo) ApplyOp
        Higher -> S ts (Part pt1:st) oo StackOp
        NoPriority -> rule sh (failure $ CantMix pt1 y)

-- No more tokens on the input stack, just have to flush
-- the remaining applicators and/or operators.
step table sh@(S tt@(t@(Atom x):ts) st@(s@(Part y):ss) oo@(os:oss) ru) =
  case findBoth table x st of
    BContinue pt1 -> go pt1
    BBegin pt1 -> go pt1
    BMissingBegin ps -> rule sh (failure $ ps `MissingBefore` x)
    BNothing -> error "can't happen" -- x is in the table for sure
    BAmbiguous amb -> rule sh (failure $ Ambiguity amb)
  where
    go pt1
      | rightHole y == Just SExpression && pt1 `continue` y && stackedOp ru =
      let ([]:h:oss') = oo
      in S ts (Part pt1:ss) ((List []:h):oss') ContinueOp
      | rightHole y == Just SExpression && pt1 `continue` y =
      let os':h:oss' = oo
          ap = List (reverse os')
      in S ts (Part pt1:ss) ((ap:h):oss') ContinueOp
      | rightHole pt1 == Just Distfix && rightHole y == Just SExpression =
      S ts (Part pt1:st) oo StackL
      | rightHole pt1 == Just SExpression =
      S ts (Part pt1:st) ([]:oo) StackL
      | rightHole y == Just SExpression =
      S ts st ((t:os):oss) SExpr

      | rightOpen y && leftOpen pt1 && stackedOp ru =
      rule sh (failure $ symbol y `MissingSubBetween` x)

      | pt1 `continue` y = S ts (Part pt1:ss) oo ContinueOp

      | not (leftOpen pt1) && begin pt1 = S ts (Part pt1:st) oo StackL

      | otherwise = case pt1 `priority` y of
        Lower -> S tt ss (apply s oo) ApplyOp
        Higher -> S ts (Part pt1:st) oo StackOp
        NoPriority -> rule sh (failure $ CantMix pt1 y)

-- No more tokens on the input stack, just have to flush
-- the remaining applicators and/or operators.
step table sh@(S tt@(t@(Atom x):ts) st@(s@(Part y):ss) oo@(os:oss) ru) =
  case findBoth table x st of
    BContinue pt1 -> go pt1
    BBegin pt1 -> go pt1
    BMissingBegin ps -> rule sh (failure $ ps `MissingBefore` x)
    BNothing -> error "can't happen" -- x is in the table for sure
    BAmbiguous amb -> rule sh (failure $ Ambiguity amb)
  where
    go pt1
      | rightHole y == Just SExpression && pt1 `continue` y && stackedOp ru =
      let ([]:h:oss') = oo
      in S ts (Part pt1:ss) ((List []:h):oss') ContinueOp
      | rightHole y == Just SExpression && pt1 `continue` y =
      let os':h:oss' = oo
          ap = List (reverse os')
      in S ts (Part pt1:ss) ((ap:h):oss') ContinueOp
      | rightHole pt1 == Just Distfix && rightHole y == Just SExpression =
      S ts (Part pt1:st) oo StackL
      | rightHole pt1 == Just SExpression =
      S ts (Part pt1:st) ([]:oo) StackL
      | rightHole y == Just SExpression =
      S ts st ((t:os):oss) SExpr

      | rightOpen y && leftOpen pt1 && stackedOp ru =
      rule sh (failure $ symbol y `MissingSubBetween` x)

      | pt1 `continue` y = S ts (Part pt1:ss) oo ContinueOp

      | not (leftOpen pt1) && begin pt1 = S ts (Part pt1:st) oo StackL

      | otherwise = case pt1 `priority` y of
        Lower -> S tt ss (apply s oo) ApplyOp
        Higher -> S ts (Part pt1:st) oo StackOp
        NoPriority -> rule sh (failure $ CantMix pt1 y)

-- No more tokens on the input stack, just have to flush
-- the remaining applicators and/or operators.