Skip to content

Commit ba4ed77

Browse files
paf31paf31
committed
Split up modules, port Expr module.
1 parent 581c909 commit ba4ed77

File tree

5 files changed

+228
-131
lines changed

5 files changed

+228
-131
lines changed

‎src/Text/Parsing/StringParser.purs‎

Lines changed: 2 additions & 131 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,5 @@
11
module Text.Parsing.StringParser where
2-
3-
import Data.Maybe (Maybe(..))
4-
import Data.String (charAt, length, take)
2+
53
import Data.Either (Either(..))
64

75
--
@@ -65,132 +63,5 @@ instance alternativeParser :: Alternative Parser where
6563
unParser p1 s (\_ ->
6664
unParser p2 s fc sc) sc)
6765

68-
--
69-
-- Some elementary parsers
70-
--
71-
7266
fail :: forall a. String -> Parser a
73-
fail msg = Parser (\_ fc _ -> fc (ParseError msg))
74-
75-
eof :: Parser {}
76-
eof = Parser (\s fc sc -> case s of
77-
{ str = str, pos = i } | i < length str -> fc (ParseError "Expected EOF")
78-
_ -> sc {} s)
79-
80-
anyChar :: Parser String
81-
anyChar = Parser (\s fc sc -> case s of
82-
{ str = str, pos = i } | i < length str -> sc (charAt i str) { str: str, pos: i + 1 }
83-
_ -> fc (ParseError "Unexpected EOF"))
84-
85-
foreign import indexOf'
86-
"function indexOf$prime(x) {\
87-
\ return function(startAt) {\
88-
\ return function(s) {\
89-
\ return s.indexOf(x, startAt);\
90-
\ }; \
91-
\ }; \
92-
\}" :: String -> Number -> String -> Number
93-
94-
string :: String -> Parser String
95-
string nt = Parser (\s fc sc -> case s of
96-
{ str = str, pos = i } | indexOf' nt i str == i -> sc nt { str: str, pos: i + length nt }
97-
{ pos = i } -> fc (ParseError $ "Expected '" ++ nt ++ "' at position " ++ show i ++ "."))
98-
99-
--
100-
-- Parsing Combinators
101-
--
102-
103-
many :: forall a. Parser a -> Parser [a]
104-
many p = many1 p <|> return []
105-
106-
many1 :: forall a. Parser a -> Parser [a]
107-
many1 p = do
108-
a <- p
109-
as <- many p
110-
return (a : as)
111-
112-
(<?>) :: forall a. Parser a -> String -> Parser a
113-
(<?>) p msg = p <|> fail msg
114-
115-
fix :: forall a. (Parser a -> Parser a) -> Parser a
116-
fix f = Parser (\s fc sc -> unParser (f (fix f)) s fc sc)
117-
118-
between :: forall a open close. Parser open -> Parser close -> Parser a -> Parser a
119-
between open close p = do
120-
open
121-
a <- p
122-
close
123-
return a
124-
125-
option :: forall a. a -> Parser a -> Parser a
126-
option a p = p <|> return a
127-
128-
optional :: forall a. Parser a -> Parser {}
129-
optional p = (p >>= \_ -> return {}) <|> return {}
130-
131-
optionMaybe :: forall a. Parser a -> Parser (Maybe a)
132-
optionMaybe p = option Nothing (Just <$> p)
133-
134-
sepBy :: forall a sep. Parser a -> Parser sep -> Parser [a]
135-
sepBy p sep = sepBy1 p sep <|> return []
136-
137-
sepBy1 :: forall a sep. Parser a -> Parser sep -> Parser [a]
138-
sepBy1 p sep = do
139-
a <- p
140-
as <- many $ do
141-
sep
142-
p
143-
return (a : as)
144-
145-
sepEndBy :: forall a sep. Parser a -> Parser sep -> Parser [a]
146-
sepEndBy p sep = sepEndBy1 p sep <|> return []
147-
148-
sepEndBy1 :: forall a sep. Parser a -> Parser sep -> Parser [a]
149-
sepEndBy1 p sep = do
150-
a <- p
151-
(do sep
152-
as <- sepEndBy p sep
153-
return (a : as)) <|> return [a]
154-
155-
endBy1 :: forall a sep. Parser a -> Parser sep -> Parser [a]
156-
endBy1 p sep = many1 $ do
157-
a <- p
158-
sep
159-
return a
160-
161-
endBy :: forall a sep. Parser a -> Parser sep -> Parser [a]
162-
endBy p sep = many $ do
163-
a <- p
164-
sep
165-
return a
166-
167-
chainr :: forall a. Parser a -> Parser (a -> a -> a) -> a -> Parser a
168-
chainr p f a = chainr1 p f <|> return a
169-
170-
chainl :: forall a. Parser a -> Parser (a -> a -> a) -> a -> Parser a
171-
chainl p f a = chainl1 p f <|> return a
172-
173-
chainl1 :: forall a. Parser a -> Parser (a -> a -> a) -> Parser a
174-
chainl1 p f = do
175-
a <- p
176-
chainl1' p f a
177-
178-
chainl1' :: forall a. Parser a -> Parser (a -> a -> a) -> a -> Parser a
179-
chainl1' p f a = (do f' <- f
180-
a' <- p
181-
chainl1' p f (f' a a')) <|> return a
182-
183-
chainr1 :: forall a. Parser a -> Parser (a -> a -> a) -> Parser a
184-
chainr1 p f = do
185-
a <- p
186-
chainr1' p f a
187-
188-
chainr1' :: forall a. Parser a -> Parser (a -> a -> a) -> a -> Parser a
189-
chainr1' p f a = (do f' <- f
190-
a' <- chainr1 p f
191-
return $ f' a a') <|> return a
192-
193-
choice :: forall a. [Parser a] -> Parser a
194-
choice [] = fail "Nothing to parse"
195-
choice [x] = x
196-
choice (x:xs) = x <|> choice xs
67+
fail msg = Parser (\_ fc _ -> fc (ParseError msg))

