1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
module Optimize ( optimize )
where
import Grammar
import LR0
import Lookahead
import Haskell
import qualified SearchTree as FM
import Base
import Maybe ( fromMaybe )
optimize :: ActionTable -> ActionTable
optimize table = fmap (map opt) table
where
lookup s = applyWithDefault (FM.lookup table) [] s
opt a@(Shift _) = a
opt a@(Reduce{ goto = e })= a{ goto = fromMaybe e (peval e) }
peval e@(_, n, s) = case [ a | a <- lookup s, match e a ] of
[Reduce{ stack = Nil :> (_, n', _), goto = e' }]
-> Just (s0, n1 { pattern = compose n n' n1}, s1)
where (s0, n1, s1) = fromMaybe e' (peval e')
_ -> Nothing
match :: Edge -> Action -> Bool
match _e (Shift _) = True
match _e (Reduce{ stack = Nil })
= True
match e (Reduce{ stack = _ :> e' })
= e == e'
compose :: Symbol -> Symbol -> Symbol -> Expr
compose e p e' = Case (Tuple (argsOf e))
[(Tuple (argsOf p), pattern e')]
argsOf = map fst . quotesOf . pattern
|
