git.iko.soy/elk
on master help sign in
Fix bugs in parser. Also adds pattern matching in anonymous functions. Still need to work on error messages though.
commit110944c4542c84666c969a8d301ecec9c7639fab authorevancz <info@elm-lang.org> dateSat 9 Jun 2012, 23:05 (14 years ago) parentc6a5ef4
4 files changed+55−49
compare with master
unifiedsplit
elm/src/Parse/ParseLib.hs+31−15 elm/src/Parse/ParseTypes.hs+8−11 elm/src/Parse/Parser.hs+14−13 elm/src/Parse/Patterns.hs+2−10
elm/src/Parse/ParseLib.hs+31−15
@@ -2,12 +2,12 @@
22module ParseLib where
33
44import Ast
5−import Control.Applicative ((<$>))
5+import Control.Applicative ((<$>),(<*>))
66import Control.Monad
77import Data.Char (isSymbol)
88import Text.Parsec hiding (newline,spaces)
99
10−reserved = [ "if", "then", "else"
10+reserveds = [ "if", "then", "else"
1111 , "case", "of", "data"
1212 , "let", "in" ]
1313
@@ -25,18 +25,22 @@ lowVar = makeVar (lower <?> "lower case variable")
2525capVar :: (Monad m) => ParsecT [Char] u m String
2626capVar = makeVar (upper <?> "upper case variable")
2727
28−makeVar p = do
29− c <- p
30− cs <- many (alphaNum <|> char '_' <|> char '\'' <?> "")
31− guard $ c:cs `notElem` reserved
32− return $ c:cs
28+innerVarChar :: (Monad m) => ParsecT [Char] u m Char
29+innerVarChar = alphaNum <|> char '_' <|> char '\'' <?> ""
3330
31+makeVar p = do v <- (:) <$> p <*> many innerVarChar
32+ guard (v `notElem` reserveds)
33+ return v
34+
35+reserved word =
36+ try (string word >> notFollowedBy innerVarChar) >> return word
37+ <?> "reserved word '" ++ word ++ "'"
3438
3539anyOp :: (Monad m) => ParsecT [Char] u m String
3640anyOp = betwixt '`' '`' var <|>
3741 (do op <- many1 (satisfy isSymbol <|> oneOf "+-/*=.$<>:&|^?%#@~!")
3842 guard (op `notElem` [ "=", "..", "->", "--" ])
39− return op) <?> "infix operator"
43+ return op) <?> "infix operator (e.g. x + y)"
4044
4145arrow :: (Monad m) => ParsecT [Char] u m String
4246arrow = string "->" <|> string "\8594" <?> "arrow (->)"
@@ -45,20 +49,32 @@ commaSep :: (Monad m) => ParsecT [Char] u m a -> ParsecT [Char] u m [a]
4549commaSep p = do
4650 x <- optionMaybe p
4751 case x of
48− Just a -> (a:) <$> many (try (whitespace >> char ',' >> whitespace >> p))
52+ Just a -> (a:) <$> many (try (whitespace >> (char ',' <?> "comma ','")) >>
53+ whitespace >> p)
4954 Nothing -> return []
5055
5156semiSep1 :: (Monad m) => ParsecT [Char] u m a -> ParsecT [Char] u m [a]
52−semiSep1 p = do a <- p
53− (a:) <$> many (try (whitespace >> char ';' >> whitespace >> p))
57+semiSep1 p = do
58+ a <- p
59+ (a:) <$> many (try (whitespace >> (char ';' <?> "semicolon ';'")) >>
60+ whitespace >> p)
5461
5562pipeSep1 :: (Monad m) => ParsecT [Char] u m a -> ParsecT [Char] u m [a]
56−pipeSep1 p = do a <- p
57− (a:) <$> many (try (whitespace >> char '|' >> whitespace >> p))
63+pipeSep1 p = do
64+ a <- p
65+ (a:) <$> many (try (whitespace >> (char '|' <?> "type divider '|'")) >>
66+ whitespace >> p)
67+
68+consSep1 :: (Monad m) => ParsecT [Char] u m a -> ParsecT [Char] u m [a]
69+consSep1 p = do
70+ a <- p
71+ (a:) <$> many (try (whitespace >> (char ':' <?> "cons operator ':'")) >>
72+ whitespace >> p)
5873
5974spaceSep1 :: (Monad m) => ParsecT [Char] u m a -> ParsecT [Char] u m [a]
60−spaceSep1 p = do a <- p
61− (a:) <$> many (try (forcedWS >> p))
75+spaceSep1 p = (:) <$> p <*> spacePrefix p
76+
77+spacePrefix p = many (try (whitespace >> p))
6278
6379betwixt a b c = do char a ; out <- c
6480 char b <?> "closing '" ++ [b] ++ "'" ; return out
elm/src/Parse/ParseTypes.hs+8−11
@@ -1,7 +1,7 @@
11module ParseTypes where
22
33import Ast
4−import Control.Applicative ((<$>))
4+import Control.Applicative ((<$>),(<*>))
55import Control.Monad (liftM)
66import Data.Char (isUpper,isLower)
77import Data.Maybe (fromMaybe)
@@ -37,7 +37,7 @@ typeSimple = VarPT <$> var
3737
3838typeApp :: (Monad m) => ParsecT [Char] u m ParseType
3939typeApp = do name <- capVar
40− args <- many (typeSimple <|> typeUnambiguous)
40+ args <- spacePrefix (typeUnambiguous <|> typeSimple)
4141 return $ case args of
4242 [] -> VarPT name
4343 _ -> ADTPT name args
@@ -45,20 +45,17 @@ typeApp = do name <- capVar
4545typeExpr :: (Monad m) => ParsecT [Char] u m ParseType
4646typeExpr = do
4747 t1 <- typeVar <|> typeApp <|> typeUnambiguous
48− whitespace ; arrow <- optionMaybe arrow ; whitespace
49− case arrow of Just _ -> LambdaPT t1 <$> typeExpr
50− Nothing -> return t1
48+ whitespace ; arr <- optionMaybe arrow ; whitespace
49+ case arr of Just _ -> LambdaPT t1 <$> typeExpr
50+ Nothing -> return t1
5151
5252typeConstructor :: (Monad m) => ParsecT [Char] u m (String, [ParseType])
53−typeConstructor = do
54− name <- capVar
55− args <- many (try (forcedWS >> (typeSimple <|> typeUnambiguous)))
56− return $ (,) name args
53+typeConstructor = (,) <$> capVar <*> spacePrefix (typeSimple <|> typeUnambiguous)
5754
5855datatype :: (Monad m) => ParsecT [Char] u m ([String], [Expr], GuidCounter [Type])
5956datatype = do
60− string "data" <?> "datatype definition (data T = A | B | ...)"
61− forcedWS ; name <- capVar ; args <- many (try (forcedWS >> lowVar))
57+ reserved "data" <?> "datatype definition (data T = A | B | ...)"
58+ forcedWS ; name <- capVar ; args <- spacePrefix lowVar
6259 whitespace ; string "=" ; whitespace
6360 tcs <- pipeSep1 typeConstructor
6461 return $ (map fst tcs , map toFunc tcs , toTypes name args tcs)
elm/src/Parse/Parser.hs+14−13
@@ -32,7 +32,8 @@ toVar v = case v of "True" -> Boolean True
3232 _ -> Var v
3333
3434chrTerm :: (Monad m) => ParsecT [Char] u m Expr
35−chrTerm = Chr <$> betwixt '\'' '\'' (backslashed <|> satisfy (/='\'')) <?> "character"
35+chrTerm = Chr <$> betwixt '\'' '\'' (backslashed <|> satisfy (/='\''))
36+ <?> "character"
3637
3738
3839-------- Complex Terms --------
@@ -67,9 +68,9 @@ appExpr = do
6768
6869binaryExpr = binops appExpr anyOp
6970
70−ifExpr = do string "if" ; forcedWS ; e1 <- expr ; forcedWS
71− string "then" ; forcedWS ; e2 <- expr ; (forcedWS <?> "an 'else' branch")
72− string "else" <?> "an 'else' branch" ; forcedWS ; If e1 e2 <$> expr
71+ifExpr = do reserved "if" ; whitespace ; e1 <- expr ; whitespace
72+ reserved "then" ; whitespace ; e2 <- expr ; (whitespace <?> "an 'else' branch")
73+ reserved "else" <?> "an 'else' branch" ; whitespace ; If e1 e2 <$> expr
7374
7475lambdaExpr = do char '\\' <|> char '\x03BB' <?> "anonymous function"
7576 whitespace
@@ -87,24 +88,24 @@ assignExpr = do
8788 fail "matching tuples is not yet supported in this context"
8889 else fail $ "Only tuples can be matched in this context, " ++
8990 "not other abstract data types such as lists."
90− _ -> fail $ "Variables in assign statement are not acceptable: " ++
91+ _ -> fail $ "Left-hand side of assign statement is not acceptable: " ++
9192 "only named variables, named functions, and tuples are okay."
9293
9394letExpr = do
94− string "let"
95+ reserved "let"
9596 brace <- optionMaybe . try $ do
9697 whitespace
9798 char '{' <?> "a set of definitions { x = ... ; y = ... }"
9899 case brace of
99− Nothing -> do forcedWS; f <- assignExpr; forcedWS; string "in"; forcedWS;
100+ Nothing -> do whitespace; f <- assignExpr; whitespace; reserved "in"; whitespace
100101 Let [f] <$> expr
101102 Just '{' -> do whitespace ; fs <- semiSep1 assignExpr ; whitespace
102103 string "}" <?> "closing bracket '}'"
103− whitespace; string "in"; forcedWS; e <- expr
104+ whitespace; reserved "in"; whitespace; e <- expr
104105 return (Let fs e)
105106
106107caseExpr = do
107− string "case"; forcedWS; e <- expr; forcedWS; string "of"; whitespace
108+ reserved "case"; whitespace; e <- expr; whitespace; reserved "of"; whitespace
108109 Case e <$> brackets (semiSep1 (case_ <?> "cases { x -> ... }"))
109110 where case_ = do p <- patternExpr; whitespace; arrow; whitespace
110111 (,) p <$> expr
@@ -117,14 +118,14 @@ def = do (f,e) <- assignExpr
117118
118119defs1 = do optional freshLine
119120 d <- datatype <|> def
120− (d:) <$> many (try (freshLine >> (datatype <|> def)))
121+ (d:) <$> many (try (try freshLine >> (datatype <|> def)))
121122
122123defs = do
123124 (fss,ess,tss) <- unzip3 <$> defs1
124125 let (fs,es,ts) = (concat fss, concat ess, concat `liftM` sequence tss)
125− optional freshLine ; optional whitespace ; eof
126+ optional freshLine ; optional spaces ; eof
126127 return (Let (zip fs es) (Var "main"), liftM (zip fs) ts)
127128
128−toDefs source = case parse defs "Elm code" source of
129+toDefs source = case parse defs "" source of
129130 Right result -> Right result
130− Left err -> Left $ show err
131+ Left err -> Left $ "Parse error at " ++ show err
elm/src/Parse/Patterns.hs+2−10
@@ -16,7 +16,7 @@ patternBasic :: Monad m => ParsecT [Char] u m Pattern
1616patternBasic =
1717 choice [ char '_' >> return PAnything
1818 , do x@(c:_) <- var
19− if isUpper c then PData x <$> patternTerm `endBy` whitespace
19+ if isUpper c then PData x <$> spacePrefix patternTerm
2020 else return $ PVar x
2121 ]
2222
@@ -24,14 +24,6 @@ patternTuple :: Monad m => ParsecT [Char] u m Pattern
2424patternTuple = do ps <- parens (commaSep patternExpr)
2525 return $ case ps of { [p] -> p; _ -> ptuple ps }
2626
27−patternCons :: Monad m => ParsecT [Char] u m Pattern
28−patternCons = do
29− p <- patternTerm
30− colon <- optionMaybe (char ':' <?> "more complicated pattern")
31− case colon of
32− Just ':' -> pcons p <$> patternExpr
33− Nothing -> return p
34−
3527patternList :: Monad m => ParsecT [Char] u m Pattern
3628patternList = plist <$> braces (commaSep patternExpr)
3729
@@ -39,4 +31,4 @@ patternTerm :: Monad m => ParsecT [Char] u m Pattern
3931patternTerm = patternTuple <|> patternList <|> patternBasic <?> "pattern"
4032
4133patternExpr :: Monad m => ParsecT [Char] u m Pattern
42−patternExpr = patternTuple <|> patternList <|> patternCons <?> "pattern"
34+patternExpr = foldl1 pcons <$> consSep1 patternTerm <?> "pattern"