1
- module Text.Parsing.Parser.Expr
1
+ module Text.Parsing.Parser.Expr
2
2
( Assoc (..)
3
3
, Operator (..)
4
4
, OperatorTable ()
@@ -7,7 +7,6 @@ module Text.Parsing.Parser.Expr
7
7
8
8
import Prelude
9
9
10
- import Data.Either
11
10
import Data.Foldable
12
11
import Data.List (List (..), (:))
13
12
@@ -33,7 +32,7 @@ type SplitAccum m s a = { rassoc :: List (ParserT s m (a -> a -> a))
33
32
-- | Build a parser from an `OperatorTable`.
34
33
-- |
35
34
-- | For example:
36
- -- |
35
+ -- |
37
36
-- | ```purescript
38
37
-- | buildExprParser [ [ Infix (string "/" $> div) AssocRight ]
39
38
-- | , [ Infix (string "*" $> mul) AssocRight ]
@@ -43,70 +42,68 @@ type SplitAccum m s a = { rassoc :: List (ParserT s m (a -> a -> a))
43
42
-- | ```
44
43
buildExprParser :: forall m s a . (Monad m ) => OperatorTable m s a -> ParserT s m a -> ParserT s m a
45
44
buildExprParser operators simpleExpr = foldl makeParser simpleExpr operators
46
-
45
+
46
+ makeParser :: forall m s a . (Monad m ) => ParserT s m a -> Array (Operator m s a ) -> ParserT s m a
47
+ makeParser term ops = do
48
+ x <- termP prefixP term postfixP
49
+ rassocP x rassocOp prefixP term postfixP
50
+ <|> lassocP x lassocOp prefixP term postfixP
51
+ <|> nassocP x nassocOp prefixP term postfixP
52
+ <|> return x
53
+ <?> " operator"
47
54
where
48
-
49
- makeParser :: ParserT s m a -> Array (Operator m s a ) -> ParserT s m a
50
- makeParser term ops = do
51
- x <- termP prefixP term postfixP
52
- rassocP x rassocOp prefixP term postfixP
53
- <|> lassocP x lassocOp prefixP term postfixP
54
- <|> nassocP x nassocOp prefixP term postfixP
55
- <|> return x
56
- <?> " operator"
57
- where
58
- accum = foldr splitOp { rassoc: Nil
59
- , lassoc: Nil
60
- , nassoc: Nil
61
- , prefix: Nil
62
- , postfix: Nil
63
- } ops
64
-
65
- rassocOp = choice accum.rassoc
66
- lassocOp = choice accum.lassoc
67
- nassocOp = choice accum.nassoc
68
- prefixOp = choice accum.prefix <?> " "
69
- postfixOp = choice accum.postfix <?> " "
70
-
71
- postfixP = postfixOp <|> return id
72
- prefixP = prefixOp <|> return id
73
-
74
- splitOp :: forall m s a . Operator m s a -> SplitAccum m s a -> SplitAccum m s a
75
- splitOp (Infix op AssocNone ) accum = accum { nassoc = op : accum.nassoc }
76
- splitOp (Infix op AssocLeft ) accum = accum { lassoc = op : accum.lassoc }
77
- splitOp (Infix op AssocRight ) accum = accum { rassoc = op : accum.rassoc }
78
- splitOp (Prefix op) accum = accum { prefix = op : accum.prefix }
79
- splitOp (Postfix op) accum = accum { postfix = op : accum.postfix }
80
-
81
- rassocP :: forall m a b c s . (Monad m ) => a -> ParserT s m (a -> a -> a ) -> ParserT s m (b -> c ) -> ParserT s m b -> ParserT s m (c -> a ) -> ParserT s m a
82
- rassocP x rassocOp prefixP term postfixP = do
83
- f <- rassocOp
84
- y <- do
85
- z <- termP prefixP term postfixP
86
- rassocP1 z rassocOp prefixP term postfixP
87
- return (f x y)
88
-
89
- rassocP1 :: forall m a b c s . (Monad m ) => a -> ParserT s m (a -> a -> a ) -> ParserT s m (b -> c ) -> ParserT s m b -> ParserT s m (c -> a ) -> ParserT s m a
90
- rassocP1 x rassocOp prefixP term postfixP = rassocP x rassocOp prefixP term postfixP <|> return x
91
-
92
- lassocP :: forall m a b c s . (Monad m ) => a -> ParserT s m (a -> a -> a ) -> ParserT s m (b -> c ) -> ParserT s m b -> ParserT s m (c -> a ) -> ParserT s m a
93
- lassocP x lassocOp prefixP term postfixP = do
94
- f <- lassocOp
95
- y <- termP prefixP term postfixP
96
- lassocP1 (f x y) lassocOp prefixP term postfixP
97
-
98
- lassocP1 :: forall m a b c s . (Monad m ) => a -> ParserT s m (a -> a -> a ) -> ParserT s m (b -> c ) -> ParserT s m b -> ParserT s m (c -> a ) -> ParserT s m a
99
- lassocP1 x lassocOp prefixP term postfixP = lassocP x lassocOp prefixP term postfixP <|> return x
100
-
101
- nassocP :: forall m a b c d e s . (Monad m ) => a -> ParserT s m (a -> d -> e ) -> ParserT s m (b -> c ) -> ParserT s m b -> ParserT s m (c -> d ) -> ParserT s m e
102
- nassocP x nassocOp prefixP term postfixP = do
103
- f <- nassocOp
104
- y <- termP prefixP term postfixP
105
- return (f x y)
106
-
107
- termP :: forall m s a b c . (Monad m ) => ParserT s m (a -> b ) -> ParserT s m a -> ParserT s m (b -> c ) -> ParserT s m c
108
- termP prefixP term postfixP = do
109
- pre <- prefixP
110
- x <- term
111
- post <- postfixP
112
- return (post (pre x))
55
+ accum = foldr splitOp { rassoc: Nil
56
+ , lassoc: Nil
57
+ , nassoc: Nil
58
+ , prefix: Nil
59
+ , postfix: Nil
60
+ } ops
61
+
62
+ rassocOp = choice accum.rassoc
63
+ lassocOp = choice accum.lassoc
64
+ nassocOp = choice accum.nassoc
65
+ prefixOp = choice accum.prefix <?> " "
66
+ postfixOp = choice accum.postfix <?> " "
67
+
68
+ postfixP = postfixOp <|> return id
69
+ prefixP = prefixOp <|> return id
70
+
71
+ splitOp :: forall m s a . Operator m s a -> SplitAccum m s a -> SplitAccum m s a
72
+ splitOp (Infix op AssocNone ) accum = accum { nassoc = op : accum.nassoc }
73
+ splitOp (Infix op AssocLeft ) accum = accum { lassoc = op : accum.lassoc }
74
+ splitOp (Infix op AssocRight ) accum = accum { rassoc = op : accum.rassoc }
75
+ splitOp (Prefix op) accum = accum { prefix = op : accum.prefix }
76
+ splitOp (Postfix op) accum = accum { postfix = op : accum.postfix }
77
+
78
+ rassocP :: forall m a b c s . (Monad m ) => a -> ParserT s m (a -> a -> a ) -> ParserT s m (b -> c ) -> ParserT s m b -> ParserT s m (c -> a ) -> ParserT s m a
79
+ rassocP x rassocOp prefixP term postfixP = do
80
+ f <- rassocOp
81
+ y <- do
82
+ z <- termP prefixP term postfixP
83
+ rassocP1 z rassocOp prefixP term postfixP
84
+ return (f x y)
85
+
86
+ rassocP1 :: forall m a b c s . (Monad m ) => a -> ParserT s m (a -> a -> a ) -> ParserT s m (b -> c ) -> ParserT s m b -> ParserT s m (c -> a ) -> ParserT s m a
87
+ rassocP1 x rassocOp prefixP term postfixP = rassocP x rassocOp prefixP term postfixP <|> return x
88
+
89
+ lassocP :: forall m a b c s . (Monad m ) => a -> ParserT s m (a -> a -> a ) -> ParserT s m (b -> c ) -> ParserT s m b -> ParserT s m (c -> a ) -> ParserT s m a
90
+ lassocP x lassocOp prefixP term postfixP = do
91
+ f <- lassocOp
92
+ y <- termP prefixP term postfixP
93
+ lassocP1 (f x y) lassocOp prefixP term postfixP
94
+
95
+ lassocP1 :: forall m a b c s . (Monad m ) => a -> ParserT s m (a -> a -> a ) -> ParserT s m (b -> c ) -> ParserT s m b -> ParserT s m (c -> a ) -> ParserT s m a
96
+ lassocP1 x lassocOp prefixP term postfixP = lassocP x lassocOp prefixP term postfixP <|> return x
97
+
98
+ nassocP :: forall m a b c d e s . (Monad m ) => a -> ParserT s m (a -> d -> e ) -> ParserT s m (b -> c ) -> ParserT s m b -> ParserT s m (c -> d ) -> ParserT s m e
99
+ nassocP x nassocOp prefixP term postfixP = do
100
+ f <- nassocOp
101
+ y <- termP prefixP term postfixP
102
+ return (f x y)
103
+
104
+ termP :: forall m s a b c . (Monad m ) => ParserT s m (a -> b ) -> ParserT s m a -> ParserT s m (b -> c ) -> ParserT s m c
105
+ termP prefixP term postfixP = do
106
+ pre <- prefixP
107
+ x <- term
108
+ post <- postfixP
109
+ return (post (pre x))
0 commit comments