{-# LANGUAGE CPP #-}

module Language.Lexer.Tlex.Plugin.TH (
    TlexTH.TlexContext (..),
    TlexTH.TlexResult (..),
    TlexTH.Runner (..),
    TlexTH.runRunner,
    THScanner (..),
    THScannerBuilderContext,
    THScannerBuilder,
    buildTHScanner,
    buildTHScannerWithReify,
    liftTlexScannerBuilder,
    thLexRule,
    outputScanner,
) where

import           Language.Lexer.Tlex.Prelude

import qualified Language.Haskell.TH                      as TH
import qualified Language.Lexer.Tlex.Data.TypeableTH      as TypeableTH
import qualified Language.Lexer.Tlex.Machine.NFA          as NFA
import qualified Language.Lexer.Tlex.Output.TH            as TlexTH
import qualified Language.Lexer.Tlex.Pipeline.MinDfa      as TlexPipeline
import qualified Language.Lexer.Tlex.Pipeline.Nfa2Dfa     as TlexPipeline
import qualified Language.Lexer.Tlex.Pipeline.Scanner2Nfa as TlexPipeline
import qualified Language.Lexer.Tlex.Syntax               as Tlex

#ifdef DEBUG
import qualified Debug.Trace                              as Debug
#endif


data THScanner e = THScanner
    { THScanner e -> OutputContext
thScannerOutputCtx   :: TlexTH.OutputContext
    , THScanner e -> Scanner e (Q Exp)
thScannerTlexScanner :: Tlex.Scanner e (TH.Q TH.Exp)
    }

data THScannerBuilderContext s e a = THScannerBuilderContext
    { THScannerBuilderContext s e a -> OutputContext
thScannerBuilderCtxOutputCtx :: TlexTH.OutputContext
    , THScannerBuilderContext s e a -> ScannerBuilderContext s e (Q Exp)
thScannerBuilderCtxTlexScannerBuilderCtx :: Tlex.ScannerBuilderContext s e (TH.Q TH.Exp)
    }

type THScannerBuilder s e a = State (THScannerBuilderContext s e a)

buildTHScanner :: forall e s a. Enum e => Bounded e
    => TH.Type -> TH.Type -> TH.Type -> THScannerBuilder s e a ()
    -> THScanner e
buildTHScanner :: Type -> Type -> Type -> THScannerBuilder s e a () -> THScanner e
buildTHScanner Type
codeUnitTy Type
startStateTy Type
actionTy THScannerBuilder s e a ()
builder =
    let outputCtx :: OutputContext
outputCtx = OutputContext :: Type -> Type -> (Int, Int) -> Type -> OutputContext
TlexTH.OutputContext
            { $sel:outputCtxStartStateTy:OutputContext :: Type
outputCtxStartStateTy = Type
startStateTy
            , $sel:outputCtxCodeUnitTy:OutputContext :: Type
outputCtxCodeUnitTy = Type
codeUnitTy
            , $sel:outputCtxCodeUnitBounds:OutputContext :: (Int, Int)
outputCtxCodeUnitBounds = (
                e -> Int
forall a. Enum a => a -> Int
fromEnum do Bounded e => e
forall a. Bounded a => a
minBound @e,
                e -> Int
forall a. Enum a => a -> Int
fromEnum do Bounded e => e
forall a. Bounded a => a
maxBound @e
            )
            , $sel:outputCtxSemanticActionTy:OutputContext :: Type
outputCtxSemanticActionTy = Type
actionTy
            }
        tlexScanner :: Scanner e (Q Exp)
tlexScanner = ScannerBuilder s e (Q Exp) () -> Scanner e (Q Exp)
forall k e (s :: k) f.
Enum e =>
ScannerBuilder s e f () -> Scanner e f
Tlex.buildScanner do
            (ScannerBuilderContext s e (Q Exp)
 -> ScannerBuilderContext s e (Q Exp))
-> ScannerBuilder s e (Q Exp) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \ScannerBuilderContext s e (Q Exp)
ctx0 -> THScannerBuilderContext s e a -> ScannerBuilderContext s e (Q Exp)
forall k (s :: k) k1 (e :: k1) k (a :: k).
THScannerBuilderContext s e a -> ScannerBuilderContext s e (Q Exp)
thScannerBuilderCtxTlexScannerBuilderCtx
                do THScannerBuilder s e a ()
-> THScannerBuilderContext s e a -> THScannerBuilderContext s e a
forall s a. State s a -> s -> s
execState THScannerBuilder s e a ()
builder do
                    THScannerBuilderContext :: forall k k1 k (s :: k) (e :: k1) (a :: k).
OutputContext
-> ScannerBuilderContext s e (Q Exp)
-> THScannerBuilderContext s e a
THScannerBuilderContext
                        { $sel:thScannerBuilderCtxOutputCtx:THScannerBuilderContext :: OutputContext
thScannerBuilderCtxOutputCtx = OutputContext
outputCtx
                        , $sel:thScannerBuilderCtxTlexScannerBuilderCtx:THScannerBuilderContext :: ScannerBuilderContext s e (Q Exp)
thScannerBuilderCtxTlexScannerBuilderCtx = ScannerBuilderContext s e (Q Exp)
ctx0
                        }
    in THScanner :: forall k (e :: k).
OutputContext -> Scanner e (Q Exp) -> THScanner e
THScanner
        { $sel:thScannerOutputCtx:THScanner :: OutputContext
thScannerOutputCtx = OutputContext
outputCtx
        , $sel:thScannerTlexScanner:THScanner :: Scanner e (Q Exp)
thScannerTlexScanner = Scanner e (Q Exp)
tlexScanner
        }

buildTHScannerWithReify :: forall s a e.
    Enum e => Bounded e => Typeable e => Typeable s => Typeable a
    => THScannerBuilder s e a () -> TH.Q (THScanner e)
buildTHScannerWithReify :: THScannerBuilder s e a () -> Q (THScanner e)
buildTHScannerWithReify THScannerBuilder s e a ()
builder = do
    Type
startStateTy <- Proxy s -> Q Type
forall k (a :: k). Typeable a => Proxy a -> Q Type
TypeableTH.liftTypeFromTypeable do Proxy s
forall k (t :: k). Proxy t
Proxy @s
    Type
codeUnitTy <- Proxy e -> Q Type
forall k (a :: k). Typeable a => Proxy a -> Q Type
TypeableTH.liftTypeFromTypeable do Proxy e
forall k (t :: k). Proxy t
Proxy @e
    Type
actionTy <- Proxy a -> Q Type
forall k (a :: k). Typeable a => Proxy a -> Q Type
TypeableTH.liftTypeFromTypeable do Proxy a
forall k (t :: k). Proxy t
Proxy @a
    THScanner e -> Q (THScanner e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure do Type -> Type -> Type -> THScannerBuilder s e a () -> THScanner e
forall k k e (s :: k) (a :: k).
(Enum e, Bounded e) =>
Type -> Type -> Type -> THScannerBuilder s e a () -> THScanner e
buildTHScanner Type
codeUnitTy Type
startStateTy Type
actionTy THScannerBuilder s e a ()
builder

liftTlexScannerBuilder :: Enum e => Tlex.ScannerBuilder s e (TH.Q TH.Exp) a -> THScannerBuilder s e f a
liftTlexScannerBuilder :: ScannerBuilder s e (Q Exp) a -> THScannerBuilder s e f a
liftTlexScannerBuilder ScannerBuilder s e (Q Exp) a
builder = do
    THScannerBuilderContext s e f
ctx0 <- StateT
  (THScannerBuilderContext s e f)
  Identity
  (THScannerBuilderContext s e f)
forall (m :: * -> *) s. Monad m => StateT s m s
get
    let (a
x, ScannerBuilderContext s e (Q Exp)
tlexCtx1) = ScannerBuilder s e (Q Exp) a
-> ScannerBuilderContext s e (Q Exp)
-> (a, ScannerBuilderContext s e (Q Exp))
forall s a. State s a -> s -> (a, s)
runState
            do ScannerBuilder s e (Q Exp) a
builder
            do THScannerBuilderContext s e f -> ScannerBuilderContext s e (Q Exp)
forall k (s :: k) k1 (e :: k1) k (a :: k).
THScannerBuilderContext s e a -> ScannerBuilderContext s e (Q Exp)
thScannerBuilderCtxTlexScannerBuilderCtx THScannerBuilderContext s e f
ctx0
    THScannerBuilderContext s e f
-> StateT (THScannerBuilderContext s e f) Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put do THScannerBuilderContext s e f
ctx0
            { $sel:thScannerBuilderCtxTlexScannerBuilderCtx:THScannerBuilderContext :: ScannerBuilderContext s e (Q Exp)
thScannerBuilderCtxTlexScannerBuilderCtx = ScannerBuilderContext s e (Q Exp)
tlexCtx1
            }
    a -> THScannerBuilder s e f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

thLexRule :: Enum e => Enum s => [s] -> Tlex.Pattern e -> TH.Q (TH.TExp a) -> THScannerBuilder s e a ()
thLexRule :: [s] -> Pattern e -> Q (TExp a) -> THScannerBuilder s e a ()
thLexRule [s]
ss Pattern e
p Q (TExp a)
act = ScannerBuilder s e (Q Exp) () -> THScannerBuilder s e a ()
forall k k e (s :: k) a (f :: k).
Enum e =>
ScannerBuilder s e (Q Exp) a -> THScannerBuilder s e f a
liftTlexScannerBuilder do [s] -> Pattern e -> Q Exp -> ScannerBuilder s e (Q Exp) ()
forall s e f.
(Enum s, Enum e) =>
[s] -> Pattern e -> f -> ScannerBuilder s e f ()
Tlex.lexRule [s]
ss Pattern e
p do TExp a -> Exp
forall a. TExp a -> Exp
TH.unType (TExp a -> Exp) -> Q (TExp a) -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q (TExp a)
act


outputScanner :: Enum e => THScanner e -> TH.Q [TH.Dec]
outputScanner :: THScanner e -> Q [Dec]
outputScanner THScanner e
scanner =
    let outputCtx :: OutputContext
outputCtx = THScanner e -> OutputContext
forall k (e :: k). THScanner e -> OutputContext
thScannerOutputCtx THScanner e
scanner
        nfa :: NFA (Q Exp)
nfa =
#ifdef DEBUG
            Debug.trace "building NFA..." do
#endif
            NFABuilder (Q Exp) () -> NFA (Q Exp)
forall m. NFABuilder m () -> NFA m
NFA.buildNFA do
                Scanner e (Q Exp) -> NFABuilder (Q Exp) ()
forall e m. Enum e => Scanner e m -> NFABuilder m ()
TlexPipeline.scanner2Nfa do THScanner e -> Scanner e (Q Exp)
forall k (e :: k). THScanner e -> Scanner e (Q Exp)
thScannerTlexScanner THScanner e
scanner
        dfa :: DFA (Q Exp)
dfa =
#ifdef DEBUG
            Debug.trace "building DFA..." do
#endif
            NFA (Q Exp) -> DFA (Q Exp)
forall a. NFA a -> DFA a
TlexPipeline.nfa2Dfa NFA (Q Exp)
nfa
        minDfa :: DFA (Q Exp)
minDfa =
#ifdef DEBUG
            Debug.trace "minizing DFA..." do
#endif
            DFA (Q Exp) -> DFA (Q Exp)
forall a. DFA a -> DFA a
TlexPipeline.minDfa DFA (Q Exp)
dfa
    in
#ifdef DEBUG
        Debug.trace "outputing DFA..." do
#endif
        OutputContext -> DFA (Q Exp) -> Q [Dec]
TlexTH.outputDfa OutputContext
outputCtx DFA (Q Exp)
minDfa