05a3fec · elk · git.iko.soy

src/AST/Source.hs+1−1

compare with master

unifiedsplit

@@ -117,7 +117,7 @@ type Decl = A.Located Decl_

117data Decl_

118 = Union (A.Located N.Name) [A.Located N.Name] [(A.Located N.Name, [Type])]

119 | Alias (A.Located N.Name) [A.Located N.Name] Type

120− | Binop (A.Located N.Name) Binop.Associativity Binop.Precedence N.Name

120+ | Binop N.Name Binop.Associativity Binop.Precedence N.Name

121 | Port (A.Located N.Name) Type

122 | Docs Text

123 | Annotation (A.Located N.Name) Type

src/AST/Valid.hs+1−1

@@ -90,7 +90,7 @@ data Module =

90data Decl = Decl (A.Located N.Name) [Src.Pattern] Expr (Maybe Src.Type)

91data Union = Union (A.Located N.Name) [A.Located N.Name] [(A.Located N.Name, [Src.Type])]

92data Alias = Alias (A.Located N.Name) [A.Located N.Name] Src.Type

93−data Binop = Binop (A.Located N.Name) Binop.Associativity Binop.Precedence N.Name

93+data Binop = Binop N.Name Binop.Associativity Binop.Precedence N.Name

94

95

96data Effects

src/Canonicalize/Module.hs+1−1

@@ -128,7 +128,7 @@ canonicalizeUnion env (Valid.Union (A.At _ name) args ctors) =

128

129

130canonicalizeBinop :: Valid.Binop -> ( N.Name, Can.Binop )

131−canonicalizeBinop (Valid.Binop (A.At _ op) associativity precedence func) =

131+canonicalizeBinop (Valid.Binop op associativity precedence func) =

132 ( op, Can.Binop_ associativity precedence func )

133

134

src/Compile.hs+1−1

@@ -55,7 +55,7 @@ compile :: DocsFlag -> Pkg.Name -> ImportDict -> I.Interfaces -> BS.ByteString -

55compile flag pkg importDict interfaces source =

56 do

57 valid <- Result.mapError Error.Syntax $

58− Parse.program source

58+ Parse.program pkg source

59

60 canonical <- Result.mapError Error.Canonicalize $

61 Canonicalize.canonicalize pkg importDict interfaces valid

src/Parse/Declaration.hs+36

@@ -2,6 +2,7 @@

2{-# LANGUAGE OverloadedStrings #-}

3module Parse.Declaration

4 ( declaration

5+ , infix_

5 )

6 )

6 where

7 where

7

8

@@ -10,10 +11,12 @@ import Data.Text (Text)

10import qualified Data.Text.Encoding as Text

11import qualified Data.Text.Encoding as Text

11

12

12import qualified AST.Source as Src

13import qualified AST.Source as Src

14+import qualified AST.Utils.Binop as Binop

13import qualified Parse.Expression as Expr

15import qualified Parse.Expression as Expr

14import qualified Parse.Pattern as Pattern

16import qualified Parse.Pattern as Pattern

15import Parse.Primitives

17import Parse.Primitives

16import qualified Parse.Primitives.Keyword as Keyword

18import qualified Parse.Primitives.Keyword as Keyword

19+import qualified Parse.Primitives.Number as Number

17import qualified Parse.Primitives.Symbol as Symbol

20import qualified Parse.Primitives.Symbol as Symbol

18import qualified Parse.Primitives.Variable as Var

21import qualified Parse.Primitives.Variable as Var

19import qualified Parse.Primitives.Whitespace as W

22import qualified Parse.Primitives.Whitespace as W

@@ -159,3 +162,36 @@ port_ start =

159 spaces

162 spaces

160 (tipe, end, pos) <- Type.expression

163 (tipe, end, pos) <- Type.expression

161 return ( A.at start end (Src.Port name tipe), end, pos )

164 return ( A.at start end (Src.Port name tipe), end, pos )

165+

166+

167+

168+-- INFIX

169+

170+

171+-- INVARIANT: always chomps to a freshline

172+--

173+infix_ :: Parser Src.Decl

174+infix_ =

175+ do start <- getPosition

176+ Keyword.infix_

177+ inContext start E.Infix $

178+ do spaces

179+ associativity <-

180+ oneOf

181+ [ Keyword.left_ >> return Binop.Left

182+ , Keyword.right_ >> return Binop.Right

183+ , Keyword.non_ >> return Binop.Non

184+ ]

185+ spaces

186+ precedence <- Number.precedence

187+ spaces

188+ Symbol.leftParen

189+ op <- Symbol.binop

190+ Symbol.rightParen

191+ spaces

192+ Symbol.equals

193+ spaces

194+ name <- Var.lower

195+ end <- getPosition

196+ checkFreshLine =<< W.whitespace

197+ return (A.at start end (Src.Binop op associativity precedence name))

src/Parse/Parse.hs+33−5

@@ -9,6 +9,7 @@ import qualified Data.ByteString as B

9

10import qualified AST.Source as Src

11import qualified AST.Valid as Valid

12+import qualified Elm.Package as Pkg

12import qualified Parse.Declaration as Decl

13import qualified Parse.Declaration as Decl

13import qualified Parse.Module as Module

14import qualified Parse.Module as Module

14import qualified Parse.Primitives as P

15import qualified Parse.Primitives as P

@@ -21,9 +22,13 @@ import qualified Validate

21-- PROGRAM

22-- PROGRAM

22

23

24

24−program :: B.ByteString -> Result.Result i w Error.Error Valid.Module

