module CodeGenC where

import Data.List(groupBy)

import CFG
import ParserTable 
import GenLRParserTable
import SampleGrammar

--------------------------------------------------------------------------------
-- C Code Generation for Parser
--------------------------------------------------------------------------------

-- cgStates iss
-- cgNonterminals augCfg
-- cgGotoTable augCfg

-- C enum type declaration for states
cgStates :: [[a]] -> IO ()
cgStates [[a]]
iss = [Char] -> IO () -> IO ()
forall a. [Char] -> IO a -> IO ()
cgEnum [Char]
"STATE" ([[a]] -> IO ()
forall a. Show a => [[a]] -> IO ()
cgStates' [[a]]
iss)
     
cgStates' :: [[a]] -> IO ()
cgStates' [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()  
cgStates' [[a]
is] = 
  do [Char] -> IO ()
putStr [Char]
"\t"
     [a] -> IO ()
forall a. Show a => [a] -> IO ()
cgState [a]
is

cgStates' [[a]
is1,[a]
is2] = 
  do [Char] -> IO ()
putStr [Char]
"\t"
     [a] -> IO ()
forall a. Show a => [a] -> IO ()
cgState [a]
is1
     [Char] -> IO ()
putStr [Char]
", "
     [a] -> IO ()
forall a. Show a => [a] -> IO ()
cgState [a]
is2
     [Char] -> IO ()
putStrLn [Char]
""

cgStates' [[a]
is1,[a]
is2,[a]
is3] = 
  do [Char] -> IO ()
putStr [Char]
"\t"
     [a] -> IO ()
forall a. Show a => [a] -> IO ()
cgState [a]
is1
     [Char] -> IO ()
putStr [Char]
", "
     [a] -> IO ()
forall a. Show a => [a] -> IO ()
cgState [a]
is2
     [Char] -> IO ()
putStr [Char]
", "
     [a] -> IO ()
forall a. Show a => [a] -> IO ()
cgState [a]
is3
     [Char] -> IO ()
putStrLn [Char]
""

cgStates' [[a]
is1,[a]
is2,[a]
is3,[a]
is4] = 
  do [Char] -> IO ()
putStr [Char]
"\t"
     [a] -> IO ()
forall a. Show a => [a] -> IO ()
cgState [a]
is1
     [Char] -> IO ()
putStr [Char]
", "
     [a] -> IO ()
forall a. Show a => [a] -> IO ()
cgState [a]
is2
     [Char] -> IO ()
putStr [Char]
", "
     [a] -> IO ()
forall a. Show a => [a] -> IO ()
cgState [a]
is3
     [Char] -> IO ()
putStr [Char]
", "
     [a] -> IO ()
forall a. Show a => [a] -> IO ()
cgState [a]
is4
     [Char] -> IO ()
putStrLn [Char]
""
     
cgStates' [[a]
is1,[a]
is2,[a]
is3,[a]
is4,[a]
is5] = 
  do [Char] -> IO ()
putStr [Char]
"\t"
     [a] -> IO ()
forall a. Show a => [a] -> IO ()
cgState [a]
is1
     [Char] -> IO ()
putStr [Char]
", "
     [a] -> IO ()
forall a. Show a => [a] -> IO ()
cgState [a]
is2
     [Char] -> IO ()
putStr [Char]
", "
     [a] -> IO ()
forall a. Show a => [a] -> IO ()
cgState [a]
is3
     [Char] -> IO ()
putStr [Char]
", "
     [a] -> IO ()
forall a. Show a => [a] -> IO ()
cgState [a]
is4
     [Char] -> IO ()
putStr [Char]
", "
     [a] -> IO ()
forall a. Show a => [a] -> IO ()
cgState [a]
is5
     [Char] -> IO ()
putStrLn [Char]
""
     
cgStates' ([a]
is1:[a]
is2:[a]
is3:[a]
is4:[a]
is5:[[a]]
iss) =
  do [Char] -> IO ()
putStr [Char]
"\t"
     [a] -> IO ()
forall a. Show a => [a] -> IO ()
cgState [a]
is1
     [Char] -> IO ()
putStr [Char]
", "
     [a] -> IO ()
forall a. Show a => [a] -> IO ()
cgState [a]
is2
     [Char] -> IO ()
