module Language.Parser.Ptera.Pipeline.SRB2Parser where

import           Language.Parser.Ptera.Prelude

import qualified Data.EnumMap.Strict                        as EnumMap
import qualified Language.Parser.Ptera.Data.Alignable.Array as AlignableArray
import qualified Language.Parser.Ptera.Data.HEnum           as HEnum
import qualified Language.Parser.Ptera.Data.Symbolic.IntMap as SymbolicIntMap
import qualified Language.Parser.Ptera.Machine.LAPEG        as LAPEG
import qualified Language.Parser.Ptera.Machine.PEG          as PEG
import qualified Language.Parser.Ptera.Machine.SRB          as SRB
import qualified Language.Parser.Ptera.Runner.Parser        as Parser
import qualified Language.Parser.Ptera.Syntax               as Syntax
import qualified Language.Parser.Ptera.Syntax.Grammar       as Grammar
import qualified Unsafe.Coerce                              as Unsafe

type Action ctx = Grammar.Action (Syntax.SemActM ctx)

srb2Parser :: forall ctx tokens elem altHelp
    .  Syntax.GrammarToken tokens elem
    => Proxy tokens -> SRB.T Int StringLit (Maybe altHelp) (Action ctx)
    -> Parser.T ctx elem altHelp
srb2Parser :: Proxy tokens
-> T Int StringLit (Maybe altHelp) (Action ctx)
-> T ctx elem altHelp
srb2Parser Proxy tokens
p T Int StringLit (Maybe altHelp) (Action ctx)
srb = RunnerParser :: forall ctx elem altHelp.
(Int -> Maybe Int)
-> (elem -> Int)
-> (Int -> Int -> Trans)
-> (Int -> AltKind)
-> (Int -> [(Int, Int)])
-> (Int -> (StringLit, Maybe altHelp))
-> (Int -> ActionM ctx)
-> RunnerParser ctx elem altHelp
Parser.RunnerParser
    { $sel:parserInitial:RunnerParser :: Int -> Maybe Int
parserInitial = \Int
s -> Maybe StateNum -> Maybe Int
coerce do Int -> EnumMap Int StateNum -> Maybe StateNum
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EnumMap.lookup Int
s do T Int StringLit (Maybe altHelp) (Action ctx)
-> EnumMap Int StateNum
forall start varDoc altDoc a.
SRB start varDoc altDoc a -> EnumMap start StateNum
SRB.initials T Int StringLit (Maybe altHelp) (Action ctx)
srb
    , $sel:parserGetTokenNum:RunnerParser :: elem -> Int
parserGetTokenNum = \elem
tok ->
        HEnum (TokensTag tokens) -> Int
forall k (as :: [k]). HEnum as -> Int
HEnum.unsafeHEnum do Proxy tokens -> elem -> HEnum (TokensTag tokens)
forall tokens elem.
GrammarToken tokens elem =>
Proxy tokens -> elem -> T (TokensTag tokens)
Syntax.tokenToTerminal Proxy tokens
p elem
tok
    , $sel:parserTrans:RunnerParser :: Int -> Int -> Trans
parserTrans = \Int
s0 Int
t -> if Int
s0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
        then Trans :: Int -> [TransOp] -> Trans
Parser.Trans
            {
                $sel:transState:Trans :: Int
transState = Int
-1,
                $sel:transOps:Trans :: [TransOp]
transOps = []
            }
        else
            let srbSt :: MState
srbSt = Array StateNum MState -> StateNum -> MState
forall n a. T n => Array n a -> n -> a
AlignableArray.forceIndex
                    do T Int StringLit (Maybe altHelp) (Action ctx)
-> Array StateNum MState
forall start varDoc altDoc a.
SRB start varDoc altDoc a -> Array StateNum MState
SRB.states T Int StringLit (Maybe altHelp) (Action ctx)
srb
                    do Int -> StateNum
SRB.StateNum Int
s0
            in Int -> MState -> Trans
buildTrans Int
t MState
srbSt
    , $sel:parserAltKind:RunnerParser :: Int -> AltKind
parserAltKind = \Int
alt -> Alt (Maybe altHelp) (Action ctx) -> AltKind
forall altDoc a. Alt altDoc a -> AltKind
LAPEG.altKind
        do Array AltNum (Alt (Maybe altHelp) (Action ctx))
-> AltNum -> Alt (Maybe altHelp) (Action ctx)
forall n a. T n => Array n a -> n -> a
AlignableArray.forceIndex
            do T Int StringLit (Maybe altHelp) (Action ctx)
-> Array AltNum (Alt (Maybe altHelp) (Action ctx))
forall start varDoc altDoc a.
SRB start varDoc altDoc a -> T AltNum (Alt altDoc a)
SRB.alts T Int StringLit (Maybe altHelp) (Action ctx)
srb
            do Int -> AltNum
LAPEG.AltNum Int
alt
    , $sel:parserAction:RunnerParser :: Int -> ActionM ctx
parserAction = \Int
alt -> Action ctx -> ActionM ctx
forall ctx. Action ctx -> ActionM ctx
runAction
        do Alt (Maybe altHelp) (Action ctx) -> Action ctx
forall altDoc a. Alt altDoc a -> a
LAPEG.altAction
            do Array AltNum (Alt (Maybe altHelp) (Action ctx))
-> AltNum -> Alt (Maybe altHelp) (Action ctx)
forall n a. T n => Array n a -> n -> a
AlignableArray.forceIndex
                do T Int StringLit (Maybe altHelp) (Action ctx)
-> Array AltNum (Alt (Maybe altHelp) (Action ctx))
forall start varDoc altDoc a.
SRB start varDoc altDoc a -> T AltNum (Alt altDoc a)
SRB.alts T Int StringLit (Maybe altHelp) (Action ctx)
srb
                do Int -> AltNum
LAPEG.AltNum Int
alt
    , $sel:parserStateHelp:RunnerParser :: Int -> [(Int, Int)]
parserStateHelp = \Int
s ->
        let srbSt :: MState
srbSt = Array StateNum MState -> StateNum -> MState
forall n a. T n => Array n a -> n -> a
AlignableArray.forceIndex
                do T Int StringLit (Maybe altHelp) (Action ctx)
-> Array StateNum MState
forall start varDoc altDoc a.
SRB start varDoc altDoc a -> Array StateNum MState
SRB.states T Int StringLit (Maybe altHelp) (Action ctx)
srb
                do Int -> StateNum
SRB.StateNum Int
s
        in [AltItem] -> [(Int, Int)]
buildStateHelp do MState -> [AltItem]
SRB.stateAltItems MState
srbSt
    , $sel:parserAltHelp:RunnerParser :: Int -> (StringLit, Maybe altHelp)
parserAltHelp = \Int
alt ->
        let vn :: VarNum
vn = Alt (Maybe altHelp) (Action ctx) -> VarNum
forall altDoc a. Alt altDoc a -> VarNum
LAPEG.altVar
                do Array AltNum (Alt (Maybe altHelp) (Action ctx))
-> AltNum -> Alt (Maybe altHelp) (Action ctx)
forall n a. T n => Array n a -> n -> a
AlignableArray.forceIndex
                    do T Int StringLit (Maybe altHelp) (Action ctx)
-> Array AltNum (Alt (Maybe altHelp) (Action ctx))
forall start varDoc altDoc a.
SRB start varDoc altDoc a -> T AltNum (Alt altDoc a)
SRB.alts T Int StringLit (Maybe altHelp) (Action ctx)
srb
                    do Int -> AltNum
LAPEG.AltNum Int
alt
            v :: Var StringLit
v = Array VarNum (Var StringLit) -> VarNum -> Var StringLit
forall n a. T n => Array n a -> n -> a
AlignableArray.forceIndex
                do T Int StringLit (Maybe altHelp) (Action ctx)
-> Array VarNum (Var StringLit)
forall start varDoc altDoc a.
SRB start varDoc altDoc a -> T VarNum (Var varDoc)
SRB.vars T Int StringLit (Maybe altHelp) (Action ctx)
srb
                do VarNum
vn
        in (Var StringLit -> StringLit
forall varDoc. Var varDoc -> varDoc
PEG.varHelp Var StringLit
v, Maybe altHelp
forall a. Maybe a
Nothing)
    }

