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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
module Thue.Parser (
ThueProgram(..),
ThueRule(..),
ThueState,
ThueChar(..),
ThueVersion(..),
parseThue,
parseThue2a,
tCh,
tLit,
tStr,
tLitStr,
fromThueState
) where
import Control.Applicative( some )
import Text.ParserCombinators.Parsec
data ThueProgram = ThueProgram { thueRules :: [ThueRule]
, thueInitialState :: ThueState
, thueVersion :: ThueVersion }
deriving (Show, Eq)
data ThueRule = ThueRule { original :: ThueState
, replacement :: ThueState }
deriving (Show, Eq)
type ThueState = [ThueChar]
data ThueChar = TChar { tChar :: Char }
| TLit { tChar :: Char }
deriving (Show, Eq)
data ThueVersion = Ver1 | Ver2a
deriving (Show, Eq)
parseThue :: String -> Either ParseError ThueProgram
parseThue = parse (thue Ver1) "error"
parseThue2a :: String -> Either ParseError ThueProgram
parseThue2a = parse (thue Ver2a) "error"
tCh :: Char -> ThueChar
tCh = TChar
tLit :: Char -> ThueChar
tLit = TLit
tStr :: String -> ThueState
tStr = map TChar
tLitStr :: String -> ThueState
tLitStr = map TLit
fromThueState :: ThueState -> String
fromThueState = map tChar
thue ver = do
many blankLine
rs <- many (rule ver)
separatorLine
i <- initialState ver
eof
return (ThueProgram rs i ver)
rule ver = do
o <- ruleState ver
separator
r <- state ver
eol
many blankLine
return (ThueRule o r)
blankLine = many (oneOf " \t") >> eol
separatorLine = separator >> eol
separator = string "::="
<?> "rule separator"
initialState ver = do
s <- (state ver) `sepEndBy` eol
return (concat s)
ruleState Ver2a = some ruleStatePart >>= return . concat
ruleState Ver1 = some (ruleStateChar Ver1) >>= return . tStr
ruleStatePart =
(try (some (ruleStateChar Ver2a) >>= return . tStr))
<|> quoteString
<?> "thue state"
ruleStateChar Ver2a = try escapeChar <|> (noneOf "\\\n\r\":") <|> colon <?> "state character"
ruleStateChar Ver1 = (noneOf "\n\r:") <|> colon <?> "state character"
colon = try (char ':' >> notFollowedBy (string ":=") >> return ':')
state Ver2a = many statePart >>= return . concat
state Ver1 = many (stateChar Ver1) >>= return . tStr
statePart =
(try (some (stateChar Ver2a) >>= return . tStr))
<|> quoteString
<?> "thue state"
stateChar Ver2a = (try escapeChar) <|> (noneOf "\\\n\r\"") <?> "state character"
stateChar Ver1 = (noneOf "\n\r") <?> "state character"
escapeChar = char '\\' >> charCode
charCode =
(char 'n' >> return '\n')
<|> (char '"')
<|> (char 'E' >> char 'O' >> char 'T' >> return '\EOT')
<|> (char ':')
<|> (char 'r' >> return '\r')
<|> (char '\\')
quoteString = do
char '"'
str <- some (stateChar Ver2a)
char '"'
return (tLitStr str)
eol = try (string "\r\n")
<|> try (string "\n\r")
<|> try (string "\r")
<|> try (string "\n")
<?> "end of line"
|