25+program :: Pkg.Name -> B.ByteString -> Result.Result i w Error.Error Valid.Module

25−program src =

26+program pkg src =

27+ let

28+ parser =

29+ if Pkg.isKernel pkg then fancyParser else normalParser

30+ in

26− case P.run chompProgram src of

31+ case P.run parser src of

27 Right modul ->

32 Right modul ->

28 Validate.validate modul

33 Validate.validate modul

29

34

@@ -31,13 +36,27 @@ program src =

31 Result.throw syntaxError

36 Result.throw syntaxError

32

37

33

38

39+-- CHOMP PROGRAMS

40+

41+

34−chompProgram :: P.Parser (Src.Module [Src.Decl])

42+normalParser :: P.Parser (Src.Module [Src.Decl])

35−chompProgram =

43+normalParser =

36 do srcModule <- Module.module_ (chompDeclarations [])

44 do srcModule <- Module.module_ (chompDeclarations [])

37 P.endOfFile

45 P.endOfFile

38 return srcModule

46 return srcModule

39

47

40

48

49+fancyParser :: P.Parser (Src.Module [Src.Decl])

50+fancyParser =

51+ do srcModule <- Module.module_ (chompDeclarations =<< chompInfixes [])

52+ P.endOfFile

53+ return srcModule

54+

55+

56+

57+-- CHOMP DECLARATIONS

58+

59+

41chompDeclarations :: [Src.Decl] -> P.Parser [Src.Decl]

60chompDeclarations :: [Src.Decl] -> P.Parser [Src.Decl]

42chompDeclarations decls =

61chompDeclarations decls =

43 do (decl, _, pos) <- Decl.declaration

62 do (decl, _, pos) <- Decl.declaration

@@ -46,3 +65,12 @@ chompDeclarations decls =

46 chompDeclarations (decl:decls)

65 chompDeclarations (decl:decls)

47 , return (reverse (decl:decls))

66 , return (reverse (decl:decls))

48 ]

67 ]

68+

69+

70+chompInfixes :: [Src.Decl] -> P.Parser [Src.Decl]

71+chompInfixes decls =

72+ do decl <- Decl.infix_

73+ P.oneOf

74+ [ chompInfixes (decl:decls)

75+ , return (decl:decls)

76+ ]

src/Parse/Primitives/Keyword.hs+29

@@ -5,6 +5,7 @@ module Parse.Primitives.Keyword

5 , if_, then_, else_

6 , case_, of_

7 , let_, in_

8+ , infix_, left_, right_, non_

8 , module_, import_, exposing_, as_, where_, effect_

9 , module_, import_, exposing_, as_, where_, effect_

9 , command_, subscription_

10 , command_, subscription_

10 )

11 )

@@ -128,6 +129,34 @@ in_ =

128

129

130

131

132+-- INFIXES

133+

134+

135+{-# NOINLINE infix_ #-}

136+infix_ :: Parser ()

137+infix_ =

138+ keyword "infix"

139+

140+

141+{-# NOINLINE left_ #-}

142+left_ :: Parser ()

143+left_ =

144+ keyword "left"

145+

146+

147+{-# NOINLINE right_ #-}

148+right_ :: Parser ()

149+right_ =

150+ keyword "right"

151+

152+

153+{-# NOINLINE non_ #-}

154+non_ :: Parser ()

155+non_ =

156+ keyword "non"

157+

158+

159+

131-- IMPORTS

160-- IMPORTS

132

161

133

162

src/Parse/Primitives/Number.hs+23

@@ -4,6 +4,7 @@ module Parse.Primitives.Number

4 ( Number(..)

5 , number

6 , chompHex

7+ , precedence

7 )

8 )

8 where

9 where

9

10

@@ -14,6 +15,7 @@ import qualified Data.ByteString.Internal as B

14import Foreign.ForeignPtr (ForeignPtr)

15import Foreign.ForeignPtr (ForeignPtr)

15import GHC.Word (Word8)

16import GHC.Word (Word8)

16

17

18+import qualified AST.Utils.Binop as Binop

17import Parse.Primitives.Internals (Parser(..), State(..), noError)

19import Parse.Primitives.Internals (Parser(..), State(..), noError)

18import qualified Parse.Primitives.Internals as I

20import qualified Parse.Primitives.Internals as I

19import qualified Parse.Primitives.Variable as Var

21import qualified Parse.Primitives.Variable as Var

@@ -270,3 +272,24 @@ stepHex fp offset terminal word acc

270 | 0x41 {- A -} <= word && word <= 0x46 {- F -} = 16 * acc + 10 + fromIntegral (word - 0x41 {- A -})

272 | 0x41 {- A -} <= word && word <= 0x46 {- F -} = 16 * acc + 10 + fromIntegral (word - 0x41 {- A -})

271 | isDirtyEnd fp offset terminal word = -2

273 | isDirtyEnd fp offset terminal word = -2

272 | True = -1

274 | True = -1

275+

276+

277+

278+-- PRECEDENCE

279+

280+

281+precedence :: Parser Binop.Precedence

282+precedence =

283+ Parser $ \(State fp offset terminal indent row col ctx) cok _ _ eerr ->

284+ if offset >= terminal then

285+ eerr noError

286+

287+ else

288+ let !word = I.unsafeIndex fp offset in

289+ if isDecimalDigit word then

290+ cok

291+ (Binop.Precedence (fromIntegral (word - 0x30 {- 0 -})))

292+ (State fp (offset + 1) terminal indent row (col + 1) ctx)

293+ noError

294+ else

295+ eerr noError