e3b8ea7 · elk · git.iko.soy

git.iko.soy/elk

Update basic parsers to use the new formats for Expr, Declaration, and Port

commite3b8ea7d09c98531e6abbd821b0e12794c832189 authorEvan Czaplicki <info@elm-lang.org> dateThu 2 Jan 2014, 23:20 (13 years ago) parentbd4d76e

4 files changed+47−57

compare with master

unifiedsplit

compiler/Parse/Binop.hs+15−15 compiler/Parse/Declaration.hs+11−21 compiler/Parse/Expression.hs+20−20 compiler/Parse/Helpers.hs+1−1

compiler/Parse/Binop.hs+15−15

@@ -6,7 +6,7 @@ import Data.List (intercalate)

66import qualified Data.Map as Map

88import SourceSyntax.Location (merge)

9−import SourceSyntax.Expression (LExpr, Expr(Binop))

9+import qualified SourceSyntax.Expression as E

1010import SourceSyntax.Declaration (Assoc(..))

1111import Text.Parsec

1212import Parse.Helpers

@@ -17,13 +17,13 @@ opLevel table op = fst $ Map.findWithDefault (9,L) op table

1717opAssoc :: OpTable -> String -> Assoc

1818opAssoc table op = snd $ Map.findWithDefault (9,L) op table

1919

20−hasLevel :: OpTable -> Int -> (String, LExpr t v) -> Bool

20+hasLevel :: OpTable -> Int -> (String, E.LParseExpr) -> Bool

2121hasLevel table n (op,_) = opLevel table op == n

2222

23−binops :: IParser (LExpr t v)

24− -> IParser (LExpr t v)

23+binops :: IParser E.LParseExpr

24+ -> IParser E.LParseExpr

2525 -> IParser String

26− -> IParser (LExpr t v)

26+ -> IParser E.LParseExpr

2727binops term last anyOp =

2828 do e <- term

2929 table <- getState

@@ -39,9 +39,9 @@ binops term last anyOp =

3939

4040split :: OpTable

4141 -> Int

42− -> LExpr t v

43− -> [(String, LExpr t v)]

44− -> IParser (LExpr t v)

42+ -> E.LParseExpr

43+ -> [(String, E.LParseExpr)]

44+ -> IParser E.LParseExpr

4545split _ _ e [] = return e

4646split table n e eops = do

4747 assoc <- getAssoc table n eops

@@ -50,26 +50,26 @@ split table n e eops = do

5050 case assoc of R -> joinR es ops

5151 _ -> joinL es ops

5252

53−splitLevel :: OpTable -> Int -> LExpr t v -> [(String, LExpr t v)]

54− -> [IParser (LExpr t v)]

53+splitLevel :: OpTable -> Int -> E.LParseExpr -> [(String, E.LParseExpr)]

54+ -> [IParser E.LParseExpr]

5555splitLevel table n e eops =

5656 case break (hasLevel table n) eops of

