module LoadAutomaton where

import AutomatonType
import SaveProdRules(tokenizeLhs)
import System.IO

loadAutomaton :: String -> String -> String
              -> IO (ActionTable, GotoTable, ProdRules)
loadAutomaton :: String
-> String -> String -> IO (ActionTable, GotoTable, ProdRules)
loadAutomaton String
grammarFileName String
actionTblFileName String
gotoTblFileName = do
  String
grammarStr   <- String -> IO String
readFile String
grammarFileName
  String
actionTblStr <- String -> IO String
readFile String
actionTblFileName
  String
gotoTblStr   <- String -> IO String
readFile String
gotoTblFileName

  ActionTable
actionTbl <- String -> IO ActionTable
loadActionTbl String
actionTblStr
  GotoTable
gotoTbl   <- String -> IO GotoTable
loadGotoTbl String
gotoTblStr
  ProdRules
prodRules <- String -> IO ProdRules
loadProdRules String
grammarStr

  (ActionTable, GotoTable, ProdRules)
-> IO (ActionTable, GotoTable, ProdRules)
forall (m :: * -> *) a. Monad m => a -> m a
return (ActionTable
actionTbl, GotoTable
gotoTbl, ProdRules
prodRules)

-- Load action table
loadActionTbl :: String -> IO ActionTable
loadActionTbl :: String -> IO ActionTable
loadActionTbl String
str = String -> IO ActionTable
tokenizeStateNumInAction String
str

tokenizeStateNumInAction :: String -> IO ActionTable
tokenizeStateNumInAction :: String -> IO ActionTable
tokenizeStateNumInAction String
str =   
  case ReadS String
lex String
str of
    [] -> ActionTable -> IO ActionTable
forall (m :: * -> *) a. Monad m => a -> m a
return []
    [(String
"", String
therest)] -> ActionTable -> IO ActionTable
forall (m :: * -> *) a. Monad m => a -> m a
return []
    [(String
stateNum, String
therest)] -> do
      (String
terminal, Action
action, ActionTable
actTbl) <- String -> IO (String, Action, ActionTable)
tokenizeTerminalInAction String
therest
      ActionTable -> IO ActionTable
forall (m :: * -> *) a. Monad m => a -> m a
return (ActionTable -> IO ActionTable) -> ActionTable -> IO ActionTable
forall a b. (a -> b) -> a -> b
$ ((String -> Int
forall a. Read a => String -> a
read String
stateNum :: Int, String
terminal), Action
action) ((Int, String), Action) -> ActionTable -> ActionTable
forall a. a -> [a] -> [a]
: ActionTable
actTbl

tokenizeTerminalInAction :: String -> IO (String, Action, ActionTable)
tokenizeTerminalInAction :: String -> IO (String, Action, ActionTable)
tokenizeTerminalInAction String
str =
  case ReadS String
lex String
str of
    [] -> String -> IO (String, Action, ActionTable)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No terminal found (1)"
    [(String
"", String
therest)] -> String -> IO (String, Action, ActionTable)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No terminal found (2)"
    [(String
terminal, String
therest)] -> do
      (Action
action, ActionTable
actTbl) <- String -> IO (Action, ActionTable)
tokenizeActioninAction String
therest
      (String, Action, ActionTable) -> IO (String, Action, ActionTable)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
terminal, Action
action, ActionTable
actTbl)

tokenizeActioninAction :: String -> IO (Action, ActionTable)
tokenizeActioninAction :: String -> IO (Action, ActionTable)
tokenizeActioninAction String
str =
  case ReadS String
lex String
str of
    [] -> String -> IO (Action, ActionTable)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No action found (1)"
    [(String
"", String
therest)] -> String -> IO (Action, ActionTable)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No action found (2)"
    [(String
action, String
therest)] -> do
      case String
action of
        String
"Shift" -> do
          String -> (Int -> Action) -> IO (Action, ActionTable)
tokenizeShiftReduceStateNumInAction String
therest Int -> Action
Shift
        String
"Reduce" -> do
          String -> (Int -> Action) -> IO (Action, ActionTable)
tokenizeShiftReduceStateNumInAction String
therest Int -> Action
Reduce
        String
"Accept" -> do
          ActionTable
actTbl <- String -> IO ActionTable
tokenizeStateNumInAction String
therest
          (Action, ActionTable) -> IO (Action, ActionTable)
forall (m :: * -> *) a. Monad m => a -> m a
return (Action
Accept, ActionTable
actTbl)

tokenizeShiftReduceStateNumInAction :: String -> (Int -> Action)
  -> IO (Action, ActionTable)
tokenizeShiftReduceStateNumInAction :: String -> (Int -> Action) -> IO (Action, ActionTable)
tokenizeShiftReduceStateNumInAction String
str Int -> Action
fn =
  case ReadS String
lex String
str of
    [] -> String -> IO (Action, ActionTable)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No shift/reduce state number found (1)"
    [(String
"", String
therest)] -> String -> IO (Action, ActionTable)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No shift/reduce state number found (2)"
    [(String
stateNum, String
therest)] -> do
      ActionTable
actTbl <- String -> IO ActionTable
tokenizeStateNumInAction String
therest
      (Action, ActionTable) -> IO (Action, ActionTable)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Action
fn (String -> Int
forall a. Read a => String -> a
read String
stateNum :: Int), ActionTable
actTbl)
      

-- Load goto table
loadGotoTbl :: String -> IO GotoTable
loadGotoTbl :: String -> IO GotoTable
loadGotoTbl String
str = String -> IO GotoTable
tokenizeStateNumInGoto String
str

