module GenLRParserTable where
import Data.List
import Data.Maybe
import System.Environment (getArgs)
import CFG
import ParserTable
import CmdArgs
import System.IO
_main :: IO ()
_main = do
[String]
args <- IO [String]
getArgs
let cmd :: Cmd
cmd = [String] -> Cmd
getCmd [String]
args
case Cmd
cmd of
CmdError String
msg -> String -> IO ()
putStrLn String
msg
CmdGrmFiles [String]
fileNames -> (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
forall p. p -> String -> IO ()
f Handle
stdout) [String]
fileNames
CmdGrmWithOption (Just String
fileName) String
prod_rule String
action_tbl String
goto_tbl -> do
String -> String -> String -> String -> IO ()
writeParseTable String
fileName String
prod_rule String
action_tbl String
goto_tbl
String -> IO ()
putStrLn String
"Done"
where
f :: p -> String -> IO ()
f p
h String
file = do
String
grammar <- String -> IO String
readFile String
file
let cfg :: CFG
cfg = String -> CFG
forall a. Read a => String -> a
read String
grammar :: CFG
Handle
-> ([Items], [ProductionRule], [(Int, ExtendedSymbol, Action)],
[(Int, Symbol, Int)])
-> IO ()
forall a a1 a2 a3 a1 a2 a3.
(Show a, Show a1, Show a2, Show a3, Show a1, Show a2, Show a3) =>
Handle -> ([Items], [a], [(a1, a2, a3)], [(a1, a2, a3)]) -> IO ()
prParseTable Handle
stdout (([Items], [ProductionRule], [(Int, ExtendedSymbol, Action)],
[(Int, Symbol, Int)])
-> IO ())
-> ([Items], [ProductionRule], [(Int, ExtendedSymbol, Action)],
[(Int, Symbol, Int)])
-> IO ()
forall a b. (a -> b) -> a -> b
$ (\([Items]
a1,[ProductionRule]
a2,[(Int, ExtendedSymbol, Action)]
a3,[(Int, Symbol, Int)]
a4,()
a5)->([Items]
a1,[ProductionRule]
a2,[(Int, ExtendedSymbol, Action)]
a3,[(Int, Symbol, Int)]
a4)) (CFG
-> ([Items], [ProductionRule], [(Int, ExtendedSymbol, Action)],
[(Int, Symbol, Int)], ())
calcEfficientLALRParseTable CFG
cfg)
writeParseTable :: String -> String -> String -> String -> IO ()
writeParseTable String
file String
prod_rule String
action_tbl String
goto_tbl =
do
String
grammar <- String -> IO String
readFile String
file
let cfg :: CFG
cfg = String -> CFG
forall a. Read a => String -> a
read String
grammar :: CFG
let ([Items]
items, [ProductionRule]
prules, [(Int, ExtendedSymbol, Action)]
actTbl, [(Int, Symbol, Int)]
gtTbl) =
(\([Items]
a1,[ProductionRule]
a2,[(Int, ExtendedSymbol, Action)]
a3,[(Int, Symbol, Int)]
a4,()
a5)->([Items]
a1,[ProductionRule]
a2,[(Int, ExtendedSymbol, Action)]
a3,[(Int, Symbol, Int)]
a4))
(CFG
-> ([Items], [ProductionRule], [(Int, ExtendedSymbol, Action)],
[(Int, Symbol, Int)], ())
calcEfficientLALRParseTable CFG
cfg)
Handle
h_pr <- String -> IOMode -> IO Handle
openFile String
prod_rule IOMode
WriteMode
Handle
h_acttbl <- String -> IOMode -> IO Handle
openFile String
action_tbl IOMode
WriteMode
Handle
h_gototbl <- String -> IOMode -> IO Handle
openFile String
goto_tbl IOMode
WriteMode
Handle -> [ProductionRule] -> IO ()
forall a. Show a => Handle -> [a] -> IO ()
prPrules Handle
h_pr [ProductionRule]
prules
Handle -> [(Int, ExtendedSymbol, Action)] -> IO ()
forall a1 a2 a3.
(Show a1, Show a2, Show a3) =>
Handle -> [(a1, a2, a3)] -> IO ()
prActTbl Handle
h_acttbl [(Int, ExtendedSymbol, Action)]
actTbl
Handle -> [(Int, Symbol, Int)] -> IO ()
forall a1 a2 a3.
(Show a1, Show a2, Show a3) =>
Handle -> [(a1, a2, a3)] -> IO ()
prGtTbl Handle
h_gototbl [(Int, Symbol, Int)]
gtTbl
Handle -> IO ()
hClose Handle
h_pr
Handle -> IO ()
hClose Handle
h_acttbl
Handle -> IO ()
hClose Handle
h_gototbl
__main :: CFG -> IO ()
__main CFG
g = do
Handle
-> ([Items], [ProductionRule], [(Int, ExtendedSymbol, Action)],
[(Int, Symbol, Int)])
-> IO ()
forall a a1 a2 a3 a1 a2 a3.
(Show a, Show a1, Show a2, Show a3, Show a1, Show a2, Show a3) =>
Handle -> ([Items], [a], [(a1, a2, a3)], [(a1, a2, a3)]) -> IO ()
prParseTable Handle
stdout (([Items], [ProductionRule], [(Int, ExtendedSymbol, Action)],
[(Int, Symbol, Int)])
-> IO ())
-> ([Items], [ProductionRule], [(Int, ExtendedSymbol, Action)],
[(Int, Symbol, Int)])
-> IO ()
forall a b. (a -> b) -> a -> b
$ (\([Items]
a1,[ProductionRule]
a2,[(Int, ExtendedSymbol, Action)]
a3,[(Int, Symbol, Int)]
a4,()
a5)->([Items]
a1,[ProductionRule]
a2,[(Int, ExtendedSymbol, Action)]
a3,[(Int, Symbol, Int)]
a4)) (CFG
-> ([Items], [ProductionRule], [(Int, ExtendedSymbol, Action)],
[(Int, Symbol, Int)], ())
calcEfficientLALRParseTable CFG
g)
prSplk' :: [(a, a, a, Items, a, a)] -> IO ()
prSplk' [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
prSplk' ((a
index0,a
index2,a
item0,Items
item0closure,a
item1,a
item2):[(a, a, a, Items, a, a)]
splk') = do
String -> IO ()
putStrLn String
"item0:"
String -> IO ()
putStrLn (a -> String
forall a. Show a => a -> String
show a
index0)
String -> IO ()
putStrLn (a -> String
forall a. Show a => a -> String
show a
item0)
String -> IO ()
putStrLn String
"closure(item0,#):"
Handle -> Items -> IO ()
prItem Handle
stdout Items
item0closure
String -> IO ()
putStrLn String
"item1:"
String -> IO ()
putStrLn (a -> String
forall a. Show a => a -> String
show a
item1)
String -> IO ()
putStrLn (a -> String
forall a. Show a => a -> String
show a
index2)
String -> IO ()
putStrLn String
"item2:"
String -> IO ()
putStrLn (a -> String
forall a. Show a => a -> String
show a
item2)
Char
ch <- IO Char
getChar
[(a, a, a, Items, a, a)] -> IO ()
prSplk' [(a, a, a, Items, a, a)]
splk'
__mainLr1 :: CFG -> IO ()
__mainLr1 CFG
g = do
Handle
-> ([Items], [ProductionRule], [(Int, ExtendedSymbol, Action)],
[(Int, Symbol, Int)])
-> IO ()
forall a a1 a2 a3 a1 a2 a3.
(Show a, Show a1, Show a2, Show a3, Show a1, Show a2, Show a3) =>
Handle -> ([Items], [a], [(a1, a2, a3)], [(a1, a2, a3)]) -> IO ()
prParseTable Handle
stdout (CFG
-> ([Items], [ProductionRule], [(Int, ExtendedSymbol, Action)],
[(Int, Symbol, Int)])
calcLR1ParseTable CFG
g)
__mainLalr1 :: CFG -> IO ()
__mainLalr1 CFG
g = do
Handle
-> ([Items], [ProductionRule], [[Int]],
[([Int], ExtendedSymbol, LALRAction)], [([Int], Symbol, [Int])])
-> IO ()
forall a a a1 a2 a3 a1 a2 a3.
(Show a, Show a, Show a1, Show a2, Show a3, Show a1, Show a2,
Show a3) =>
Handle
-> ([Items], [a], [a], [(a1, a2, a3)], [(a1, a2, a3)]) -> IO ()
prLALRParseTable Handle
stdout (CFG
-> ([Items], [ProductionRule], [[Int]],
[([Int], ExtendedSymbol, LALRAction)], [([Int], Symbol, [Int])])
calcLALRParseTable CFG
g)
indexPrule :: AUGCFG -> ProductionRule -> Int
indexPrule :: CFG -> ProductionRule -> Int
indexPrule CFG
augCfg ProductionRule
prule = [ProductionRule] -> ProductionRule -> Int -> Int
forall t t. (Show t, Eq t, Num t) => [t] -> t -> t -> t
indexPrule' [ProductionRule]
prules ProductionRule
prule Int
0
where
CFG String
_ [ProductionRule]
prules = CFG
augCfg
indexPrule' :: [t] -> t -> t -> t
indexPrule' [] t
prule t
n = String -> t
forall a. HasCallStack => String -> a
error (String
"indexPrule: not found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ t -> String
forall a. Show a => a -> String
show t
prule)
indexPrule' (t
r:[t]
rs) t
prule t
n =
if t
r t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
prule then t
n else [t] -> t -> t -> t
indexPrule' [t]
rs t
prule (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1)
prPrules :: Handle -> [a] -> IO ()
prPrules Handle
h [a]
ps = Handle -> [a] -> Integer -> IO ()
forall t a. (Show t, Show a, Num t) => Handle -> [a] -> t -> IO ()
prPrules' Handle
h [a]
ps Integer
0
prPrules' :: Handle -> [a] -> t -> IO ()
prPrules' Handle
h [] t
n = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
prPrules' Handle
h (a
prule:[a]
prules) t
n =
do Handle -> String -> IO ()
hPutStrLn Handle
h (t -> String
forall a. Show a => a -> String
show t
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
prule)
Handle -> [a] -> t -> IO ()
prPrules' Handle
h [a]
prules (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1)
symbols :: CFG -> [Symbol]
symbols :: CFG -> [Symbol]
symbols (CFG String
start [ProductionRule]
prules)
= [String -> Symbol
Nonterminal String
x | Nonterminal String
x <- [Symbol]
syms] [Symbol] -> [Symbol] -> [Symbol]
forall a. [a] -> [a] -> [a]
++
[String -> Symbol
Terminal String
x | Terminal String
x <- [Symbol]
syms]
where
f :: ProductionRule -> [Symbol]
f (ProductionRule String
x [Symbol]
syms) = String -> Symbol
Nonterminal String
xSymbol -> [Symbol] -> [Symbol]
forall a. a -> [a] -> [a]
:[Symbol]
syms
syms :: [Symbol]
syms = [Symbol] -> [Symbol]
forall a. Eq a => [a] -> [a]
nub (String -> Symbol
Nonterminal String
start Symbol -> [Symbol] -> [Symbol]
forall a. a -> [a] -> [a]
: [[Symbol]] -> [Symbol]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((ProductionRule -> [Symbol]) -> [ProductionRule] -> [[Symbol]]
forall a b. (a -> b) -> [a] -> [b]
map ProductionRule -> [Symbol]
f [ProductionRule]
prules))
first :: [(Symbol, [ExtendedSymbol])] -> Symbol -> [ExtendedSymbol]
first :: [(Symbol, [ExtendedSymbol])] -> Symbol -> [ExtendedSymbol]
first [(Symbol, [ExtendedSymbol])]
tbl Symbol
x = case (Symbol -> [(Symbol, [ExtendedSymbol])] -> Maybe [ExtendedSymbol]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Symbol
x [(Symbol, [ExtendedSymbol])]
tbl) of
Maybe [ExtendedSymbol]
Nothing -> [Symbol -> ExtendedSymbol
Symbol Symbol
x]
Just [ExtendedSymbol]
y -> [ExtendedSymbol]
y
first_ :: [(Symbol, [ExtendedSymbol])] -> [Symbol] -> [ExtendedSymbol]
first_ :: [(Symbol, [ExtendedSymbol])] -> [Symbol] -> [ExtendedSymbol]
first_ [(Symbol, [ExtendedSymbol])]
tbl [] = []
first_ [(Symbol, [ExtendedSymbol])]
tbl (Symbol
z:[Symbol]
zs) = let zRng :: [ExtendedSymbol]
zRng = [(Symbol, [ExtendedSymbol])] -> Symbol -> [ExtendedSymbol]
first [(Symbol, [ExtendedSymbol])]
tbl Symbol
z in
if ExtendedSymbol -> [ExtendedSymbol] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ExtendedSymbol
Epsilon [ExtendedSymbol]
zRng
then [ExtendedSymbol] -> [ExtendedSymbol] -> [ExtendedSymbol]
forall a. Eq a => [a] -> [a] -> [a]
union ([ExtendedSymbol] -> [ExtendedSymbol] -> [ExtendedSymbol]
forall a. Eq a => [a] -> [a] -> [a]
(\\) [ExtendedSymbol]
zRng [ExtendedSymbol
Epsilon]) ([(Symbol, [ExtendedSymbol])] -> [Symbol] -> [ExtendedSymbol]
first_ [(Symbol, [ExtendedSymbol])]
tbl [Symbol]
zs)
else [ExtendedSymbol]
zRng
extFirst :: [(Symbol, [ExtendedSymbol])] -> ExtendedSymbol -> [ExtendedSymbol]
extFirst :: [(Symbol, [ExtendedSymbol])] -> ExtendedSymbol -> [ExtendedSymbol]
extFirst [(Symbol, [ExtendedSymbol])]
tbl (Symbol Symbol
x) = [(Symbol, [ExtendedSymbol])] -> Symbol -> [ExtendedSymbol]
first [(Symbol, [ExtendedSymbol])]
tbl Symbol
x
extFirst [(Symbol, [ExtendedSymbol])]
tbl (ExtendedSymbol
EndOfSymbol) = [ExtendedSymbol
EndOfSymbol]
extFirst [(Symbol, [ExtendedSymbol])]
tbl (ExtendedSymbol
Epsilon) = String -> [ExtendedSymbol]
forall a. HasCallStack => String -> a
error String
"extFirst_ : Epsilon"
extFirst_ :: [(Symbol, [ExtendedSymbol])] -> [ExtendedSymbol] -> [ExtendedSymbol]
extFirst_ :: [(Symbol, [ExtendedSymbol])]
-> [ExtendedSymbol] -> [ExtendedSymbol]
extFirst_ [(Symbol, [ExtendedSymbol])]
tbl [] = []
extFirst_ [(Symbol, [ExtendedSymbol])]
tbl (ExtendedSymbol
z:[ExtendedSymbol]
zs) = let zRng :: [ExtendedSymbol]
zRng = [(Symbol, [ExtendedSymbol])] -> ExtendedSymbol -> [ExtendedSymbol]
extFirst [(Symbol, [ExtendedSymbol])]
tbl ExtendedSymbol
z in
if ExtendedSymbol -> [ExtendedSymbol] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ExtendedSymbol
Epsilon [ExtendedSymbol]
zRng
then [ExtendedSymbol] -> [ExtendedSymbol] -> [ExtendedSymbol]
forall a. Eq a => [a] -> [a] -> [a]
union ([ExtendedSymbol] -> [ExtendedSymbol] -> [ExtendedSymbol]
forall a. Eq a => [a] -> [a] -> [a]
(\\) [ExtendedSymbol]
zRng [ExtendedSymbol
Epsilon]) ([(Symbol, [ExtendedSymbol])]
-> [ExtendedSymbol] -> [ExtendedSymbol]
extFirst_ [(Symbol, [ExtendedSymbol])]
tbl [ExtendedSymbol]
zs)
else [ExtendedSymbol]
zRng
calcFirst :: CFG -> [(Symbol, [ExtendedSymbol])]
calcFirst :: CFG -> [(Symbol, [ExtendedSymbol])]
calcFirst CFG
cfg = CFG
-> [(Symbol, [ExtendedSymbol])]
-> [Symbol]
-> [(Symbol, [ExtendedSymbol])]
calcFirst' CFG
cfg (CFG -> [(Symbol, [ExtendedSymbol])]
initFirst CFG
cfg) (CFG -> [Symbol]
symbols CFG
cfg)
initFirst :: CFG -> [(Symbol, [ExtendedSymbol])]
initFirst CFG
cfg =
let syms :: [Symbol]
syms = CFG -> [Symbol]
symbols CFG
cfg
CFG String
_ [ProductionRule]
prules = CFG
cfg
in [(String -> Symbol
Terminal String
x, [Symbol -> ExtendedSymbol
Symbol (String -> Symbol
Terminal String
x)])
| Terminal String
x <- [Symbol]
syms]
[(Symbol, [ExtendedSymbol])]
-> [(Symbol, [ExtendedSymbol])] -> [(Symbol, [ExtendedSymbol])]
forall a. [a] -> [a] -> [a]
++
[(String -> Symbol
Nonterminal String
x, [ExtendedSymbol
Epsilon | ProductionRule String
y [] <- [ProductionRule]
prules, String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
y])
| Nonterminal String
x <- [Symbol]
syms]
calcFirst' :: CFG
-> [(Symbol, [ExtendedSymbol])]
-> [Symbol]
-> [(Symbol, [ExtendedSymbol])]
calcFirst' CFG
cfg [(Symbol, [ExtendedSymbol])]
currTbl [Symbol]
syms =
let (Bool
isChanged, [(Symbol, [ExtendedSymbol])]
nextFst) = CFG
-> [(Symbol, [ExtendedSymbol])]
-> [Symbol]
-> (Bool, [(Symbol, [ExtendedSymbol])])
calcFirst'' CFG
cfg [(Symbol, [ExtendedSymbol])]
currTbl [Symbol]
syms in
if Bool
isChanged then CFG
-> [(Symbol, [ExtendedSymbol])]
-> [Symbol]
-> [(Symbol, [ExtendedSymbol])]
calcFirst' CFG
cfg [(Symbol, [ExtendedSymbol])]
nextFst [Symbol]
syms else [(Symbol, [ExtendedSymbol])]
currTbl
calcFirst'' :: CFG
-> [(Symbol, [ExtendedSymbol])]
-> [Symbol]
-> (Bool, [(Symbol, [ExtendedSymbol])])
calcFirst'' CFG
cfg [(Symbol, [ExtendedSymbol])]
tbl []
= (Bool
False, [])
calcFirst'' CFG
cfg [(Symbol, [ExtendedSymbol])]
tbl (Terminal String
x:[Symbol]
therest)
= CFG
-> [(Symbol, [ExtendedSymbol])]
-> (Bool, (Symbol, [ExtendedSymbol]))
-> [Symbol]
-> (Bool, [(Symbol, [ExtendedSymbol])])
calcFirst''' CFG
cfg [(Symbol, [ExtendedSymbol])]
tbl (Bool
False, (String -> Symbol
Terminal String
x, [(Symbol, [ExtendedSymbol])] -> Symbol -> [ExtendedSymbol]
first [(Symbol, [ExtendedSymbol])]
tbl (String -> Symbol
Terminal String
x))) [Symbol]
therest
calcFirst'' CFG
cfg [(Symbol, [ExtendedSymbol])]
tbl (Nonterminal String
x:[Symbol]
therest)
= CFG
-> [(Symbol, [ExtendedSymbol])]
-> (Bool, (Symbol, [ExtendedSymbol]))
-> [Symbol]
-> (Bool, [(Symbol, [ExtendedSymbol])])
calcFirst''' CFG
cfg [(Symbol, [ExtendedSymbol])]
tbl (Bool
ischanged, (String -> Symbol
Nonterminal String
x, [ExtendedSymbol]
rng)) [Symbol]
therest
where
CFG String
start [ProductionRule]
prules = CFG
cfg
addendum :: [ExtendedSymbol]
addendum = [[Symbol]] -> [ExtendedSymbol]
f [[Symbol]
zs | ProductionRule String
y [Symbol]
zs <- [ProductionRule]
prules, String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
y]
currRng :: [ExtendedSymbol]
currRng = [(Symbol, [ExtendedSymbol])] -> Symbol -> [ExtendedSymbol]
first [(Symbol, [ExtendedSymbol])]
tbl (String -> Symbol
Nonterminal String
x)
ischanged :: Bool
ischanged = [ExtendedSymbol] -> [ExtendedSymbol] -> [ExtendedSymbol]
forall a. Eq a => [a] -> [a] -> [a]
(\\) [ExtendedSymbol]
addendum [ExtendedSymbol]
currRng [ExtendedSymbol] -> [ExtendedSymbol] -> Bool
forall a. Eq a => a -> a -> Bool
/= []
rng :: [ExtendedSymbol]
rng = [ExtendedSymbol] -> [ExtendedSymbol] -> [ExtendedSymbol]
forall a. Eq a => [a] -> [a] -> [a]
union [ExtendedSymbol]
addendum [ExtendedSymbol]
currRng
f :: [[Symbol]] -> [ExtendedSymbol]
f [] = []
f ([Symbol]
zs:[[Symbol]]
zss) = [ExtendedSymbol] -> [ExtendedSymbol] -> [ExtendedSymbol]
forall a. Eq a => [a] -> [a] -> [a]
union ([(Symbol, [ExtendedSymbol])] -> [Symbol] -> [ExtendedSymbol]
first_ [(Symbol, [ExtendedSymbol])]
tbl [Symbol]
zs) ([[Symbol]] -> [ExtendedSymbol]
f [[Symbol]]
zss)
calcFirst''' :: CFG
-> [(Symbol, [ExtendedSymbol])]
-> (Bool, (Symbol, [ExtendedSymbol]))
-> [Symbol]
-> (Bool, [(Symbol, [ExtendedSymbol])])
calcFirst''' CFG
cfg [(Symbol, [ExtendedSymbol])]
tbl (Bool
bool1, (Symbol, [ExtendedSymbol])
oneupdated) [Symbol]
therest =
let (Bool
bool2, [(Symbol, [ExtendedSymbol])]
therestupdated) = CFG
-> [(Symbol, [ExtendedSymbol])]
-> [Symbol]
-> (Bool, [(Symbol, [ExtendedSymbol])])
calcFirst'' CFG
cfg [(Symbol, [ExtendedSymbol])]
tbl [Symbol]
therest in
(Bool
bool1 Bool -> Bool -> Bool
|| Bool
bool2, (Symbol, [ExtendedSymbol])
oneupdated(Symbol, [ExtendedSymbol])
-> [(Symbol, [ExtendedSymbol])] -> [(Symbol, [ExtendedSymbol])]
forall a. a -> [a] -> [a]
:[(Symbol, [ExtendedSymbol])]
therestupdated)
follow :: [(Symbol, [ExtendedSymbol])] -> Symbol -> [ExtendedSymbol]
follow :: [(Symbol, [ExtendedSymbol])] -> Symbol -> [ExtendedSymbol]
follow [(Symbol, [ExtendedSymbol])]
tbl Symbol
x = case Symbol -> [(Symbol, [ExtendedSymbol])] -> Maybe [ExtendedSymbol]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Symbol
x [(Symbol, [ExtendedSymbol])]
tbl of
Maybe [ExtendedSymbol]
Nothing -> String -> [ExtendedSymbol]
forall a. HasCallStack => String -> a
error (Symbol -> String
forall a. Show a => a -> String
show Symbol
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(Symbol, [ExtendedSymbol])] -> String
forall a. Show a => a -> String
show [(Symbol, [ExtendedSymbol])]
tbl)
Just [ExtendedSymbol]
z -> [ExtendedSymbol]
z
calcFollow :: CFG -> [(Symbol, [ExtendedSymbol])]
calcFollow :: CFG -> [(Symbol, [ExtendedSymbol])]
calcFollow CFG
cfg = [(Symbol, [ExtendedSymbol])]
-> [ProductionRule]
-> [(Symbol, [ExtendedSymbol])]
-> [(Symbol, [ExtendedSymbol])]
calcFollow' (CFG -> [(Symbol, [ExtendedSymbol])]
calcFirst CFG
cfg) [ProductionRule]
prules (CFG -> [(Symbol, [ExtendedSymbol])]
initFollow CFG
cfg)
where CFG String
_ [ProductionRule]
prules = CFG
cfg
initFollow :: CFG -> [(Symbol, [ExtendedSymbol])]
initFollow CFG
cfg =
let CFG String
start [ProductionRule]
prules = CFG
cfg
in [(String -> Symbol
Nonterminal String
x, [ExtendedSymbol
EndOfSymbol | String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
start])
| Nonterminal String
x <- CFG -> [Symbol]
symbols CFG
cfg]
calcFollow' :: [(Symbol, [ExtendedSymbol])]
-> [ProductionRule]
-> [(Symbol, [ExtendedSymbol])]
-> [(Symbol, [ExtendedSymbol])]
calcFollow' [(Symbol, [ExtendedSymbol])]
fstTbl [ProductionRule]
prules [(Symbol, [ExtendedSymbol])]
currTbl =
let (Bool
isChanged, [(Symbol, [ExtendedSymbol])]
nextFlw) = [(Symbol, [ExtendedSymbol])]
-> [(Symbol, [ExtendedSymbol])]
-> [ProductionRule]
-> Bool
-> (Bool, [(Symbol, [ExtendedSymbol])])
calcFollow'' [(Symbol, [ExtendedSymbol])]
fstTbl [(Symbol, [ExtendedSymbol])]
currTbl [ProductionRule]
prules Bool
False in
if Bool
isChanged then [(Symbol, [ExtendedSymbol])]
-> [ProductionRule]
-> [(Symbol, [ExtendedSymbol])]
-> [(Symbol, [ExtendedSymbol])]
calcFollow' [(Symbol, [ExtendedSymbol])]
fstTbl [ProductionRule]
prules [(Symbol, [ExtendedSymbol])]
nextFlw else [(Symbol, [ExtendedSymbol])]
currTbl
calcFollow'' :: [(Symbol, [ExtendedSymbol])]
-> [(Symbol, [ExtendedSymbol])]
-> [ProductionRule]
-> Bool
-> (Bool, [(Symbol, [ExtendedSymbol])])
calcFollow'' [(Symbol, [ExtendedSymbol])]
fstTbl [(Symbol, [ExtendedSymbol])]
flwTbl [] Bool
b = (Bool
b, [(Symbol, [ExtendedSymbol])]
flwTbl)
calcFollow'' [(Symbol, [ExtendedSymbol])]
fstTbl [(Symbol, [ExtendedSymbol])]
flwTbl (ProductionRule String
y [Symbol]
zs:[ProductionRule]
therest) Bool
b =
[(Symbol, [ExtendedSymbol])]
-> [(Symbol, [ExtendedSymbol])]
-> [ProductionRule]
-> Bool
-> (Bool, [(Symbol, [ExtendedSymbol])])
calcFollow'' [(Symbol, [ExtendedSymbol])]
fstTbl [(Symbol, [ExtendedSymbol])]
tbl' [ProductionRule]
therest Bool
b'
where
(Bool
b',[(Symbol, [ExtendedSymbol])]
tbl') = [Symbol]
-> [(Symbol, [ExtendedSymbol])]
-> Bool
-> (Bool, [(Symbol, [ExtendedSymbol])])
f [Symbol]
zs [(Symbol, [ExtendedSymbol])]
flwTbl Bool
b
_y :: Symbol
_y = String -> Symbol
Nonterminal String
y
f :: [Symbol]
-> [(Symbol, [ExtendedSymbol])]
-> Bool
-> (Bool, [(Symbol, [ExtendedSymbol])])
f [] [(Symbol, [ExtendedSymbol])]
tbl Bool
b = (Bool
b, [(Symbol, [ExtendedSymbol])]
tbl)
f [Terminal String
z] [(Symbol, [ExtendedSymbol])]
tbl Bool
b = (Bool
b, [(Symbol, [ExtendedSymbol])]
tbl)
f [Nonterminal String
z] [(Symbol, [ExtendedSymbol])]
tbl Bool
b =
let flwZ :: [ExtendedSymbol]
flwZ = [(Symbol, [ExtendedSymbol])] -> Symbol -> [ExtendedSymbol]
follow [(Symbol, [ExtendedSymbol])]
flwTbl (String -> Symbol
Nonterminal String
z)
zRng :: [ExtendedSymbol]
zRng = [ExtendedSymbol] -> [ExtendedSymbol] -> [ExtendedSymbol]
forall a. Eq a => [a] -> [a] -> [a]
union [ExtendedSymbol]
flwZ ([(Symbol, [ExtendedSymbol])] -> Symbol -> [ExtendedSymbol]
follow [(Symbol, [ExtendedSymbol])]
flwTbl Symbol
_y)
isChanged :: Bool
isChanged = [ExtendedSymbol] -> [ExtendedSymbol] -> [ExtendedSymbol]
forall a. Eq a => [a] -> [a] -> [a]
(\\) [ExtendedSymbol]
zRng [ExtendedSymbol]
flwZ [ExtendedSymbol] -> [ExtendedSymbol] -> Bool
forall a. Eq a => a -> a -> Bool
/= []
in (Bool
isChanged, Symbol
-> [ExtendedSymbol]
-> [(Symbol, [ExtendedSymbol])]
-> [(Symbol, [ExtendedSymbol])]
forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
upd (String -> Symbol
Nonterminal String
z) [ExtendedSymbol]
zRng [(Symbol, [ExtendedSymbol])]
tbl)
f (Terminal String
z:[Symbol]
zs) [(Symbol, [ExtendedSymbol])]
tbl Bool
b = [Symbol]
-> [(Symbol, [ExtendedSymbol])]
-> Bool
-> (Bool, [(Symbol, [ExtendedSymbol])])
f [Symbol]
zs [(Symbol, [ExtendedSymbol])]
tbl Bool
b
f (Nonterminal String
z:[Symbol]
zs) [(Symbol, [ExtendedSymbol])]
tbl Bool
b =
let fstZS :: [ExtendedSymbol]
fstZS = [(Symbol, [ExtendedSymbol])] -> [Symbol] -> [ExtendedSymbol]
first_ [(Symbol, [ExtendedSymbol])]
fstTbl [Symbol]
zs
flwZ :: [ExtendedSymbol]
flwZ = [(Symbol, [ExtendedSymbol])] -> Symbol -> [ExtendedSymbol]
follow [(Symbol, [ExtendedSymbol])]
flwTbl (String -> Symbol
Nonterminal String
z)
zRng :: [ExtendedSymbol]
zRng = [ExtendedSymbol] -> [ExtendedSymbol] -> [ExtendedSymbol]
forall a. Eq a => [a] -> [a] -> [a]
union ([(Symbol, [ExtendedSymbol])] -> Symbol -> [ExtendedSymbol]
follow [(Symbol, [ExtendedSymbol])]
flwTbl (String -> Symbol
Nonterminal String
z))
([ExtendedSymbol] -> [ExtendedSymbol] -> [ExtendedSymbol]
forall a. Eq a => [a] -> [a] -> [a]
union ([ExtendedSymbol] -> [ExtendedSymbol] -> [ExtendedSymbol]
forall a. Eq a => [a] -> [a] -> [a]
(\\) [ExtendedSymbol]
fstZS [ExtendedSymbol
Epsilon])
(if ExtendedSymbol -> [ExtendedSymbol] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ExtendedSymbol
Epsilon [ExtendedSymbol]
fstZS
then [(Symbol, [ExtendedSymbol])] -> Symbol -> [ExtendedSymbol]
follow [(Symbol, [ExtendedSymbol])]
flwTbl Symbol
_y
else []))
isChanged :: Bool
isChanged = [ExtendedSymbol] -> [ExtendedSymbol] -> [ExtendedSymbol]
forall a. Eq a => [a] -> [a] -> [a]
(\\) [ExtendedSymbol]
zRng [ExtendedSymbol]
flwZ [ExtendedSymbol] -> [ExtendedSymbol] -> Bool
forall a. Eq a => a -> a -> Bool
/= []
in [Symbol]
-> [(Symbol, [ExtendedSymbol])]
-> Bool
-> (Bool, [(Symbol, [ExtendedSymbol])])
f [Symbol]
zs (Symbol
-> [ExtendedSymbol]
-> [(Symbol, [ExtendedSymbol])]
-> [(Symbol, [ExtendedSymbol])]
forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
upd (String -> Symbol
Nonterminal String
z) [ExtendedSymbol]
zRng [(Symbol, [ExtendedSymbol])]
tbl) Bool
isChanged
upd :: a -> b -> [(a, b)] -> [(a, b)]
upd a
z b
zRng [(a, b)]
tbl = [if a
z a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x then (a
x, b
zRng) else (a
x,b
xRng) | (a
x,b
xRng) <- [(a, b)]
tbl]
closure :: AUGCFG -> Items -> Items
closure :: CFG -> Items -> Items
closure CFG
augCfg Items
items =
if Bool
isChanged
then CFG -> Items -> Items
closure CFG
augCfg Items
itemsUpdated
else Items
items
where
CFG String
s [ProductionRule]
prules = CFG
augCfg
(Bool
isChanged, Items
itemsUpdated)
= [(Symbol, [ExtendedSymbol])]
-> [ProductionRule] -> Items -> Items -> Bool -> (Bool, Items)
closure' (CFG -> [(Symbol, [ExtendedSymbol])]
calcFirst CFG
augCfg) [ProductionRule]
prules Items
items Items
items Bool
False
closure' :: [(Symbol, [ExtendedSymbol])]
-> [ProductionRule] -> Items -> Items -> Bool -> (Bool, Items)
closure' [(Symbol, [ExtendedSymbol])]
fstTbl [ProductionRule]
prules Items
cls [] Bool
b = (Bool
b, Items
cls)
closure' [(Symbol, [ExtendedSymbol])]
fstTbl [ProductionRule]
prules Items
cls (Item (ProductionRule String
x [Symbol]
alphaBbeta) Int
d [ExtendedSymbol]
lookahead:Items
items) Bool
b =
if [Symbol]
_Bbeta [Symbol] -> [Symbol] -> Bool
forall a. Eq a => a -> a -> Bool
/= []
then Items -> Bool -> [ProductionRule] -> (Bool, Items)
f Items
cls Bool
b [ProductionRule]
prules
else [(Symbol, [ExtendedSymbol])]
-> [ProductionRule] -> Items -> Items -> Bool -> (Bool, Items)
closure' [(Symbol, [ExtendedSymbol])]
fstTbl [ProductionRule]
prules Items
cls Items
items Bool
b
where
_Bbeta :: [Symbol]
_Bbeta = Int -> [Symbol] -> [Symbol]
forall a. Int -> [a] -> [a]
drop Int
d [Symbol]
alphaBbeta
_B :: Symbol
_B = [Symbol] -> Symbol
forall a. [a] -> a
head [Symbol]
_Bbeta
beta :: [Symbol]
beta = [Symbol] -> [Symbol]
forall a. [a] -> [a]
tail [Symbol]
_Bbeta
f :: Items -> Bool -> [ProductionRule] -> (Bool, Items)
f Items
cls Bool
b [] = [(Symbol, [ExtendedSymbol])]
-> [ProductionRule] -> Items -> Items -> Bool -> (Bool, Items)
closure' [(Symbol, [ExtendedSymbol])]
fstTbl [ProductionRule]
prules Items
cls Items
items Bool
b
f Items
cls Bool
b (r :: ProductionRule
r@(ProductionRule String
y [Symbol]
gamma):[ProductionRule]
rs) =
if Symbol
_B Symbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Symbol
Nonterminal String
y
then (if [ExtendedSymbol]
lookahead [ExtendedSymbol] -> [ExtendedSymbol] -> Bool
forall a. Eq a => a -> a -> Bool
== []
then Items
-> Bool -> ProductionRule -> [ProductionRule] -> (Bool, Items)
flrzero Items
cls Bool
b ProductionRule
r [ProductionRule]
rs
else Items
-> Bool
-> ProductionRule
-> [ProductionRule]
-> [ExtendedSymbol]
-> (Bool, Items)
g Items
cls Bool
b ProductionRule
r [ProductionRule]
rs ([(Symbol, [ExtendedSymbol])]
-> [ExtendedSymbol] -> [ExtendedSymbol]
extFirst_ [(Symbol, [ExtendedSymbol])]
fstTbl ((Symbol -> ExtendedSymbol) -> [Symbol] -> [ExtendedSymbol]
forall a b. (a -> b) -> [a] -> [b]
map Symbol -> ExtendedSymbol
Symbol [Symbol]
beta [ExtendedSymbol] -> [ExtendedSymbol] -> [ExtendedSymbol]
forall a. [a] -> [a] -> [a]
++ [ExtendedSymbol]
lookahead)))
else Items -> Bool -> [ProductionRule] -> (Bool, Items)
f Items
cls Bool
b [ProductionRule]
rs
flrzero :: Items
-> Bool -> ProductionRule -> [ProductionRule] -> (Bool, Items)
flrzero Items
cls Bool
b ProductionRule
r [ProductionRule]
rs =
let item :: Item
item = ProductionRule -> Int -> [ExtendedSymbol] -> Item
Item ProductionRule
r Int
0 []
in if Item -> Items -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Item
item Items
cls then Items -> Bool -> [ProductionRule] -> (Bool, Items)
f Items
cls Bool
b [ProductionRule]
rs
else Items -> Bool -> [ProductionRule] -> (Bool, Items)
f (Items
cls Items -> Items -> Items
forall a. [a] -> [a] -> [a]
++ [Item
item]) Bool
True [ProductionRule]
rs
g :: Items
-> Bool
-> ProductionRule
-> [ProductionRule]
-> [ExtendedSymbol]
-> (Bool, Items)
g Items
cls Bool
b ProductionRule
r [ProductionRule]
rs [] = Items -> Bool -> [ProductionRule] -> (Bool, Items)
f Items
cls Bool
b [ProductionRule]
rs
g Items
cls Bool
b ProductionRule
r [ProductionRule]
rs (Symbol (Terminal String
t) : [ExtendedSymbol]
fstSyms) =
let item :: Item
item = ProductionRule -> Int -> [ExtendedSymbol] -> Item
Item ProductionRule
r Int
0 [Symbol -> ExtendedSymbol
Symbol (String -> Symbol
Terminal String
t)]
in if Item -> Items -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Item
item Items
cls
then Items
-> Bool
-> ProductionRule
-> [ProductionRule]
-> [ExtendedSymbol]
-> (Bool, Items)
g Items
cls Bool
b ProductionRule
r [ProductionRule]
rs [ExtendedSymbol]
fstSyms
else Items
-> Bool
-> ProductionRule
-> [ProductionRule]
-> [ExtendedSymbol]
-> (Bool, Items)
g (Items
clsItems -> Items -> Items
forall a. [a] -> [a] -> [a]
++[Item
item]) Bool
True ProductionRule
r [ProductionRule]
rs [ExtendedSymbol]
fstSyms
g Items
cls Bool
b ProductionRule
r [ProductionRule]
rs (Symbol (Nonterminal String
t) : [ExtendedSymbol]
fstSyms) = Items
-> Bool
-> ProductionRule
-> [ProductionRule]
-> [ExtendedSymbol]
-> (Bool, Items)
g Items
cls Bool
b ProductionRule
r [ProductionRule]
rs [ExtendedSymbol]
fstSyms
g Items
cls Bool
b ProductionRule
r [ProductionRule]
rs (ExtendedSymbol
EndOfSymbol : [ExtendedSymbol]
fstSyms) =
let item :: Item
item = ProductionRule -> Int -> [ExtendedSymbol] -> Item
Item ProductionRule
r Int
0 [ExtendedSymbol
EndOfSymbol]
in if Item -> Items -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Item
item Items
cls
then Items
-> Bool
-> ProductionRule
-> [ProductionRule]
-> [ExtendedSymbol]
-> (Bool, Items)
g Items
cls Bool
b ProductionRule
r [ProductionRule]
rs [ExtendedSymbol]
fstSyms
else Items
-> Bool
-> ProductionRule
-> [ProductionRule]
-> [ExtendedSymbol]
-> (Bool, Items)
g (Items
clsItems -> Items -> Items
forall a. [a] -> [a] -> [a]
++[Item
item]) Bool
True ProductionRule
r [ProductionRule]
rs [ExtendedSymbol]
fstSyms
g Items
cls Bool
b ProductionRule
r [ProductionRule]
rs (ExtendedSymbol
Epsilon : [ExtendedSymbol]
fstSyms) = String -> (Bool, Items)
forall a. HasCallStack => String -> a
error String
"closure: Epsilon"
calcLR0Items :: AUGCFG -> Itemss
calcLR0Items :: CFG -> [Items]
calcLR0Items CFG
augCfg = CFG -> [Symbol] -> [Items] -> [Items]
calcItems' CFG
augCfg [Symbol]
syms [Items]
iss0
where
CFG String
_S [ProductionRule]
prules = CFG
augCfg
i0 :: Item
i0 = ProductionRule -> Int -> [ExtendedSymbol] -> Item
Item ([ProductionRule] -> ProductionRule
forall a. [a] -> a
head [ProductionRule]
prules) Int
0 []
is0 :: Items
is0 = CFG -> Items -> Items
closure CFG
augCfg [Item
i0]
iss0 :: [Items]
iss0 = [ Items
is0 ]
syms :: [Symbol]
syms = [Symbol] -> [Symbol] -> [Symbol]
forall a. Eq a => [a] -> [a] -> [a]
(\\) (CFG -> [Symbol]
symbols CFG
augCfg) [String -> Symbol
Nonterminal String
_S]
calcLR1Items :: AUGCFG -> Itemss
calcLR1Items :: CFG -> [Items]
calcLR1Items CFG
augCfg = CFG -> [Symbol] -> [Items] -> [Items]
calcItems' CFG
augCfg [Symbol]
syms [Items]
iss0
where
CFG String
_S [ProductionRule]
prules = CFG
augCfg
i0 :: Item
i0 = ProductionRule -> Int -> [ExtendedSymbol] -> Item
Item ([ProductionRule] -> ProductionRule
forall a. [a] -> a
head [ProductionRule]
prules) Int
0 [ExtendedSymbol
EndOfSymbol]
is0 :: Items
is0 = CFG -> Items -> Items
closure CFG
augCfg [Item
i0]
iss0 :: [Items]
iss0 = [ Items
is0 ]
syms :: [Symbol]
syms = [Symbol] -> [Symbol] -> [Symbol]
forall a. Eq a => [a] -> [a] -> [a]
(\\) (CFG -> [Symbol]
symbols CFG
augCfg) [String -> Symbol
Nonterminal String
_S]
calcItems' :: CFG -> [Symbol] -> [Items] -> [Items]
calcItems' CFG
augCfg [Symbol]
syms [Items]
currIss =
if Bool
isUpdated
then CFG -> [Symbol] -> [Items] -> [Items]
calcItems' CFG
augCfg [Symbol]
syms [Items]
nextIss
else [Items]
currIss
where
(Bool
isUpdated, [Items]
nextIss) = [Items] -> Bool -> [Items] -> (Bool, [Items])
f [Items]
currIss Bool
False [Items]
currIss
f :: [Items] -> Bool -> [Items] -> (Bool, [Items])
f [] Bool
b [Items]
currIss = (Bool
b, [Items]
currIss)
f (Items
is:[Items]
iss) Bool
b [Items]
currIss = Items -> [Items] -> Bool -> [Items] -> [Symbol] -> (Bool, [Items])
g Items
is [Items]
iss Bool
b [Items]
currIss [Symbol]
syms
g :: Items -> [Items] -> Bool -> [Items] -> [Symbol] -> (Bool, [Items])
g Items
is [Items]
iss Bool
b [Items]
currIss [] = [Items] -> Bool -> [Items] -> (Bool, [Items])
f [Items]
iss Bool
b [Items]
currIss
g Items
is [Items]
iss Bool
b [Items]
currIss (x:xs) =
let is' :: Items
is' = CFG -> Items -> Symbol -> Items
goto CFG
augCfg Items
is Symbol
x
in if Items
is' Items -> Items -> Bool
forall a. Eq a => a -> a -> Bool
== [] Bool -> Bool -> Bool
|| Items -> [Items] -> Bool
elemItems Items
is' [Items]
currIss
then Items -> [Items] -> Bool -> [Items] -> [Symbol] -> (Bool, [Items])
g Items
is [Items]
iss Bool
b [Items]
currIss [Symbol]
xs
else Items -> [Items] -> Bool -> [Items] -> [Symbol] -> (Bool, [Items])
g Items
is [Items]
iss Bool
True ([Items]
currIss [Items] -> [Items] -> [Items]
forall a. [a] -> [a] -> [a]
++ [Items
is']) [Symbol]
xs
elemItems :: Items -> Itemss -> Bool
elemItems :: Items -> [Items] -> Bool
elemItems Items
is0 [] = Bool
False
elemItems Items
is0 (Items
is:[Items]
iss) = Items -> Items -> Bool
eqItems Items
is0 Items
is Bool -> Bool -> Bool
|| Items -> [Items] -> Bool
elemItems Items
is0 [Items]
iss
eqItems :: Items -> Items -> Bool
eqItems :: Items -> Items -> Bool
eqItems Items
is1 Items
is2 = Items -> Items -> Items
forall a. Eq a => [a] -> [a] -> [a]
(\\) Items
is1 Items
is2 Items -> Items -> Bool
forall a. Eq a => a -> a -> Bool
== [] Bool -> Bool -> Bool
&& Items -> Items -> Items
forall a. Eq a => [a] -> [a] -> [a]
(\\) Items
is2 Items
is1 Items -> Items -> Bool
forall a. Eq a => a -> a -> Bool
== []
indexItem :: String -> Itemss -> Items -> Int
indexItem :: String -> [Items] -> Items -> Int
indexItem String
loc [Items]
items Items
item = String -> [Items] -> Items -> Int -> Int
forall t. Num t => String -> [Items] -> Items -> t -> t
indexItem' String
loc [Items]
items Items
item Int
0
indexItem' :: String -> [Items] -> Items -> t -> t
indexItem' String
loc (Items
item1:[Items]
items) Items
item2 t
n
= if Items -> Items -> Bool
eqItems Items
item1 Items
item2 then t
n else String -> [Items] -> Items -> t -> t
indexItem' String
loc [Items]
items Items
item2 (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1)
indexItem' String
loc [] Items
item t
n = String -> t
forall a. HasCallStack => String -> a
error (String
"indexItem: not found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Items -> String
forall a. Show a => a -> String
show Items
item String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
loc)
goto :: AUGCFG -> Items -> Symbol -> Items
goto :: CFG -> Items -> Symbol -> Items
goto CFG
augCfg Items
items Symbol
x = CFG -> Items -> Items
closure CFG
augCfg Items
itemsOverX
where
itemsOverX :: Items
itemsOverX = [ ProductionRule -> Int -> [ExtendedSymbol] -> Item
Item (String -> [Symbol] -> ProductionRule
ProductionRule String
z [Symbol]
alphaXbeta) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [ExtendedSymbol]
y
| Item (ProductionRule String
z [Symbol]
alphaXbeta) Int
j [ExtendedSymbol]
y <- Items
items
, let _Xbeta :: [Symbol]
_Xbeta = Int -> [Symbol] -> [Symbol]
forall a. Int -> [a] -> [a]
drop Int
j [Symbol]
alphaXbeta
, [Symbol]
_Xbeta [Symbol] -> [Symbol] -> Bool
forall a. Eq a => a -> a -> Bool
/= []
, Symbol
x Symbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
== [Symbol] -> Symbol
forall a. [a] -> a
head [Symbol]
_Xbeta ]
sharp :: Symbol
sharp = String -> Symbol
Terminal String
"#"
sharpSymbol :: ExtendedSymbol
sharpSymbol = Symbol -> ExtendedSymbol
Symbol Symbol
sharp
calcEfficientLALRParseTable :: CFG
-> ([Items], [ProductionRule], [(Int, ExtendedSymbol, Action)],
[(Int, Symbol, Int)], ())
calcEfficientLALRParseTable CFG
augCfg =
([Items]
lr1items, [ProductionRule]
prules, [(Int, ExtendedSymbol, Action)]
actionTable, [(Int, Symbol, Int)]
gotoTable, ())
where
CFG String
_S' [ProductionRule]
prules = CFG
augCfg
lr0items :: [Items]
lr0items = CFG -> [Items]
calcLR0Items CFG
augCfg
lr0kernelitems :: [Items]
lr0kernelitems = (Items -> Items) -> [Items] -> [Items]
forall a b. (a -> b) -> [a] -> [b]
map ((Item -> Bool) -> Items -> Items
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> Item -> Bool
isKernel (CFG -> String
startNonterminal CFG
augCfg))) [Items]
lr0items
syms :: [Symbol]
syms = [Symbol] -> [Symbol] -> [Symbol]
forall a. Eq a => [a] -> [a] -> [a]
(\\) (CFG -> [Symbol]
symbols CFG
augCfg) [String -> Symbol
Nonterminal String
_S']
terminalSyms :: [Symbol]
terminalSyms = [String -> Symbol
Terminal String
x | Terminal String
x <- [Symbol]
syms]
nonterminalSyms :: [Symbol]
nonterminalSyms = [String -> Symbol
Nonterminal String
x | Nonterminal String
x <- [Symbol]
syms]
lr0GotoTable :: [(Int, Symbol, Int)]
lr0GotoTable = CFG -> [Items] -> [(Int, Symbol, Int)]
calcLr0GotoTable CFG
augCfg [Items]
lr0items
splk :: [(Item, Int, [ExtendedSymbol])]
splk = (ProductionRule -> Int -> [ExtendedSymbol] -> Item
Item ([ProductionRule] -> ProductionRule
forall a. [a] -> a
head [ProductionRule]
prules) Int
0 [], Int
0, [ExtendedSymbol
EndOfSymbol]) (Item, Int, [ExtendedSymbol])
-> [(Item, Int, [ExtendedSymbol])]
-> [(Item, Int, [ExtendedSymbol])]
forall a. a -> [a] -> [a]
: (((Item, Int, [ExtendedSymbol], (Int, Int, Item, Items, Item, Item))
-> (Item, Int, [ExtendedSymbol]))
-> [(Item, Int, [ExtendedSymbol],
(Int, Int, Item, Items, Item, Item))]
-> [(Item, Int, [ExtendedSymbol])]
forall a b. (a -> b) -> [a] -> [b]
map (\(Item
a1,Int
a2,[ExtendedSymbol]
a3,(Int, Int, Item, Items, Item, Item)
a4)->(Item
a1,Int
a2,[ExtendedSymbol]
a3)) [(Item, Int, [ExtendedSymbol],
(Int, Int, Item, Items, Item, Item))]
splk')
splk' :: [(Item, Int, [ExtendedSymbol],
(Int, Int, Item, Items, Item, Item))]
splk' = CFG
-> [Items]
-> [(Int, Symbol, Int)]
-> [(Item, Int, [ExtendedSymbol],
(Int, Int, Item, Items, Item, Item))]
forall a.
(Num a, Enum a, Eq a) =>
CFG
-> [Items]
-> [(a, Symbol, Int)]
-> [(Item, Int, [ExtendedSymbol],
(a, Int, Item, Items, Item, Item))]
calcSplk CFG
augCfg [Items]
lr0kernelitems [(Int, Symbol, Int)]
lr0GotoTable
splk'' :: [(Int, Int, Item, Items, Item, Item)]
splk'' = ((Item, Int, [ExtendedSymbol], (Int, Int, Item, Items, Item, Item))
-> (Int, Int, Item, Items, Item, Item))
-> [(Item, Int, [ExtendedSymbol],
(Int, Int, Item, Items, Item, Item))]
-> [(Int, Int, Item, Items, Item, Item)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Item
a1,Int
a2,[ExtendedSymbol]
a3,(Int, Int, Item, Items, Item, Item)
a4)->(Int, Int, Item, Items, Item, Item)
a4) [(Item, Int, [ExtendedSymbol],
(Int, Int, Item, Items, Item, Item))]
splk'
prop :: [(Item, Int, Item, Int)]
prop = CFG -> [Items] -> [(Int, Symbol, Int)] -> [(Item, Int, Item, Int)]
forall b.
(Num b, Enum b, Eq b) =>
CFG -> [Items] -> [(b, Symbol, Int)] -> [(Item, b, Item, Int)]
calcProp CFG
augCfg [Items]
lr0kernelitems [(Int, Symbol, Int)]
lr0GotoTable
lr1kernelitems :: [Items]
lr1kernelitems = [(Item, Int, [ExtendedSymbol])]
-> [(Item, Int, Item, Int)] -> [Items] -> [Items]
computeLookaheads [(Item, Int, [ExtendedSymbol])]
splk [(Item, Int, Item, Int)]
prop [Items]
lr0kernelitems
lr1items :: [Items]
lr1items = (Items -> Items) -> [Items] -> [Items]
forall a b. (a -> b) -> [a] -> [b]
map (CFG -> Items -> Items
closure CFG
augCfg) [Items]
lr1kernelitems
([(Int, ExtendedSymbol, Action)]
actionTable, [(Int, Symbol, Int)]
gotoTable) = CFG
-> [Items]
-> ([(Int, ExtendedSymbol, Action)], [(Int, Symbol, Int)])
calcEfficientLALRActionGotoTable CFG
augCfg [Items]
lr1items
calcLr0GotoTable :: CFG -> [Items] -> [(Int, Symbol, Int)]
calcLr0GotoTable CFG
augCfg [Items]
lr0items =
[(Int, Symbol, Int)] -> [(Int, Symbol, Int)]
forall a. Eq a => [a] -> [a]
nub [ (Int
from, Symbol
h, Int
to)
| Items
item1 <- [Items]
lr0items
, Item (ProductionRule String
y [Symbol]
ys) Int
j [ExtendedSymbol]
lookahead <- Items
item1
, let from :: Int
from = String -> [Items] -> Items -> Int
indexItem String
"lr0GotoTable(from)" [Items]
lr0items Items
item1
, let ri :: Int
ri = CFG -> ProductionRule -> Int
indexPrule CFG
augCfg (String -> [Symbol] -> ProductionRule
ProductionRule String
y [Symbol]
ys)
, let ys' :: [Symbol]
ys' = Int -> [Symbol] -> [Symbol]
forall a. Int -> [a] -> [a]
drop Int
j [Symbol]
ys
, let h :: Symbol
h = [Symbol] -> Symbol
forall a. [a] -> a
head [Symbol]
ys'
, let to :: Int
to = String -> [Items] -> Items -> Int
indexItem String
"lr0GotoTable(to)" [Items]
lr0items (CFG -> Items -> Symbol -> Items
goto CFG
augCfg Items
item1 Symbol
h)
, [Symbol]
ys' [Symbol] -> [Symbol] -> Bool
forall a. Eq a => a -> a -> Bool
/= []
]
calcSplk :: CFG
-> [Items]
-> [(a, Symbol, Int)]
-> [(Item, Int, [ExtendedSymbol],
(a, Int, Item, Items, Item, Item))]
calcSplk CFG
augCfg [Items]
lr0kernelitems [(a, Symbol, Int)]
lr0GotoTable =
[ (ProductionRule -> Int -> [ExtendedSymbol] -> Item
Item ProductionRule
prule2 Int
dot2 [], Int
toIndex, [ExtendedSymbol]
lookahead1, (a
fromIndex, Int
toIndex, Item
item0, Items
lr1items, Item
item1, Item
item2))
| (a
fromIndex, Items
lr0kernelitem) <- [a] -> [Items] -> [(a, Items)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a
0..] [Items]
lr0kernelitems
, item0 :: Item
item0@(Item ProductionRule
prule0 Int
dot0 [ExtendedSymbol]
_) <- Items
lr0kernelitem
, let lr1items :: Items
lr1items = CFG -> Items -> Items
closure CFG
augCfg [ProductionRule -> Int -> [ExtendedSymbol] -> Item
Item ProductionRule
prule0 Int
dot0 [ExtendedSymbol
sharpSymbol]]
, item1 :: Item
item1@(Item prule1 :: ProductionRule
prule1@(ProductionRule String
lhs [Symbol]
rhs) Int
dot1 [ExtendedSymbol]
lookahead1) <- Items
lr1items
, [ExtendedSymbol]
lookahead1 [ExtendedSymbol] -> [ExtendedSymbol] -> Bool
forall a. Eq a => a -> a -> Bool
/= [ExtendedSymbol
sharpSymbol]
, let therestrhs :: [Symbol]
therestrhs = Int -> [Symbol] -> [Symbol]
forall a. Int -> [a] -> [a]
drop Int
dot1 [Symbol]
rhs
, [Symbol]
therestrhs [Symbol] -> [Symbol] -> Bool
forall a. Eq a => a -> a -> Bool
/= []
, let symbolx :: Symbol
symbolx = [Symbol] -> Symbol
forall a. [a] -> a
head [Symbol]
therestrhs
, let toIndexes :: [Int]
toIndexes = [Int
t | (a
f,Symbol
x,Int
t) <- [(a, Symbol, Int)]
lr0GotoTable, a
fa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
fromIndex, Symbol
xSymbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
==Symbol
symbolx ]
, [Int]
toIndexes [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
/= []
, let toIndex :: Int
toIndex = [Int] -> Int
forall a. [a] -> a
head [Int]
toIndexes
, let gotoIX :: Items
gotoIX = [Items]
lr0kernelitems [Items] -> Int -> Items
forall a. [a] -> Int -> a
!! Int
toIndex
, item2 :: Item
item2@(Item ProductionRule
prule2 Int
dot2 [ExtendedSymbol]
lookahead2) <- Items
gotoIX
, ProductionRule
prule1 ProductionRule -> ProductionRule -> Bool
forall a. Eq a => a -> a -> Bool
== ProductionRule
prule2
]
calcProp :: CFG -> [Items] -> [(b, Symbol, Int)] -> [(Item, b, Item, Int)]
calcProp CFG
augCfg [Items]
lr0kernelitems [(b, Symbol, Int)]
lr0GotoTable =
[ (ProductionRule -> Int -> [ExtendedSymbol] -> Item
Item ProductionRule
prule0 Int
dot0 [], b
fromIndex, ProductionRule -> Int -> [ExtendedSymbol] -> Item
Item ProductionRule
prule2 Int
dot2 [], Int
toIndex)
| (b
fromIndex, Items
lr0kernelitem) <- [b] -> [Items] -> [(b, Items)]
forall a b. [a] -> [b] -> [(a, b)]
zip [b
0..] [Items]
lr0kernelitems
, Item ProductionRule
prule0 Int
dot0 [ExtendedSymbol]
_ <- Items
lr0kernelitem
, let lr1items :: Items
lr1items = CFG -> Items -> Items
closure CFG
augCfg [ProductionRule -> Int -> [ExtendedSymbol] -> Item
Item ProductionRule
prule0 Int
dot0 [ExtendedSymbol
sharpSymbol]]
, Item prule1 :: ProductionRule
prule1@(ProductionRule String
lhs [Symbol]
rhs) Int
dot1 [ExtendedSymbol]
lookahead1 <- Items
lr1items
, [ExtendedSymbol]
lookahead1 [ExtendedSymbol] -> [ExtendedSymbol] -> Bool
forall a. Eq a => a -> a -> Bool
== [ExtendedSymbol
sharpSymbol]
, let therestrhs :: [Symbol]
therestrhs = Int -> [Symbol] -> [Symbol]
forall a. Int -> [a] -> [a]
drop Int
dot1 [Symbol]
rhs
, [Symbol]
therestrhs [Symbol] -> [Symbol] -> Bool
forall a. Eq a => a -> a -> Bool
/= []
, let symbolx :: Symbol
symbolx = [Symbol] -> Symbol
forall a. [a] -> a
head [Symbol]
therestrhs
, let toIndexes :: [Int]
toIndexes = [Int
t | (b
f,Symbol
x,Int
t) <- [(b, Symbol, Int)]
lr0GotoTable, b
fb -> b -> Bool
forall a. Eq a => a -> a -> Bool
==b
fromIndex, Symbol
xSymbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
==Symbol
symbolx ]
, [Int]
toIndexes [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
/= []
, let toIndex :: Int
toIndex = [Int] -> Int
forall a. [a] -> a
head [Int]
toIndexes
, let gotoIX :: Items
gotoIX = [Items]
lr0kernelitems [Items] -> Int -> Items
forall a. [a] -> Int -> a
!! Int
toIndex
, Item ProductionRule
prule2 Int
dot2 [ExtendedSymbol]
lookahead2 <- Items
gotoIX
, ProductionRule
prule1 ProductionRule -> ProductionRule -> Bool
forall a. Eq a => a -> a -> Bool
== ProductionRule
prule2
]
calcEfficientLALRActionGotoTable :: CFG
-> [Items]
-> ([(Int, ExtendedSymbol, Action)], [(Int, Symbol, Int)])
calcEfficientLALRActionGotoTable CFG
augCfg [Items]
items = ([(Int, ExtendedSymbol, Action)]
actionTable, [(Int, Symbol, Int)]
gotoTable)
where
CFG String
_S' [ProductionRule]
prules = CFG
augCfg
f :: [(ActionTable,GotoTable)] -> (ActionTable, GotoTable)
f :: [([(Int, ExtendedSymbol, Action)], [(Int, Symbol, Int)])]
-> ([(Int, ExtendedSymbol, Action)], [(Int, Symbol, Int)])
f [([(Int, ExtendedSymbol, Action)], [(Int, Symbol, Int)])]
l = case [([(Int, ExtendedSymbol, Action)], [(Int, Symbol, Int)])]
-> ([[(Int, ExtendedSymbol, Action)]], [[(Int, Symbol, Int)]])
forall a b. [(a, b)] -> ([a], [b])
unzip [([(Int, ExtendedSymbol, Action)], [(Int, Symbol, Int)])]
l of ([[(Int, ExtendedSymbol, Action)]]
fst,[[(Int, Symbol, Int)]]
snd) -> ([(Int, ExtendedSymbol, Action)]
-> [(Int, ExtendedSymbol, Action)]
-> [(Int, ExtendedSymbol, Action)]
forall a b c.
(Show a, Show b, Show c, Eq a, Eq b, Eq c) =>
[(a, b, c)] -> [(a, b, c)] -> [(a, b, c)]
g [] ([[(Int, ExtendedSymbol, Action)]]
-> [(Int, ExtendedSymbol, Action)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Int, ExtendedSymbol, Action)]]
fst), [(Int, Symbol, Int)]
-> [(Int, Symbol, Int)] -> [(Int, Symbol, Int)]
h [] ([[(Int, Symbol, Int)]] -> [(Int, Symbol, Int)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Int, Symbol, Int)]]
snd))
g :: [(a, b, c)] -> [(a, b, c)] -> [(a, b, c)]
g [(a, b, c)]
actTbl [] = [(a, b, c)]
actTbl
g [(a, b, c)]
actTbl ((a
i,b
x,c
a):[(a, b, c)]
triples) =
let bs :: [Bool]
bs = [c
a' c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== c
a | (a
i',b
x',c
a') <- [(a, b, c)]
actTbl, a
i' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
i Bool -> Bool -> Bool
&& b
x' b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
x ] in
if [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then [(a, b, c)] -> [(a, b, c)] -> [(a, b, c)]
g ([(a, b, c)]
actTbl [(a, b, c)] -> [(a, b, c)] -> [(a, b, c)]
forall a. [a] -> [a] -> [a]
++ [(a
i,b
x,c
a)]) [(a, b, c)]
triples
else if [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
bs
then [(a, b, c)] -> [(a, b, c)] -> [(a, b, c)]
g [(a, b, c)]
actTbl [(a, b, c)]
triples
else String -> [(a, b, c)]
forall a. HasCallStack => String -> a
error (String
"Conflict: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ (a, b, c) -> String
forall a. Show a => a -> String
show (a
i,b
x,c
a)
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(a, b, c)] -> String
forall a. Show a => a -> String
show [(a, b, c)]
actTbl)
h :: GotoTable -> GotoTable -> GotoTable
h :: [(Int, Symbol, Int)]
-> [(Int, Symbol, Int)] -> [(Int, Symbol, Int)]
h [(Int, Symbol, Int)]
gtTbl [] = [(Int, Symbol, Int)]
gtTbl
h [(Int, Symbol, Int)]
gtTbl ((Int
i,Symbol
x,Int
j):[(Int, Symbol, Int)]
triples) =
let bs :: [Bool]
bs = [Int
j' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j | (Int
i',Symbol
x',Int
j') <- [(Int, Symbol, Int)]
gtTbl, Int
i' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i Bool -> Bool -> Bool
&& Symbol
x' Symbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
== Symbol
x ] in
if [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then [(Int, Symbol, Int)]
-> [(Int, Symbol, Int)] -> [(Int, Symbol, Int)]
h ([(Int, Symbol, Int)]
gtTbl [(Int, Symbol, Int)]
-> [(Int, Symbol, Int)] -> [(Int, Symbol, Int)]
forall a. [a] -> [a] -> [a]
++ [(Int
i,Symbol
x,Int
j)]) [(Int, Symbol, Int)]
triples
else if [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
bs
then [(Int, Symbol, Int)]
-> [(Int, Symbol, Int)] -> [(Int, Symbol, Int)]
h [(Int, Symbol, Int)]
gtTbl [(Int, Symbol, Int)]
triples
else String -> [(Int, Symbol, Int)]
forall a. HasCallStack => String -> a
error (String
"Conflict: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Symbol, Int) -> String
forall a. Show a => a -> String
show (Int
i,Symbol
x,Int
j)
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(Int, Symbol, Int)] -> String
forall a. Show a => a -> String
show [(Int, Symbol, Int)]
gtTbl)
mkLr0 :: Item -> Item
mkLr0 (Item ProductionRule
prule Int
dot [ExtendedSymbol]
_) = ProductionRule -> Int -> [ExtendedSymbol] -> Item
Item ProductionRule
prule Int
dot []
itemsInLr0 :: [Items]
itemsInLr0 = (Items -> Items) -> [Items] -> [Items]
forall a b. (a -> b) -> [a] -> [b]
map (Items -> Items
forall a. Eq a => [a] -> [a]
nub (Items -> Items) -> (Items -> Items) -> Items -> Items
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Item -> Item) -> Items -> Items
forall a b. (a -> b) -> [a] -> [b]
map Item -> Item
mkLr0) [Items]
items
([(Int, ExtendedSymbol, Action)]
actionTable, [(Int, Symbol, Int)]
gotoTable) = [([(Int, ExtendedSymbol, Action)], [(Int, Symbol, Int)])]
-> ([(Int, ExtendedSymbol, Action)], [(Int, Symbol, Int)])
f
[ if [Symbol]
ys' [Symbol] -> [Symbol] -> Bool
forall a. Eq a => a -> a -> Bool
== []
then if String
y String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
_S' Bool -> Bool -> Bool
&& ExtendedSymbol
a ExtendedSymbol -> ExtendedSymbol -> Bool
forall a. Eq a => a -> a -> Bool
== ExtendedSymbol
EndOfSymbol
then ([(Int
from, ExtendedSymbol
a, Action
Accept) ], [])
else ([(Int
from, ExtendedSymbol
a, Int -> Action
Reduce Int
ri)], [])
else if Symbol -> Bool
isTerminal Symbol
h
then ([(Int
from, Symbol -> ExtendedSymbol
Symbol Symbol
h, Int -> Action
Shift Int
to) ], [])
else ([] , [(Int
from, Symbol
h, Int
to)])
| (Int
from,Items
item1) <- [Int] -> [Items] -> [(Int, Items)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Items]
items
, Item (ProductionRule String
y [Symbol]
ys) Int
j [ExtendedSymbol
a] <- Items
item1
, let ri :: Int
ri = CFG -> ProductionRule -> Int
indexPrule CFG
augCfg (String -> [Symbol] -> ProductionRule
ProductionRule String
y [Symbol]
ys)
, let ys' :: [Symbol]
ys' = Int -> [Symbol] -> [Symbol]
forall a. Int -> [a] -> [a]
drop Int
j [Symbol]
ys
, let h :: Symbol
h = [Symbol] -> Symbol
forall a. [a] -> a
head [Symbol]
ys'
, let to :: Int
to = String -> [Items] -> Items -> Int
indexItem String
"lr1ActionGotoTable(to)" [Items]
itemsInLr0 (CFG -> Items -> Symbol -> Items
goto CFG
augCfg (Items -> Items
forall a. Eq a => [a] -> [a]
nub (Items -> Items) -> Items -> Items
forall a b. (a -> b) -> a -> b
$ (Item -> Item) -> Items -> Items
forall a b. (a -> b) -> [a] -> [b]
map Item -> Item
mkLr0 Items
item1) Symbol
h)
]
type Lookahead = [ExtendedSymbol]
type SpontaneousLookahead = [(Item, Int, Lookahead)]
type PropagateLookahead = [(Item, Int, Item, Int)]
computeLookaheads :: SpontaneousLookahead -> PropagateLookahead -> Itemss -> Itemss
computeLookaheads :: [(Item, Int, [ExtendedSymbol])]
-> [(Item, Int, Item, Int)] -> [Items] -> [Items]
computeLookaheads [(Item, Int, [ExtendedSymbol])]
splk [(Item, Int, Item, Int)]
prlk [Items]
lr0kernelitemss = [Items]
lr1kernelitemss
where
lr1kernelitemss :: [Items]
lr1kernelitemss =
[ [Items] -> Items
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ if [[ExtendedSymbol]]
lookaheads [[ExtendedSymbol]] -> [[ExtendedSymbol]] -> Bool
forall a. Eq a => a -> a -> Bool
== [] then [ProductionRule -> Int -> [ExtendedSymbol] -> Item
Item ProductionRule
prule Int
dot []]
else [ ProductionRule -> Int -> [ExtendedSymbol] -> Item
Item ProductionRule
prule Int
dot [ExtendedSymbol]
lookahead | [ExtendedSymbol]
lookahead <- [[ExtendedSymbol]]
lookaheads ]
| (Item ProductionRule
prule Int
dot [ExtendedSymbol]
_, [[ExtendedSymbol]]
lookaheads) <- [(Item, [[ExtendedSymbol]])]
itemlks ]
| [(Item, [[ExtendedSymbol]])]
itemlks <- [[(Item, [[ExtendedSymbol]])]]
lr1kernelitemlkss ]
initLr1kernelitemlkss :: [(Int, [(Item, [[ExtendedSymbol]])])]
initLr1kernelitemlkss = [(Int, Items)] -> [(Int, [(Item, [[ExtendedSymbol]])])]
init ([Int] -> [Items] -> [(Int, Items)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Items]
lr0kernelitemss)
lr1kernelitemlkss :: [[(Item, [[ExtendedSymbol]])]]
lr1kernelitemlkss = ([Int], [[(Item, [[ExtendedSymbol]])]])
-> [[(Item, [[ExtendedSymbol]])]]
forall a b. (a, b) -> b
snd ([(Int, [(Item, [[ExtendedSymbol]])])]
-> ([Int], [[(Item, [[ExtendedSymbol]])]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Int, [(Item, [[ExtendedSymbol]])])]
-> [(Int, [(Item, [[ExtendedSymbol]])])]
forall a. Eq a => [(Int, [(Item, [a])])] -> [(Int, [(Item, [a])])]
prop [(Int, [(Item, [[ExtendedSymbol]])])]
initLr1kernelitemlkss))
init :: [(Int, Items)] -> [(Int, [(Item, [[ExtendedSymbol]])])]
init [] = []
init ((Int
index,Items
items):[(Int, Items)]
iitemss) = (Int
index, Int -> Items -> [(Item, [[ExtendedSymbol]])]
init' Int
index Items
items) (Int, [(Item, [[ExtendedSymbol]])])
-> [(Int, [(Item, [[ExtendedSymbol]])])]
-> [(Int, [(Item, [[ExtendedSymbol]])])]
forall a. a -> [a] -> [a]
: [(Int, Items)] -> [(Int, [(Item, [[ExtendedSymbol]])])]
init [(Int, Items)]
iitemss
init' :: Int -> Items -> [(Item, [[ExtendedSymbol]])]
init' Int
index [] = []
init' Int
index (Item
item:Items
items) = (Item
item, Int
-> Item
-> [[ExtendedSymbol]]
-> [(Item, Int, [ExtendedSymbol])]
-> [[ExtendedSymbol]]
forall t t a. (Eq t, Eq t) => t -> t -> [a] -> [(t, t, a)] -> [a]
init'' Int
index Item
item [] [(Item, Int, [ExtendedSymbol])]
splk ) (Item, [[ExtendedSymbol]])
-> [(Item, [[ExtendedSymbol]])] -> [(Item, [[ExtendedSymbol]])]
forall a. a -> [a] -> [a]
: Int -> Items -> [(Item, [[ExtendedSymbol]])]
init' Int
index Items
items
init'' :: t -> t -> [a] -> [(t, t, a)] -> [a]
init'' t
index t
itembase [a]
lookaheads [] = [a]
lookaheads
init'' t
index t
itembase [a]
lookaheads ((t
splkitem,t
loc,a
lookahead):[(t, t, a)]
splkitems) =
if t
index t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
loc Bool -> Bool -> Bool
&& t
itembase t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
splkitem
then t -> t -> [a] -> [(t, t, a)] -> [a]
init'' t
index t
itembase ([a]
lookaheads [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
lookahead]) [(t, t, a)]
splkitems
else t -> t -> [a] -> [(t, t, a)] -> [a]
init'' t
index t
itembase [a]
lookaheads [(t, t, a)]
splkitems
prop :: [(Int, [(Item, [a])])] -> [(Int, [(Item, [a])])]
prop [(Int, [(Item, [a])])]
ilr1kernelitemlkss =
let itemToLks :: [(Item, Int, [a])]
itemToLks = [(Int, [(Item, [a])])]
-> [(Item, Int, Item, Int)] -> [(Item, Int, [a])]
forall b a a b.
Eq b =>
[(b, [(Item, [a])])] -> [(Item, b, a, b)] -> [(a, b, [a])]
collect [(Int, [(Item, [a])])]
ilr1kernelitemlkss [(Item, Int, Item, Int)]
prlk
(Bool
changed, [(Int, [(Item, [a])])]
ilr1kernelitemlkss') =
[(Int, [(Item, [a])])]
-> [(Item, Int, [a])] -> (Bool, [(Int, [(Item, [a])])])
forall a a.
(Eq a, Eq a) =>
[(a, [(Item, [a])])]
-> [(Item, a, [a])] -> (Bool, [(a, [(Item, [a])])])
copy [(Int, [(Item, [a])])]
ilr1kernelitemlkss [(Item, Int, [a])]
itemToLks
in if Bool
changed then [(Int, [(Item, [a])])] -> [(Int, [(Item, [a])])]
prop [(Int, [(Item, [a])])]
ilr1kernelitemlkss'
else [(Int, [(Item, [a])])]
ilr1kernelitemlkss
collect :: [(b, [(Item, [a])])] -> [(Item, b, a, b)] -> [(a, b, [a])]
collect [(b, [(Item, [a])])]
ilr1kernelitemlkss [] = []
collect [(b, [(Item, [a])])]
ilr1kernelitemlkss ((Item, b, a, b)
itemFromTo:[(Item, b, a, b)]
itemFromTos) =
let (Item
itemFrom, b
fromIndex, a
itemTo, b
toIndex) = (Item, b, a, b)
itemFromTo
lookaheads :: [a]
lookaheads = Item -> b -> [a] -> [(b, [(Item, [a])])] -> [a]
forall t a. Eq t => Item -> t -> [a] -> [(t, [(Item, [a])])] -> [a]
collect' Item
itemFrom b
fromIndex [] [(b, [(Item, [a])])]
ilr1kernelitemlkss
in (a
itemTo, b
toIndex, [a]
lookaheads) (a, b, [a]) -> [(a, b, [a])] -> [(a, b, [a])]
forall a. a -> [a] -> [a]
: [(b, [(Item, [a])])] -> [(Item, b, a, b)] -> [(a, b, [a])]
collect [(b, [(Item, [a])])]
ilr1kernelitemlkss [(Item, b, a, b)]
itemFromTos
collect' :: Item -> t -> [a] -> [(t, [(Item, [a])])] -> [a]
collect' Item
itemFrom t
fromIndex [a]
lookaheads [] = [a]
lookaheads
collect' Item
itemFrom t
fromIndex [a]
lookaheads ((t
index, [(Item, [a])]
iitemlks):[(t, [(Item, [a])])]
iitemlkss) =
if t
fromIndex t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
index
then Item -> t -> [a] -> [(t, [(Item, [a])])] -> [a]
collect' Item
itemFrom t
fromIndex
(Item -> [a] -> [(Item, [a])] -> [a]
forall a. Item -> [a] -> [(Item, [a])] -> [a]
collect'' Item
itemFrom [a]
lookaheads [(Item, [a])]
iitemlks) [(t, [(Item, [a])])]
iitemlkss
else Item -> t -> [a] -> [(t, [(Item, [a])])] -> [a]
collect' Item
itemFrom t
fromIndex [a]
lookaheads [(t, [(Item, [a])])]
iitemlkss
collect'' :: Item -> [a] -> [(Item, [a])] -> [a]
collect'' Item
itemFrom [a]
lookaheads [] = [a]
lookaheads
collect'' Item
itemFrom [a]
lookaheads ((Item ProductionRule
prule Int
dot [ExtendedSymbol]
_, [a]
lks):[(Item, [a])]
itemlks) =
let Item ProductionRule
pruleFrom Int
dotFrom [ExtendedSymbol]
_ = Item
itemFrom
lookaheads' :: [a]
lookaheads' = if ProductionRule
pruleFrom ProductionRule -> ProductionRule -> Bool
forall a. Eq a => a -> a -> Bool
== ProductionRule
prule Bool -> Bool -> Bool
&& Int
dotFrom Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
dot
then [a]
lks else []
in Item -> [a] -> [(Item, [a])] -> [a]
collect'' Item
itemFrom ([a]
lookaheads [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
lookaheads') [(Item, [a])]
itemlks
copy :: [(a, [(Item, [a])])]
-> [(Item, a, [a])] -> (Bool, [(a, [(Item, [a])])])
copy [(a, [(Item, [a])])]
iitemlkss [] = (Bool
False, [(a, [(Item, [a])])]
iitemlkss)
copy [(a, [(Item, [a])])]
iitemlkss ((Item, a, [a])
itemToLookahead:[(Item, a, [a])]
itemToLookaheads) =
let (Bool
changed1, [(a, [(Item, [a])])]
iitemlkss1) = [(a, [(Item, [a])])]
-> (Item, a, [a]) -> (Bool, [(a, [(Item, [a])])])
forall a a.
(Eq a, Eq a) =>
[(a, [(Item, [a])])]
-> (Item, a, [a]) -> (Bool, [(a, [(Item, [a])])])
copy' [(a, [(Item, [a])])]
iitemlkss (Item, a, [a])
itemToLookahead
(Bool
changed2, [(a, [(Item, [a])])]
iitemlkss2) = [(a, [(Item, [a])])]
-> [(Item, a, [a])] -> (Bool, [(a, [(Item, [a])])])
copy [(a, [(Item, [a])])]
iitemlkss1 [(Item, a, [a])]
itemToLookaheads
in (Bool
changed1 Bool -> Bool -> Bool
|| Bool
changed2, [(a, [(Item, [a])])]
iitemlkss2)
copy' :: [(a, [(Item, [a])])]
-> (Item, a, [a]) -> (Bool, [(a, [(Item, [a])])])
copy' [] (Item, a, [a])
itemToLookahead = (Bool
False, [])
copy' ((a
index,[(Item, [a])]
itemlks):[(a, [(Item, [a])])]
iitemlkss) (Item, a, [a])
itemToLookahead =
let (Bool
changed1, [(Item, [a])]
itemlks1) = a -> [(Item, [a])] -> (Item, a, [a]) -> (Bool, [(Item, [a])])
forall b a.
(Eq b, Eq a) =>
b -> [(Item, [a])] -> (Item, b, [a]) -> (Bool, [(Item, [a])])
copy'' a
index [(Item, [a])]
itemlks (Item, a, [a])
itemToLookahead
(Bool
changed2, [(a, [(Item, [a])])]
itemlkss2) = [(a, [(Item, [a])])]
-> (Item, a, [a]) -> (Bool, [(a, [(Item, [a])])])
copy' [(a, [(Item, [a])])]
iitemlkss (Item, a, [a])
itemToLookahead
in (Bool
changed1 Bool -> Bool -> Bool
|| Bool
changed2, (a
index,[(Item, [a])]
itemlks1)(a, [(Item, [a])]) -> [(a, [(Item, [a])])] -> [(a, [(Item, [a])])]
forall a. a -> [a] -> [a]
:[(a, [(Item, [a])])]
itemlkss2)
copy'' :: b -> [(Item, [a])] -> (Item, b, [a]) -> (Bool, [(Item, [a])])
copy'' b
index [] (Item, b, [a])
itemToLookahead = (Bool
False, [])
copy'' b
index ((Item, [a])
itemlk:[(Item, [a])]
itemlks) (Item, b, [a])
itemToLookahead =
let (Item ProductionRule
prule1 Int
dot1 [ExtendedSymbol]
_, b
toIndex, [a]
lookahead1) = (Item, b, [a])
itemToLookahead
(Item ProductionRule
prule2 Int
dot2 [ExtendedSymbol]
l2, [a]
lookahead2) = (Item, [a])
itemlk
lookahead2' :: [a]
lookahead2' =
if ProductionRule
prule1 ProductionRule -> ProductionRule -> Bool
forall a. Eq a => a -> a -> Bool
== ProductionRule
prule2 Bool -> Bool -> Bool
&& Int
dot1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
dot2
Bool -> Bool -> Bool
&& b
index b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
toIndex
Bool -> Bool -> Bool
&& [a]
lookahead1 [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
lookahead2 [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
/= []
then [a] -> [a]
forall a. Eq a => [a] -> [a]
nub ([a]
lookahead1 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
lookahead2) else [a]
lookahead2
changed1 :: Bool
changed1 = [a]
lookahead2' [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
/= [a]
lookahead2
itemlk1 :: (Item, [a])
itemlk1 = (ProductionRule -> Int -> [ExtendedSymbol] -> Item
Item ProductionRule
prule2 Int
dot2 [ExtendedSymbol]
l2, [a]
lookahead2')
(Bool
changed2, [(Item, [a])]
itemlks2) = b -> [(Item, [a])] -> (Item, b, [a]) -> (Bool, [(Item, [a])])
copy'' b
index [(Item, [a])]
itemlks (Item, b, [a])
itemToLookahead
in (Bool
changed1 Bool -> Bool -> Bool
|| Bool
changed2, (Item, [a])
itemlk1(Item, [a]) -> [(Item, [a])] -> [(Item, [a])]
forall a. a -> [a] -> [a]
:[(Item, [a])]
itemlks2)
prLkhTable :: [([(a, a, [a])], [(a, a, a, a)])] -> IO ()
prLkhTable [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
prLkhTable (([(a, a, [a])]
spontaneous, [(a, a, a, a)]
propagate):[([(a, a, [a])], [(a, a, a, a)])]
lkhTable) = do
[(a, a, [a])] -> IO ()
forall a a a. (Show a, Show a, Show a) => [(a, a, [a])] -> IO ()
prSpontaneous [(a, a, [a])]
spontaneous
[(a, a, a, a)] -> IO ()
forall a a a a.
(Show a, Show a, Show a, Show a) =>
[(a, a, a, a)] -> IO ()
prPropagate [(a, a, a, a)]
propagate
[([(a, a, [a])], [(a, a, a, a)])] -> IO ()
prLkhTable [([(a, a, [a])], [(a, a, a, a)])]
lkhTable
prSpontaneous :: [(a, a, [a])] -> IO ()
prSpontaneous [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
prSpontaneous ((a
item, a
loc, [a
lookahead]):[(a, a, [a])]
spontaneous) = do
String -> IO ()
putStr (a -> String
forall a. Show a => a -> String
show a
item String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
loc)
String -> IO ()
putStr String
", "
String -> IO ()
putStrLn (a -> String
forall a. Show a => a -> String
show a
lookahead)
[(a, a, [a])] -> IO ()
prSpontaneous [(a, a, [a])]
spontaneous
prPropagate :: [(a, a, a, a)] -> IO ()
prPropagate [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
prPropagate ((a
from, a
fromIndex, a
to, a
toIndex):[(a, a, a, a)]
propagate) = do
String -> IO ()
putStr (a -> String
forall a. Show a => a -> String
show a
from String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
fromIndex)
String -> IO ()
putStr String
" -prop-> "
String -> IO ()
putStr (a -> String
forall a. Show a => a -> String
show a
to String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
toIndex)
String -> IO ()
putStrLn String
""
[(a, a, a, a)] -> IO ()
prPropagate [(a, a, a, a)]
propagate
calcLR1ParseTable :: AUGCFG -> (Itemss, ProductionRules, ActionTable, GotoTable)
calcLR1ParseTable :: CFG
-> ([Items], [ProductionRule], [(Int, ExtendedSymbol, Action)],
[(Int, Symbol, Int)])
calcLR1ParseTable CFG
augCfg = ([Items]
items, [ProductionRule]
prules, [(Int, ExtendedSymbol, Action)]
actionTable, [(Int, Symbol, Int)]
gotoTable)
where
CFG String
_S' [ProductionRule]
prules = CFG
augCfg
items :: [Items]
items = CFG -> [Items]
calcLR1Items CFG
augCfg
([(Int, ExtendedSymbol, Action)]
actionTable, [(Int, Symbol, Int)]
gotoTable) = CFG
-> [Items]
-> ([(Int, ExtendedSymbol, Action)], [(Int, Symbol, Int)])
calcLR1ActionGotoTable CFG
augCfg [Items]
items
calcLR1ActionGotoTable :: CFG
-> [Items]
-> ([(Int, ExtendedSymbol, Action)], [(Int, Symbol, Int)])
calcLR1ActionGotoTable CFG
augCfg [Items]
items = ([(Int, ExtendedSymbol, Action)]
actionTable, [(Int, Symbol, Int)]
gotoTable)
where
CFG String
_S' [ProductionRule]
prules = CFG
augCfg
f :: [(ActionTable,GotoTable)] -> (ActionTable, GotoTable)
f :: [([(Int, ExtendedSymbol, Action)], [(Int, Symbol, Int)])]
-> ([(Int, ExtendedSymbol, Action)], [(Int, Symbol, Int)])
f [([(Int, ExtendedSymbol, Action)], [(Int, Symbol, Int)])]
l = case [([(Int, ExtendedSymbol, Action)], [(Int, Symbol, Int)])]
-> ([[(Int, ExtendedSymbol, Action)]], [[(Int, Symbol, Int)]])
forall a b. [(a, b)] -> ([a], [b])
unzip [([(Int, ExtendedSymbol, Action)], [(Int, Symbol, Int)])]
l of ([[(Int, ExtendedSymbol, Action)]]
fst,[[(Int, Symbol, Int)]]
snd) -> ([(Int, ExtendedSymbol, Action)]
-> [(Int, ExtendedSymbol, Action)]
-> [(Int, ExtendedSymbol, Action)]
forall a b c.
(Show a, Show b, Show c, Eq a, Eq b, Eq c) =>
[(a, b, c)] -> [(a, b, c)] -> [(a, b, c)]
g [] ([[(Int, ExtendedSymbol, Action)]]
-> [(Int, ExtendedSymbol, Action)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Int, ExtendedSymbol, Action)]]
fst), [(Int, Symbol, Int)]
-> [(Int, Symbol, Int)] -> [(Int, Symbol, Int)]
h [] ([[(Int, Symbol, Int)]] -> [(Int, Symbol, Int)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Int, Symbol, Int)]]
snd))
g :: [(a, b, c)] -> [(a, b, c)] -> [(a, b, c)]
g [(a, b, c)]
actTbl [] = [(a, b, c)]
actTbl
g [(a, b, c)]
actTbl ((a
i,b
x,c
a):[(a, b, c)]
triples) =
let bs :: [Bool]
bs = [c
a' c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== c
a | (a
i',b
x',c
a') <- [(a, b, c)]
actTbl, a
i' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
i Bool -> Bool -> Bool
&& b
x' b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
x ] in
if [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then [(a, b, c)] -> [(a, b, c)] -> [(a, b, c)]
g ([(a, b, c)]
actTbl [(a, b, c)] -> [(a, b, c)] -> [(a, b, c)]
forall a. [a] -> [a] -> [a]
++ [(a
i,b
x,c
a)]) [(a, b, c)]
triples
else if [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
bs
then [(a, b, c)] -> [(a, b, c)] -> [(a, b, c)]
g [(a, b, c)]
actTbl [(a, b, c)]
triples
else String -> [(a, b, c)]
forall a. HasCallStack => String -> a
error (String
"Conflict: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ (a, b, c) -> String
forall a. Show a => a -> String
show (a
i,b
x,c
a)
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(a, b, c)] -> String
forall a. Show a => a -> String
show [(a, b, c)]
actTbl)
h :: GotoTable -> GotoTable -> GotoTable
h :: [(Int, Symbol, Int)]
-> [(Int, Symbol, Int)] -> [(Int, Symbol, Int)]
h [(Int, Symbol, Int)]
gtTbl [] = [(Int, Symbol, Int)]
gtTbl
h [(Int, Symbol, Int)]
gtTbl ((Int
i,Symbol
x,Int
j):[(Int, Symbol, Int)]
triples) =
let bs :: [Bool]
bs = [Int
j' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j | (Int
i',Symbol
x',Int
j') <- [(Int, Symbol, Int)]
gtTbl, Int
i' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i Bool -> Bool -> Bool
&& Symbol
x' Symbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
== Symbol
x ] in
if [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then [(Int, Symbol, Int)]
-> [(Int, Symbol, Int)] -> [(Int, Symbol, Int)]
h ([(Int, Symbol, Int)]
gtTbl [(Int, Symbol, Int)]
-> [(Int, Symbol, Int)] -> [(Int, Symbol, Int)]
forall a. [a] -> [a] -> [a]
++ [(Int
i,Symbol
x,Int
j)]) [(Int, Symbol, Int)]
triples
else if [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
bs
then [(Int, Symbol, Int)]
-> [(Int, Symbol, Int)] -> [(Int, Symbol, Int)]
h [(Int, Symbol, Int)]
gtTbl [(Int, Symbol, Int)]
triples
else String -> [(Int, Symbol, Int)]
forall a. HasCallStack => String -> a
error (String
"Conflict: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Symbol, Int) -> String
forall a. Show a => a -> String
show (Int
i,Symbol
x,Int
j)
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(Int, Symbol, Int)] -> String
forall a. Show a => a -> String
show [(Int, Symbol, Int)]
gtTbl)
([(Int, ExtendedSymbol, Action)]
actionTable, [(Int, Symbol, Int)]
gotoTable) = [([(Int, ExtendedSymbol, Action)], [(Int, Symbol, Int)])]
-> ([(Int, ExtendedSymbol, Action)], [(Int, Symbol, Int)])
f
[ if [Symbol]
ys' [Symbol] -> [Symbol] -> Bool
forall a. Eq a => a -> a -> Bool
== []
then if String
y String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
_S'
then ([(Int
from, ExtendedSymbol
a, Action
Accept) ], [])
else ([(Int
from, ExtendedSymbol
a, Int -> Action
Reduce Int
ri)], [])
else if Symbol -> Bool
isTerminal Symbol
h
then ([(Int
from, Symbol -> ExtendedSymbol
Symbol Symbol
h, Int -> Action
Shift Int
to) ], [])
else ([] , [(Int
from, Symbol
h, Int
to)])
| Items
item1 <- [Items]
items
, Item (ProductionRule String
y [Symbol]
ys) Int
j [ExtendedSymbol
a] <- Items
item1
, let from :: Int
from = String -> [Items] -> Items -> Int
indexItem String
"lr1ActionGotoTable(from)" [Items]
items Items
item1
, let ri :: Int
ri = CFG -> ProductionRule -> Int
indexPrule CFG
augCfg (String -> [Symbol] -> ProductionRule
ProductionRule String
y [Symbol]
ys)
, let ys' :: [Symbol]
ys' = Int -> [Symbol] -> [Symbol]
forall a. Int -> [a] -> [a]
drop Int
j [Symbol]
ys
, let h :: Symbol
h = [Symbol] -> Symbol
forall a. [a] -> a
head [Symbol]
ys'
, let to :: Int
to = String -> [Items] -> Items -> Int
indexItem String
"lr1ActionGotoTable(to)" [Items]
items (CFG -> Items -> Symbol -> Items
goto CFG
augCfg Items
item1 Symbol
h)
]
prParseTable :: Handle -> ([Items], [a], [(a1, a2, a3)], [(a1, a2, a3)]) -> IO ()
prParseTable Handle
h ([Items]
items, [a]
prules, [(a1, a2, a3)]
actTbl, [(a1, a2, a3)]
gtTbl) =
do Handle -> String -> IO ()
hPutStrLn Handle
h (Int -> String
forall a. Show a => a -> String
show ([Items] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Items]
items) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" states")
Handle -> [Items] -> IO ()
prItems Handle
h [Items]
items
Handle -> String -> IO ()
hPutStrLn Handle
h String
""
Handle -> [a] -> IO ()
forall a. Show a => Handle -> [a] -> IO ()
prPrules Handle
h [a]
prules
Handle -> String -> IO ()
hPutStrLn Handle
h String
""
Handle -> [(a1, a2, a3)] -> IO ()
forall a1 a2 a3.
(Show a1, Show a2, Show a3) =>
Handle -> [(a1, a2, a3)] -> IO ()
prActTbl Handle
h [(a1, a2, a3)]
actTbl
Handle -> String -> IO ()
hPutStrLn Handle
h String
""
Handle -> [(a1, a2, a3)] -> IO ()
forall a1 a2 a3.
(Show a1, Show a2, Show a3) =>
Handle -> [(a1, a2, a3)] -> IO ()
prGtTbl Handle
h [(a1, a2, a3)]
gtTbl
prLALRParseTable :: Handle
-> ([Items], [a], [a], [(a1, a2, a3)], [(a1, a2, a3)]) -> IO ()
prLALRParseTable Handle
h ([Items]
items, [a]
prules, [a]
iss, [(a1, a2, a3)]
lalrActTbl, [(a1, a2, a3)]
lalrGtTbl) =
do Handle -> String -> IO ()
hPutStrLn Handle
h (Int -> String
forall a. Show a => a -> String
show ([Items] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Items]
items) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" states")
Handle -> [Items] -> IO ()
prItems Handle
h [Items]
items
Handle -> String -> IO ()
hPutStrLn Handle
h String
""
Handle -> [a] -> IO ()
forall a. Show a => Handle -> [a] -> IO ()
prPrules Handle
h [a]
prules
Handle -> String -> IO ()
hPutStrLn Handle
h String
""
Handle -> String -> IO ()
hPutStrLn Handle
h (Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
iss) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" states")
Handle -> [a] -> IO ()
forall a. Show a => Handle -> [a] -> IO ()
prStates Handle
h [a]
iss
Handle -> String -> IO ()
hPutStrLn Handle
h String
""
Handle -> [(a1, a2, a3)] -> IO ()
forall a1 a2 a3.
(Show a1, Show a2, Show a3) =>
Handle -> [(a1, a2, a3)] -> IO ()
prActTbl Handle
h [(a1, a2, a3)]
lalrActTbl
Handle -> String -> IO ()
hPutStrLn Handle
h String
""
Handle -> [(a1, a2, a3)] -> IO ()
forall a1 a2 a3.
(Show a1, Show a2, Show a3) =>
Handle -> [(a1, a2, a3)] -> IO ()
prGtTbl Handle
h [(a1, a2, a3)]
lalrGtTbl
prStates :: Handle -> [a] -> IO ()
prStates Handle
h [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
prStates Handle
h (a
is:[a]
iss) =
do Handle -> String -> IO ()
hPutStrLn Handle
h (a -> String
forall a. Show a => a -> String
show a
is)
Handle -> [a] -> IO ()
prStates Handle
h [a]
iss
calcLALRParseTable :: AUGCFG ->
(Itemss, ProductionRules, [[Int]], LALRActionTable
, LALRGotoTable)
calcLALRParseTable :: CFG
-> ([Items], [ProductionRule], [[Int]],
[([Int], ExtendedSymbol, LALRAction)], [([Int], Symbol, [Int])])
calcLALRParseTable CFG
augCfg = ([Items]
itemss, [ProductionRule]
prules, [[Int]]
iss, [([Int], ExtendedSymbol, LALRAction)]
lalrActTbl, [([Int], Symbol, [Int])]
lalrGtTbl)
where
([Items]
itemss, [ProductionRule]
prules, [(Int, ExtendedSymbol, Action)]
actTbl, [(Int, Symbol, Int)]
gtTbl) = CFG
-> ([Items], [ProductionRule], [(Int, ExtendedSymbol, Action)],
[(Int, Symbol, Int)])
calcLR1ParseTable CFG
augCfg
itemss' :: [Items]
itemss' = (Items -> Items -> Bool) -> [Items] -> [Items]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy Items -> Items -> Bool
eqCore [Items]
itemss
iss :: [[Int]]
iss = [ [Int
i | (Int
i, Items
items) <- [Int] -> [Items] -> [(Int, Items)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Items]
itemss, Items -> Items -> Bool
eqCore Items
items Items
items']
| Items
items' <- [Items]
itemss']
lalrActTbl :: [([Int], ExtendedSymbol, LALRAction)]
lalrActTbl = [ ([Int]
is, ExtendedSymbol
x, LALRAction
lalrAct)
| [Int]
is <- [[Int]]
iss
, let syms :: [ExtendedSymbol]
syms = [ExtendedSymbol] -> [ExtendedSymbol]
forall a. Eq a => [a] -> [a]
nub [ ExtendedSymbol
y | Int
i <- [Int]
is, (Int
j, ExtendedSymbol
y, Action
a) <- [(Int, ExtendedSymbol, Action)]
actTbl, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j ]
, ExtendedSymbol
x <- [ExtendedSymbol]
syms
, let lalrAct :: LALRAction
lalrAct = [LALRAction] -> LALRAction
actionCheck ([LALRAction] -> LALRAction) -> [LALRAction] -> LALRAction
forall a b. (a -> b) -> a -> b
$
[LALRAction] -> [LALRAction]
forall a. Eq a => [a] -> [a]
nub [ [[Int]] -> Action -> LALRAction
toLalrAction [[Int]]
iss Action
a
| Int
i <- [Int]
is
, let r :: Maybe Action
r = Int
-> ExtendedSymbol
-> [(Int, ExtendedSymbol, Action)]
-> Maybe Action
forall a b c. (Eq a, Eq b) => a -> b -> [(a, b, c)] -> Maybe c
lookupTable Int
i ExtendedSymbol
x [(Int, ExtendedSymbol, Action)]
actTbl
, Maybe Action -> Bool
forall a. Maybe a -> Bool
isJust Maybe Action
r
, let Just Action
a = Maybe Action
r ] ]
lalrGtTbl :: [([Int], Symbol, [Int])]
lalrGtTbl = [ ([Int]
is, Symbol
x, [Int]
js)
| [Int]
is <- [[Int]]
iss
, let syms :: [Symbol]
syms = [Symbol] -> [Symbol]
forall a. Eq a => [a] -> [a]
nub [ Symbol
y | Int
i <- [Int]
is, (Int
j, Symbol
y, Int
k) <- [(Int, Symbol, Int)]
gtTbl, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j]
, Symbol
x <- [Symbol]
syms
, let js :: [Int]
js = [[Int]] -> [Int]
stateCheck ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall a b. (a -> b) -> a -> b
$
[[Int]] -> [[Int]]
forall a. Eq a => [a] -> [a]
nub [ [[Int]] -> Int -> [Int]
forall t (t :: * -> *).
(Show t, Foldable t, Eq t) =>
[t t] -> t -> t t
toIs [[Int]]
iss Int
j'
| Int
i <- [Int]
is
, (Int
i', Symbol
x', Int
j') <- [(Int, Symbol, Int)]
gtTbl
, Int
iInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
i' Bool -> Bool -> Bool
&& Symbol
xSymbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
==Symbol
x' ] ]
eqCore :: Items -> Items -> Bool
eqCore :: Items -> Items -> Bool
eqCore Items
items1 Items
items2 = Items -> Items -> Bool
subsetCore Items
items1 Items
items2 Bool -> Bool -> Bool
&& Items -> Items -> Bool
subsetCore Items
items2 Items
items1
subsetCore :: Items -> Items -> Bool
subsetCore [] Items
items2 = Bool
True
subsetCore (Item
item1:Items
items1) Items
items2 = Item -> Items -> Bool
elemCore Item
item1 Items
items2 Bool -> Bool -> Bool
&& Items -> Items -> Bool
subsetCore Items
items1 Items
items2
elemCore :: Item -> Items -> Bool
elemCore (Item ProductionRule
prule1 Int
i1 [ExtendedSymbol]
a) [] = Bool
False
elemCore (Item ProductionRule
prule1 Int
i1 [ExtendedSymbol]
a) (Item ProductionRule
prule2 Int
i2 [ExtendedSymbol]
_:Items
items) =
if ProductionRule
prule1 ProductionRule -> ProductionRule -> Bool
forall a. Eq a => a -> a -> Bool
== ProductionRule
prule2 Bool -> Bool -> Bool
&& Int
i1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i2
then Bool
True else Item -> Items -> Bool
elemCore (ProductionRule -> Int -> [ExtendedSymbol] -> Item
Item ProductionRule
prule1 Int
i1 [ExtendedSymbol]
a) Items
items
toLalrAction :: [[Int]] -> Action -> LALRAction
toLalrAction :: [[Int]] -> Action -> LALRAction
toLalrAction [[Int]]
iss (Shift Int
i) = [Int] -> LALRAction
LALRShift ([[Int]] -> Int -> [Int]
forall t (t :: * -> *).
(Show t, Foldable t, Eq t) =>
[t t] -> t -> t t
toIs [[Int]]
iss Int
i)
toLalrAction [[Int]]
iss (Reduce Int
i) = Int -> LALRAction
LALRReduce Int
i
toLalrAction [[Int]]
iss (Action
Accept) = LALRAction
LALRAccept
toLalrAction [[Int]]
iss (Action
Reject) = LALRAction
LALRReject
toIs :: [t t] -> t -> t t
toIs [] t
i = String -> t t
forall a. HasCallStack => String -> a
error (String
"toIs: not found" String -> String -> String
forall a. [a] -> [a] -> [a]
++ t -> String
forall a. Show a => a -> String
show t
i)
toIs (t t
is:[t t]
iss) t
i = if t -> t t -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem t
i t t
is then t t
is else [t t] -> t -> t t
toIs [t t]
iss t
i
actionCheck :: [LALRAction] -> LALRAction
actionCheck :: [LALRAction] -> LALRAction
actionCheck [LALRAction
a] = LALRAction
a
actionCheck [LALRAction]
as = String -> LALRAction
forall a. HasCallStack => String -> a
error (String
"LALR Action Conflict: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [LALRAction] -> String
forall a. Show a => a -> String
show [LALRAction]
as)
stateCheck :: [[Int]] -> [Int]
stateCheck :: [[Int]] -> [Int]
stateCheck [[Int]
is] = [Int]
is
stateCheck [[Int]]
iss = String -> [Int]
forall a. HasCallStack => String -> a
error (String
"LALR State Conflict: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [[Int]] -> String
forall a. Show a => a -> String
show [[Int]]
iss)