@@ -1,84 +0,0 @@
1−module Parse.Binop (binops, infixOp) where
2−
3−import Text.Parsec
4− ( (<|>), choice, lookAhead, lower, many1
5− , notFollowedBy, satisfy, string, try
6− )
7−
8−import qualified AST.Expression.Source as Src
9−import qualified AST.Helpers as Help
10−import Parse.Helpers (IParser, addLocation, commitIf, expecting, failure, whitespace)
11−import qualified Reporting.Annotation as A
12−
13−
14−
15−-- BINARY EXPRESSIONS
16−
17−
18−binops :: IParser Src.RawExpr -> IParser Src.RawExpr -> IParser Src.RawExpr
19−binops parseTerm parseLastTerm =
20− addLocation $
21− do expr <- parseTerm
22− (ops, last) <- binopsHelp parseTerm parseLastTerm expr
23− case ops of
24− [] ->
25− return (A.drop last)
26−
27− _ ->
28− return (Src.Binop ops last)
29−
30−
31−binopsHelp
32− :: IParser Src.RawExpr
33− -> IParser Src.RawExpr
34− -> Src.RawExpr
35− -> IParser ([(Src.RawExpr, A.Located String)], Src.RawExpr)
36−binopsHelp parseTerm parseLastTerm expr =
37− choice
38− [ commitIf (whitespace >> infixOpWith (fail "")) $
39− do whitespace
40− op <- addLocation infixOp
41− whitespace
42− choice
43− [ do (ops, last) <- binopsHelp parseTerm parseLastTerm =<< try parseTerm
44− return ( (expr, op) : ops, last )
45− , (,) [(expr, op)] <$> parseLastTerm
46− ]
47− , return ( [], expr )
48− ]
49−
50−
51−
52−-- INFIX OPERATORS
53−
54−
55−infixOp :: IParser String
56−infixOp =
57− infixOpWith notReserved
58−
59−
60−infixOpWith :: IParser String -> IParser String
61−infixOpWith checker =
62− expecting "an infix operator like (+)" $
63− do op <- checker <|> many1 (satisfy Help.isSymbol)
64− case op of
65− "." -> notFollowedBy lower >> return op
66− _ -> return op
67−
68−
69−notReserved :: IParser a
70−notReserved =
71− choice
72− [ failOn "=" "The = operator is reserved for defining variables. Maybe you want == instead? Or maybe you are defining a variable, but there is whitespace before it?"
73− , failOn "->" "Arrows are reserved for cases and anonymous functions. Maybe you want > or >= instead?"
74− , failOn "|" "Vertical bars are reserved for use in union type declarations. Maybe you want || instead?"
75− , failOn ":" "A single colon is for type annotations. Maybe you want :: instead? Or maybe you are defining a type annotation, but there is whitespace before it?"
76− ]
77−
78−
79−failOn :: String -> String -> IParser a
80−failOn op msg =
81− do try $ lookAhead $ do
82− string op
83− notFollowedBy (satisfy Help.isSymbol)
84− failure msg