-
Notifications
You must be signed in to change notification settings - Fork 84
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Split out Tabular some more but also add Main
- Loading branch information
1 parent
11e3e78
commit 4aa441a
Showing
12 changed files
with
254 additions
and
169 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,52 @@ | ||
| > module Happy.Tabular.FindRedundancies where | ||
|
|
||
| > import Happy.Grammar | ||
| > import Happy.Tabular.Tables | ||
| > import Data.Array( assocs, elems, (!) ) | ||
| > import Data.List | ||
|
|
||
| Find unused rules and tokens | ||
|
|
||
| > find_redundancies | ||
| > :: SelectReductions -> Grammar -> ActionTable -> ([Int], [String]) | ||
| > find_redundancies extract_reductions g action_table = | ||
| > (unused_rules, map (env !) unused_terminals) | ||
| > where | ||
| > Grammar { terminals = terms, | ||
| > token_names = env, | ||
| > eof_term = eof, | ||
| > starts = starts', | ||
| > productions = productions' | ||
| > } = g | ||
|
|
||
| > actions = concat (map assocs (elems action_table)) | ||
| > start_rules = [ 0 .. (length starts' - 1) ] | ||
| > used_rules = start_rules ++ | ||
| > nub [ r | (_,a) <- actions, r <- extract_reductions a ] | ||
| > used_tokens = errorTok : eof : | ||
| > nub [ t | (t,a) <- actions, is_shift a ] | ||
| > n_prods = length productions' | ||
| > unused_terminals = filter (`notElem` used_tokens) terms | ||
| > unused_rules = filter (`notElem` used_rules ) [0..n_prods-1] | ||
|
|
||
| > is_shift :: LRAction -> Bool | ||
| > is_shift (LR'Shift _ _) = True | ||
| > is_shift (LR'Multiple _ LR'Shift{}) = True | ||
| > is_shift _ = False | ||
|
|
||
| --- | ||
| selects what counts as a reduction when calculating used/unused | ||
|
|
||
| > type SelectReductions = LRAction -> [Int] | ||
|
|
||
| > select_all_reductions :: SelectReductions | ||
| > select_all_reductions = go | ||
| > where go (LR'Reduce r _) = [r] | ||
| > go (LR'Multiple as a) = concatMap go (a : as) | ||
| > go _ = [] | ||
|
|
||
| > select_first_reduction :: SelectReductions | ||
| > select_first_reduction = go | ||
| > where go (LR'Reduce r _) = [r] | ||
| > go (LR'Multiple _ a) = go a -- eg R/R conflict | ||
| > go _ = [] |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,114 @@ | ||
| module Happy.Tabular.Main ( | ||
| TabularArgs(..), TabularResult, runTabular | ||
| ) where | ||
|
|
||
| import Happy.Grammar | ||
| import Happy.Tabular.Tables | ||
| import qualified Happy.Tabular.LALR as LALR | ||
| import Happy.Tabular.FindRedundancies | ||
| import Happy.Tabular.Info | ||
| import Happy.Tabular | ||
| import Data.Array (Array) | ||
| import System.IO | ||
| import System.Exit (exitWith, ExitCode(..)) | ||
| import Control.Monad | ||
| import Data.Version (Version) | ||
|
|
||
| -------- Main entry point (runTabular) -------- | ||
|
|
||
| data TabularArgs = TabularArgs { | ||
| inFile :: String, -- printed to the info file, not used otherwise | ||
| infoFile :: Maybe String, | ||
|
|
||
| dumpLR0 :: Bool, | ||
| dumpLA :: Bool, | ||
| dumpAction :: Bool, | ||
| dumpGoto :: Bool | ||
| } | ||
|
|
||
| type TabularResult = (ActionTable, GotoTable, [LALR.Lr1State], [Int]) | ||
|
|
||
| runTabular :: Bool -> TabularArgs -> Grammar -> Version -> IO TabularResult | ||
| runTabular glr args g version = do | ||
| let select_reductions = | ||
| if glr | ||
| then select_all_reductions | ||
| else select_first_reduction | ||
|
|
||
| let tables = genTables select_reductions g | ||
| sets = lr0items tables | ||
| la = lookaheads tables | ||
| items2 = lr1items tables | ||
| goto = gotoTable tables | ||
| action = actionTable tables | ||
| (conflictArray, (sr,rr)) = conflicts tables | ||
| optPrint (dumpLR0 args) (print sets) | ||
| optPrint (dumpLA args) (print la) | ||
| optPrint (dumpAction args) (print action) | ||
| optPrint (dumpGoto args) (print goto) | ||
| reportUnusedRules tables | ||
| let (unused_rules, unused_terminals) = redundancies tables | ||
| writeInfoFile sets g action goto conflictArray (inFile args) (infoFile args) unused_rules unused_terminals version | ||
| reportConflicts g sr rr | ||
| return (action, goto, items2, unused_rules) | ||
| where | ||
| optPrint b io = when b (putStr "\n---------------------\n" >> io) | ||
|
|
||
| -------- Helpers -------- | ||
|
|
||
| reportUnusedRules :: Tables -> IO () | ||
| reportUnusedRules tables = do | ||
| let (unused_rules, unused_terminals) = redundancies tables | ||
| when (not (null unused_rules)) $ | ||
| hPutStrLn stderr ("unused rules: " ++ show (length unused_rules)) | ||
| when (not (null unused_terminals)) $ | ||
| hPutStrLn stderr ("unused terminals: " ++ show (length unused_terminals)) | ||
|
|
||
| reportConflicts :: Grammar -> Int -> Int -> IO () | ||
| reportConflicts g sr rr = case expect g of | ||
| Just n | n == sr && rr == 0 -> return () | ||
| Just _ | rr > 0 -> | ||
| die $ "The grammar has reduce/reduce conflicts.\n" ++ | ||
| "This is not allowed when an expect directive is given\n" | ||
| Just _ -> | ||
| die $ "The grammar has " ++ show sr ++ " shift/reduce conflicts.\n" ++ | ||
| "This is different from the number given in the expect directive\n" | ||
| _ -> do | ||
| if sr /= 0 | ||
| then hPutStrLn stderr ("shift/reduce conflicts: " ++ show sr) | ||
| else return () | ||
|
|
||
| if rr /= 0 | ||
| then hPutStrLn stderr ("reduce/reduce conflicts: " ++ show rr) | ||
| else return () | ||
|
|
||
| die :: String -> IO a | ||
| die s = hPutStr stderr s >> exitWith (ExitFailure 1) | ||
|
|
||
| writeInfoFile | ||
| :: [LALR.ItemSetWithGotos] | ||
| -> Grammar | ||
| -> ActionTable | ||
| -> GotoTable | ||
| -> Array Int (Int,Int) | ||
| -> String | ||
| -> Maybe String | ||
| -> [Int] | ||
| -> [String] | ||
| -> Version | ||
| -> IO () | ||
| writeInfoFile sets g action goto conflictArray file info_file unused_rules unused_terminals version = | ||
| let info = genInfoFile | ||
| (map fst sets) | ||
| g | ||
| action | ||
| goto | ||
| (token_specs g) | ||
| conflictArray | ||
| file | ||
| unused_rules | ||
| unused_terminals | ||
| version | ||
| in case info_file of | ||
| Just s -> writeFile s info >> hPutStrLn stderr ("Grammar info written to: " ++ s) | ||
| Nothing -> return () |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,24 @@ | ||
| Datatypes for goto and action tables which are consumed by happy-backend. | ||
|
|
||
| > module Happy.Tabular.Tables ( | ||
| > LRAction(..), ActionTable, Goto(..), GotoTable | ||
| > ) where | ||
|
|
||
| > import Happy.Grammar | ||
|
|
||
| > import Data.Array | ||
|
|
||
| > data LRAction = LR'Shift Int Priority -- state number and priority | ||
| > | LR'Reduce Int Priority-- rule no and priority | ||
| > | LR'Accept -- :-) | ||
| > | LR'Fail -- :-( | ||
| > | LR'MustFail -- :-( | ||
| > | LR'Multiple [LRAction] LRAction -- conflict | ||
| > deriving (Eq, Show) | ||
|
|
||
| > type ActionTable = Array Int{-state-} (Array Int{-terminal#-} LRAction) | ||
|
|
||
| > data Goto = Goto Int | NoGoto | ||
| > deriving(Eq, Show) | ||
|
|
||
| > type GotoTable = Array Int{-state-} (Array Int{-nonterminal #-} Goto) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.