Skip to content

Commit

Permalink
Remove code changes
Browse files Browse the repository at this point in the history
  • Loading branch information
knothed committed Aug 30, 2021
1 parent 65e4a80 commit 16b23f4
Show file tree
Hide file tree
Showing 8 changed files with 150 additions and 94 deletions.
25 changes: 21 additions & 4 deletions packages/grammar/src/Happy/Grammar/Grammar.lhs
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,12 @@ The Grammar data type.

> data Production
> = Production Name [Name] (String,[Int]) Priority
> deriving (Show)

#ifdef DEBUG

> deriving Show

#endif

> data Grammar
> = Grammar {
Expand All @@ -53,11 +58,11 @@ The Grammar data type.
> attributetype :: String,
> lexer :: Maybe (String,String),
> error_handler :: Maybe String,
> error_sig :: ErrorHandlerType,
> hd :: Maybe String,
> tl :: Maybe String
> error_sig :: ErrorHandlerType
> }

#ifdef DEBUG

> instance Show Grammar where
> showsPrec _ (Grammar
> { productions = p
Expand All @@ -83,12 +88,24 @@ The Grammar data type.
> . showString "\neof = " . shows eof
> . showString "\n"

#endif

> data Assoc = LeftAssoc | RightAssoc | None

#ifdef DEBUG

> deriving Show

#endif

> data Priority = No | Prio Assoc Int | PrioLowest

#ifdef DEBUG

> deriving Show

#endif

> instance Eq Priority where
> No == No = True
> Prio _ i == Prio _ j = i == j
Expand Down
116 changes: 60 additions & 56 deletions packages/tabular/src/Happy/Tabular.hs
Original file line number Diff line number Diff line change
@@ -1,93 +1,84 @@
module Happy.Tabular(
mkFirst, genLR0Items, genLookaheads, genLR1States, genActionTable, genGotoTable, countConflicts,
Lr0Item(..), Lr1Item(..), Lr0State, Lr1State, LookaheadInfo,
TabularArgs(..), TabularResult, runTabular
) where
module Happy.Tabular (TabularArgs(..), Lr1State, TabularResult, runTabular) where

import Happy.Grammar.Grammar
import Happy.Tabular.NameSet (NameSet)
import Happy.Tabular.Tables
import Happy.Tabular.First
import qualified Happy.Tabular.LALR as LALR
import Happy.Tabular.LALR (Lr0Item, Lr1Item, precalcClosure0, propLookaheads, calcLookaheads, mergeLookaheadInfo)
import Happy.Tabular.LALR
import Happy.Tabular.FindRedundancies
import Happy.Tabular.Info
import Data.Set (Set)
import Data.Array (Array)
import System.IO
import System.Exit
import System.Exit hiding (die)
import Control.Monad

-------- Pure tabular functions, may be called without creating TabularArgs --------

type Lr0State = (Set Lr0Item, [(Name, Int)])
type Lr1State = ([Lr1Item], [(Name, Int)])
type LookaheadInfo = Array Int [(Lr0Item, NameSet)]

genLR0Items :: Grammar -> [Lr0State]
genLR0Items g = LALR.genLR0items g (precalcClosure0 g)

genLookaheads :: Grammar -> [Lr0State] -> ([Name] -> NameSet) -> LookaheadInfo
genLookaheads g sets first =
let (spont, prop) = propLookaheads g sets first in
calcLookaheads (length sets) spont prop

genLR1States :: LookaheadInfo -> [Lr0State] -> [Lr1State]
genLR1States = mergeLookaheadInfo

genActionTable :: Grammar -> ([Name] -> NameSet) -> [Lr1State] -> ActionTable
genActionTable = LALR.genActionTable

genGotoTable :: Grammar -> [Lr0State] -> GotoTable
genGotoTable = LALR.genGotoTable

countConflicts :: ActionTable -> (Array Int (Int, Int), (Int, Int))
countConflicts = LALR.countConflicts

-------- Main entry point (runTabular) --------

data TabularArgs = TabularArgs {
inFile :: String, -- printed to the info file, not used otherwise
infoFile :: Maybe String,
infoFile :: Maybe String

#ifdef DEBUG

,
dumpLR0 :: Bool,
dumpLA :: Bool,
dumpAction :: Bool,
dumpGoto :: Bool

#endif

}

type Lr1State = ([Lr1Item], [(Name, Int)])
type TabularResult = (ActionTable, GotoTable, [Lr1State], [Int])

runTabular :: TabularArgs -> Grammar -> IO TabularResult
runTabular args g =
let first = mkFirst g
sets = genLR0Items g
la = genLookaheads g sets first
items2 = genLR1States la sets
goto = genGotoTable g sets
action = genActionTable g first items2
(conflictArray, (sr,rr)) = (countConflicts action)
runTabular :: TabularArgs -> Bool -> Grammar -> IO TabularResult
runTabular args glr g =
let first = {-# SCC "First" #-} (mkFirst g)
closures = {-# SCC "Closures" #-} (precalcClosure0 g)
sets = {-# SCC "LR0_Sets" #-} (genLR0items g closures)
_lainfo@(spont,prop) = {-# SCC "Prop" #-} (propLookaheads g sets first)
la = {-# SCC "Calc" #-} (calcLookaheads (length sets) spont prop)
items2 = {-# SCC "Merge" #-} (mergeLookaheadInfo la sets)
goto = {-# SCC "Goto" #-} (genGotoTable g sets)
action = {-# SCC "Action" #-} (genActionTable g first items2)
(conflictArray,(sr,rr)) = {-# SCC "Conflict" #-} (countConflicts action)
in do

#ifdef DEBUG

optPrint (dumpLR0 args) (print sets)
optPrint (dumpLA args) (print la)
optPrint (dumpAction args) (print action)
optPrint (dumpGoto args) (print goto)
(unused_rules, unused_terminals) <- reportUnusedRules g action

#endif

(unused_rules, unused_terminals) <- reportUnusedRules glr g action
writeInfoFile sets g action goto conflictArray (inFile args) (infoFile args) unused_rules unused_terminals
reportConflicts g sr rr
return (action, goto, items2, unused_rules)

#ifdef DEBUG

where
optPrint b io = when b (putStr "\n---------------------\n" >> io)

#endif


-------- Helpers --------

reportUnusedRules :: Grammar -> ActionTable -> IO ([Int], [String])
reportUnusedRules g action =
let result@(unused_rules, unused_terminals) = find_redundancies first_reduction g action in do
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))
return result
reportUnusedRules :: Bool -> Grammar -> ActionTable -> IO ([Int], [String])
reportUnusedRules glr g action =
let reduction_filter = if glr then any_reduction else first_reduction
(unused_rules, unused_terminals) = find_redundancies reduction_filter g action in do
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)))
return (unused_rules, unused_terminals)

reportConflicts :: Grammar -> Int -> Int -> IO ()
reportConflicts g sr rr = case expect g of
Expand All @@ -106,14 +97,27 @@ reportConflicts g sr rr = case expect g of
if rr /= 0
then hPutStrLn stderr ("reduce/reduce conflicts: " ++ show rr)
else return ()
#if !MIN_VERSION_base(4,8,0)
where die s = hPutStr stderr s >> exitWith (ExitFailure 1)
#endif

die :: String -> IO a
die s = hPutStr stderr s >> exitWith (ExitFailure 1)

type ItemSetWithGotos = (Set Lr0Item, [(Name,Int)])
writeInfoFile :: [ItemSetWithGotos] -> Grammar -> ActionTable -> GotoTable -> Array Int (Int,Int) -> String -> Maybe String -> [Int] -> [String] -> IO ()
writeInfoFile sets g action goto conflictArray file info_file unused_rules unused_terminals =
let info = genInfoFile (map fst sets) g action goto (token_specs g) conflictArray file unused_rules unused_terminals in
case info_file of
Just s -> writeFile s info >> hPutStrLn stderr ("Grammar info written to: " ++ s)
Nothing -> return ()
Nothing -> return ()

---
--- selects what counts as a reduction when calculating used/unused

any_reduction :: LRAction -> [Int]
any_reduction (LR'Reduce r _) = [r]
any_reduction (LR'Multiple as a) = concatMap any_reduction (a : as)
any_reduction _ = []

first_reduction :: LRAction -> [Int]
first_reduction (LR'Reduce r _) = [r]
first_reduction (LR'Multiple _ a) = first_reduction a -- eg R/R conflict
first_reduction _ = []
15 changes: 1 addition & 14 deletions packages/tabular/src/Happy/Tabular/FindRedundancies.lhs
Original file line number Diff line number Diff line change
Expand Up @@ -32,17 +32,4 @@ Find unused rules and tokens
> 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

> any_reduction :: LRAction -> [Int]
> any_reduction (LR'Reduce r _) = [r]
> any_reduction (LR'Multiple as a) = concatMap any_reduction (a : as)
> any_reduction _ = []

> first_reduction :: LRAction -> [Int]
> first_reduction (LR'Reduce r _) = [r]
> first_reduction (LR'Multiple _ a) = first_reduction a -- eg R/R conflict
> first_reduction _ = []
> is_shift _ = False
15 changes: 14 additions & 1 deletion packages/tabular/src/Happy/Tabular/LALR.lhs
Original file line number Diff line number Diff line change
Expand Up @@ -36,11 +36,24 @@ Generation of LALR parsing tables.
This means rule $a$, with dot at $b$ (all starting at 0)

> data Lr0Item = Lr0 {-#UNPACK#-}!Int {-#UNPACK#-}!Int -- (rule, dot)
> deriving (Eq,Ord,Show)
> deriving (Eq,Ord

#ifdef DEBUG

> ,Show

#endif

> )

> data Lr1Item = Lr1 {-#UNPACK#-}!Int {-#UNPACK#-}!Int NameSet -- (rule, dot, lookahead)

#ifdef DEBUG

> deriving (Show)

#endif

> type RuleList = [Lr0Item]

-----------------------------------------------------------------------------
Expand Down
20 changes: 18 additions & 2 deletions packages/tabular/src/Happy/Tabular/Tables.lhs
Original file line number Diff line number Diff line change
Expand Up @@ -14,11 +14,27 @@ Datatypes for goto and action tables which are consumed by happy-backend.
> | LR'Fail -- :-(
> | LR'MustFail -- :-(
> | LR'Multiple [LRAction] LRAction -- conflict
> deriving (Eq, Show)
> deriving(Eq

#ifdef DEBUG

> ,Show

#endif

> )

> type ActionTable = Array Int{-state-} (Array Int{-terminal#-} LRAction)

> data Goto = Goto Int | NoGoto
> deriving(Eq, Show)
> deriving(Eq

#ifdef DEBUG

> ,Show

#endif

> )

> type GotoTable = Array Int{-state-} (Array Int{-nonterminal #-} Goto)
5 changes: 5 additions & 0 deletions src/AbsSyn.lhs
Original file line number Diff line number Diff line change
Expand Up @@ -47,8 +47,13 @@ Here is the abstract syntax of the language we parse.
> = PrecNone -- no user-specified precedence
> | PrecShift -- %shift
> | PrecId String -- %prec ID

#ifdef DEBUG

> deriving Show

#endif

%-----------------------------------------------------------------------------
Parser Generator Directives.

Expand Down
Loading

0 comments on commit 16b23f4

Please sign in to comment.