putStr [Char]
", "
     [a] -> IO ()
forall a. Show a => [a] -> IO ()
cgState [a]
is3
     [Char] -> IO ()
putStr [Char]
", "
     [a] -> IO ()
forall a. Show a => [a] -> IO ()
cgState [a]
is4
     [Char] -> IO ()
putStr [Char]
", "
     [a] -> IO ()
forall a. Show a => [a] -> IO ()
cgState [a]
is5
     [Char] -> IO ()
putStrLn [Char]
","
     [[a]] -> IO ()
cgStates' [[a]]
iss
     
cgState :: [a] -> IO ()
cgState [a]
is = [Char] -> IO ()
putStr ([a] -> [Char]
forall a. Show a => [a] -> [Char]
cgToState [a]
is) 
     
cgToState :: [a] -> [Char]
cgToState [a]
is = [Char]
"S" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [a] -> [Char]
forall a. Show a => [a] -> [Char]
cgToState' [a]
is

cgToState' :: [a] -> [Char]
cgToState' []     = [Char]
""
cgToState' [a
i]    = a -> [Char]
forall a. Show a => a -> [Char]
show a
i
cgToState' (a
i:[a]
is) = a -> [Char]
forall a. Show a => a -> [Char]
show a
i [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++  [Char]
"_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [a] -> [Char]
cgToState' [a]
is

-- C enum type declaration for nonterminals

cgNonterminals :: CFG -> IO ()
cgNonterminals CFG
augCfg = 
  [Char] -> IO () -> IO ()
forall a. [Char] -> IO a -> IO ()
cgEnum [Char]
"Nonterminal" ([[Char]] -> IO ()
cgNonterminals' ([[Char]] -> [[Char]]
cgCNames (CFG -> [[Char]]
nonterminals CFG
augCfg)))
    
cgNonterminals' :: [[Char]] -> IO ()
cgNonterminals' []     = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()    
cgNonterminals' [[Char]
x]    = 
  do [Char] -> IO ()
putStr [Char]
"\t"
     [Char] -> IO ()
putStr [Char]
x
     [Char] -> IO ()
putStrLn [Char]
""
cgNonterminals' [[Char]
x1,[Char]
x2]    = 
  do [Char] -> IO ()
putStr [Char]
"\t"
     [Char] -> IO ()
putStr [Char]
x1
     [Char] -> IO ()
putStr [Char]
", "
     [Char] -> IO ()
putStr [Char]
x2
     [Char] -> IO ()
putStrLn [Char]
""
cgNonterminals' ([Char]
x1:[Char]
x2:[[Char]]
xs) = 
  do [Char] -> IO ()
putStr [Char]
"\t"
     [Char] -> IO ()
putStr [Char]
x1
     [Char] -> IO ()
putStr [Char]
", "
     [Char] -> IO ()
putStr [Char]
x2
     [Char] -> IO ()
putStr [Char]
", "
     [Char] -> IO ()
putStrLn [Char]
""
     [[Char]] -> IO ()
cgNonterminals' [[Char]]
xs
     
cgCNames :: [[Char]] -> [[Char]]
cgCNames [[Char]]
nts = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
cgToCName [[Char]]
nts

cgToCName :: [Char] -> [Char]
cgToCName [Char]
x = [Char]
"NONTERMINAL_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
cgToCName' [Char]
x

cgToCName' :: [Char] -> [Char]
cgToCName' []     = []      -- CAUTION: Don't use S' with S_ for nonterminals.
cgToCName' (Char
c:[Char]
cs) = 
  (if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' then Char
'_' else Char
c) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
cgToCName' [Char]
cs 

cgEnum :: [Char] -> IO a -> IO ()
cgEnum [Char]
name IO a
action =
  do [Char] -> IO ()
putStrLn ([Char]
"enum " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" {")
     IO a
action
     [Char] -> IO ()
putStrLn [Char]
"};"

-- C array for goto_table
cgGotoTable :: CFG -> IO ()
cgGotoTable CFG
augCfg =
  do Int -> Int -> IO ()