‎src/Text/Parsing/StringParser/Combinators.purs‎

Lines changed: 99 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,99 @@
1+
module Text.Parsing.StringParser.Combinators where
2+
3+
import Data.Maybe (Maybe(..))
4+
import Text.Parsing.StringParser
5+
6+
many :: forall a. Parser a -> Parser [a]
7+
many p = many1 p <|> return []
8+
9+
many1 :: forall a. Parser a -> Parser [a]
10+
many1 p = do
11+
a <- p
12+
as <- many p
13+
return (a : as)
14+
15+
(<?>) :: forall a. Parser a -> String -> Parser a
16+
(<?>) p msg = p <|> fail msg
17+
18+
fix :: forall a. (Parser a -> Parser a) -> Parser a
19+
fix f = Parser (\s fc sc -> unParser (f (fix f)) s fc sc)
20+
21+
between :: forall a open close. Parser open -> Parser close -> Parser a -> Parser a
22+
between open close p = do
23+
open
24+
a <- p
25+
close
26+
return a
27+
28+
option :: forall a. a -> Parser a -> Parser a
29+
option a p = p <|> return a
30+
31+
optional :: forall a. Parser a -> Parser {}
32+
optional p = (p >>= \_ -> return {}) <|> return {}
33+
34+
optionMaybe :: forall a. Parser a -> Parser (Maybe a)
35+
optionMaybe p = option Nothing (Just <$> p)
36+
37+
sepBy :: forall a sep. Parser a -> Parser sep -> Parser [a]
38+
sepBy p sep = sepBy1 p sep <|> return []
39+
40+
sepBy1 :: forall a sep. Parser a -> Parser sep -> Parser [a]
41+
sepBy1 p sep = do
42+
a <- p
43+
as <- many $ do
44+
sep
45+
p
46+
return (a : as)
47+
48+
sepEndBy :: forall a sep. Parser a -> Parser sep -> Parser [a]
49+
sepEndBy p sep = sepEndBy1 p sep <|> return []
50+
51+
sepEndBy1 :: forall a sep. Parser a -> Parser sep -> Parser [a]
52+
sepEndBy1 p sep = do
53+
a <- p
54+
(do sep
55+
as <- sepEndBy p sep
56+
return (a : as)) <|> return [a]
57+
58+
endBy1 :: forall a sep. Parser a -> Parser sep -> Parser [a]
59+
endBy1 p sep = many1 $ do
60+
a <- p
61+
sep
62+
return a
63+
64+
endBy :: forall a sep. Parser a -> Parser sep -> Parser [a]
65+
endBy p sep = many $ do
66+
a <- p
67+
sep
68+
return a
69+
70+
chainr :: forall a. Parser a -> Parser (a -> a -> a) -> a -> Parser a
71+
chainr p f a = chainr1 p f <|> return a
72+
73+
chainl :: forall a. Parser a -> Parser (a -> a -> a) -> a -> Parser a
74+
chainl p f a = chainl1 p f <|> return a
75+
76+
chainl1 :: forall a. Parser a -> Parser (a -> a -> a) -> Parser a
77+
chainl1 p f = do
78+
a <- p
79+
chainl1' p f a
80+
81+
chainl1' :: forall a. Parser a -> Parser (a -> a -> a) -> a -> Parser a
82+
chainl1' p f a = (do f' <- f
83+
a' <- p
84+
chainl1' p f (f' a a')) <|> return a
85+
86+
chainr1 :: forall a. Parser a -> Parser (a -> a -> a) -> Parser a
87+
chainr1 p f = do
88+
a <- p
89+
chainr1' p f a
90+
91+
chainr1' :: forall a. Parser a -> Parser (a -> a -> a) -> a -> Parser a
92+
chainr1' p f a = (do f' <- f
93+
a' <- chainr1 p f
94+
return $ f' a a') <|> return a
95+
96+
choice :: forall a. [Parser a] -> Parser a
97+
choice [] = fail "Nothing to parse"
98+
choice [x] = x
99+
choice (x:xs) = x <|> choice xs