buildTrans :: Int -> SRB.MState -> Parser.Trans
buildTrans :: Int -> MState -> Trans
buildTrans Int
t MState
srbSt = case Int -> IntMap Trans -> Maybe Trans
forall a. Int -> IntMap a -> Maybe a
SymbolicIntMap.lookup Int
t do MState -> IntMap Trans
SRB.stateTrans MState
srbSt of
    Maybe Trans
Nothing ->
        Trans :: Int -> [TransOp] -> Trans
Parser.Trans
            {
                $sel:transState:Trans :: Int
transState = Int
-1,
                $sel:transOps:Trans :: [TransOp]
transOps = []
            }
    Just (SRB.TransWithOps [TransOp]
ops (SRB.StateNum Int
s1)) ->
        Trans :: Int -> [TransOp] -> Trans
Parser.Trans
            {
                $sel:transState:Trans :: Int
transState = Int
s1,
                $sel:transOps:Trans :: [TransOp]
transOps = TransOp -> TransOp
transOp (TransOp -> TransOp) -> [TransOp] -> [TransOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TransOp]
ops
            }
    Just (SRB.TransReduce (LAPEG.AltNum Int
alt)) ->
        Trans :: Int -> [TransOp] -> Trans
Parser.Trans
            {
                $sel:transState:Trans :: Int
transState = Int
-1,
                $sel:transOps:Trans :: [TransOp]
transOps = [Int -> TransOp
Parser.TransOpReduce Int
alt]
            }

