module Data.Parser.Grempa.Parser.Dynamic
( mkDynamicParser
, constrWrapper
, idWrapper
) where
import qualified Control.Arrow as A
import Data.Array
import Data.Data
import Data.Function
import qualified Data.Map as M
import Data.Maybe
import Data.Parser.Grempa.Aux.Aux
import Data.Parser.Grempa.Parser.Driver
import Data.Parser.Grempa.Parser.LALR
import Data.Parser.Grempa.Parser.Result
import Data.Parser.Grempa.Parser.Table
import Data.Parser.Grempa.Grammar.Token
import qualified Data.Parser.Grempa.Grammar.Typed as T
import Data.Parser.Grempa.Grammar.Untyped
actToFun :: Ord t => ActionTable t -> ActionFun t
actToFun table st t = fromMaybe def $ M.lookup t stateTable
where
a = listToArr (M.empty, Error []) table'
(stateTable, def) = if inRange (bounds a) st
then a ! st
else (M.empty, Error [])
table' = map (A.second (A.first M.fromList)) table
gotoToFun :: GotoTable t -> GotoFun t
gotoToFun table st rule = a ! (st, rule)
where
a = listToArr (1) table
dynamicRT :: (Token t', Token t, Typeable a)
=> (t -> t')
-> T.Grammar t a
-> [t]
-> T.GrammarState t (ParseResult t' (ReductionTree t'), ProdFunTable)
dynamicRT c g inp = do
g' <- T.augment g
let (unt, funs) = unType c g'
(at,gt,st) = lalr unt
res = driver (actToFun at, gotoToFun gt, st) $ map c inp
return (res, funs)
mkDynamicParser :: (Token t, Token t', Typeable a)
=> (t -> t', t' -> t)
-> T.Grammar t a
-> Parser t a
mkDynamicParser (c, unc) g inp =
let (res, funs) = T.evalGrammar $ dynamicRT c g inp
in resultDriver unc funs g res
data CTok a = CTok {unCTok :: a}
deriving (Show, Data, Typeable)
instance Token a => Eq (CTok a) where
CTok x == CTok y = ((==) `on` toConstr) x y
instance Token a => Ord (CTok a) where
CTok x `compare` CTok y = case ((==) `on` toConstr) x y of
True -> EQ
False -> x `compare` y
constrWrapper :: (t -> CTok t, CTok t -> t)
constrWrapper = (CTok, unCTok)
idWrapper :: (t -> t, t -> t)
idWrapper = (id, id)