bb54ad6 · elk · git.iko.soy

src/Docs/Check.hs+2−1

compare with master

unifiedsplit

@@ -11,8 +11,9 @@ import qualified AST.Variable as Var

11import qualified Docs.AST as Docs

12import qualified Elm.Compiler.Type as Type

13import Elm.Utils ((|>))

14+import Parse.Binop (infixOp)

14import Parse.Helpers

15import Parse.Helpers

15− ( addLocation, anyUntil, commaSep1, iParse, parens, simpleNewline, infixOp

16+ ( addLocation, anyUntil, commaSep1, iParse, parens, simpleNewline

16 , var, whitespace

17 , var, whitespace

17 )

18 )

18import qualified Reporting.Annotation as A

19import qualified Reporting.Annotation as A

src/Parse/Binop.hs+26−7

@@ -1,17 +1,37 @@

1−module Parse.Binop (binops, OpTable) where

1+module Parse.Binop (infixOp, binops, OpTable) where

2

3+import Control.Monad (guard)

3import qualified Data.List as List

4import qualified Data.List as List

4import qualified Data.Map as Map

5import qualified Data.Map as Map

5−import Text.Parsec ((<|>), choice, getState, try)

6+import Text.Parsec ((<|>), choice, getState, lower, many1, notFollowedBy, satisfy, try)

6

7

7import AST.Declaration (Assoc(L, N, R))

8import AST.Declaration (Assoc(L, N, R))

