Skip to content

Commit 0a7305a

Browse files
Yuta1004Yuta1004
committed
[add] 強制的に LR テーブルにマークするための関数を追加
1 parent 03e623c commit 0a7305a

File tree

5 files changed

+71
-58
lines changed

5 files changed

+71
-58
lines changed

‎lib/copager2/src/Copager2/Parse/LR/Common/Table.hs‎

Lines changed: 17 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,8 @@ module Copager2.Parse.LR.Common.Table
66
, LRTableBuilder
77
, build
88
, mark
9-
, markRow
9+
, tryMark
10+
, tryMarkRow
1011
) where
1112

1213
import Control.Monad (forM_)
@@ -76,16 +77,28 @@ mark :: (TokenSet ts, RuleSet ts rs)
7677
-> LRTableBuilder ts rs ()
7778
mark row (Just col) act = do
7879
modify $ \tables@Tables { action } ->
79-
tables { action = tryInsert (row, col) act action }
80+
tables { action = insert (row, col) act action }
8081
mark row Nothing act = do
82+
modify $ \tables@Tables { eof_action } ->
83+
tables { eof_action = insert row act eof_action }
84+
85+
tryMark :: (TokenSet ts, RuleSet ts rs)
86+
=> Int
87+
-> Maybe ts
88+
-> LRAction rs
89+
-> LRTableBuilder ts rs ()
90+
tryMark row (Just col) act = do
91+
modify $ \tables@Tables { action } ->
92+
tables { action = tryInsert (row, col) act action }
93+
tryMark row Nothing act = do
8194
modify $ \tables@Tables { eof_action } ->
8295
tables { eof_action = tryInsert row act eof_action }
8396

84-
markRow :: (TokenSet ts, RuleSet ts rs)
97+
tryMarkRow :: (TokenSet ts, RuleSet ts rs)
8598
=> Int
8699
-> LRAction rs
87100
-> LRTableBuilder ts rs ()
88-
markRow row act = do
101+
tryMarkRow row act = do
89102
modify $ \tables@Tables { action, eof_action } ->
90103
let action' = foldl
91104
(\a col -> tryInsert (row, col) act a)

‎lib/copager2/src/Copager2/Parse/LR/LALR1.hs‎

Lines changed: 13 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@ import Data.Proxy (Proxy(..))
88
import Copager2.Core.Language.Token (TokenSet)
99
import Copager2.Core.Language.Rule (RuleElem(..), RuleSet(..))
1010
import Copager2.Parse.LR.Common.Stack (Stack, mkStack)
11-
import Copager2.Parse.LR.Common.Table (LRAction(..), LRTables, LRTableBuilder, build, mark)
11+
import Copager2.Parse.LR.Common.Table (LRAction(..), LRTables, LRTableBuilder, build, mark, tryMark)
1212
import Copager2.Parse.LR.Common.LR1.DFA (LR1DFANode(..), mkDFA, contains, findAll)
1313
import Copager2.Parse.LR.Common.LR1.Item (LR1Item(..), isAcceptState, isReduceState)
1414
import Copager2.Parse.LR.Common.LALR1.DFA (convertDFA)
@@ -31,28 +31,28 @@ mkLALR1 =
3131
let lr1Dfa = mkDFA (defTop Proxy)
3232
lalr1Dfa = convertDFA lr1Dfa
3333
table = build lalr1Dfa $ \node@LR1DFANode { id } -> do
34+
-- A -> α β . [la] を含む場合，la 列に Reduce をマーク
35+
forM_ (findAll node isReduceState) $
36+
tryMarkReduce id
3437
-- S -> Top . [$] を含む場合， EOF 列に対して Accept をマーク
3538
when (contains node isAcceptState) $
3639
markAccept id
37-
-- A -> α β . [la] を含む場合，la 列に Reduce をマーク
38-
forM_ (findAll node isReduceState) $
39-
markReduce id
4040
in LALR1 { stack = mkStack, table }
4141

42-
markAccept :: (TokenSet ts, RuleSet ts rs)
43-
=> Int
44-
-> LRTableBuilder ts rs ()
45-
markAccept id = mark id Nothing Accept
46-
47-
markReduce :: (TokenSet ts, RuleSet ts rs)
42+
tryMarkReduce :: (TokenSet ts, RuleSet ts rs)
4843
=> Int
4944
-> LR1Item ts rs
5045
-> LRTableBuilder ts rs ()
51-
markReduce id LR1Item { lhs = Just lhs, rhsPre, lookahead } =
46+
tryMarkReduce id LR1Item { lhs = Just lhs, rhsPre, lookahead } =
5247
let rhsLen = length rhsPre
5348
token = case lookahead of
5449
Term t -> Just t
5550
EOF -> Nothing
5651
_ -> error "unreachable"
57-
in mark id token $ Reduce lhs rhsLen
58-
markReduce _ _ = return ()
52+
in tryMark id token $ Reduce lhs rhsLen
53+
tryMarkReduce _ _ = return ()
54+
55+
markAccept :: (TokenSet ts, RuleSet ts rs)
56+
=> Int
57+
-> LRTableBuilder ts rs ()
58+
markAccept id = mark id Nothing Accept

