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 :: forall ctx tokens elem altHelp.
GrammarToken tokens elem =>
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 = Parser.RunnerParser
    { $sel:parserInitial:RunnerParser :: Int -> Maybe Int
parserInitial = \Int
s -> coerce :: forall a b. Coercible a b => a -> b
coerce do forall k a. Enum k => k -> EnumMap k a -> Maybe a
EnumMap.lookup Int
s do 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 ->
        forall k (as :: [k]). HEnum as -> Int
HEnum.unsafeHEnum do 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 forall a. Ord a => a -> a -> Bool
< Int
0
        then Parser.Trans
            {
                $sel:transState:Trans :: Int
transState = Int
-1,
                $sel:transOps:Trans :: [TransOp]
transOps = []
            }
        else
            let srbSt :: MState
srbSt = forall n a. T n => Array n a -> n -> a
AlignableArray.forceIndex
                    do 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 -> forall altDoc a. Alt altDoc a -> AltKind
LAPEG.altKind
        do forall n a. T n => Array n a -> n -> a
AlignableArray.forceIndex
            do 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 -> forall ctx. Action ctx -> ActionM ctx
runAction
        do forall altDoc a. Alt altDoc a -> a
LAPEG.altAction
            do forall n a. T n => Array n a -> n -> a
AlignableArray.forceIndex
                do 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 = forall n a. T n => Array n a -> n -> a
AlignableArray.forceIndex
                do 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 = forall altDoc a. Alt altDoc a -> VarNum
LAPEG.altVar
                do forall n a. T n => Array n a -> n -> a
AlignableArray.forceIndex
                    do 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 = forall n a. T n => Array n a -> n -> a
AlignableArray.forceIndex
                do 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 (forall varDoc. Var varDoc -> varDoc
PEG.varHelp Var StringLit
v, forall a. Maybe a
Nothing)
    }

buildTrans :: Int -> SRB.MState -> Parser.Trans
buildTrans :: Int -> MState -> Trans
buildTrans Int
t MState
srbSt = case forall a. Int -> IntMap a -> Maybe a
SymbolicIntMap.lookup Int
t do MState -> IntMap Trans
SRB.stateTrans MState
srbSt of
    Maybe Trans
Nothing ->
        Parser.Trans
            {
                $sel:transState:Trans :: Int
transState = Int
-1,
                $sel:transOps:Trans :: [TransOp]
transOps = []
            }
    Just (SRB.TransWithOps [TransOp]
ops (SRB.StateNum Int
s1)) ->
        Parser.Trans
            {
                $sel:transState:Trans :: Int
transState = Int
s1,
                $sel:transOps:Trans :: [TransOp]
transOps = TransOp -> TransOp
transOp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TransOp]
ops
            }
    Just (SRB.TransReduce (LAPEG.AltNum Int
alt)) ->
        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 =
    [
        ( coerce :: forall a b. Coercible a b => a -> b
coerce do AltItem -> AltNum
SRB.altItemAltNum AltItem
altItem
        , coerce :: forall a b. Coercible a b => a -> b
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 :: forall ctx. Action ctx -> ActionM ctx
runAction (Grammar.Action (Syntax.SemActM HList us -> ActionTask ctx a
f)) = forall ctx.
([ReduceArgument] -> ActionTask ctx ReduceArgument) -> ActionM ctx
Parser.ActionM \[ReduceArgument]
l ->
        forall a. a -> ReduceArgument
Parser.ReduceArgument forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HList us -> ActionTask ctx a
f do forall {us2 :: [*]}. [ReduceArgument] -> HList us2
goL [ReduceArgument]
l
    where
        goL :: [ReduceArgument] -> HList us2
goL = \case
            [] ->
                forall (us1 :: [*]) (us2 :: [*]). HList us1 -> HList us2
unsafeCoerceHList HList '[]
Syntax.HNil
            Parser.ReduceArgument a
x:[ReduceArgument]
xs ->
                forall (us1 :: [*]) (us2 :: [*]). HList us1 -> HList us2
unsafeCoerceHList do a
x forall u (us :: [*]). u -> HList us -> HList (u : us)
Syntax.:* [ReduceArgument] -> HList us2
goL [ReduceArgument]
xs

        unsafeCoerceHList :: Syntax.HList us1 -> Syntax.HList us2
        unsafeCoerceHList :: forall (us1 :: [*]) (us2 :: [*]). HList us1 -> HList us2
unsafeCoerceHList = forall a b. a -> b
Unsafe.unsafeCoerce