tokenizeStateNumInGoto :: String -> IO GotoTable
tokenizeStateNumInGoto :: String -> IO GotoTable
tokenizeStateNumInGoto String
str =
  case ReadS String
lex String
str of
    [] -> GotoTable -> IO GotoTable
forall (m :: * -> *) a. Monad m => a -> m a
return []
    [(String
"", String
therest)] -> GotoTable -> IO GotoTable
forall (m :: * -> *) a. Monad m => a -> m a
return []
    [(String
stateNum, String
therest)] -> do
      (String
nonterminal, String
toStateNum, GotoTable
actTbl) <- String -> IO (String, String, GotoTable)
tokenizeNonterminalInGoto String
therest
      GotoTable -> IO GotoTable
forall (m :: * -> *) a. Monad m => a -> m a
return (GotoTable -> IO GotoTable) -> GotoTable -> IO GotoTable
forall a b. (a -> b) -> a -> b
$ ((String -> Int
forall a. Read a => String -> a
read String
stateNum :: Int, String
nonterminal), String -> Int
forall a. Read a => String -> a
read String
toStateNum :: Int) ((Int, String), Int) -> GotoTable -> GotoTable
forall a. a -> [a] -> [a]
: GotoTable
actTbl

tokenizeNonterminalInGoto :: String -> IO (String, String, GotoTable)
tokenizeNonterminalInGoto :: String -> IO (String, String, GotoTable)
tokenizeNonterminalInGoto String
str =
  case ReadS String
lex String
str of
    [] -> String -> IO (String, String, GotoTable)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No nonterminal found (1)"
    [(String
"", String
therest)] -> String -> IO (String, String, GotoTable)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No nonterminal found (2)"
    [(String
nonterminal,String
therest)] -> do
      (String
toStateNum, GotoTable
actTbl) <- String -> IO (String, GotoTable)
tokenizeToStateNumInGoto String
therest
      (String, String, GotoTable) -> IO (String, String, GotoTable)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
nonterminal, String
toStateNum, GotoTable
actTbl)

tokenizeToStateNumInGoto :: String -> IO (String, GotoTable)
tokenizeToStateNumInGoto :: String -> IO (String, GotoTable)
tokenizeToStateNumInGoto String
str =
  case ReadS String
lex String
str of
    [] -> String -> IO (String, GotoTable)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No to-state found (1)"
    [(String
"", String
therest)] -> String -> IO (String, GotoTable)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No to-state found (2)"
    [(String
toStateNum,String
therest)] -> do
      GotoTable
actTbl <- String -> IO GotoTable
tokenizeStateNumInGoto String
therest
      (String, GotoTable) -> IO (String, GotoTable)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
toStateNum, GotoTable
actTbl)

-- Load production rules
loadProdRules :: String -> IO ProdRules
loadProdRules :: String -> IO ProdRules
loadProdRules String
str = do
  [(Int, String, [String])]
numLhsRhsList <- (String -> IO (Int, String, [String]))
-> [String] -> IO [(Int, String, [String])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (Int, String, [String])
tokenizeNumInProdRules (String -> [String]
splitWithCR String
str)
  ProdRules -> IO ProdRules
forall (m :: * -> *) a. Monad m => a -> m a
return [ (String
lhs, [String]
rhs) | (Int
i, String
lhs, [String]
rhs) <- [(Int, String, [String])]
numLhsRhsList ]

tokenizeNumInProdRules :: String -> IO (Int, String, [String])
tokenizeNumInProdRules :: String -> IO (Int, String, [String])
tokenizeNumInProdRules String
str =
  case ReadS String
lex String
str of 
    [] -> String -> IO (Int, String, [String])
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No rule number found (1)"
    [(String
"", String
therest)] -> String -> IO (Int, String, [String])
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No rule number found (2)"
    [(String
ruleNumStr, String
therest)] -> do
      (String
lhs, [String]
rhs) <- String -> IO (String, [String])
tokenizeColonInProdRules String
therest
      (Int, String, [String]) -> IO (Int, String, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Int
forall a. Read a => String -> a
read String
ruleNumStr :: Int, String
lhs, [String]
rhs)

tokenizeColonInProdRules :: String -> IO (String, [String])
tokenizeColonInProdRules :: String -> IO (String, [String])
tokenizeColonInProdRules String
str =
  case ReadS String
lex String
str of
    [] -> String -> IO (String, [String])
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No colon found (1)"
    [(String
"", String
therest)] -> String -> IO (String, [String])
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No colon found (2)"
    [(String
colon, String
therest)] -> do
      let lhsRhs :: [String]
lhsRhs = String -> [String]
tokenizeLhs String
therest
      (String, [String]) -> IO (String, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> String
forall a. [a] -> a
head [String]
lhsRhs, [String] -> [String]
forall a. [a] -> [a]
tail [String]
lhsRhs)
    

splitWithCR :: String -> [String]
splitWithCR :: String -> [String]
splitWithCR String
str =
  [ String
line | String
line <- String -> String -> [String]
splitWithCR' String
"" String
str, String
line String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"" ]

splitWithCR' :: String -> String -> [String]
splitWithCR' :: String -> String -> [String]
splitWithCR' String
app [] = (String -> String
forall a. [a] -> [a]
reverse String
app) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: []
splitWithCR' String
app (Char
'\n':String
therest) = (String -> String
forall a. [a] -> [a]
reverse String
app) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> String -> [String]
splitWithCR' String
"" String
therest
splitWithCR' String
app (Char
ch:String
therest) = String -> String -> [String]
splitWithCR' (Char
ch Char -> String -> String
forall a. a -> [a] -> [a]
: String
app) String
therest