‎lib/copager2/src/Copager2/Parse/LR/LR0.hs‎

Lines changed: 12 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@ import Data.Proxy (Proxy(..))
88
import Copager2.Core.Language.Token (TokenSet)
99
import Copager2.Core.Language.Rule (RuleSet(..))
1010
import Copager2.Parse.LR.Common.Stack (Stack, mkStack)
11-
import Copager2.Parse.LR.Common.Table (LRAction(..), LRTables, LRTableBuilder, build, mark, markRow)
11+
import Copager2.Parse.LR.Common.Table (LRAction(..), LRTables, LRTableBuilder, build, mark, tryMarkRow)
1212
import Copager2.Parse.LR.Common.LR0.DFA (LR0DFANode(..), mkDFA, contains, findAll)
1313
import Copager2.Parse.LR.Common.LR0.Item (LR0Item(..), isAcceptState, isReduceState)
1414

@@ -29,24 +29,24 @@ mkLR0 :: (TokenSet ts, RuleSet ts rs) => LR0 ts rs
2929
mkLR0 =
3030
let dfa = mkDFA (defTop Proxy)
3131
table = build dfa $ \node@LR0DFANode { id } -> do
32+
-- A -> α β . を含む場合，全列に Reduce をマーク
33+
forM_ (findAll node isReduceState) $
34+
tryMarkReduce id
3235
-- S -> Top . を含む場合， EOF 列に対して Accept をマーク
3336
when (contains node isAcceptState) $
3437
markAccept id
35-
-- A -> α β . を含む場合，全列に Reduce をマーク
36-
forM_ (findAll node isReduceState) $
37-
markReduce id
3838
in LR0 { stack = mkStack, table }
3939

40-
markAccept :: (TokenSet ts, RuleSet ts rs)
40+
tryMarkReduce :: (TokenSet ts, RuleSet ts rs)
4141
=> Int
42+
-> LR0Item ts rs
4243
-> LRTableBuilder ts rs ()
43-
markAccept id = mark id Nothing Accept
44+
tryMarkReduce id LR0Item { lhs = Just lhs, rhsPre } =
45+
let rhsLen = length rhsPre
46+
in tryMarkRow id $ Reduce lhs rhsLen
47+
tryMarkReduce _ _ = return ()
4448

45-
markReduce :: (TokenSet ts, RuleSet ts rs)
49+
markAccept :: (TokenSet ts, RuleSet ts rs)
4650
=> Int
47-
-> LR0Item ts rs
4851
-> LRTableBuilder ts rs ()
49-
markReduce id LR0Item { lhs = Just lhs, rhsPre } =
50-
let rhsLen = length rhsPre
51-
in markRow id $ Reduce lhs rhsLen
52-
markReduce _ _ = return ()
52+
markAccept id = mark id Nothing Accept

‎lib/copager2/src/Copager2/Parse/LR/LR1.hs‎

Lines changed: 13 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@ import Data.Proxy (Proxy(..))
88
import Copager2.Core.Language.Token (TokenSet)
99
import Copager2.Core.Language.Rule (RuleElem(..), RuleSet(..))
1010
import Copager2.Parse.LR.Common.Stack (Stack, mkStack)
11-
import Copager2.Parse.LR.Common.Table (LRAction(..), LRTables, LRTableBuilder, build, mark)
11+
import Copager2.Parse.LR.Common.Table (LRAction(..), LRTables, LRTableBuilder, build, mark, tryMark)
1212
import Copager2.Parse.LR.Common.LR1.DFA (LR1DFANode(..), mkDFA, contains, findAll)
1313
import Copager2.Parse.LR.Common.LR1.Item (LR1Item(..), isAcceptState, isReduceState)
1414

@@ -29,28 +29,28 @@ mkLR1 :: (TokenSet ts, RuleSet ts rs) => LR1 ts rs
2929
mkLR1 =
3030
let dfa = mkDFA (defTop Proxy)
3131
table = build dfa $ \node@LR1DFANode { id } -> do
32+
-- A -> α β . [la] を含む場合，la 列に Reduce をマーク
33+
forM_ (findAll node isReduceState) $
34+
tryMarkReduce id
3235
-- S -> Top . [$] を含む場合， EOF 列に対して Accept をマーク
3336
when (contains node isAcceptState) $
3437
markAccept id
35-
-- A -> α β . [la] を含む場合，la 列に Reduce をマーク
36-
forM_ (findAll node isReduceState) $
37-
markReduce id
3838
in LR1 { stack = mkStack, table }
3939

