git.iko.soy/elk
on master help sign in
Update basic parsers to use the new formats for Expr, Declaration, and Port
e3b8ea7Evan Czaplicki
compiler/Parse/Binop.hs+15−15
compare with master
unifiedsplit
@@ -6,7 +6,7 @@ import Data.List (intercalate)
6import qualified Data.Map as Map
6import qualified Data.Map as Map
7
7
8import SourceSyntax.Location (merge)
8import SourceSyntax.Location (merge)
9−import SourceSyntax.Expression (LExpr, Expr(Binop))
9+import qualified SourceSyntax.Expression as E
10import SourceSyntax.Declaration (Assoc(..))
10import SourceSyntax.Declaration (Assoc(..))
11import Text.Parsec
11import Text.Parsec
12import Parse.Helpers
12import Parse.Helpers
@@ -17,13 +17,13 @@ opLevel table op = fst $ Map.findWithDefault (9,L) op table
17opAssoc :: OpTable -> String -> Assoc
17opAssoc :: OpTable -> String -> Assoc
18opAssoc table op = snd $ Map.findWithDefault (9,L) op table
18opAssoc table op = snd $ Map.findWithDefault (9,L) op table
19
19
20−hasLevel :: OpTable -> Int -> (String, LExpr t v) -> Bool
20+hasLevel :: OpTable -> Int -> (String, E.LParseExpr) -> Bool
21hasLevel table n (op,_) = opLevel table op == n
21hasLevel table n (op,_) = opLevel table op == n
22
22
23−binops :: IParser (LExpr t v)
23+binops :: IParser E.LParseExpr
24− -> IParser (LExpr t v)
24+ -> IParser E.LParseExpr
25 -> IParser String
25 -> IParser String
26− -> IParser (LExpr t v)
26+ -> IParser E.LParseExpr
27binops term last anyOp =
27binops term last anyOp =
28 do e <- term
28 do e <- term
29 table <- getState
29 table <- getState
@@ -39,9 +39,9 @@ binops term last anyOp =
39
39
40split :: OpTable
40split :: OpTable
41 -> Int
41 -> Int
42− -> LExpr t v
42+ -> E.LParseExpr
43− -> [(String, LExpr t v)]
43+ -> [(String, E.LParseExpr)]
44− -> IParser (LExpr t v)
44+ -> IParser E.LParseExpr
45split _ _ e [] = return e
45split _ _ e [] = return e
46split table n e eops = do
46split table n e eops = do
47 assoc <- getAssoc table n eops
47 assoc <- getAssoc table n eops
@@ -50,26 +50,26 @@ split table n e eops = do
50 case assoc of R -> joinR es ops
50 case assoc of R -> joinR es ops
51 _ -> joinL es ops
51 _ -> joinL es ops
52
52
53−splitLevel :: OpTable -> Int -> LExpr t v -> [(String, LExpr t v)]
53+splitLevel :: OpTable -> Int -> E.LParseExpr -> [(String, E.LParseExpr)]
54− -> [IParser (LExpr t v)]
54+ -> [IParser E.LParseExpr]
55splitLevel table n e eops =
55splitLevel table n e eops =
56 case break (hasLevel table n) eops of
56 case break (hasLevel table n) eops of
57 (lops, (op,e'):rops) ->
57 (lops, (op,e'):rops) ->
58 split table (n+1) e lops : splitLevel table n e' rops
58 split table (n+1) e lops : splitLevel table n e' rops
59 (lops, []) -> [ split table (n+1) e lops ]
59 (lops, []) -> [ split table (n+1) e lops ]
60
60
61−joinL :: [LExpr t v] -> [String] -> IParser (LExpr t v)
61+joinL :: [E.LParseExpr] -> [String] -> IParser E.LParseExpr
62joinL [e] [] = return e
62joinL [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
64joinL _ _ = failure "Ill-formed binary expression. Report a compiler bug."
64joinL _ _ = failure "Ill-formed binary expression. Report a compiler bug."
65
65
66−joinR :: [LExpr t v] -> [String] -> IParser (LExpr t v)
66+joinR :: [E.LParseExpr] -> [String] -> IParser E.LParseExpr
67joinR [e] [] = return e
67joinR [e] [] = return e
68joinR (a:b:es) (op:ops) = do e <- joinR (b:es) ops
68joinR (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))
70joinR _ _ = failure "Ill-formed binary expression. Report a compiler bug."
70joinR _ _ = failure "Ill-formed binary expression. Report a compiler bug."
71
71
72−getAssoc :: OpTable -> Int -> [(String,LExpr t v)] -> IParser Assoc
72+getAssoc :: OpTable -> Int -> [(String,E.LParseExpr)] -> IParser Assoc
73getAssoc table n eops
73getAssoc table n eops
74 | all (==L) assocs = return L
74 | all (==L) assocs = return L
75 | all (==R) assocs = return R
75 | all (==R) assocs = return R
compiler/Parse/Declaration.hs+11−21
@@ -14,13 +14,13 @@ import qualified Parse.Type as Type
14import qualified SourceSyntax.Declaration as D
14import qualified SourceSyntax.Declaration as D
15
15
16
16
17−declaration :: IParser (D.Declaration t v)
17+declaration :: IParser D.ParseDeclaration
18declaration = alias <|> datatype <|> infixDecl <|> port <|> definition
18declaration = alias <|> datatype <|> infixDecl <|> port <|> definition
19
19
20−definition :: IParser (D.Declaration t v)
20+definition :: IParser D.ParseDeclaration
21definition = D.Definition <$> Expr.def
21definition = D.Definition <$> Expr.def
22
22
23−alias :: IParser (D.Declaration t v)
23+alias :: IParser D.ParseDeclaration
24alias = do
24alias = do
25 reserved "type" <?> "type alias (type Point = {x:Int, y:Int})"
25 reserved "type" <?> "type alias (type Point = {x:Int, y:Int})"
26 forcedWS
26 forcedWS
@@ -34,7 +34,7 @@ alias = do
34 return [D.Json]
34 return [D.Json]
35 return (D.TypeAlias alias args tipe json)
35 return (D.TypeAlias alias args tipe json)
36
36
37−datatype :: IParser (D.Declaration t v)
37+datatype :: IParser D.ParseDeclaration
38datatype = do
38datatype = do
39 reserved "data" <?> "datatype definition (data T = A | B | ...)"
39 reserved "data" <?> "datatype definition (data T = A | B | ...)"
40 forcedWS
40 forcedWS
@@ -45,7 +45,7 @@ datatype = do
45 return $ D.Datatype name args tcs []
45 return $ D.Datatype name args tcs []
46
46
47
47
48−infixDecl :: IParser (D.Declaration t v)
48+infixDecl :: IParser D.ParseDeclaration
49infixDecl = do
49infixDecl = do
50 assoc <- choice [ reserved "infixl" >> return D.L
50 assoc <- choice [ reserved "infixl" >> return D.L
51 , reserved "infix" >> return D.N
51 , reserved "infix" >> return D.N
@@ -56,23 +56,13 @@ infixDecl = do
56 D.Fixity assoc (read [n]) <$> anyOp
56 D.Fixity assoc (read [n]) <$> anyOp
57
57
58
58
59−port :: IParser (D.Declaration t v)
59+port :: IParser D.ParseDeclaration
60port =
60port =
61 do try (reserved "port")
61 do try (reserved "port")
62 whitespace
62 whitespace
63 name <- lowVar
63 name <- lowVar
64− padded hasType
64+ whitespace
65− tipe <- Type.expr
65+ let port' op ctor expr = do { try op ; whitespace ; ctor name <$> expr }
66− expr <- choice [ do try (outPort name)
66+ D.Port <$> choice [ port' hasType D.PortAnnotation Type.expr
67− padded equals
67+ , port' hasType D.SendDefinition Expr.expr
68− Just <$> Expr.expr
68+ , port' hasType D.SendDefinition 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"
compiler/Parse/Expression.hs+20−20
@@ -20,21 +20,21 @@ import SourceSyntax.Expression
20
20
21-------- Basic Terms --------
21-------- Basic Terms --------
22
22
23−varTerm :: IParser (Expr t v)
23+varTerm :: IParser ParseExpr
24varTerm = toVar <$> var <?> "variable"
24varTerm = toVar <$> var <?> "variable"
25
25
26−toVar :: String -> Expr t v
26+toVar :: String -> ParseExpr
27toVar v = case v of "True" -> Literal (Literal.Boolean True)
27toVar v = case v of "True" -> Literal (Literal.Boolean True)
28 "False" -> Literal (Literal.Boolean False)
28 "False" -> Literal (Literal.Boolean False)
29 _ -> Var v
29 _ -> Var v
30
30
31−accessor :: IParser (Expr t v)
31+accessor :: IParser ParseExpr
32accessor = do
32accessor = do
33 (start, lbl, end) <- located (try (string "." >> rLabel))
33 (start, lbl, end) <- located (try (string "." >> rLabel))
34 let loc e = Location.at start end e
34 let loc e = Location.at start end e
35 return (Lambda (PVar "_") (loc $ Access (loc $ Var "_") lbl))
35 return (Lambda (PVar "_") (loc $ Access (loc $ Var "_") lbl))
36
36
37−negative :: IParser (Expr t v)
37+negative :: IParser ParseExpr
38negative = do
38negative = do
39 (start, nTerm, end) <-
39 (start, nTerm, end) <-
40 located (try (char '-' >> notFollowedBy (char '.' <|> char '-')) >> term)
40 located (try (char '-' >> notFollowedBy (char '.' <|> char '-')) >> term)
@@ -44,7 +44,7 @@ negative = do
44
44
45-------- Complex Terms --------
45-------- Complex Terms --------
46
46
47−listTerm :: IParser (Expr t v)
47+listTerm :: IParser ParseExpr
48listTerm = markdown' <|> braces (try range <|> ExplicitList <$> commaSep expr)
48listTerm = markdown' <|> braces (try range <|> ExplicitList <$> commaSep expr)
49 where
49 where
50 range = do
50 range = do
@@ -67,7 +67,7 @@ listTerm = markdown' <|> braces (try range <|> ExplicitList <$> commaSep expr)
67 string "}}"
67 string "}}"
68 return (md ++ span uid (length exprs), exprs ++ [e])
68 return (md ++ span uid (length exprs), exprs ++ [e])
69
69
70−parensTerm :: IParser (LExpr t v)
70+parensTerm :: IParser LParseExpr
71parensTerm = try (parens opFn) <|> parens (tupleFn <|> parened)
71parensTerm = try (parens opFn) <|> parens (tupleFn <|> parened)
72 where
72 where
73 opFn = do
73 opFn = do
@@ -90,7 +90,7 @@ parensTerm = try (parens opFn) <|> parens (tupleFn <|> parened)
90 [e] -> e
90 [e] -> e
91 _ -> Location.at start end (tuple es)
91 _ -> Location.at start end (tuple es)
92
92
93−recordTerm :: IParser (LExpr t v)
93+recordTerm :: IParser LParseExpr
94recordTerm = brackets $ choice [ misc, addLocation record ]
94recordTerm = brackets $ choice [ misc, addLocation record ]
95 where field = do
95 where field = do
96 label <- rLabel
96 label <- rLabel
@@ -123,14 +123,14 @@ recordTerm = brackets $ choice [ misc, addLocation record ]
123 Nothing -> try (insert record) <|> try (modify record)
123 Nothing -> try (insert record) <|> try (modify record)
124
124
125
125
126−term :: IParser (LExpr t v)
126+term :: IParser LParseExpr
127term = addLocation (choice [ Literal <$> literal, listTerm, accessor, negative ])
127term = addLocation (choice [ Literal <$> literal, listTerm, accessor, negative ])
128 <|> accessible (addLocation varTerm <|> parensTerm <|> recordTerm)
128 <|> accessible (addLocation varTerm <|> parensTerm <|> recordTerm)
129 <?> "basic term (4, x, 'c', etc.)"
129 <?> "basic term (4, x, 'c', etc.)"
130
130
131-------- Applications --------
131-------- Applications --------
132
132
133−appExpr :: IParser (LExpr t v)
133+appExpr :: IParser LParseExpr
134appExpr = do
134appExpr = do
135 t <- term
135 t <- term
136 ts <- constrainedSpacePrefix term $ \str ->
136 ts <- constrainedSpacePrefix term $ \str ->
@@ -141,12 +141,12 @@ appExpr = do
141
141
142-------- Normal Expressions --------
142-------- Normal Expressions --------
143
143
144−binaryExpr :: IParser (LExpr t v)
144+binaryExpr :: IParser LParseExpr
145binaryExpr = binops appExpr lastExpr anyOp
145binaryExpr = binops appExpr lastExpr anyOp
146 where lastExpr = addLocation (choice [ ifExpr, letExpr, caseExpr ])
146 where lastExpr = addLocation (choice [ ifExpr, letExpr, caseExpr ])
147 <|> lambdaExpr
147 <|> lambdaExpr
148
148
149−ifExpr :: IParser (Expr t v)
149+ifExpr :: IParser ParseExpr
150ifExpr = reserved "if" >> whitespace >> (normal <|> multiIf)
150ifExpr = reserved "if" >> whitespace >> (normal <|> multiIf)
151 where
151 where
152 normal = do
152 normal = do
@@ -162,7 +162,7 @@ ifExpr = reserved "if" >> whitespace >> (normal <|> multiIf)
162 b <- expr ; padded arrow
162 b <- expr ; padded arrow
163 (,) b <$> expr
163 (,) b <$> expr
164
164
165−lambdaExpr :: IParser (LExpr t v)
165+lambdaExpr :: IParser LParseExpr
166lambdaExpr = do char '\\' <|> char '\x03BB' <?> "anonymous function"
166lambdaExpr = do char '\\' <|> char '\x03BB' <?> "anonymous function"
167 whitespace
167 whitespace
168 args <- spaceSep1 Pattern.term
168 args <- spaceSep1 Pattern.term
@@ -170,17 +170,17 @@ lambdaExpr = do char '\\' <|> char '\x03BB' <?> "anonymous function"
170 body <- expr
170 body <- expr
171 return (makeFunction args body)
171 return (makeFunction args body)
172
172
173−defSet :: IParser [Def t v]
173+defSet :: IParser [ParseDef]
174defSet = block (do d <- def ; whitespace ; return d)
174defSet = block (do d <- def ; whitespace ; return d)
175
175
176−letExpr :: IParser (Expr t v)
176+letExpr :: IParser ParseExpr
177letExpr = do
177letExpr = do
178 reserved "let" ; whitespace
178 reserved "let" ; whitespace
179 defs <- defSet
179 defs <- defSet
180 padded (reserved "in")
180 padded (reserved "in")
181 Let defs <$> expr
181 Let defs <$> expr
182
182
183−caseExpr :: IParser (Expr t v)
183+caseExpr :: IParser ParseExpr
184caseExpr = do
184caseExpr = do
185 reserved "case"; e <- padded expr; reserved "of"; whitespace
185 reserved "case"; e <- padded expr; reserved "of"; whitespace
186 Case e <$> (with <|> without)
186 Case e <$> (with <|> without)
@@ -190,7 +190,7 @@ caseExpr = do
190 with = brackets (semiSep1 (case_ <?> "cases { x -> ... }"))
190 with = brackets (semiSep1 (case_ <?> "cases { x -> ... }"))
191 without = block (do c <- case_ ; whitespace ; return c)
191 without = block (do c <- case_ ; whitespace ; return c)
192
192
193−expr :: IParser (LExpr t v)
193+expr :: IParser LParseExpr
194expr = addLocation (choice [ ifExpr, letExpr, caseExpr ])
194expr = addLocation (choice [ ifExpr, letExpr, caseExpr ])
195 <|> lambdaExpr
195 <|> lambdaExpr
196 <|> binaryExpr
196 <|> binaryExpr
@@ -216,18 +216,18 @@ defStart =
216 return $ if o == '`' then [ PVar $ takeWhile (/='`') p, p1, p2 ]
216 return $ if o == '`' then [ PVar $ takeWhile (/='`') p, p1, p2 ]
217 else [ PVar (o:p), p1, p2 ]
217 else [ PVar (o:p), p1, p2 ]
218
218
219−makeFunction :: [Pattern] -> LExpr t v -> LExpr t v
219+makeFunction :: [Pattern] -> LParseExpr -> LParseExpr
220makeFunction args body@(L s _) =
220makeFunction args body@(L s _) =
221 foldr (\arg body' -> L s $ Lambda arg body') body args
221 foldr (\arg body' -> L s $ Lambda arg body') body args
222
222
223−definition :: IParser (Def t v)
223+definition :: IParser ParseDef
224definition = withPos $ do
224definition = withPos $ do
225 (name:args) <- defStart
225 (name:args) <- defStart
226 padded equals
226 padded equals
227 body <- expr
227 body <- expr
228 return . Def name $ makeFunction args body
228 return . Def name $ makeFunction args body
229
229
230−typeAnnotation :: IParser (Def t v)
230+typeAnnotation :: IParser ParseDef
231typeAnnotation = TypeAnnotation <$> try start <*> Type.expr
231typeAnnotation = TypeAnnotation <$> try start <*> Type.expr
232 where
232 where
233 start = do
233 start = do
@@ -235,5 +235,5 @@ typeAnnotation = TypeAnnotation <$> try start <*> Type.expr
235 padded hasType
235 padded hasType
236 return v
236 return v
237
237
238−def :: IParser (Def t v)
238+def :: IParser ParseDef
239def = typeAnnotation <|> definition
239def = typeAnnotation <|> definition
compiler/Parse/Helpers.hs+1−1
@@ -206,7 +206,7 @@ located p = do
206 end <- getPosition
206 end <- getPosition
207 return (start, e, end)
207 return (start, e, end)
208
208
209−accessible :: IParser (LExpr t v) -> IParser (LExpr t v)
209+accessible :: IParser LParseExpr -> IParser LParseExpr
210accessible expr = do
210accessible expr = do
211 start <- getPosition
211 start <- getPosition
212 ce@(L _ e) <- expr
212 ce@(L _ e) <- expr