8import AST.Expression.General (Expr'(Binop))

9import AST.Expression.General (Expr'(Binop))

9import qualified AST.Expression.Source as Source

10import qualified AST.Expression.Source as Source

11+import qualified AST.Helpers as Help

10import qualified AST.Variable as Var

12import qualified AST.Variable as Var

11−import Parse.Helpers (IParser, OpTable, commitIf, failure, whitespace)

13+import Parse.Helpers (IParser, OpTable, commitIf, expecting, failure, whitespace)

12import qualified Reporting.Annotation as A

14import qualified Reporting.Annotation as A

13

15

14

16

17+

18+-- INFIX OPERATORS

19+

20+

21+infixOp :: IParser String

22+infixOp =

23+ expecting "an infix operator like (+)" $

24+ do op <- many1 (satisfy (\c -> Help.isSymbol c && c /= '`'))

25+ guard (op `notElem` [ "=", "..", "->", "--", "|", ":" ])

26+ case op of

27+ "." -> notFollowedBy lower >> return op

28+ _ -> return op

29+

30+

31+

32+-- BINARY EXPRESSIONS

33+

34+

15opLevel :: OpTable -> String -> Int

35opLevel :: OpTable -> String -> Int

16opLevel table op =

36opLevel table op =

17 fst $ Map.findWithDefault (9,L) op table

37 fst $ Map.findWithDefault (9,L) op table

@@ -30,18 +50,17 @@ hasLevel table n (op,_) =

30binops

50binops

31 :: IParser Source.Expr

51 :: IParser Source.Expr

32 -> IParser Source.Expr

52 -> IParser Source.Expr

33− -> IParser String

34 -> IParser Source.Expr

53 -> IParser Source.Expr

35−binops term last anyOp =

54+binops term last =

36 do e <- term

55 do e <- term

37 table <- getState

56 table <- getState

38 split table 0 e =<< nextOps

57 split table 0 e =<< nextOps

39 where

58 where

40 nextOps =

59 nextOps =

41 choice

60 choice

42− [ commitIf (whitespace >> anyOp) $

61+ [ commitIf (whitespace >> infixOp) $

43 do whitespace

62 do whitespace

44− op <- anyOp

63+ op <- infixOp

45 whitespace

64 whitespace

46 expr <- Left <$> try term <|> Right <$> last

65 expr <- Left <$> try term <|> Right <$> last

47 case expr of

66 case expr of

src/Parse/Declaration.hs+2−1

@@ -4,6 +4,7 @@ module Parse.Declaration where

4import Text.Parsec ( (<?>), choice, digit, optionMaybe, string, try )

5

6import qualified AST.Declaration as Decl

7+import qualified Parse.Binop as Binop

7import qualified Parse.Expression as Expr

8import qualified Parse.Expression as Expr

8import Parse.Helpers as Help

9import Parse.Helpers as Help

9import qualified Parse.Type as Type

10import qualified Parse.Type as Type

@@ -79,7 +80,7 @@ infixDecl =

79 forcedWS

80 forcedWS

80 n <- digit

81 n <- digit

81 forcedWS

82 forcedWS

82− op <- infixOp

83+ op <- Binop.infixOp

83 return $ Decl.Fixity (Decl.Infix op assoc (read [n]))

84 return $ Decl.Fixity (Decl.Infix op assoc (read [n]))

84

85

86

src/Parse/Expression.hs+4−4

@@ -121,7 +121,7 @@ parensTerm =

121 in

122 do (start, mkExpr, end) <-

123 located $ choice $

124− [ mkBinop <$> try (parens infixOp)

124+ [ mkBinop <$> try (parens Binop.infixOp)

125 , parens (tupleFn <|> parenedExpr)

126 ]

127 return (mkExpr start end)

@@ -202,7 +202,7 @@ expr =

202

203binaryExpr :: IParser Source.Expr

204binaryExpr =

205− Binop.binops appExpr lastExpr infixOp

205+ Binop.binops appExpr lastExpr

206 where

207 lastExpr =

208 addLocation (choice [ letExpr, caseExpr, ifExpr ])

@@ -296,7 +296,7 @@ annotation :: (String -> T.Raw -> a) -> IParser (A.Located a)

296annotation creator =

297 let

298 start =

299− do v <- lowVar <|> parens infixOp

299+ do v <- lowVar <|> parens Binop.infixOp

300 padded hasType

301 return v

302 in

@@ -325,6 +325,6 @@ makeFunction args body@(A.A ann _) =

325defStart :: IParser (P.Raw, [P.Raw])

326defStart =

327 expecting "the definition of a value (x = ...)" $

328− do starter <- try Pattern.term <|> addLocation (P.Var <$> parens infixOp)

328+ do starter <- try Pattern.term <|> addLocation (P.Var <$> parens Binop.infixOp)

329 args <- spacePrefix Pattern.term

330 return (starter, args)

src/Parse/Helpers.hs+1−16

@@ -1,7 +1,7 @@

1module Parse.Helpers where

2

3import Prelude hiding (until)

4−import Control.Monad (guard, join)

4+import Control.Monad (join)

5import Control.Monad.State (State)

6import Data.Char (isUpper)

7import qualified Data.Map as Map

@@ -14,7 +14,6 @@ import qualified Text.Parsec.Token as T

14import qualified AST.Declaration as Decl

15import qualified AST.Expression.General as E

16import qualified AST.Expression.Source as Source

17−import qualified AST.Helpers as Help

18import qualified AST.Literal as L

17import qualified AST.Literal as L

19import qualified AST.Variable as Variable

18import qualified AST.Variable as Variable

20import qualified Reporting.Annotation as A

19import qualified Reporting.Annotation as A

@@ -111,20 +110,6 @@ reserved word =

111

110

112

111

113

112

114−-- INFIX OPERATORS

115−

116−

117−infixOp :: IParser String

118−infixOp =

119− expecting "an infix operator like (+)" $

120− do op <- many1 (satisfy (\c -> Help.isSymbol c && c /= '`'))

121− guard (op `notElem` [ "=", "..", "->", "--", "|", ":" ])

122− case op of

123− "." -> notFollowedBy lower >> return op

124− _ -> return op

125−

126−

127−

128-- COMMON SYMBOLS

113-- COMMON SYMBOLS

129

114

130

115

src/Parse/Module.hs+1

@@ -3,6 +3,7 @@ module Parse.Module (moduleDecl, header, getModuleName) where

3

4import Text.Parsec hiding (newline, spaces)

5

6+import Parse.Binop (infixOp)

6import Parse.Helpers

7import Parse.Helpers

7import qualified AST.Module as Module

8import qualified AST.Module as Module

8import qualified AST.Module.Name as ModuleName

9import qualified AST.Module.Name as ModuleName