forall a a. (Show a, Show a) => a -> a -> IO ()
prGotoTableDim ([[Int]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Int]]
iss) ([[Char]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
nts)
     [[Int]] -> [[Char]] -> LALRGotoTable -> IO ()
prGotoTableArr [[Int]]
iss [[Char]]
nts LALRGotoTable
gotoTbl
  where
    (Itemss
_,ProductionRules
_,[[Int]]
iss,LALRActionTable
_,LALRGotoTable
gotoTbl) = CFG
-> (Itemss, ProductionRules, [[Int]], LALRActionTable,
    LALRGotoTable)
calcLALRParseTable CFG
augCfg
    nts :: [[Char]]
nts                 = CFG -> [[Char]]
nonterminals CFG
augCfg
    
cg_noofstates :: [Char]
cg_noofstates   = [Char]
"NOOFSTATES"
cg_noofnonterms :: [Char]
cg_noofnonterms = [Char]
"NOOFNONTERMINALS"
  
prGotoTableDim :: a -> a -> IO ()
prGotoTableDim a
no_states a
no_nonterms =    
  do [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"#define " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cg_noofstates   [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
no_states
     [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"#define " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cg_noofnonterms [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
no_nonterms
     [Char] -> IO ()
putStrLn [Char]
""
     
prGotoTableArr :: [[Int]] -> [String] -> LALRGotoTable -> IO ()
prGotoTableArr :: [[Int]] -> [[Char]] -> LALRGotoTable -> IO ()
prGotoTableArr [[Int]]
states [[Char]]
nonterms LALRGotoTable
gotoTbl = 
  do [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"int goto_table[" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cg_noofstates [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ 
       [Char]
"][" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cg_noofnonterms [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"] = {"
     [[Int]] -> [[Char]] -> LALRGotoTable -> IO ()
forall t a.
(Eq t, Show a) =>
[t] -> [[Char]] -> [(t, Symbol, [a])] -> IO ()
prGotoTableArr' [[Int]]
states [[Char]]
nonterms LALRGotoTable
gotoTbl
     [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"};"

prGotoTableArr' :: [t] -> [[Char]] -> [(t, Symbol, [a])] -> IO ()
prGotoTableArr' [t
i] [[Char]]
nonterms [(t, Symbol, [a])]
gotoTbl = 
  do [Char] -> IO ()
putStr [Char]
"\t"
     [Char] -> IO ()
putStr [Char]
"{"
     t -> [[Char]] -> [(t, Symbol, [a])] -> IO ()
forall t a.
(Eq t, Show a) =>
t -> [[Char]] -> [(t, Symbol, [a])] -> IO ()
prGotoTableArr'' t
i [[Char]]
nonterms [(t, Symbol, [a])]
gotoTbl
     [Char] -> IO ()
putStrLn [Char]
"}"
prGotoTableArr' (t
i:[t]
states) [[Char]]
nonterms [(t, Symbol, [a])]
gotoTbl = 
  do [Char] -> IO ()
putStr [Char]
"\t"
     [Char] -> IO ()
putStr [Char]
"{"
     t -> [[Char]] -> [(t, Symbol, [a])] -> IO ()
forall t a.
(Eq t, Show a) =>
t -> [[Char]] -> [(t, Symbol, [a])] -> IO ()
prGotoTableArr'' t
i [[Char]]
nonterms [(t, Symbol, [a])]
gotoTbl
     [Char] -> IO ()
putStrLn [Char]
"},"
     [t] -> [[Char]] -> [(t, Symbol, [a])] -> IO ()
prGotoTableArr' [t]
states [[Char]]
nonterms [(t, Symbol, [a])]
gotoTbl
     
prGotoTableArr'' :: t -> [[Char]] -> [(t, Symbol, [a])] -> IO ()
prGotoTableArr'' t
i [[Char]
x] [(t, Symbol, [a])]
gotoTbl =
  case t -> Symbol -> [(t, Symbol, [a])] -> Maybe [a]
forall a b c. (Eq a, Eq b) => a -> b -> [(a, b, c)] -> Maybe c
lookupTable t
i ([Char] -> Symbol
Nonterminal [Char]
x) [(t, Symbol, [a])]
gotoTbl of
    Maybe [a]
Nothing -> do [Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show (-Integer
1)
    Just [a]
k  -> do [Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [a] -> [Char]
forall a. Show a => [a] -> [Char]
cgToState [a]
k
prGotoTableArr'' t
i ([Char]
x:[[Char]]
nonterms) [(t, Symbol, [a])]
gotoTbl =
  case t -> Symbol -> [(t, Symbol, [a])] -> Maybe [a]
forall a b c. (Eq a, Eq b) => a -> b -> [(a, b, c)] -> Maybe c
lookupTable t
i ([Char] -> Symbol
Nonterminal [Char]
x) [(t, Symbol, [a])]
gotoTbl of
    Maybe [a]
Nothing -> do [Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show (-Integer
1) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
","
                  t -> [[Char]] -> [(t, Symbol, [a])] -> IO ()
prGotoTableArr'' t
i [[Char]]
nonterms [(t, Symbol, [a])]
gotoTbl
    Just [a]
k  -> do [Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [a] -> [Char]
forall a. Show a => [a] -> [Char]
cgToState [a]
k [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
","
                  t -> [[Char]] -> [(t, Symbol, [a])] -> IO ()
prGotoTableArr'' t
i [[Char]]
nonterms [(t, Symbol, [a])]
gotoTbl
                  
-- Generate C code for an LALR action table
cgActionsInStates :: CFG -> IO ()
cgActionsInStates CFG
augCfg =
  do let nTabs :: Integer
nTabs = Integer
1
     Integer -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab Integer
nTabs
     [Char] -> IO ()
putStrLn [Char]
"switch( top() )"
     Integer -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab Integer
nTabs
     [Char] -> IO ()
putStrLn [Char]
"{"
     (LALRActionTable -> IO ()) -> [LALRActionTable] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\LALRActionTable
t -> Integer -> LALRActionTable -> [(Int, ProductionRule)] -> IO ()
forall t a.
(Eq t, Num t, Show a) =>
t
-> [([a], ExtendedSymbol, LALRAction)]
-> [(Int, ProductionRule)]
-> IO ()
cgInStates Integer
nTabs LALRActionTable
t [(Int, ProductionRule)]
iprules) ((([Int], ExtendedSymbol, LALRAction)
 -> ([Int], ExtendedSymbol, LALRAction) -> Bool)
-> LALRActionTable -> [LALRActionTable]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy ([Int], ExtendedSymbol, LALRAction)
-> ([Int], ExtendedSymbol, LALRAction) -> Bool
forall a b c b c. Eq a => (a, b, c) -> (a, b, c) -> Bool
eqState LALRActionTable
lalrActTbl)
     Integer -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab Integer
nTabs
     [Char] -> IO ()
putStrLn [Char]
"} /* switch ( top() ) */ "
     
  where
    CFG [Char]
start ProductionRules
prules     = CFG
augCfg
    iprules :: [(Int, ProductionRule)]
iprules              = [Int] -> ProductionRules -> [(Int, ProductionRule)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ProductionRules
prules 
    (Itemss
_,ProductionRules
_,[[Int]]
_,LALRActionTable
lalrActTbl,LALRGotoTable
_) = CFG
-> (Itemss, ProductionRules, [[Int]], LALRActionTable,
    LALRGotoTable)
calcLALRParseTable CFG
augCfg
    
    eqState :: (a, b, c) -> (a, b, c) -> Bool
eqState (a
x1,b
_,c
_) (a
x2,b
_,c
_) = a
x1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x2
     
cgInStates :: t
-> [([a], ExtendedSymbol, LALRAction)]
-> [(Int, ProductionRule)]
-> IO ()
cgInStates t
n (([a]
state,ExtendedSymbol
extSym,LALRAction
acts):[([a], ExtendedSymbol, LALRAction)]
lalrActTbl) [(Int, ProductionRule)]
iprules =
  do t -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab t
n
     [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"case " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [a] -> [Char]
forall a. Show a => [a] -> [Char]
cgToState [a]
state  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":"
     t
-> [([a], ExtendedSymbol, LALRAction)]
-> [(Int, ProductionRule)]
-> IO ()
forall t a.
(Eq t, Num t) =>
t
-> [(a, ExtendedSymbol, LALRAction)]
-> [(Int, ProductionRule)]
-> IO ()
cgActions (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1) (([a]
state,ExtendedSymbol
extSym,LALRAction
acts)([a], ExtendedSymbol, LALRAction)
-> [([a], ExtendedSymbol, LALRAction)]
-> [([a], ExtendedSymbol, LALRAction)]
forall a. a -> [a] -> [a]
:[([a], ExtendedSymbol, LALRAction)]
lalrActTbl) [(Int, ProductionRule)]
iprules
     t -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1)
     [Char] -> IO ()
putStrLn [Char]
"break;"
     [Char] -> IO ()
putStrLn [Char]
""
cgInStates t
n [] [(Int, ProductionRule)]
iprules
  = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     
cgActions :: t
-> [(a, ExtendedSymbol, LALRAction)]
-> [(Int, ProductionRule)]
-> IO ()
cgActions t
n [(a, ExtendedSymbol, LALRAction)]
lalrActTbl [(Int, ProductionRule)]
iprules =
  do t -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab t
n
     [Char] -> IO ()
putStrLn [Char]
"switch ( toks[current_tok] )"
     t -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab t
n
     [Char] -> IO ()
putStrLn [Char]
"{"
     
     t
-> [(a, ExtendedSymbol, LALRAction)]
-> [(Int, ProductionRule)]
-> IO ()
forall t a.
(Eq t, Num t) =>
t
-> [(a, ExtendedSymbol, LALRAction)]
-> [(Int, ProductionRule)]
-> IO ()
cgActions' t
n [(a, ExtendedSymbol, LALRAction)]
lalrActTbl [(Int, ProductionRule)]
iprules
     
     t -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab t
n
     [Char] -> IO ()
putStrLn [Char]
"default:"
     t -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1)
     [Char] -> IO ()
putStrLn [Char]
"error = REJECT;"
     t -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1)
     [Char] -> IO ()
putStrLn [Char]
"break;"
     [Char] -> IO ()
putStrLn [Char]
""
     
     t -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab t
n
     [Char] -> IO ()
putStrLn [Char]
"}"
  
cgActions' :: t
-> [(a, ExtendedSymbol, LALRAction)]
-> [(Int, ProductionRule)]
-> IO ()
cgActions' t
n [] [(Int, ProductionRule)]
iprules = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
cgActions' t
n ((a
_,ExtendedSymbol
extsym,LALRAction
action):[(a, ExtendedSymbol, LALRAction)]
extSymActs) [(Int, ProductionRule)]
iprules =
  do t
-> ExtendedSymbol -> LALRAction -> [(Int, ProductionRule)] -> IO ()
forall t.
(Eq t, Num t) =>
t
-> ExtendedSymbol -> LALRAction -> [(Int, ProductionRule)] -> IO ()
cgAction t
n ExtendedSymbol
extsym LALRAction
action [(Int, ProductionRule)]
iprules
     t
-> [(a, ExtendedSymbol, LALRAction)]
-> [(Int, ProductionRule)]
-> IO ()
cgActions' t
n [(a, ExtendedSymbol, LALRAction)]
extSymActs [(Int, ProductionRule)]
iprules

cgAction :: t
-> ExtendedSymbol -> LALRAction -> [(Int, ProductionRule)] -> IO ()
cgAction t
n ExtendedSymbol
extsym (LALRShift [Int]
state) [(Int, ProductionRule)]
iprules =
  do t -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab t
n
     ExtendedSymbol -> IO ()
cgActionCase ExtendedSymbol
extsym
     t -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1)
     [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"push (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ExtendedSymbol -> [Char]
cgTerminalName ExtendedSymbol
extsym  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
");"
     t -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1)
     [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"push (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Int] -> [Char]
forall a. Show a => [a] -> [Char]
cgToState [Int]
state [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
");"
     t -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1)
     [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"current_tok += " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show (ExtendedSymbol -> Integer
forall p. Num p => ExtendedSymbol -> p
offset ExtendedSymbol
extsym) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
";"
     t -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1)
     [Char] -> IO ()
putStrLn [Char]
"break;"
     [Char] -> IO ()
putStrLn [Char]
""
     
cgAction t
n ExtendedSymbol
extsym (LALRAction
LALRAccept) [(Int, ProductionRule)]
iprules =
  do t -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab t
n 
     ExtendedSymbol -> IO ()
cgActionCase ExtendedSymbol
extsym
     t -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1)
     [Char] -> IO ()
putStrLn [Char]
"error = ACCEPT;"
     t -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1)
     [Char] -> IO ()
putStrLn [Char]
"break;"
     
cgAction t
n ExtendedSymbol
extsym (LALRReduce Int
i) [(Int, ProductionRule)]
iprules =
  case Maybe ProductionRule
maybeprule of
    Maybe ProductionRule
Nothing -> [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"cgActionsInState: Cannot find " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" prule"
    Just (ProductionRule [Char]
y [Symbol]
ys) -> t -> ExtendedSymbol -> [Char] -> [Symbol] -> Int -> IO ()
forall t (t :: * -> *) a p.
(Eq t, Num t, Foldable t) =>
t -> ExtendedSymbol -> [Char] -> t a -> p -> IO ()
cgAction' t
n ExtendedSymbol
extsym [Char]
y [Symbol]
ys Int
i 
  where
    maybeprule :: Maybe ProductionRule
maybeprule = Int -> [(Int, ProductionRule)] -> Maybe ProductionRule
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
i [(Int, ProductionRule)]
iprules
     
cgAction t
n ExtendedSymbol
extsym (LALRAction
LALRReject) [(Int, ProductionRule)]
iprules =     
  [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"cgActionsInState: LALRReject unexpected"
     
cgAction' :: t -> ExtendedSymbol -> [Char] -> t a -> p -> IO ()
cgAction' t
n ExtendedSymbol
extsym [Char]
y t a
ys p
i =
  do t -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab t
n
     ExtendedSymbol -> IO ()
cgActionCase ExtendedSymbol
extsym
     (Int -> IO ()) -> [Int] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Int
i -> do { t -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1); [Char] -> IO ()
putStrLn [Char]
"pop();" }) [Int
1..t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
ys Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2]
     [Char] -> IO ()
putStrLn [Char]
""
     t -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1)
     [Char] -> IO ()
putStrLn [Char]
"next = top();"
     t -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1)
     [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"push (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
cgToCName [Char]
y  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
");"
     t -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1)
     [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"next = goto_table[next][" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
cgToCName [Char]
y [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"];"
     t -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1)
     [Char] -> IO ()
putStrLn [Char]
"if (0 <= next) push (next); else error = next;"
     t -> IO ()
forall t. (Eq t, Num t) => t -> IO ()
prTab (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1)
     [Char] -> IO ()
putStrLn [Char]
"break;"
     
-- Attribute of tokens specific to g3
offset :: ExtendedSymbol -> p
offset (Symbol (Terminal [Char]
"var")) = p
3
offset ExtendedSymbol
_                         = p
1
     
cgActionCase :: ExtendedSymbol -> IO ()
cgActionCase ExtendedSymbol
extsym =
  [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"case " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ExtendedSymbol -> [Char]
cgTerminalName ExtendedSymbol
extsym [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":"

    
cgTerminalName :: ExtendedSymbol -> [Char]
cgTerminalName ExtendedSymbol
extsym = 
  case ExtendedSymbol
extsym of
    Symbol (Terminal [Char]
t) -> [Char] -> [Char]
cgTerminalName' [Char]
t
    ExtendedSymbol
EndOfSymbol -> [Char]
cgNameEndOfSymbol
    ExtendedSymbol
_ -> [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"cgTerminalName: not a terminal symbol"
    
cgTerminalName' :: [Char] -> [Char]
cgTerminalName' [Char]
t =     
  case [Char] -> [([Char], [Char])] -> Maybe [Char]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
t [([Char], [Char])]
g3_attrib_terminals of
    Maybe [Char]
Nothing -> [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"cgTerminalName: not found " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
t
    Just [Char]
y  -> [Char]
y
    
-- The attribute of $
cgNameEndOfSymbol :: [Char]
cgNameEndOfSymbol = [Char]
"ENDOFSYMBOL"
  
prTab :: t -> IO ()
prTab t
0 = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()     
prTab t
n = 
  do [Char] -> IO ()
putStr [Char]
"\t"
     t -> IO ()
prTab (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1)