‎src/Text/Parsing/StringParser/Expr.purs‎

Lines changed: 86 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,86 @@
1+
module Text.Parsing.StringParser.Expr where
2+
3+
import Data.Either
4+
import Data.Foldable
5+
6+
import Text.Parsing.StringParser
7+
import Text.Parsing.StringParser.Combinators
8+
9+
data Assoc = AssocNone | AssocLeft | AssocRight
10+
11+
data Operator a = Infix (Parser (a -> a -> a)) Assoc
12+
| Prefix (Parser (a -> a))
13+
| Postfix (Parser (a -> a))
14+
15+
type OperatorTable a = [[Operator a]]
16+
17+
type SplitAccum a = { rassoc :: [Parser (a -> a -> a)]
18+
, lassoc :: [Parser (a -> a -> a)]
19+
, nassoc :: [Parser (a -> a -> a)]
20+
, prefix :: [Parser (a -> a)]
21+
, postfix :: [Parser (a -> a)] }
22+
23+
buildExprParser :: forall a. OperatorTable a -> Parser a -> Parser a
24+
buildExprParser operators simpleExpr =
25+
let
26+
makeParser term ops =
27+
let
28+
accum = foldr splitOp { rassoc: [], lassoc: [], nassoc: [], prefix: [], postfix: [] } ops
29+
30+
rassocOp = choice accum.rassoc
31+
lassocOp = choice accum.lassoc
32+
nassocOp = choice accum.nassoc
33+
prefixOp = choice accum.prefix <?> ""
34+
postfixOp = choice accum.postfix <?> ""
35+
36+
postfixP = postfixOp <|> return id
37+
prefixP = prefixOp <|> return id
38+
in do
39+
x <- termP prefixP term postfixP
40+
rassocP x rassocOp prefixP term postfixP
41+
<|> lassocP x lassocOp prefixP term postfixP
42+
<|> nassocP x nassocOp prefixP term postfixP
43+
<|> return x
44+
<?> "operator"
45+
46+
splitOp :: forall a. Operator a -> SplitAccum a -> SplitAccum a
47+
splitOp (Infix op AssocNone) accum = accum { nassoc = op: accum.nassoc }
48+
splitOp (Infix op AssocLeft) accum = accum { lassoc = op: accum.lassoc }
49+
splitOp (Infix op AssocRight) accum = accum { rassoc = op: accum.rassoc }
50+
splitOp (Prefix op) accum = accum { prefix = op: accum.prefix }
51+
splitOp (Postfix op) accum = accum { postfix = op: accum.postfix }
52+
53+
rassocP :: forall a b c. a -> Parser (a -> a -> a) -> Parser (b -> c) -> Parser b -> Parser (c -> a) -> Parser a
54+
rassocP x rassocOp prefixP term postfixP = do
55+
f <- rassocOp
56+
y <- do
57+
z <- termP prefixP term postfixP
58+
rassocP1 z rassocOp prefixP term postfixP
59+
return (f x y)
60+
61+
rassocP1 :: forall a b c. a -> Parser (a -> a -> a) -> Parser (b -> c) -> Parser b -> Parser (c -> a) -> Parser a
62+
rassocP1 x rassocOp prefixP term postfixP = rassocP x rassocOp prefixP term postfixP <|> return x
63+
64+
lassocP :: forall a b c. a -> Parser (a -> a -> a) -> Parser (b -> c) -> Parser b -> Parser (c -> a) -> Parser a
65+
lassocP x lassocOp prefixP term postfixP = do
66+
f <- lassocOp
67+
y <- termP prefixP term postfixP
68+
lassocP1 (f x y) lassocOp prefixP term postfixP
69+
70+
lassocP1 :: forall a b c. a -> Parser (a -> a -> a) -> Parser (b -> c) -> Parser b -> Parser (c -> a) -> Parser a
71+
lassocP1 x lassocOp prefixP term postfixP = lassocP x lassocOp prefixP term postfixP <|> return x
72+
73+
nassocP :: forall a b c d e. a -> Parser (a -> d -> e) -> Parser (b -> c) -> Parser b -> Parser (c -> d) -> Parser e
74+
nassocP x nassocOp prefixP term postfixP = do
75+
f <- nassocOp
76+
y <- termP prefixP term postfixP
77+
return (f x y)
78+
79+
termP :: forall a b c. Parser (a -> b) -> Parser a -> Parser (b -> c) -> Parser c
80+
termP prefixP term postfixP = do
81+
pre <- prefixP
82+
x <- term
83+
post <- postfixP
84+
return (post (pre x))
85+
86+
in foldl (makeParser) simpleExpr operators

