05a3fec · elk · git.iko.soy

git.iko.soy/elk

Add parser for infix declarations

commit05a3fecf80e8f7a3da1301d3fdb54129d428fd29 authorEvan Czaplicki <evancz@users.noreply.github.com> dateFri 15 Dec 2017, 20:13 (9 years ago) parent63e885c

8 files changed+125−9

compare with master

unifiedsplit

src/AST/Source.hs+1−1 src/AST/Valid.hs+1−1 src/Canonicalize/Module.hs+1−1 src/Compile.hs+1−1 src/Parse/Declaration.hs+36 src/Parse/Parse.hs+33−5 src/Parse/Primitives/Keyword.hs+29 src/Parse/Primitives/Number.hs+23

src/AST/Source.hs+1−1

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

117117data Decl_

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

119119 | 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

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

122122 | Docs Text

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

src/AST/Valid.hs+1−1

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

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

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

9292data 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

9494

9595

9696data Effects

src/Canonicalize/Module.hs+1−1

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

128128

129129

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

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

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

132132 ( op, Can.Binop_ associativity precedence func )

133133

134134

src/Compile.hs+1−1

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

5555compile flag pkg importDict interfaces source =

5656 do

5757 valid <- Result.mapError Error.Syntax $

58− Parse.program source

58+ Parse.program pkg source

5959

6060 canonical <- Result.mapError Error.Canonicalize $

6161 Canonicalize.canonicalize pkg importDict interfaces valid

src/Parse/Declaration.hs+36

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

22{-# LANGUAGE OverloadedStrings #-}

33module Parse.Declaration

44 ( declaration

5+ , infix_

56 )

67 where

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

1011import qualified Data.Text.Encoding as Text

1112

1213import qualified AST.Source as Src

14+import qualified AST.Utils.Binop as Binop

1315import qualified Parse.Expression as Expr

1416import qualified Parse.Pattern as Pattern

1517import Parse.Primitives

1618import qualified Parse.Primitives.Keyword as Keyword

19+import qualified Parse.Primitives.Number as Number

1720import qualified Parse.Primitives.Symbol as Symbol

1821import qualified Parse.Primitives.Variable as Var

1922import qualified Parse.Primitives.Whitespace as W

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

159162 spaces

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

161164 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

1010import qualified AST.Source as Src

1111import qualified AST.Valid as Valid

12+import qualified Elm.Package as Pkg

1213import qualified Parse.Declaration as Decl

1314import qualified Parse.Module as Module

1415import qualified Parse.Primitives as P

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

2122-- PROGRAM

2223

2324

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

25−program src =

26− case P.run chompProgram src of

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

26+program pkg src =

27+ let

28+ parser =

29+ if Pkg.isKernel pkg then fancyParser else normalParser

30+ in

31+ case P.run parser src of

2732 Right modul ->

2833 Validate.validate modul

2934

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

3136 Result.throw syntaxError

3237

3338

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

35−chompProgram =

39+-- CHOMP PROGRAMS

40+

41+

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

43+normalParser =

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

3745 P.endOfFile

3846 return srcModule

3947

4048

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+

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

4261chompDeclarations decls =

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

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

4665 chompDeclarations (decl:decls)

4766 , return (reverse (decl:decls))

4867 ]

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

55 , if_, then_, else_

66 , case_, of_

77 , let_, in_

8+ , infix_, left_, right_, non_

89 , module_, import_, exposing_, as_, where_, effect_

910 , command_, subscription_

1011 )

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

128129

129130

130131

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+

131160-- IMPORTS

132161

133162

src/Parse/Primitives/Number.hs+23

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

44 ( Number(..)

55 , number

66 , chompHex

7+ , precedence

78 )

89 where

910

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

1415import Foreign.ForeignPtr (ForeignPtr)

1516import GHC.Word (Word8)

1617

18+import qualified AST.Utils.Binop as Binop

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

1820import qualified Parse.Primitives.Internals as I

1921import qualified Parse.Primitives.Variable as Var

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

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

271273 | isDirtyEnd fp offset terminal word = -2

272274 | 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