buildStateHelp :: [SRB.AltItem] -> [(Parser.AltNum, Int)]
buildStateHelp :: [AltItem] -> [(Int, Int)]
buildStateHelp [AltItem]
altItems =
    [
        ( AltNum -> Int
coerce do AltItem -> AltNum
SRB.altItemAltNum AltItem
altItem
        , Position -> Int
coerce do AltItem -> Position
SRB.altItemCurPos AltItem
altItem
        )
    | AltItem
altItem <- [AltItem]
altItems
    ]

transOp :: SRB.TransOp -> Parser.TransOp
transOp :: TransOp -> TransOp
transOp = \case
    SRB.TransOpEnter (LAPEG.VarNum Int
v) Bool
needBack Maybe StateNum
mEnterSn ->
        let enterSn :: Int
enterSn = case Maybe StateNum
mEnterSn of
                Maybe StateNum
Nothing ->
                    Int
-1
                Just (SRB.StateNum Int
x) ->
                    Int
x
        in Int -> Bool -> Int -> TransOp
Parser.TransOpEnter Int
v Bool
needBack Int
enterSn
    SRB.TransOpPushBackpoint (SRB.StateNum Int
backSn) ->
        Int -> TransOp
Parser.TransOpPushBackpoint Int
backSn
    SRB.TransOpHandleNot (LAPEG.AltNum Int
alt) ->
        Int -> TransOp
Parser.TransOpHandleNot Int
alt
    TransOp
SRB.TransOpShift ->
        TransOp
Parser.TransOpShift

runAction :: Action ctx -> Parser.ActionM ctx
runAction :: Action ctx -> ActionM ctx
runAction (Grammar.Action (Syntax.SemActM HList us -> ActionTask ctx a
f)) = ([ReduceArgument] -> ActionTask ctx ReduceArgument) -> ActionM ctx
forall ctx.
([ReduceArgument] -> ActionTask ctx ReduceArgument) -> ActionM ctx
Parser.ActionM \[ReduceArgument]
l ->
        a -> ReduceArgument
forall a. a -> ReduceArgument
Parser.ReduceArgument (a -> ReduceArgument)
-> ActionTask ctx a -> ActionTask ctx ReduceArgument
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HList us -> ActionTask ctx a
f do [ReduceArgument] -> HList us
forall (us2 :: [*]). [ReduceArgument] -> HList us2
goL [ReduceArgument]
l
    where
        goL :: [ReduceArgument] -> HList us2
goL = \case
            [] ->
                HList '[] -> HList us2
forall (us1 :: [*]) (us2 :: [*]). HList us1 -> HList us2
unsafeCoerceHList HList '[]
Syntax.HNil
            Parser.ReduceArgument a
x:[ReduceArgument]
xs ->
                HList (a : us2) -> HList us2
forall (us1 :: [*]) (us2 :: [*]). HList us1 -> HList us2
unsafeCoerceHList do a
x a -> HList us2 -> HList (a : us2)
forall u (us :: [*]). u -> HList us -> HList (u : us)
Syntax.:* [ReduceArgument] -> HList us2
goL [ReduceArgument]
xs

        unsafeCoerceHList :: Syntax.HList us1 -> Syntax.HList us2
        unsafeCoerceHList :: HList us1 -> HList us2
unsafeCoerceHList = HList us1 -> HList us2
forall a b. a -> b
Unsafe.unsafeCoerce