{-# LANGUAGE UndecidableInstances #-} -- For Cursorable (Cursor inp)
-- | Build the 'Instr'uction 'Program' of a 'Machine'
-- from the 'Comb'inators of a 'Grammar'.
-- 'Instr'uctions are kept introspectable
-- to enable more optimizations now possible because
-- of a broader knowledge of the 'Instr'uctions around
-- those generated (eg. by using 'joinNext').
module Symantic.Parser.Machine.Program where

import Data.Bool (Bool(..))
import Data.Ord (Ord)
import Data.Function (($), (.))
import Type.Reflection (Typeable)
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.Functor as Functor
import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.Syntax as TH
import qualified Symantic.Parser.Haskell as H

import Symantic.Parser.Grammar
import Symantic.Parser.Machine.Input
import Symantic.Parser.Machine.Instructions
import Symantic.Parser.Machine.Optimize
import Symantic.Univariant.Trans

-- * Type 'Program'
-- | A 'Program' is a tree of 'Instr'uctions,
-- where each 'Instr'uction is built by a continuation
-- to be able to introspect, duplicate and/or change
-- the next 'Instr'uction.
data Program repr inp a = Program { forall (repr :: ReprInstr) inp a.
Program repr inp a
-> forall (vs :: [*]) (es :: Peano) ret.
   SomeInstr repr inp (a : vs) ('Succ es) ret
   -> SomeInstr repr inp vs ('Succ es) ret
unProgram ::
  forall vs es ret.
  -- This is the next instruction
  SomeInstr repr inp (a ': vs) ('Succ es) ret ->
  -- This is the current instruction
  SomeInstr repr inp vs ('Succ es) ret }

-- | Build an interpreter of the 'Program' of the given 'Machine'.
optimizeMachine ::
  forall inp es repr a.
  Machine (InputToken inp) repr =>
  Program repr inp a ->
  repr inp '[] ('Succ es) a
optimizeMachine :: forall inp (es :: Peano) (repr :: ReprInstr) a.
Machine (InputToken inp) repr =>
Program repr inp a -> repr inp '[] ('Succ es) a
optimizeMachine (Program forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
f) = SomeInstr repr inp '[] ('Succ es) a -> repr inp '[] ('Succ es) a
forall (from :: * -> *) (to :: * -> *) a.
Trans from to =>
from a -> to a
trans (forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
f @'[] @es SomeInstr repr inp '[a] ('Succ es) a
forall (repr :: ReprInstr) inp a (es :: Peano).
Routinable repr =>
repr inp '[a] es a
ret)

instance
  Stackable repr =>
  Applicable (Program repr inp) where
  pure :: forall a. TermGrammar a -> Program repr inp a
pure TermGrammar a
x = (forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
forall (repr :: ReprInstr) inp a.
(forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
Program (TermInstr a
-> SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall (repr :: ReprInstr) v inp (vs :: [*]) (es :: Peano) a.
Stackable repr =>
TermInstr v -> repr inp (v : vs) es a -> repr inp vs es a
push (TermGrammar a -> TermInstr a
forall (from :: * -> *) (to :: * -> *) a.
Trans from to =>
from a -> to a
trans TermGrammar a
x))
  Program forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp ((a -> b) : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
f <*> :: forall a b.
Program repr inp (a -> b)
-> Program repr inp a -> Program repr inp b
<*> Program forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
x = (forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (b : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp b
forall (repr :: ReprInstr) inp a.
(forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
Program (SomeInstr repr inp ((a -> b) : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp ((a -> b) : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
f (SomeInstr repr inp ((a -> b) : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> (SomeInstr repr inp (b : vs) ('Succ es) ret
    -> SomeInstr repr inp ((a -> b) : vs) ('Succ es) ret)
-> SomeInstr repr inp (b : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeInstr repr inp (a : (a -> b) : vs) ('Succ es) ret
-> SomeInstr repr inp ((a -> b) : vs) ('Succ es) ret
forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
x (SomeInstr repr inp (a : (a -> b) : vs) ('Succ es) ret
 -> SomeInstr repr inp ((a -> b) : vs) ('Succ es) ret)
-> (SomeInstr repr inp (b : vs) ('Succ es) ret
    -> SomeInstr repr inp (a : (a -> b) : vs) ('Succ es) ret)
-> SomeInstr repr inp (b : vs) ('Succ es) ret
-> SomeInstr repr inp ((a -> b) : vs) ('Succ es) ret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeInstr repr inp (b : vs) ('Succ es) ret
-> SomeInstr repr inp (a : (a -> b) : vs) ('Succ es) ret
forall (repr :: ReprInstr) inp y (vs :: [*]) (es :: Peano) a x.
Stackable repr =>
repr inp (y : vs) es a -> repr inp (x : (x -> y) : vs) es a
appI)
  liftA2 :: forall a b c.
TermGrammar (a -> b -> c)
-> Program repr inp a -> Program repr inp b -> Program repr inp c
liftA2 TermGrammar (a -> b -> c)
f (Program forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
x) (Program forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (b : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
y) =
    (forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (c : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp c
forall (repr :: ReprInstr) inp a.
(forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
Program (SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
x (SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> (SomeInstr repr inp (c : vs) ('Succ es) ret
    -> SomeInstr repr inp (a : vs) ('Succ es) ret)
-> SomeInstr repr inp (c : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeInstr repr inp (b : a : vs) ('Succ es) ret
-> SomeInstr repr inp (a : vs) ('Succ es) ret
forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (b : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
y (SomeInstr repr inp (b : a : vs) ('Succ es) ret
 -> SomeInstr repr inp (a : vs) ('Succ es) ret)
-> (SomeInstr repr inp (c : vs) ('Succ es) ret
    -> SomeInstr repr inp (b : a : vs) ('Succ es) ret)
-> SomeInstr repr inp (c : vs) ('Succ es) ret
-> SomeInstr repr inp (a : vs) ('Succ es) ret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TermInstr (a -> b -> c)
-> SomeInstr repr inp (c : vs) ('Succ es) ret
-> SomeInstr repr inp (b : a : vs) ('Succ es) ret
forall (repr :: ReprInstr) x y z inp (vs :: [*]) (es :: Peano) a.
Stackable repr =>
TermInstr (x -> y -> z)
-> repr inp (z : vs) es a -> repr inp (y : x : vs) es a
liftI2 (TermGrammar (a -> b -> c) -> TermInstr (a -> b -> c)
forall (from :: * -> *) (to :: * -> *) a.
Trans from to =>
from a -> to a
trans TermGrammar (a -> b -> c)
f))
  Program forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
x *> :: forall a b.
Program repr inp a -> Program repr inp b -> Program repr inp b
*> Program forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (b : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
y = (forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (b : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp b
forall (repr :: ReprInstr) inp a.
(forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
Program (SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
x (SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> (SomeInstr repr inp (b : vs) ('Succ es) ret
    -> SomeInstr repr inp (a : vs) ('Succ es) ret)
-> SomeInstr repr inp (b : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeInstr repr inp vs ('Succ es) ret
-> SomeInstr repr inp (a : vs) ('Succ es) ret
forall (repr :: ReprInstr) inp (vs :: [*]) (es :: Peano) a v.
Stackable repr =>
repr inp vs es a -> repr inp (v : vs) es a
pop (SomeInstr repr inp vs ('Succ es) ret
 -> SomeInstr repr inp (a : vs) ('Succ es) ret)
-> (SomeInstr repr inp (b : vs) ('Succ es) ret
    -> SomeInstr repr inp vs ('Succ es) ret)
-> SomeInstr repr inp (b : vs) ('Succ es) ret
-> SomeInstr repr inp (a : vs) ('Succ es) ret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeInstr repr inp (b : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (b : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
y)
  Program forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
x <* :: forall a b.
Program repr inp a -> Program repr inp b -> Program repr inp a
<* Program forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (b : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
y = (forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
forall (repr :: ReprInstr) inp a.
(forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
Program (SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
x (SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> (SomeInstr repr inp (a : vs) ('Succ es) ret
    -> SomeInstr repr inp (a : vs) ('Succ es) ret)
-> SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeInstr repr inp (b : a : vs) ('Succ es) ret
-> SomeInstr repr inp (a : vs) ('Succ es) ret
forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (b : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
y (SomeInstr repr inp (b : a : vs) ('Succ es) ret
 -> SomeInstr repr inp (a : vs) ('Succ es) ret)
-> (SomeInstr repr inp (a : vs) ('Succ es) ret
    -> SomeInstr repr inp (b : a : vs) ('Succ es) ret)
-> SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp (a : vs) ('Succ es) ret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp (b : a : vs) ('Succ es) ret
forall (repr :: ReprInstr) inp (vs :: [*]) (es :: Peano) a v.
Stackable repr =>
repr inp vs es a -> repr inp (v : vs) es a
pop)
instance
  ( Cursorable (Cursor inp)
  , Branchable repr
  , Failable repr
  , Inputable repr
  , Joinable repr
  , Stackable repr
  ) => Alternable (Program repr inp) where
  empty :: forall a. Program repr inp a
empty = (forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
forall (repr :: ReprInstr) inp a.
(forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
Program ((forall (vs :: [*]) (es :: Peano) ret.
  SomeInstr repr inp (a : vs) ('Succ es) ret
  -> SomeInstr repr inp vs ('Succ es) ret)
 -> Program repr inp a)
-> (forall (vs :: [*]) (es :: Peano) ret.
    SomeInstr repr inp (a : vs) ('Succ es) ret
    -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
forall a b. (a -> b) -> a -> b
$ \SomeInstr repr inp (a : vs) ('Succ es) ret
_next -> [ErrorItem (InputToken inp)]
-> SomeInstr repr inp vs ('Succ es) ret
forall (repr :: ReprInstr) inp (vs :: [*]) (es :: Peano) a.
Failable repr =>
[ErrorItem (InputToken inp)] -> repr inp vs ('Succ es) a
fail []
  Program forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
l <|> :: forall a.
Program repr inp a -> Program repr inp a -> Program repr inp a
<|> Program forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
r = Program repr inp a -> Program repr inp a
forall (repr :: ReprInstr) inp v.
Joinable repr =>
Program repr inp v -> Program repr inp v
joinNext (Program repr inp a -> Program repr inp a)
-> Program repr inp a -> Program repr inp a
forall a b. (a -> b) -> a -> b
$ (forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
forall (repr :: ReprInstr) inp a.
(forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
Program ((forall (vs :: [*]) (es :: Peano) ret.
  SomeInstr repr inp (a : vs) ('Succ es) ret
  -> SomeInstr repr inp vs ('Succ es) ret)
 -> Program repr inp a)
-> (forall (vs :: [*]) (es :: Peano) ret.
    SomeInstr repr inp (a : vs) ('Succ es) ret
    -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
forall a b. (a -> b) -> a -> b
$ \SomeInstr repr inp (a : vs) ('Succ es) ret
next ->
    SomeInstr repr inp vs ('Succ ('Succ es)) ret
-> SomeInstr repr inp (Cursor inp : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall (repr :: ReprInstr) inp (vs :: [*]) (es :: Peano) a.
Failable repr =>
repr inp vs ('Succ es) a
-> repr inp (Cursor inp : vs) es a -> repr inp vs es a
catchFail
      (SomeInstr repr inp (a : vs) ('Succ ('Succ es)) ret
-> SomeInstr repr inp vs ('Succ ('Succ es)) ret
forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
l (SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp (a : vs) ('Succ ('Succ es)) ret
forall (repr :: ReprInstr) inp (vs :: [*]) (es :: Peano) a.
Failable repr =>
repr inp vs es a -> repr inp vs ('Succ es) a
popFail SomeInstr repr inp (a : vs) ('Succ es) ret
next))
      (SomeInstr repr inp vs ('Succ es) ret
-> SomeInstr repr inp (Cursor inp : vs) ('Succ es) ret
forall inp (repr :: ReprInstr) (vs :: [*]) (es :: Peano) ret.
(Cursorable (Cursor inp), Branchable repr, Failable repr,
 Inputable repr, Stackable repr) =>
SomeInstr repr inp vs ('Succ es) ret
-> SomeInstr repr inp (Cursor inp : vs) ('Succ es) ret
failIfConsumed (SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
r SomeInstr repr inp (a : vs) ('Succ es) ret
next))
  try :: forall a. Program repr inp a -> Program repr inp a
try (Program forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
x) = (forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
forall (repr :: ReprInstr) inp a.
(forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
Program ((forall (vs :: [*]) (es :: Peano) ret.
  SomeInstr repr inp (a : vs) ('Succ es) ret
  -> SomeInstr repr inp vs ('Succ es) ret)
 -> Program repr inp a)
-> (forall (vs :: [*]) (es :: Peano) ret.
    SomeInstr repr inp (a : vs) ('Succ es) ret
    -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
forall a b. (a -> b) -> a -> b
$ \SomeInstr repr inp (a : vs) ('Succ es) ret
next ->
    SomeInstr repr inp vs ('Succ ('Succ es)) ret
-> SomeInstr repr inp (Cursor inp : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall (repr :: ReprInstr) inp (vs :: [*]) (es :: Peano) a.
Failable repr =>
repr inp vs ('Succ es) a
-> repr inp (Cursor inp : vs) es a -> repr inp vs es a
catchFail
      (SomeInstr repr inp (a : vs) ('Succ ('Succ es)) ret
-> SomeInstr repr inp vs ('Succ ('Succ es)) ret
forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
x (SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp (a : vs) ('Succ ('Succ es)) ret
forall (repr :: ReprInstr) inp (vs :: [*]) (es :: Peano) a.
Failable repr =>
repr inp vs es a -> repr inp vs ('Succ es) a
popFail SomeInstr repr inp (a : vs) ('Succ es) ret
next))
      -- On exception, reset the input,
      -- and propagate the failure.
      (SomeInstr repr inp vs ('Succ es) ret
-> SomeInstr repr inp (Cursor inp : vs) ('Succ es) ret
forall (repr :: ReprInstr) inp (vs :: [*]) (es :: Peano) a.
Inputable repr =>
repr inp vs es a -> repr inp (Cursor inp : vs) es a
loadInput ([ErrorItem (InputToken inp)]
-> SomeInstr repr inp vs ('Succ es) ret
forall (repr :: ReprInstr) inp (vs :: [*]) (es :: Peano) a.
Failable repr =>
[ErrorItem (InputToken inp)] -> repr inp vs ('Succ es) a
fail []))

-- | If no input has been consumed by the failing alternative
-- then continue with the given continuation.
-- Otherwise, propagate the 'Fail'ure.
failIfConsumed ::
  Cursorable (Cursor inp) =>
  Branchable repr =>
  Failable repr =>
  Inputable repr =>
  Stackable repr =>
  SomeInstr repr inp vs ('Succ es) ret ->
  SomeInstr repr inp (Cursor inp : vs) ('Succ es) ret
failIfConsumed :: forall inp (repr :: ReprInstr) (vs :: [*]) (es :: Peano) ret.
(Cursorable (Cursor inp), Branchable repr, Failable repr,
 Inputable repr, Stackable repr) =>
SomeInstr repr inp vs ('Succ es) ret
-> SomeInstr repr inp (Cursor inp : vs) ('Succ es) ret
failIfConsumed SomeInstr repr inp vs ('Succ es) ret
k = SomeInstr repr inp (Cursor inp : Cursor inp : vs) ('Succ es) ret
-> SomeInstr repr inp (Cursor inp : vs) ('Succ es) ret
forall (repr :: ReprInstr) inp (vs :: [*]) (es :: Peano) a.
Inputable repr =>
repr inp (Cursor inp : vs) es a -> repr inp vs es a
pushInput (TermInstr (Cursor inp -> Cursor inp -> Bool)
-> SomeInstr repr inp (Bool : vs) ('Succ es) ret
-> SomeInstr repr inp (Cursor inp : Cursor inp : vs) ('Succ es) ret
forall (repr :: ReprInstr) x y z inp (vs :: [*]) (es :: Peano) a.
Stackable repr =>
TermInstr (x -> y -> z)
-> repr inp (z : vs) es a -> repr inp (y : x : vs) es a
liftI2 (Code Q (Cursor inp -> Cursor inp -> Bool)
-> TermInstr (Cursor inp -> Cursor inp -> Bool)
forall (repr :: * -> *) a. repr a -> Term repr a
H.Term Code Q (Cursor inp -> Cursor inp -> Bool)
forall cur. Cursorable cur => CodeQ (cur -> cur -> Bool)
sameOffset) (SomeInstr repr inp vs ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
-> SomeInstr repr inp (Bool : vs) ('Succ es) ret
forall (repr :: ReprInstr) inp (vs :: [*]) (es :: Peano) a.
Branchable repr =>
repr inp vs es a -> repr inp vs es a -> repr inp (Bool : vs) es a
ifI SomeInstr repr inp vs ('Succ es) ret
k ([ErrorItem (InputToken inp)]
-> SomeInstr repr inp vs ('Succ es) ret
forall (repr :: ReprInstr) inp (vs :: [*]) (es :: Peano) a.
Failable repr =>
[ErrorItem (InputToken inp)] -> repr inp vs ('Succ es) a
fail [])))

-- | @('joinNext' m)@ factorize the next 'Instr'uction
-- to be able to reuse it multiple times without duplication.
-- It does so by introducing a 'defJoin'
-- and passing the corresponding 'refJoin'
-- as next 'Instr'uction to @(m)@,
-- unless factorizing is useless because the next 'Instr'uction
-- is already a 'refJoin' or a 'ret'.
-- It should be used each time the next 'Instr'uction
-- is used multiple times.
joinNext ::
  Joinable repr =>
  Program repr inp v ->
  Program repr inp v
joinNext :: forall (repr :: ReprInstr) inp v.
Joinable repr =>
Program repr inp v -> Program repr inp v
joinNext (Program forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (v : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
m) = (forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (v : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp v
forall (repr :: ReprInstr) inp a.
(forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
Program ((forall (vs :: [*]) (es :: Peano) ret.
  SomeInstr repr inp (v : vs) ('Succ es) ret
  -> SomeInstr repr inp vs ('Succ es) ret)
 -> Program repr inp v)
-> (forall (vs :: [*]) (es :: Peano) ret.
    SomeInstr repr inp (v : vs) ('Succ es) ret
    -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp v
forall a b. (a -> b) -> a -> b
$ \case
  -- Double refJoin Optimization:
  -- If a join-node points directly to another join-node,
  -- then reuse it
  next :: SomeInstr repr inp (v : vs) ('Succ es) ret
next@(Instr RefJoin{}) -> SomeInstr repr inp (v : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (v : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
m SomeInstr repr inp (v : vs) ('Succ es) ret
next
  -- Terminal refJoin Optimization:
  -- If a join-node points directly to a terminal operation,
  -- then it's useless to introduce a join-node.
  next :: SomeInstr repr inp (v : vs) ('Succ es) ret
next@(Instr Ret{}) -> SomeInstr repr inp (v : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (v : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
m SomeInstr repr inp (v : vs) ('Succ es) ret
next
  -- Introduce a join-node.
  SomeInstr repr inp (v : vs) ('Succ es) ret
next -> LetName v
-> SomeInstr repr inp (v : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall (repr :: ReprInstr) v inp (vs :: [*]) (es :: Peano) a.
Joinable repr =>
LetName v
-> repr inp (v : vs) es a -> repr inp vs es a -> repr inp vs es a
defJoin LetName v
forall {a}. LetName a
joinName SomeInstr repr inp (v : vs) ('Succ es) ret
next (SomeInstr repr inp (v : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (v : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
m (LetName v -> SomeInstr repr inp (v : vs) ('Succ es) ret
forall (repr :: ReprInstr) v inp (vs :: [*]) (es :: Peano) a.
Joinable repr =>
LetName v -> repr inp (v : vs) es a
refJoin LetName v
forall {a}. LetName a
joinName))
    where joinName :: LetName a
joinName = Name -> LetName a
forall a. Name -> LetName a
LetName (Name -> LetName a) -> Name -> LetName a
forall a b. (a -> b) -> a -> b
$ IO Name -> Name
forall a. IO a -> a
unsafePerformIO (IO Name -> Name) -> IO Name -> Name
forall a b. (a -> b) -> a -> b
$ String -> IO Name
forall (m :: * -> *). Quasi m => String -> m Name
TH.qNewName String
"join"

instance
  ( tok ~ InputToken inp
  , Readable tok repr
  , Typeable tok
  ) => Satisfiable tok (Program repr inp) where
  satisfy :: [ErrorItem tok]
-> TermGrammar (tok -> Bool) -> Program repr inp tok
satisfy [ErrorItem tok]
es TermGrammar (tok -> Bool)
p = (forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (tok : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp tok
forall (repr :: ReprInstr) inp a.
(forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
Program ((forall (vs :: [*]) (es :: Peano) ret.
  SomeInstr repr inp (tok : vs) ('Succ es) ret
  -> SomeInstr repr inp vs ('Succ es) ret)
 -> Program repr inp tok)
-> (forall (vs :: [*]) (es :: Peano) ret.
    SomeInstr repr inp (tok : vs) ('Succ es) ret
    -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp tok
forall a b. (a -> b) -> a -> b
$ [ErrorItem tok]
-> TermInstr (tok -> Bool)
-> SomeInstr repr inp (tok : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall tok (repr :: ReprInstr) inp (vs :: [*]) (es :: Peano) a.
(Readable tok repr, tok ~ InputToken inp) =>
[ErrorItem tok]
-> TermInstr (tok -> Bool)
-> repr inp (tok : vs) ('Succ es) a
-> repr inp vs ('Succ es) a
read [ErrorItem tok]
es (TermGrammar (tok -> Bool) -> TermInstr (tok -> Bool)
forall (from :: * -> *) (to :: * -> *) a.
Trans from to =>
from a -> to a
trans TermGrammar (tok -> Bool)
p)
instance
  ( Branchable repr
  , Joinable repr
  , Stackable repr
  ) => Selectable (Program repr inp) where
  branch :: forall a b c.
Program repr inp (Either a b)
-> Program repr inp (a -> c)
-> Program repr inp (b -> c)
-> Program repr inp c
branch (Program forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (Either a b : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
lr) (Program forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp ((a -> c) : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
l) (Program forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp ((b -> c) : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
r) = Program repr inp c -> Program repr inp c
forall (repr :: ReprInstr) inp v.
Joinable repr =>
Program repr inp v -> Program repr inp v
joinNext (Program repr inp c -> Program repr inp c)
-> Program repr inp c -> Program repr inp c
forall a b. (a -> b) -> a -> b
$ (forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (c : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp c
forall (repr :: ReprInstr) inp a.
(forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
Program ((forall (vs :: [*]) (es :: Peano) ret.
  SomeInstr repr inp (c : vs) ('Succ es) ret
  -> SomeInstr repr inp vs ('Succ es) ret)
 -> Program repr inp c)
-> (forall (vs :: [*]) (es :: Peano) ret.
    SomeInstr repr inp (c : vs) ('Succ es) ret
    -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp c
forall a b. (a -> b) -> a -> b
$ \SomeInstr repr inp (c : vs) ('Succ es) ret
next ->
    SomeInstr repr inp (Either a b : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (Either a b : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
lr (SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp (b : vs) ('Succ es) ret
-> SomeInstr repr inp (Either a b : vs) ('Succ es) ret
forall (repr :: ReprInstr) inp x (vs :: [*]) (es :: Peano) r y.
Branchable repr =>
repr inp (x : vs) es r
-> repr inp (y : vs) es r -> repr inp (Either x y : vs) es r
caseI
      (SomeInstr repr inp ((a -> c) : a : vs) ('Succ es) ret
-> SomeInstr repr inp (a : vs) ('Succ es) ret
forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp ((a -> c) : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
l (SomeInstr repr inp (a : (a -> c) : vs) ('Succ es) ret
-> SomeInstr repr inp ((a -> c) : a : vs) ('Succ es) ret
forall (repr :: ReprInstr) inp x y (vs :: [*]) (es :: Peano) a.
Stackable repr =>
repr inp (x : y : vs) es a -> repr inp (y : x : vs) es a
swap (SomeInstr repr inp (c : vs) ('Succ es) ret
-> SomeInstr repr inp (a : (a -> c) : vs) ('Succ es) ret
forall (repr :: ReprInstr) inp y (vs :: [*]) (es :: Peano) a x.
Stackable repr =>
repr inp (y : vs) es a -> repr inp (x : (x -> y) : vs) es a
appI SomeInstr repr inp (c : vs) ('Succ es) ret
next)))
      (SomeInstr repr inp ((b -> c) : b : vs) ('Succ es) ret
-> SomeInstr repr inp (b : vs) ('Succ es) ret
forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp ((b -> c) : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
r (SomeInstr repr inp (b : (b -> c) : vs) ('Succ es) ret
-> SomeInstr repr inp ((b -> c) : b : vs) ('Succ es) ret
forall (repr :: ReprInstr) inp x y (vs :: [*]) (es :: Peano) a.
Stackable repr =>
repr inp (x : y : vs) es a -> repr inp (y : x : vs) es a
swap (SomeInstr repr inp (c : vs) ('Succ es) ret
-> SomeInstr repr inp (b : (b -> c) : vs) ('Succ es) ret
forall (repr :: ReprInstr) inp y (vs :: [*]) (es :: Peano) a x.
Stackable repr =>
repr inp (y : vs) es a -> repr inp (x : (x -> y) : vs) es a
appI SomeInstr repr inp (c : vs) ('Succ es) ret
next))))
instance
  ( Branchable repr
  , Joinable repr
  ) => Matchable (Program repr inp) where
  conditional :: forall a b.
Eq a =>
Program repr inp a
-> [TermGrammar (a -> Bool)]
-> [Program repr inp b]
-> Program repr inp b
-> Program repr inp b
conditional (Program forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
a) [TermGrammar (a -> Bool)]
ps [Program repr inp b]
bs (Program forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (b : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
d) = Program repr inp b -> Program repr inp b
forall (repr :: ReprInstr) inp v.
Joinable repr =>
Program repr inp v -> Program repr inp v
joinNext (Program repr inp b -> Program repr inp b)
-> Program repr inp b -> Program repr inp b
forall a b. (a -> b) -> a -> b
$ (forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (b : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp b
forall (repr :: ReprInstr) inp a.
(forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
Program ((forall (vs :: [*]) (es :: Peano) ret.
  SomeInstr repr inp (b : vs) ('Succ es) ret
  -> SomeInstr repr inp vs ('Succ es) ret)
 -> Program repr inp b)
-> (forall (vs :: [*]) (es :: Peano) ret.
    SomeInstr repr inp (b : vs) ('Succ es) ret
    -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp b
forall a b. (a -> b) -> a -> b
$ \SomeInstr repr inp (b : vs) ('Succ es) ret
next ->
    SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
a ([TermInstr (a -> Bool)]
-> [SomeInstr repr inp vs ('Succ es) ret]
-> SomeInstr repr inp vs ('Succ es) ret
-> SomeInstr repr inp (a : vs) ('Succ es) ret
forall (repr :: ReprInstr) v inp (vs :: [*]) (es :: Peano) a.
Branchable repr =>
[TermInstr (v -> Bool)]
-> [repr inp vs es a] -> repr inp vs es a -> repr inp (v : vs) es a
choices
      (TermGrammar (a -> Bool) -> TermInstr (a -> Bool)
forall (from :: * -> *) (to :: * -> *) a.
Trans from to =>
from a -> to a
trans (TermGrammar (a -> Bool) -> TermInstr (a -> Bool))
-> [TermGrammar (a -> Bool)] -> [TermInstr (a -> Bool)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Functor.<$> [TermGrammar (a -> Bool)]
ps)
      ((\(Program forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (b : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
b) -> SomeInstr repr inp (b : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (b : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
b SomeInstr repr inp (b : vs) ('Succ es) ret
next) (Program repr inp b -> SomeInstr repr inp vs ('Succ es) ret)
-> [Program repr inp b] -> [SomeInstr repr inp vs ('Succ es) ret]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Functor.<$> [Program repr inp b]
bs)
      (SomeInstr repr inp (b : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (b : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
d SomeInstr repr inp (b : vs) ('Succ es) ret
next))
instance
  ( Ord (InputToken inp)
  , Cursorable (Cursor inp)
  , Branchable repr
  , Failable repr
  , Inputable repr
  , Joinable repr
  , Readable (InputToken inp) repr
  , Typeable (InputToken inp)
  , Stackable repr
  ) => Lookable (Program repr inp) where
  look :: forall a. Program repr inp a -> Program repr inp a
look (Program forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
x) = (forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
forall (repr :: ReprInstr) inp a.
(forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
Program ((forall (vs :: [*]) (es :: Peano) ret.
  SomeInstr repr inp (a : vs) ('Succ es) ret
  -> SomeInstr repr inp vs ('Succ es) ret)
 -> Program repr inp a)
-> (forall (vs :: [*]) (es :: Peano) ret.
    SomeInstr repr inp (a : vs) ('Succ es) ret
    -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
forall a b. (a -> b) -> a -> b
$ \SomeInstr repr inp (a : vs) ('Succ es) ret
next ->
    SomeInstr repr inp (Cursor inp : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall (repr :: ReprInstr) inp (vs :: [*]) (es :: Peano) a.
Inputable repr =>
repr inp (Cursor inp : vs) es a -> repr inp vs es a
pushInput (SomeInstr repr inp (a : Cursor inp : vs) ('Succ es) ret
-> SomeInstr repr inp (Cursor inp : vs) ('Succ es) ret
forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
x (SomeInstr repr inp (Cursor inp : a : vs) ('Succ es) ret
-> SomeInstr repr inp (a : Cursor inp : vs) ('Succ es) ret
forall (repr :: ReprInstr) inp x y (vs :: [*]) (es :: Peano) a.
Stackable repr =>
repr inp (x : y : vs) es a -> repr inp (y : x : vs) es a
swap (SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp (Cursor inp : a : vs) ('Succ es) ret
forall (repr :: ReprInstr) inp (vs :: [*]) (es :: Peano) a.
Inputable repr =>
repr inp vs es a -> repr inp (Cursor inp : vs) es a
loadInput SomeInstr repr inp (a : vs) ('Succ es) ret
next)))
  eof :: Program repr inp ()
eof = Program repr inp (InputToken inp) -> Program repr inp ()
forall (repr :: * -> *) a. Lookable repr => repr a -> repr ()
negLook ([ErrorItem (InputToken inp)]
-> TermGrammar (InputToken inp -> Bool)
-> Program repr inp (InputToken inp)
forall tok (repr :: * -> *).
Satisfiable tok repr =>
[ErrorItem tok] -> TermGrammar (tok -> Bool) -> repr tok
satisfy [{-discarded by negLook-}] ((Term ValueCode (InputToken inp) -> Term ValueCode Bool)
-> TermGrammar (InputToken inp -> Bool)
forall (repr :: * -> *) a b.
Termable repr =>
(repr a -> repr b) -> repr (a -> b)
H.lam1 (\Term ValueCode (InputToken inp)
_x -> Bool -> Term ValueCode Bool
forall (repr :: * -> *). Termable repr => Bool -> repr Bool
H.bool Bool
True)))
        -- This sets a better failure message
        Program repr inp () -> Program repr inp () -> Program repr inp ()
forall (repr :: * -> *) a.
Alternable repr =>
repr a -> repr a -> repr a
<|> ((forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (() : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp ()
forall (repr :: ReprInstr) inp a.
(forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
Program ((forall (vs :: [*]) (es :: Peano) ret.
  SomeInstr repr inp (() : vs) ('Succ es) ret
  -> SomeInstr repr inp vs ('Succ es) ret)
 -> Program repr inp ())
-> (forall (vs :: [*]) (es :: Peano) ret.
    SomeInstr repr inp (() : vs) ('Succ es) ret
    -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp ()
forall a b. (a -> b) -> a -> b
$ \SomeInstr repr inp (() : vs) ('Succ es) ret
_k -> [ErrorItem (InputToken inp)]
-> SomeInstr repr inp vs ('Succ es) ret
forall (repr :: ReprInstr) inp (vs :: [*]) (es :: Peano) a.
Failable repr =>
[ErrorItem (InputToken inp)] -> repr inp vs ('Succ es) a
fail [ErrorItem (InputToken inp)
forall tok. ErrorItem tok
ErrorItemEnd])
  negLook :: forall a. Program repr inp a -> Program repr inp ()
negLook (Program forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
x) = (forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (() : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp ()
forall (repr :: ReprInstr) inp a.
(forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
Program ((forall (vs :: [*]) (es :: Peano) ret.
  SomeInstr repr inp (() : vs) ('Succ es) ret
  -> SomeInstr repr inp vs ('Succ es) ret)
 -> Program repr inp ())
-> (forall (vs :: [*]) (es :: Peano) ret.
    SomeInstr repr inp (() : vs) ('Succ es) ret
    -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp ()
forall a b. (a -> b) -> a -> b
$ \SomeInstr repr inp (() : vs) ('Succ es) ret
next ->
    SomeInstr repr inp vs ('Succ ('Succ es)) ret
-> SomeInstr repr inp (Cursor inp : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall (repr :: ReprInstr) inp (vs :: [*]) (es :: Peano) a.
Failable repr =>
repr inp vs ('Succ es) a
-> repr inp (Cursor inp : vs) es a -> repr inp vs es a
catchFail
      -- On x success, discard the result,
      -- and replace this 'CatchFail''s failure handler
      -- by a 'Fail'ure whose 'farthestExpecting' is negated,
      -- then a failure is raised from the input
      -- when entering 'negLook', to avoid odd cases:
      -- - where the failure that made (negLook x)
      --   succeed can get the blame for the overall
      --   failure of the grammar.
      -- - where the overall failure of
      --   the grammar might be blamed on something in x
      --   that, if corrected, still makes x succeed and
      --   (negLook x) fail.
      (SomeInstr repr inp (Cursor inp : vs) ('Succ ('Succ es)) ret
-> SomeInstr repr inp vs ('Succ ('Succ es)) ret
forall (repr :: ReprInstr) inp (vs :: [*]) (es :: Peano) a.
Inputable repr =>
repr inp (Cursor inp : vs) es a -> repr inp vs es a
pushInput (SomeInstr repr inp (a : Cursor inp : vs) ('Succ ('Succ es)) ret
-> SomeInstr repr inp (Cursor inp : vs) ('Succ ('Succ es)) ret
forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
x (SomeInstr repr inp (Cursor inp : vs) ('Succ ('Succ es)) ret
-> SomeInstr repr inp (a : Cursor inp : vs) ('Succ ('Succ es)) ret
forall (repr :: ReprInstr) inp (vs :: [*]) (es :: Peano) a v.
Stackable repr =>
repr inp vs es a -> repr inp (v : vs) es a
pop (SomeInstr repr inp (Cursor inp : vs) ('Succ es) ret
-> SomeInstr repr inp (Cursor inp : vs) ('Succ ('Succ es)) ret
forall (repr :: ReprInstr) inp (vs :: [*]) (es :: Peano) a.
Failable repr =>
repr inp vs es a -> repr inp vs ('Succ es) a
popFail (SomeInstr repr inp vs ('Succ es) ret
-> SomeInstr repr inp (Cursor inp : vs) ('Succ es) ret
forall (repr :: ReprInstr) inp (vs :: [*]) (es :: Peano) a.
Inputable repr =>
repr inp vs es a -> repr inp (Cursor inp : vs) es a
loadInput ([ErrorItem (InputToken inp)]
-> SomeInstr repr inp vs ('Succ es) ret
forall (repr :: ReprInstr) inp (vs :: [*]) (es :: Peano) a.
Failable repr =>
[ErrorItem (InputToken inp)] -> repr inp vs ('Succ es) a
fail []))))))
      -- On x failure, reset the input,
      -- and go on with the next 'Instr'uctions.
      (SomeInstr repr inp vs ('Succ es) ret
-> SomeInstr repr inp (Cursor inp : vs) ('Succ es) ret
forall (repr :: ReprInstr) inp (vs :: [*]) (es :: Peano) a.
Inputable repr =>
repr inp vs es a -> repr inp (Cursor inp : vs) es a
loadInput (TermInstr ()
-> SomeInstr repr inp (() : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall (repr :: ReprInstr) v inp (vs :: [*]) (es :: Peano) a.
Stackable repr =>
TermInstr v -> repr inp (v : vs) es a -> repr inp vs es a
push TermInstr ()
forall (repr :: * -> *). Termable repr => repr ()
H.unit SomeInstr repr inp (() : vs) ('Succ es) ret
next))
instance
  Routinable repr =>
  Letable TH.Name (Program repr inp) where
  def :: forall a. Name -> Program repr inp a -> Program repr inp a
def Name
n (Program forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
v) = (forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
forall (repr :: ReprInstr) inp a.
(forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
Program ((forall (vs :: [*]) (es :: Peano) ret.
  SomeInstr repr inp (a : vs) ('Succ es) ret
  -> SomeInstr repr inp vs ('Succ es) ret)
 -> Program repr inp a)
-> (forall (vs :: [*]) (es :: Peano) ret.
    SomeInstr repr inp (a : vs) ('Succ es) ret
    -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
forall a b. (a -> b) -> a -> b
$ \SomeInstr repr inp (a : vs) ('Succ es) ret
next ->
    LetName a
-> SomeInstr repr inp '[] ('Succ 'Zero) a
-> SomeInstr repr inp vs ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall (repr :: ReprInstr) v inp (vs :: [*]) (es :: Peano) a.
Routinable repr =>
LetName v
-> repr inp '[] ('Succ 'Zero) v
-> repr inp vs ('Succ es) a
-> repr inp vs ('Succ es) a
subroutine (Name -> LetName a
forall a. Name -> LetName a
LetName Name
n) (SomeInstr repr inp '[a] ('Succ 'Zero) a
-> SomeInstr repr inp '[] ('Succ 'Zero) a
forall (vs :: [*]) (es :: Peano) ret.
SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
v SomeInstr repr inp '[a] ('Succ 'Zero) a
forall (repr :: ReprInstr) inp a (es :: Peano).
Routinable repr =>
repr inp '[a] es a
ret) (LetName a
-> SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall (repr :: ReprInstr) v inp (vs :: [*]) (es :: Peano) a.
Routinable repr =>
LetName v
-> repr inp (v : vs) ('Succ es) a -> repr inp vs ('Succ es) a
call (Name -> LetName a
forall a. Name -> LetName a
LetName Name
n) SomeInstr repr inp (a : vs) ('Succ es) ret
next)
  ref :: forall a. Bool -> Name -> Program repr inp a
ref Bool
_isRec Name
n = (forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
forall (repr :: ReprInstr) inp a.
(forall (vs :: [*]) (es :: Peano) ret.
 SomeInstr repr inp (a : vs) ('Succ es) ret
 -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
Program ((forall (vs :: [*]) (es :: Peano) ret.
  SomeInstr repr inp (a : vs) ('Succ es) ret
  -> SomeInstr repr inp vs ('Succ es) ret)
 -> Program repr inp a)
-> (forall (vs :: [*]) (es :: Peano) ret.
    SomeInstr repr inp (a : vs) ('Succ es) ret
    -> SomeInstr repr inp vs ('Succ es) ret)
-> Program repr inp a
forall a b. (a -> b) -> a -> b
$ \case
    -- Returning just after a 'call' is useless:
    -- using 'jump' lets the 'ret' of the 'subroutine'
    -- directly return where it would in two 'ret's.
    Instr Ret{} -> LetName ret -> SomeInstr repr inp '[] ('Succ es) ret
forall (repr :: ReprInstr) a inp (es :: Peano).
Routinable repr =>
LetName a -> repr inp '[] ('Succ es) a
jump (Name -> LetName ret
forall a. Name -> LetName a
LetName Name
n)
    SomeInstr repr inp (a : vs) ('Succ es) ret
next -> LetName a
-> SomeInstr repr inp (a : vs) ('Succ es) ret
-> SomeInstr repr inp vs ('Succ es) ret
forall (repr :: ReprInstr) v inp (vs :: [*]) (es :: Peano) a.
Routinable repr =>
LetName v
-> repr inp (v : vs) ('Succ es) a -> repr inp vs ('Succ es) a
call (Name -> LetName a
forall a. Name -> LetName a
LetName Name
n) SomeInstr repr inp (a : vs) ('Succ es) ret
next
instance
  ( Cursorable (Cursor inp)
  , Branchable repr
  , Failable repr
  , Inputable repr
  , Joinable repr
  , Stackable repr
  ) => Foldable (Program repr inp) where
  {-
  chainPre op p = go <*> p
    where go = (H..) <$> op <*> go <|> pure H.id
  chainPost p op = p <**> go
    where go = (H..) <$> op <*> go <|> pure H.id
  -}