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