‎src/Text/Parsing/StringParser/String.purs‎

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
module Text.Parsing.StringParser.String where
2+
3+
import Data.String (charAt, length, take, indexOf')
4+
import Text.Parsing.StringParser
5+
6+
eof :: Parser {}
7+
eof = Parser (\s fc sc -> case s of
8+
{ str = str, pos = i } | i < length str -> fc (ParseError "Expected EOF")
9+
_ -> sc {} s)
10+
11+
anyChar :: Parser String
12+
anyChar = Parser (\s fc sc -> case s of
13+
{ str = str, pos = i } | i < length str -> sc (charAt i str) { str: str, pos: i + 1 }
14+
_ -> fc (ParseError "Unexpected EOF"))
15+
16+
string :: String -> Parser String
17+
string nt = Parser (\s fc sc -> case s of
18+
{ str = str, pos = i } | indexOf' nt i str == i -> sc nt { str: str, pos: i + length nt }
19+
{ pos = i } -> fc (ParseError $ "Expected '" ++ nt ++ "' at position " ++ show i ++ "."))

‎tests/Tests.purs‎

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,9 @@ import Debug.Trace
99
import Control.Monad.Eff
1010

1111
import Text.Parsing.StringParser
12+
import Text.Parsing.StringParser.Combinators
13+
import Text.Parsing.StringParser.String
14+
import Text.Parsing.StringParser.Expr
1215

1316
import qualified Test.QuickCheck as QC
1417

@@ -29,6 +32,24 @@ opTest :: Parser String
2932
opTest = chainl anyChar (do
3033
string "+"
3134
return (++)) ""
35+
36+
digit :: Parser Number
37+
digit = (string "0" >>= \_ -> return 0)
38+
<|> (string "1" >>= \_ -> return 1)
39+
<|> (string "2" >>= \_ -> return 2)
40+
<|> (string "3" >>= \_ -> return 3)
41+
<|> (string "4" >>= \_ -> return 4)
42+
<|> (string "5" >>= \_ -> return 5)
43+
<|> (string "6" >>= \_ -> return 6)
44+
<|> (string "7" >>= \_ -> return 7)
45+
<|> (string "8" >>= \_ -> return 8)
46+
<|> (string "9" >>= \_ -> return 9)
47+
48+
exprTest :: Parser Number
49+
exprTest = buildExprParser [[Infix (string "/" >>= \_ -> return (/)) AssocRight]
50+
,[Infix (string "*" >>= \_ -> return (*)) AssocRight]
51+
,[Infix (string "-" >>= \_ -> return (-)) AssocRight]
52+
,[Infix (string "+" >>= \_ -> return (+)) AssocRight]] digit
3253

3354
main = do
3455
parseTest nested "(((a)))"
@@ -42,3 +63,4 @@ main = do
4263
eof
4364
return as) "a,a,a,"
4465
parseTest opTest "a+b+c"
66+
parseTest exprTest "1*2+3/4-5"

0 commit comments

Comments
 (0)