11module Text.Parsing.Parser.Expr where
22
33import Prelude
4+
45import Data.Array
56import Data.Either
7+ import Data.Foldable
8+
69import Text.Parsing.Parser
710import Text.Parsing.Parser.Combinators
811
@@ -11,34 +14,43 @@ data Assoc = AssocNone | AssocLeft | AssocRight
1114data Operator s a = Infix (Parser s (a -> a -> a )) Assoc |
1215 Prefix (Parser s (a -> a )) |
1316 Postfix (Parser s (a -> a ))
14-
17+
1518type OperatorTable s a = [[Operator s a ]]
1619
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 )] }
1825
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 }
2532
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
2634rassocP x rassocOp prefixP term postfixP = do
2735 f <- rassocOp
28- y <- do
36+ y <- do
2937 z <- termP prefixP term postfixP
3038 rassocP1 z rassocOp prefixP term postfixP
3139 return (f x y)
3240
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
3342rassocP1 x rassocOp prefixP term postfixP = rassocP x rassocOp prefixP term postfixP <|> return x
3443
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
3545lassocP x lassocOp prefixP term postfixP = do
3646 f <- lassocOp
3747 y <- termP prefixP term postfixP
3848 lassocP1 (f x y) lassocOp prefixP term postfixP
3949
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
4051lassocP1 x lassocOp prefixP term postfixP = lassocP x lassocOp prefixP term postfixP <|> return x
4152
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
4254nassocP x nassocOp prefixP term postfixP = do
4355 f <- nassocOp
4456 y <- termP prefixP term postfixP
@@ -52,10 +64,10 @@ termP prefixP term postfixP = do
5264 return (post (pre x))
5365
5466buildExprParser :: forall s a . OperatorTable s a -> Parser s a -> Parser s a
55- buildExprParser operators simpleExpr =
67+ buildExprParser operators simpleExpr =
5668 let makeParser term ops =
5769 let accum = foldr splitOp { rassoc: [] , lassoc: [] , nassoc: [] , prefix: [] , postfix: [] } ops in
58-
70+
5971 let rassocOp = choice accum. rassoc in
6072 let lassocOp = choice accum. lassoc in
6173 let nassocOp = choice accum. nassoc in
@@ -64,13 +76,13 @@ buildExprParser operators simpleExpr =
6476
6577 let postfixP = postfixOp <|> return id in
6678 let prefixP = prefixOp <|> return id in
67-
68- do
79+
80+ do
6981 x <- termP prefixP term postfixP
7082 rassocP x rassocOp prefixP term postfixP
7183 <|> lassocP x lassocOp prefixP term postfixP
7284 <|> nassocP x nassocOp prefixP term postfixP
73- <|> return x
85+ <|> return x
7486 <?> " operator"
75-
87+
7688 in foldl (makeParser) simpleExpr operators
0 commit comments