40-
markAccept :: (TokenSet ts, RuleSet ts rs)
41-
=> Int
42-
-> LRTableBuilder ts rs ()
43-
markAccept id = mark id Nothing Accept
44-
45-
markReduce :: (TokenSet ts, RuleSet ts rs)
40+
tryMarkReduce :: (TokenSet ts, RuleSet ts rs)
4641
=> Int
4742
-> LR1Item ts rs
4843
-> LRTableBuilder ts rs ()
49-
markReduce id LR1Item { lhs = Just lhs, rhsPre, lookahead } =
44+
tryMarkReduce id LR1Item { lhs = Just lhs, rhsPre, lookahead } =
5045
let rhsLen = length rhsPre
5146
token = case lookahead of
5247
Term t -> Just t
5348
EOF -> Nothing
5449
_ -> error "unreachable"
55-
in mark id token $ Reduce lhs rhsLen
56-
markReduce _ _ = return ()
50+
in tryMark id token $ Reduce lhs rhsLen
51+
tryMarkReduce _ _ = return ()
52+
53+
markAccept :: (TokenSet ts, RuleSet ts rs)
54+
=> Int
55+
-> LRTableBuilder ts rs ()
56+
markAccept id = mark id Nothing Accept

‎lib/copager2/src/Copager2/Parse/LR/SLR1.hs‎

Lines changed: 16 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ import Copager2.Core.Language.Token (TokenSet)
1212
import Copager2.Core.Language.Rule (RuleElem(..), RuleSet(..))
1313
import Copager2.Parse.Common.Follow (mkFollowSet)
1414
import Copager2.Parse.LR.Common.Stack (Stack, mkStack)
15-
import Copager2.Parse.LR.Common.Table (LRAction(..), LRTables, LRTableBuilder, build, mark)
15+
import Copager2.Parse.LR.Common.Table (LRAction(..), LRTables, LRTableBuilder, build, mark, tryMark)
1616
import Copager2.Parse.LR.Common.LR0.DFA (LR0DFANode(..), mkDFA, contains, findAll)
1717
import Copager2.Parse.LR.Common.LR0.Item (LR0Item(..), isAcceptState, isReduceState)
1818

@@ -35,29 +35,29 @@ mkSLR1 =
3535
followSet = mkFollowSet topRule
3636
dfa = mkDFA topRule
3737
table = build dfa $ \node@LR0DFANode { id } -> do
38-
-- S -> Top . を含む場合， EOF 列に対して Accept をマーク
39-
when (contains node isAcceptState) $
40-
markAccept id
4138
-- A -> α β . を含む場合，Follow 列に対して Reduce をマーク
4239
forM_ (findAll node isReduceState) $ \item@LR0Item { lhs } ->
4340
forM_ (followSet ! fromJust lhs) $
44-
markReduce id item
41+
tryMarkReduce id item
42+
-- S -> Top . を含む場合， EOF 列に対して Accept をマーク
43+
when (contains node isAcceptState) $
44+
markAccept id
4545
in SLR1 { stack = mkStack, table }
4646

47-
markAccept :: (TokenSet ts, RuleSet ts rs)
48-
=> Int
49-
-> LRTableBuilder ts rs ()
50-
markAccept id = mark id Nothing Accept
51-
52-
markReduce :: (TokenSet ts, RuleSet ts rs)
47+
tryMarkReduce :: (TokenSet ts, RuleSet ts rs)
5348
=> Int
5449
-> LR0Item ts rs
5550
-> RuleElem ts rs
5651
-> LRTableBuilder ts rs ()
57-
markReduce id LR0Item { lhs = Just lhs, rhsPre } (Term term) =
52+
tryMarkReduce id LR0Item { lhs = Just lhs, rhsPre } (Term term) =
5853
let rhsLen = length rhsPre
59-
in mark id (Just term) $ Reduce lhs rhsLen
60-
markReduce id LR0Item { lhs = Just lhs, rhsPre } EOF =
54+
in tryMark id (Just term) $ Reduce lhs rhsLen
55+
tryMarkReduce id LR0Item { lhs = Just lhs, rhsPre } EOF =
6156
let rhsLen = length rhsPre
62-
in mark id Nothing $ Reduce lhs rhsLen
63-
markReduce _ _ _ = return ()
57+
in tryMark id Nothing $ Reduce lhs rhsLen
58+
tryMarkReduce _ _ _ = return ()
59+
60+
markAccept :: (TokenSet ts, RuleSet ts rs)
61+
=> Int
62+
-> LRTableBuilder ts rs ()
63+
markAccept id = mark id Nothing Accept

0 commit comments

Comments
 (0)