5757 (lops, (op,e'):rops) ->

5858 split table (n+1) e lops : splitLevel table n e' rops

5959 (lops, []) -> [ split table (n+1) e lops ]

6060

61−joinL :: [LExpr t v] -> [String] -> IParser (LExpr t v)

61+joinL :: [E.LParseExpr] -> [String] -> IParser E.LParseExpr

6262joinL [e] [] = return e

63−joinL (a:b:es) (op:ops) = joinL (merge a b (Binop op a b) : es) ops

63+joinL (a:b:es) (op:ops) = joinL (merge a b (E.Binop op a b) : es) ops

6464joinL _ _ = failure "Ill-formed binary expression. Report a compiler bug."

6565

66−joinR :: [LExpr t v] -> [String] -> IParser (LExpr t v)

66+joinR :: [E.LParseExpr] -> [String] -> IParser E.LParseExpr

6767joinR [e] [] = return e

6868joinR (a:b:es) (op:ops) = do e <- joinR (b:es) ops

69− return (merge a e (Binop op a e))

69+ return (merge a e (E.Binop op a e))

7070joinR _ _ = failure "Ill-formed binary expression. Report a compiler bug."

7171

72−getAssoc :: OpTable -> Int -> [(String,LExpr t v)] -> IParser Assoc

72+getAssoc :: OpTable -> Int -> [(String,E.LParseExpr)] -> IParser Assoc

7373getAssoc table n eops

7474 | all (==L) assocs = return L

7575 | all (==R) assocs = return R

compiler/Parse/Declaration.hs+11−21

@@ -14,13 +14,13 @@ import qualified Parse.Type as Type

1414import qualified SourceSyntax.Declaration as D

1515

1616

17−declaration :: IParser (D.Declaration t v)

17+declaration :: IParser D.ParseDeclaration

1818declaration = alias <|> datatype <|> infixDecl <|> port <|> definition

1919

20−definition :: IParser (D.Declaration t v)

20+definition :: IParser D.ParseDeclaration

2121definition = D.Definition <$> Expr.def

2222

23−alias :: IParser (D.Declaration t v)

23+alias :: IParser D.ParseDeclaration

2424alias = do

2525 reserved "type" <?> "type alias (type Point = {x:Int, y:Int})"

2626 forcedWS

@@ -34,7 +34,7 @@ alias = do

3434 return [D.Json]

3535 return (D.TypeAlias alias args tipe json)

3636

37−datatype :: IParser (D.Declaration t v)

37+datatype :: IParser D.ParseDeclaration

3838datatype = do

3939 reserved "data" <?> "datatype definition (data T = A | B | ...)"

4040 forcedWS

@@ -45,7 +45,7 @@ datatype = do

4545 return $ D.Datatype name args tcs []

4646

4747

48−infixDecl :: IParser (D.Declaration t v)

48+infixDecl :: IParser D.ParseDeclaration

4949infixDecl = do

5050 assoc <- choice [ reserved "infixl" >> return D.L

5151 , reserved "infix" >> return D.N

@@ -56,23 +56,13 @@ infixDecl = do

5656 D.Fixity assoc (read [n]) <$> anyOp

5757

5858

59−port :: IParser (D.Declaration t v)

59+port :: IParser D.ParseDeclaration

6060port =

6161 do try (reserved "port")

6262 whitespace

6363 name <- lowVar

64− padded hasType

65− tipe <- Type.expr

66− expr <- choice [ do try (outPort name)

67− padded equals

68− Just <$> Expr.expr

69− , return Nothing

70− ]

71− return $ D.Port name tipe expr

72− where

73− outPort name = do

74− freshLine

75− reserved "port"

76− whitespace

77− name' <- lowVar

78− if name == name' then return () else fail "different port"

64+ whitespace

65+ let port' op ctor expr = do { try op ; whitespace ; ctor name <$> expr }

66+ D.Port <$> choice [ port' hasType D.PortAnnotation Type.expr

67+ , port' hasType D.SendDefinition Expr.expr

68+ , port' hasType D.SendDefinition Expr.expr ]

compiler/Parse/Expression.hs+20−20

@@ -20,21 +20,21 @@ import SourceSyntax.Expression

2020

2121-------- Basic Terms --------

2222

23−varTerm :: IParser (Expr t v)

23+varTerm :: IParser ParseExpr

2424varTerm = toVar <$> var <?> "variable"

2525

26−toVar :: String -> Expr t v

26+toVar :: String -> ParseExpr

2727toVar v = case v of "True" -> Literal (Literal.Boolean True)

2828 "False" -> Literal (Literal.Boolean False)

2929 _ -> Var v

3030

31−accessor :: IParser (Expr t v)

31+accessor :: IParser ParseExpr

3232accessor = do

3333 (start, lbl, end) <- located (try (string "." >> rLabel))

3434 let loc e = Location.at start end e

3535 return (Lambda (PVar "_") (loc $ Access (loc $ Var "_") lbl))

3636

37−negative :: IParser (Expr t v)

37+negative :: IParser ParseExpr

3838negative = do

3939 (start, nTerm, end) <-

4040 located (try (char '-' >> notFollowedBy (char '.' <|> char '-')) >> term)

@@ -44,7 +44,7 @@ negative = do

4444

4545-------- Complex Terms --------

4646

47−listTerm :: IParser (Expr t v)

47+listTerm :: IParser ParseExpr

4848listTerm = markdown' <|> braces (try range <|> ExplicitList <$> commaSep expr)

4949 where

5050 range = do

@@ -67,7 +67,7 @@ listTerm = markdown' <|> braces (try range <|> ExplicitList <$> commaSep expr)

6767 string "}}"

6868 return (md ++ span uid (length exprs), exprs ++ [e])

6969

70−parensTerm :: IParser (LExpr t v)

70+parensTerm :: IParser LParseExpr

7171parensTerm = try (parens opFn) <|> parens (tupleFn <|> parened)

7272 where

7373 opFn = do

@@ -90,7 +90,7 @@ parensTerm = try (parens opFn) <|> parens (tupleFn <|> parened)

9090 [e] -> e

9191 _ -> Location.at start end (tuple es)

9292

93−recordTerm :: IParser (LExpr t v)

93+recordTerm :: IParser LParseExpr

9494recordTerm = brackets $ choice [ misc, addLocation record ]

9595 where field = do

9696 label <- rLabel

@@ -123,14 +123,14 @@ recordTerm = brackets $ choice [ misc, addLocation record ]

123123 Nothing -> try (insert record) <|> try (modify record)

124124

125125

126−term :: IParser (LExpr t v)

126+term :: IParser LParseExpr

127127term = addLocation (choice [ Literal <$> literal, listTerm, accessor, negative ])

128128 <|> accessible (addLocation varTerm <|> parensTerm <|> recordTerm)

129129 <?> "basic term (4, x, 'c', etc.)"

130130

131131-------- Applications --------

132132

133−appExpr :: IParser (LExpr t v)

133+appExpr :: IParser LParseExpr

134134appExpr = do

135135 t <- term

136136 ts <- constrainedSpacePrefix term $ \str ->

@@ -141,12 +141,12 @@ appExpr = do

141141

142142-------- Normal Expressions --------

143143

144−binaryExpr :: IParser (LExpr t v)

144+binaryExpr :: IParser LParseExpr

145145binaryExpr = binops appExpr lastExpr anyOp

146146 where lastExpr = addLocation (choice [ ifExpr, letExpr, caseExpr ])

147147 <|> lambdaExpr

148148

149−ifExpr :: IParser (Expr t v)

149+ifExpr :: IParser ParseExpr

150150ifExpr = reserved "if" >> whitespace >> (normal <|> multiIf)

151151 where

152152 normal = do

@@ -162,7 +162,7 @@ ifExpr = reserved "if" >> whitespace >> (normal <|> multiIf)

162162 b <- expr ; padded arrow

163163 (,) b <$> expr

164164

165−lambdaExpr :: IParser (LExpr t v)

165+lambdaExpr :: IParser LParseExpr

166166lambdaExpr = do char '\\' <|> char '\x03BB' <?> "anonymous function"

167167 whitespace

168168 args <- spaceSep1 Pattern.term

@@ -170,17 +170,17 @@ lambdaExpr = do char '\\' <|> char '\x03BB' <?> "anonymous function"

170170 body <- expr

171171 return (makeFunction args body)

172172

173−defSet :: IParser [Def t v]

173+defSet :: IParser [ParseDef]

174174defSet = block (do d <- def ; whitespace ; return d)

175175

176−letExpr :: IParser (Expr t v)

176+letExpr :: IParser ParseExpr

177177letExpr = do

178178 reserved "let" ; whitespace

179179 defs <- defSet

180180 padded (reserved "in")

181181 Let defs <$> expr

182182

183−caseExpr :: IParser (Expr t v)

183+caseExpr :: IParser ParseExpr

184184caseExpr = do

185185 reserved "case"; e <- padded expr; reserved "of"; whitespace

186186 Case e <$> (with <|> without)

@@ -190,7 +190,7 @@ caseExpr = do

190190 with = brackets (semiSep1 (case_ <?> "cases { x -> ... }"))

191191 without = block (do c <- case_ ; whitespace ; return c)

192192

193−expr :: IParser (LExpr t v)

193+expr :: IParser LParseExpr

194194expr = addLocation (choice [ ifExpr, letExpr, caseExpr ])

195195 <|> lambdaExpr

196196 <|> binaryExpr

@@ -216,18 +216,18 @@ defStart =

216216 return $ if o == '`' then [ PVar $ takeWhile (/='`') p, p1, p2 ]

217217 else [ PVar (o:p), p1, p2 ]

218218

219−makeFunction :: [Pattern] -> LExpr t v -> LExpr t v

219+makeFunction :: [Pattern] -> LParseExpr -> LParseExpr

220220makeFunction args body@(L s _) =

221221 foldr (\arg body' -> L s $ Lambda arg body') body args

222222

223−definition :: IParser (Def t v)

223+definition :: IParser ParseDef

224224definition = withPos $ do

225225 (name:args) <- defStart

226226 padded equals

227227 body <- expr

228228 return . Def name $ makeFunction args body

229229

230−typeAnnotation :: IParser (Def t v)

230+typeAnnotation :: IParser ParseDef

231231typeAnnotation = TypeAnnotation <$> try start <*> Type.expr

232232 where

233233 start = do

@@ -235,5 +235,5 @@ typeAnnotation = TypeAnnotation <$> try start <*> Type.expr

235235 padded hasType

236236 return v

237237

238−def :: IParser (Def t v)

238+def :: IParser ParseDef

239239def = typeAnnotation <|> definition

compiler/Parse/Helpers.hs+1−1

@@ -206,7 +206,7 @@ located p = do

206206 end <- getPosition

207207 return (start, e, end)

208208

209−accessible :: IParser (LExpr t v) -> IParser (LExpr t v)

209+accessible :: IParser LParseExpr -> IParser LParseExpr

210210accessible expr = do

211211 start <- getPosition

212212 ce@(L _ e) <- expr