1----------------------------------------------------------------------------- 2Generation of LALR parsing tables. 3 4(c) 1993-1996 Andy Gill, Simon Marlow 5(c) 1997-2001 Simon Marlow 6----------------------------------------------------------------------------- 7 8> module LALR 9> (genActionTable, genGotoTable, genLR0items, precalcClosure0, 10> propLookaheads, calcLookaheads, mergeLookaheadInfo, countConflicts, 11> Lr0Item(..), Lr1Item) 12> where 13 14> import GenUtils 15> import Data.Set ( Set ) 16> import qualified Data.Set as Set hiding ( Set ) 17> import qualified NameSet 18> import NameSet ( NameSet ) 19> import Grammar 20 21> import Control.Monad (guard) 22> import Control.Monad.ST 23> import Data.Array.ST 24> import Data.Array as Array 25> import Data.List (nub,foldl',groupBy,sortBy) 26> import Data.Function (on) 27> import Data.Maybe (listToMaybe, maybeToList) 28 29> unionMap :: (Ord b) => (a -> Set b) -> Set a -> Set b 30> unionMap f = Set.foldr (Set.union . f) Set.empty 31 32> unionNameMap :: (Name -> NameSet) -> NameSet -> NameSet 33> unionNameMap f = NameSet.foldr (NameSet.union . f) NameSet.empty 34 35This means rule $a$, with dot at $b$ (all starting at 0) 36 37> data Lr0Item = Lr0 {-#UNPACK#-}!Int {-#UNPACK#-}!Int -- (rule, dot) 38> deriving (Eq,Ord 39 40#ifdef DEBUG 41 42> ,Show 43 44#endif 45 46> ) 47 48> data Lr1Item = Lr1 {-#UNPACK#-}!Int {-#UNPACK#-}!Int NameSet -- (rule, dot, lookahead) 49 50#ifdef DEBUG 51 52> deriving (Show) 53 54#endif 55 56> type RuleList = [Lr0Item] 57 58----------------------------------------------------------------------------- 59Generating the closure of a set of LR(0) items 60 61Precalculate the rule closure for each non-terminal in the grammar, 62using a memo table so that no work is repeated. 63 64> precalcClosure0 :: Grammar -> Name -> RuleList 65> precalcClosure0 g = 66> \n -> maybe [] id (lookup n info') 67> where 68> 69> info' :: [(Name, RuleList)] 70> info' = map (\(n,rules) -> (n,map (\rule -> Lr0 rule 0) (NameSet.toAscList rules))) info 71 72> info :: [(Name, NameSet)] 73> info = mkClosure (==) (\f -> map (follow f) f) 74> (map (\nt -> (nt,NameSet.fromList (lookupProdsOfName g nt))) nts) 75 76> follow :: [(Name, NameSet)] -> (Name, NameSet) -> (Name, NameSet) 77> follow f (nt,rules) = (nt, unionNameMap (followNT f) rules `NameSet.union` rules) 78 79> followNT :: [(Name, NameSet)] -> Int -> NameSet 80> followNT f rule = 81> case findRule g rule 0 of 82> Just nt | nt >= firstStartTok && nt < fst_term -> 83> maybe (error "followNT") id (lookup nt f) 84> _ -> NameSet.empty 85 86> nts = non_terminals g 87> fst_term = first_term g 88 89> closure0 :: Grammar -> (Name -> RuleList) -> Set Lr0Item -> Set Lr0Item 90> closure0 g closureOfNT set = Set.foldr addRules Set.empty set 91> where 92> fst_term = first_term g 93> addRules rule set' = Set.union (Set.fromList (rule : closureOfRule rule)) set' 94> 95> closureOfRule (Lr0 rule dot) = 96> case findRule g rule dot of 97> (Just nt) | nt >= firstStartTok && nt < fst_term 98> -> closureOfNT nt 99> _ -> [] 100 101----------------------------------------------------------------------------- 102Generating the closure of a set of LR(1) items 103 104> closure1 :: Grammar -> ([Name] -> NameSet) -> [Lr1Item] -> [Lr1Item] 105> closure1 g first set 106> = fst (mkClosure (\(_,new) _ -> null new) addItems ([],set)) 107> where 108> fst_term = first_term g 109 110> addItems :: ([Lr1Item],[Lr1Item]) -> ([Lr1Item],[Lr1Item]) 111> addItems (old_items, new_items) = (new_old_items, new_new_items) 112> where 113> new_old_items = new_items `union_items` old_items 114> new_new_items = subtract_items 115> (foldr union_items [] (map fn new_items)) 116> new_old_items 117 118> fn :: Lr1Item -> [Lr1Item] 119> fn (Lr1 rule dot as) = case drop dot lhs of 120> (b:beta) | b >= firstStartTok && b < fst_term -> 121> let terms = unionNameMap 122> (\a -> first (beta ++ [a])) as 123> in 124> [ (Lr1 rule' 0 terms) | rule' <- lookupProdsOfName g b ] 125> _ -> [] 126> where Production _name lhs _ _ = lookupProdNo g rule 127 128Subtract the first set of items from the second. 129 130> subtract_items :: [Lr1Item] -> [Lr1Item] -> [Lr1Item] 131> subtract_items items1 items2 = foldr (subtract_item items2) [] items1 132 133These utilities over item sets are crucial to performance. 134 135Stamp on overloading with judicious use of type signatures... 136 137> subtract_item :: [Lr1Item] -> Lr1Item -> [Lr1Item] -> [Lr1Item] 138> subtract_item [] i result = i : result 139> subtract_item ((Lr1 rule dot as):items) i@(Lr1 rule' dot' as') result = 140> case compare rule' rule of 141> LT -> i : result 142> GT -> carry_on 143> EQ -> case compare dot' dot of 144> LT -> i : result 145> GT -> carry_on 146> EQ -> case NameSet.difference as' as of 147> bs | NameSet.null bs -> result 148> | otherwise -> (Lr1 rule dot bs) : result 149> where 150> carry_on = subtract_item items i result 151 152Union two sets of items. 153 154> union_items :: [Lr1Item] -> [Lr1Item] -> [Lr1Item] 155> union_items is [] = is 156> union_items [] is = is 157> union_items (i@(Lr1 rule dot as):is) (i'@(Lr1 rule' dot' as'):is') = 158> case compare rule rule' of 159> LT -> drop_i 160> GT -> drop_i' 161> EQ -> case compare dot dot' of 162> LT -> drop_i 163> GT -> drop_i' 164> EQ -> (Lr1 rule dot (as `NameSet.union` as')) : union_items is is' 165> where 166> drop_i = i : union_items is (i':is') 167> drop_i' = i' : union_items (i:is) is' 168 169----------------------------------------------------------------------------- 170goto(I,X) function 171 172The input should be the closure of a set of kernel items I together with 173a token X (terminal or non-terminal. Output will be the set of kernel 174items for the set of items goto(I,X) 175 176> gotoClosure :: Grammar -> Set Lr0Item -> Name -> Set Lr0Item 177> gotoClosure gram i x = unionMap fn i 178> where 179> fn (Lr0 rule_no dot) = 180> case findRule gram rule_no dot of 181> Just t | x == t -> Set.singleton (Lr0 rule_no (dot+1)) 182> _ -> Set.empty 183 184----------------------------------------------------------------------------- 185Generating LR0 Item sets 186 187The item sets are generated in much the same way as we find the 188closure of a set of items: we use two sets, those which have already 189generated more sets, and those which have just been generated. We 190keep iterating until the second set is empty. 191 192The addItems function is complicated by the fact that we need to keep 193information about which sets were generated by which others. 194 195> type ItemSetWithGotos = (Set Lr0Item, [(Name,Int)]) 196 197> genLR0items :: Grammar -> (Name -> RuleList) -> [ItemSetWithGotos] 198> genLR0items g precalcClosures 199> = fst (mkClosure (\(_,new) _ -> null new) 200> addItems 201> (([],startRules))) 202> where 203 204> n_starts = length (starts g) 205> startRules :: [Set Lr0Item] 206> startRules = [ Set.singleton (Lr0 rule 0) | rule <- [0..n_starts] ] 207 208> tokens = non_terminals g ++ terminals g 209 210> addItems :: ([ItemSetWithGotos], [Set Lr0Item]) 211> -> ([ItemSetWithGotos], [Set Lr0Item]) 212> 213> addItems (oldSets,newSets) = (newOldSets, reverse newNewSets) 214> where 215> 216> newOldSets = oldSets ++ (zip newSets intgotos) 217 218> itemSets = map fst oldSets ++ newSets 219 220First thing to do is for each set in I in newSets, generate goto(I,X) 221for each token (terminals and nonterminals) X. 222 223> gotos :: [[(Name,Set Lr0Item)]] 224> gotos = map (filter (not . Set.null . snd)) 225> (map (\i -> let i' = closure0 g precalcClosures i in 226> [ (x,gotoClosure g i' x) | x <- tokens ]) newSets) 227 228Next, we assign each new set a number, which is the index of this set 229in the list of sets comprising all the sets generated so far plus 230those generated in this iteration. We also filter out those sets that 231are new, i.e. don't exist in the current list of sets, so that they 232can be added. 233 234We also have to make sure that there are no duplicate sets in the 235*current* batch of goto(I,X) sets, as this could be disastrous. I 236think I've squished this one with the '++ reverse newSets' in 237numberSets. 238 239numberSets is built this way so we can use it quite neatly with a foldr. 240Unfortunately, the code's a little opaque. 241 242> numberSets 243> :: [(Name,Set Lr0Item)] 244> -> (Int, 245> [[(Name,Int)]], 246> [Set Lr0Item]) 247> -> (Int, [[(Name,Int)]], [Set Lr0Item]) 248> 249> numberSets [] (i,gotos',newSets') = (i,([]:gotos'),newSets') 250> numberSets ((x,gotoix):rest) (i,g':gotos',newSets') 251> = numberSets rest 252> (case indexInto 0 gotoix (itemSets ++ reverse newSets') of 253> Just j -> (i, ((x,j):g'):gotos', newSets') 254> Nothing -> (i+1,((x,i):g'):gotos', gotoix:newSets')) 255> numberSets _ _ = error "genLR0items/numberSets: Unhandled case" 256 257Finally, do some fiddling around to get this all in the form we want. 258 259> intgotos :: [[(Name,Int)]] 260> newNewSets :: [Set Lr0Item] 261> (_, ([]:intgotos), newNewSets) = 262> foldr numberSets (length newOldSets, [[]], []) gotos 263 264> indexInto :: Eq a => Int -> a -> [a] -> Maybe Int 265> indexInto _ _ [] = Nothing 266> indexInto i x (y:ys) | x == y = Just i 267> | otherwise = let j = i + 1 in j `seq` indexInto j x ys 268 269----------------------------------------------------------------------------- 270Computing propagation of lookaheads 271 272ToDo: generate this info into an array to be used in the subsequent 273calcLookaheads pass. 274 275> propLookaheads 276> :: Grammar 277> -> [(Set Lr0Item,[(Name,Int)])] -- LR(0) kernel sets 278> -> ([Name] -> NameSet) -- First function 279> -> ( 280> [(Int, Lr0Item, NameSet)], -- spontaneous lookaheads 281> Array Int [(Lr0Item, Int, Lr0Item)] -- propagated lookaheads 282> ) 283 284> propLookaheads gram sets first = (concat s, array (0,length sets - 1) 285> [ (a,b) | (a,b) <- p ]) 286> where 287 288> (s,p) = unzip (zipWith propLASet sets [0..]) 289 290> propLASet :: (Set Lr0Item, [(Name, Int)]) -> Int -> ([(Int, Lr0Item, NameSet)],(Int,[(Lr0Item, Int, Lr0Item)])) 291> propLASet (set,goto) i = (start_spont ++ concat s', (i, concat p')) 292> where 293 294> (s',p') = unzip (map propLAItem (Set.toAscList set)) 295 296> -- spontaneous EOF lookaheads for each start state & rule... 297> start_info :: [(String, Name, Name, Bool)] 298> start_info = starts gram 299 300> start_spont :: [(Int, Lr0Item ,NameSet)] 301> start_spont = [ (start, (Lr0 start 0), 302> NameSet.singleton (startLookahead gram partial)) 303> | (start, (_,_,_,partial)) <- 304> zip [0..] start_info] 305 306> propLAItem :: Lr0Item -> ([(Int, Lr0Item, NameSet)], [(Lr0Item, Int, Lr0Item)]) 307> propLAItem item@(Lr0 rule dot) = (spontaneous, propagated) 308> where 309> lookupGoto msg x = maybe (error msg) id (lookup x goto) 310 311> j = closure1 gram first [Lr1 rule dot (NameSet.singleton dummyTok)] 312 313> spontaneous :: [(Int, Lr0Item, NameSet)] 314> spontaneous = do 315> (Lr1 rule' dot' ts) <- j 316> let ts' = NameSet.delete dummyTok ts 317> guard (not $ NameSet.null ts') 318> maybeToList $ do r <- findRule gram rule' dot' 319> return ( lookupGoto "spontaneous" r 320> , Lr0 rule' (dot' + 1) 321> , ts' ) 322 323> propagated :: [(Lr0Item, Int, Lr0Item)] 324> propagated = do 325> (Lr1 rule' dot' ts) <- j 326> guard $ NameSet.member dummyTok ts 327> maybeToList $ do r <- findRule gram rule' dot' 328> return ( item 329> , lookupGoto "propagated" r 330> , Lr0 rule' (dot' + 1) ) 331 332The lookahead for a start rule depends on whether it was declared 333with %name or %partial: a %name parser is assumed to parse the whole 334input, ending with EOF, whereas a %partial parser may parse only a 335part of the input: it accepts when the error token is found. 336 337> startLookahead :: Grammar -> Bool -> Name 338> startLookahead gram partial = if partial then errorTok else eof_term gram 339 340----------------------------------------------------------------------------- 341Calculate lookaheads 342 343Special version using a mutable array: 344 345> calcLookaheads 346> :: Int -- number of states 347> -> [(Int, Lr0Item, NameSet)] -- spontaneous lookaheads 348> -> Array Int [(Lr0Item, Int, Lr0Item)] -- propagated lookaheads 349> -> Array Int [(Lr0Item, NameSet)] 350 351> calcLookaheads n_states spont prop 352> = runST $ do 353> arr <- newArray (0,n_states) [] 354> propagate arr (fold_lookahead spont) 355> freeze arr 356 357> where 358> propagate :: STArray s Int [(Lr0Item, NameSet)] 359> -> [(Int, Lr0Item, NameSet)] -> ST s () 360> propagate _ [] = return () 361> propagate arr new = do 362> let 363> items = [ (i,item'',s) | (j,item,s) <- new, 364> (item',i,item'') <- prop ! j, 365> item == item' ] 366> new_new <- get_new arr items [] 367> add_lookaheads arr new 368> propagate arr new_new 369 370This function is needed to merge all the (set_no,item,name) triples 371into (set_no, item, set name) triples. It can be removed when we get 372the spontaneous lookaheads in the right form to begin with (ToDo). 373 374> add_lookaheads :: STArray s Int [(Lr0Item, NameSet)] 375> -> [(Int, Lr0Item, NameSet)] 376> -> ST s () 377> add_lookaheads arr = mapM_ $ \(i,item,s) 378> -> do las <- readArray arr i 379> writeArray arr i (add_lookahead item s las) 380 381> get_new :: STArray s Int [(Lr0Item, NameSet)] 382> -> [(Int, Lr0Item, NameSet)] 383> -> [(Int, Lr0Item, NameSet)] 384> -> ST s [(Int, Lr0Item, NameSet)] 385> get_new _ [] new = return new 386> get_new arr (l@(i,_item,_s):las) new = do 387> state_las <- readArray arr i 388> get_new arr las (get_new' l state_las new) 389 390> add_lookahead :: Lr0Item -> NameSet -> [(Lr0Item,NameSet)] -> 391> [(Lr0Item,NameSet)] 392> add_lookahead item s [] = [(item,s)] 393> add_lookahead item s (m@(item',s') : las) 394> | item == item' = (item, s `NameSet.union` s') : las 395> | otherwise = m : add_lookahead item s las 396 397> get_new' :: (Int,Lr0Item,NameSet) -> [(Lr0Item,NameSet)] -> 398> [(Int,Lr0Item,NameSet)] -> [(Int,Lr0Item,NameSet)] 399> get_new' l [] new = l : new 400> get_new' l@(i,item,s) ((item',s') : las) new 401> | item == item' = 402> let s'' = s NameSet.\\ s' in 403> if NameSet.null s'' then new else (i,item,s'') : new 404> | otherwise = 405> get_new' l las new 406 407> fold_lookahead :: [(Int,Lr0Item,NameSet)] -> [(Int,Lr0Item,NameSet)] 408> fold_lookahead = 409> map (\cs@(((a,b),_):_) -> (a,b,NameSet.unions $ map snd cs)) . 410> groupBy ((==) `on` fst) . 411> sortBy (compare `on` fst) . 412> map (\(a,b,c) -> ((a,b),c)) 413 414----------------------------------------------------------------------------- 415Merge lookaheads 416 417Stick the lookahead info back into the state table. 418 419> mergeLookaheadInfo 420> :: Array Int [(Lr0Item, NameSet)] -- lookahead info 421> -> [(Set Lr0Item, [(Name,Int)])] -- state table 422> -> [ ([Lr1Item], [(Name,Int)]) ] 423 424> mergeLookaheadInfo lookaheads sets 425> = zipWith mergeIntoSet sets [0..] 426> where 427 428> mergeIntoSet :: (Set Lr0Item, [(Name, Int)]) -> Int -> ([Lr1Item], [(Name, Int)]) 429> mergeIntoSet (items, goto) i 430> = (map mergeIntoItem (Set.toAscList items), goto) 431> where 432 433> mergeIntoItem :: Lr0Item -> Lr1Item 434> mergeIntoItem item@(Lr0 rule dot) = Lr1 rule dot la 435> where la = case [ s | (item',s) <- lookaheads ! i, 436> item == item' ] of 437> [] -> NameSet.empty 438> [x] -> x 439> _ -> error "mergIntoItem" 440 441----------------------------------------------------------------------------- 442Generate the goto table 443 444This is pretty straightforward, given all the information we stored 445while generating the LR0 sets of items. 446 447Generating the goto table doesn't need lookahead info. 448 449> genGotoTable :: Grammar -> [(Set Lr0Item,[(Name,Int)])] -> GotoTable 450> genGotoTable g sets = gotoTable 451> where 452> Grammar{ first_nonterm = fst_nonterm, 453> first_term = fst_term, 454> non_terminals = non_terms } = g 455> 456> -- goto array doesn't include %start symbols 457> gotoTable = listArray (0,length sets-1) 458> [ 459> (array (fst_nonterm, fst_term-1) [ 460> (n, maybe NoGoto Goto (lookup n goto)) 461> | n <- non_terms, 462> n >= fst_nonterm, n < fst_term ]) 463> | (_set,goto) <- sets ] 464 465----------------------------------------------------------------------------- 466Generate the action table 467 468> genActionTable :: Grammar -> ([Name] -> NameSet) -> 469> [([Lr1Item],[(Name,Int)])] -> ActionTable 470> genActionTable g first sets = actionTable 471> where 472> Grammar { first_term = fst_term, 473> terminals = terms, 474> starts = starts', 475> priorities = prios } = g 476 477> n_starts = length starts' 478> isStartRule rule = rule < n_starts -- a bit hacky, but it'll do for now 479 480> term_lim = (head terms,last terms) 481> actionTable = array (0,length sets-1) 482> [ (set_no, accumArray res 483> LR'Fail term_lim 484> (possActions goto set)) 485> | ((set,goto),set_no) <- zip sets [0..] ] 486 487> possAction goto _set (Lr1 rule pos la) = 488> case findRule g rule pos of 489> Just t | t >= fst_term || t == errorTok -> 490> let f j = (t,LR'Shift j p) 491> p = maybe No id (lookup t prios) 492> in map f $ maybeToList (lookup t goto) 493> Nothing 494> | isStartRule rule 495> -> let (_,_,_,partial) = starts' !! rule in 496> [ (startLookahead g partial, LR'Accept{-'-}) ] 497> | otherwise 498> -> let Production _ _ _ p = lookupProdNo g rule in 499> NameSet.toAscList la `zip` repeat (LR'Reduce rule p) 500> _ -> [] 501 502> possActions goto coll = do item <- closure1 g first coll 503> possAction goto coll item 504 505These comments are now out of date! /JS 506 507Here's how we resolve conflicts, leaving a complete record of the 508conflicting actions in an LR'Multiple structure for later output in 509the info file. 510 511Shift/reduce conflicts are always resolved as shift actions, and 512reduce/reduce conflicts are resolved as a reduce action using the rule 513with the lowest number (i.e. the rule that comes first in the grammar 514file.) 515 516NOTES on LR'MustFail: this was introduced as part of the precedence 517parsing changes. The problem with LR'Fail is that it is a soft 518failure: we sometimes substitute an LR'Fail for an LR'Reduce (eg. when 519computing default actions), on the grounds that an LR'Fail in this 520state will also be an LR'Fail in the goto state, so we'll fail 521eventually. This may not be true with precedence parsing, though. If 522there are two non-associative operators together, we must fail at this 523point rather than reducing. Hence the use of LR'MustFail. 524 525 526NOTE: on (LR'Multiple as a) handling 527 PCC [sep04] has changed this to have the following invariants: 528 * the winning action appears only once, in the "a" slot 529 * only reductions appear in the "as" list 530 * there are no duplications 531 This removes complications elsewhere, where LR'Multiples were 532 building up tree structures... 533 534> res LR'Fail x = x 535> res x LR'Fail = x 536> res LR'MustFail _ = LR'MustFail 537> res _ LR'MustFail = LR'MustFail 538> res x x' | x == x' = x 539> res (LR'Accept) _ = LR'Accept 540> res _ (LR'Accept) = LR'Accept 541 542> res (LR'Multiple as x) (LR'Multiple bs x') 543> | x == x' = LR'Multiple (nub $ as ++ bs) x 544> -- merge dropped reductions for identical action 545 546> | otherwise 547> = case res x x' of 548> LR'Multiple cs a 549> | a == x -> LR'Multiple (nub $ x' : as ++ bs ++ cs) x 550> | a == x' -> LR'Multiple (nub $ x : as ++ bs ++ cs) x' 551> | otherwise -> error "failed invariant in resolve" 552> -- last means an unexpected change 553> other -> other 554> -- merge dropped reductions for clashing actions, but only 555> -- if they were S/R or R/R 556 557> res a@(LR'Multiple _ _) b = res a (LR'Multiple [] b) 558> res a b@(LR'Multiple _ _) = res (LR'Multiple [] a) b 559> -- leave cases above to do the appropriate merging 560 561> res a@(LR'Shift {}) b@(LR'Reduce {}) = res b a 562> res a@(LR'Reduce _ p) b@(LR'Shift _ p') 563> = case (p,p') of 564> (PrioLowest,PrioLowest) -> LR'MustFail 565> (_,PrioLowest) -> a 566> (PrioLowest,_) -> b 567> (No,_) -> LR'Multiple [a] b -- shift wins 568> (_,No) -> LR'Multiple [a] b -- shift wins 569> (Prio c i, Prio _ j) 570> | i < j -> b 571> | i > j -> a 572> | otherwise -> 573> case c of 574> LeftAssoc -> a 575> RightAssoc -> b 576> None -> LR'MustFail 577> res a@(LR'Reduce r p) b@(LR'Reduce r' p') 578> = case (p,p') of 579> (PrioLowest,PrioLowest) -> 580> LR'Multiple [a] b -- give to earlier rule? 581> (_,PrioLowest) -> a 582> (PrioLowest,_) -> b 583> (No,_) -> LR'Multiple [a] b -- give to earlier rule? 584> (_,No) -> LR'Multiple [a] b 585> (Prio _ i, Prio _ j) 586> | i < j -> b 587> | j > i -> a 588> | r < r' -> LR'Multiple [b] a 589> | otherwise -> LR'Multiple [a] b 590> res _ _ = error "confict in resolve" 591 592----------------------------------------------------------------------------- 593Count the conflicts 594 595> countConflicts :: ActionTable -> (Array Int (Int,Int), (Int,Int)) 596> countConflicts action 597> = (conflictArray, foldl' (\(a,b) (c,d) -> let ac = a + c; bd = b + d in ac `seq` bd `seq` (ac,bd)) (0,0) conflictList) 598> 599> where 600> 601> conflictArray = listArray (Array.bounds action) conflictList 602> conflictList = map countConflictsState (assocs action) 603> 604> countConflictsState (_state, actions) 605> = foldr countMultiples (0,0) (elems actions) 606> where 607> countMultiples (LR'Multiple (_:_) (LR'Shift{})) (sr,rr) 608> = (sr + 1, rr) 609> countMultiples (LR'Multiple (_:_) (LR'Reduce{})) (sr,rr) 610> = (sr, rr + 1) 611> countMultiples (LR'Multiple _ _) _ 612> = error "bad conflict representation" 613> countMultiples _ c = c 614 615----------------------------------------------------------------------------- 616 617> findRule :: Grammar -> Int -> Int -> Maybe Name 618> findRule g rule dot = listToMaybe (drop dot lhs) 619> where Production _ lhs _ _ = lookupProdNo g rule 620