459cf8e · elk · git.iko.soy

git.iko.soy/elk

Switch parsers over to new AST

commit459cf8ec7359e02c913a7014f014cf84d311c0b3 authorevancz <info@elm-lang.org> dateThu 13 Jun 2013, 19:15 (13 years ago) parent339ad77

7 files changed+117−96

compare with master

unifiedsplit

compiler/Parse/Binops.hs → compiler/Parse/Binop.hs+1−1 compiler/Parse/Expr.hs → compiler/Parse/Expression.hs+31−46 compiler/Parse/Foreign.hs+9−6 compiler/Parse/Literal.hs+33 compiler/Parse/Modules.hs → compiler/Parse/Module.hs+3−3 compiler/Parse/Patterns.hs → compiler/Parse/Pattern.hs+36−35 compiler/Parse/Types.hs → compiler/Parse/Type.hs+4−5

compiler/Parse/Binops.hs → compiler/Parse/Binop.hsrenamed+1−1

@@ -1,4 +1,4 @@

1−module Parse.Binops (binops, infixStmt, OpTable) where

1+module Parse.Binop (binops, infixStmt, OpTable) where

33import Control.Monad.Error

44import Data.List (intercalate)

compiler/Parse/Expr.hs → compiler/Parse/Expression.hsrenamed+31−46

@@ -1,20 +1,22 @@

1−module Parse.Expr (def,term) where

1+module Parse.Expression (def,term) where

33import Control.Applicative ((<$>), (<*>))

4−import Control.Monad

5−import Data.Char (isSymbol, isDigit)

64import Data.List (foldl')

75import Text.Parsec hiding (newline,spaces)

86import Text.Parsec.Indent

97import qualified Text.Pandoc as Pan

108

11−import Parse.Library

12−import Parse.Patterns

13−import Parse.Binops

14−import Parse.Types

9+import Parse.Helpers

10+import qualified Parse.Pattern as Pattern

11+import qualified Parse.Type as Type

12+import Parse.Binop

13+import Parse.Literal

1514

16−import Ast

17−import Located

15+import SourceSyntax.Location as Location

16+import SourceSyntax.Pattern hiding (tuple,list)

17+import qualified SourceSyntax.Literal as Literal

18+import SourceSyntax.Expression

19+import SourceSyntax.Declaration (Declaration(Definition))

1820

1921import Guid

2022import Types.Types (Type (VarT), Scheme (Forall))

@@ -24,36 +26,19 @@ import System.IO.Unsafe

2426

2527-------- Basic Terms --------

2628

27−numTerm :: IParser Expr

28−numTerm = toExpr <$> (preNum <?> "number")

29− where toExpr n | '.' `elem` n = FloatNum (read n)

30− | otherwise = IntNum (read n)

31− preNum = (++) <$> many1 digit <*> option "" postNum

32− postNum = do try $ lookAhead (string "." >> digit)

33− string "."

34− ('.':) <$> many1 digit

35−

36−strTerm :: IParser Expr

37−strTerm = liftM Str . expecting "string" . betwixt '"' '"' . many $

38− backslashed <|> satisfy (/='"')

39−

4029varTerm :: IParser Expr

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

4231

43−toVar v = case v of "True" -> Boolean True

44− "False" -> Boolean False

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

33+ "False" -> Literal (Literal.Boolean False)

4534 _ -> Var v

4635

47−chrTerm :: IParser Expr

48−chrTerm = Chr <$> betwixt '\'' '\'' (backslashed <|> satisfy (/='\''))

49− <?> "character"

50−

5136accessor :: IParser Expr

5237accessor = do

5338 start <- getPosition

5439 lbl <- try (string "." >> rLabel)

5540 end <- getPosition

56− let loc e = addLoc ("." ++ lbl) (pos start end e)

41+ let loc e = Location.add ("." ++ lbl) (Location.at start end e)

5742 return (Lambda "_" (loc $ Access (loc $ Var "_") lbl))

5843

5944

@@ -76,7 +61,7 @@ parensTerm = parens $ choice

7661 [ do start <- getPosition

7762 op <- try anyOp

7863 end <- getPosition

79− let loc = pos start end

64+ let loc = Location.at start end

8065 return . loc . Lambda "x" . loc . Lambda "y" . loc $

8166 Binop op (loc $ Var "x") (loc $ Var "y")

8267 , do start <- getPosition

@@ -84,24 +69,24 @@ parensTerm = parens $ choice

8469 commas <- comma >> many (whitespace >> comma)

8570 end <- getPosition

8671 let vars = map (('v':) . show) [ 0 .. length commas + 1 ]

87− loc = pos start end

72+ loc = Location.at start end

8873 return $ foldr (\x e -> loc $ Lambda x e)

8974 (loc . tuple $ map (loc . Var) vars) vars

9075 , do start <- getPosition

9176 es <- commaSep expr

9277 end <- getPosition

9378 return $ case es of [e] -> e

94− _ -> pos start end (tuple es)

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

9580 ]

9681

9782recordTerm :: IParser LExpr

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

9984 where field = do

100− fDefs <- (:) <$> (PVar <$> rLabel) <*> spacePrefix patternTerm

85+ fDefs <- (:) <$> (PVar <$> rLabel) <*> spacePrefix Pattern.term

10186 whitespace

10287 e <- string "=" >> whitespace >> expr

10388 n <- sourceLine <$> getPosition

104− runAt (1000 * n) $ flattenPatterns fDefs e

89+ runAt (1000 * n) $ Pattern.flatten fDefs e

10590 extract [ FnDef f args exp ] = return (f,args,exp)

10691 extract _ = fail "Improperly formed record field."

10792 record = Record <$> (mapM extract =<< commaSep field)

@@ -127,7 +112,7 @@ recordTerm = brackets $ choice [ misc, addLocation record ]

127112

128113

129114term :: IParser LExpr

130−term = addLocation (choice [ numTerm, strTerm, chrTerm, listTerm, accessor ])

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

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

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

133118

@@ -138,7 +123,7 @@ appExpr = do

138123 tlist <- spaceSep1 term

139124 return $ case tlist of

140125 t:[] -> t

141− t:ts -> foldl' (\f x -> epos f x $ App f x) t ts

126+ t:ts -> foldl' (\f x -> Location.merge f x $ App f x) t ts

142127

143128-------- Normal Expressions --------

144129

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

154139 thenBranch <- expr

155140 whitespace <?> "an 'else' branch" ; reserved "else" <?> "an 'else' branch" ; whitespace

156141 elseBranch <- expr

157− return $ MultiIf [(bool, thenBranch), (notLocated (Var "otherwise"), elseBranch)]

142+ return $ MultiIf [(bool, thenBranch), (Location.none (Var "otherwise"), elseBranch)]

158143 multiIf = MultiIf <$> spaceSep1 iff

159144 where iff = do string "|" ; whitespace

160145 b <- expr ; whitespace ; string "->" ; whitespace

@@ -163,10 +148,10 @@ ifExpr = reserved "if" >> whitespace >> (normal <|> multiIf)

163148lambdaExpr :: IParser LExpr

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

165150 whitespace

166− pats <- spaceSep1 patternTerm

151+ pats <- spaceSep1 Pattern.term

167152 whitespace ; arrow ; whitespace

168153 e <- expr

169− return . run $ makeLambda pats e

154+ return . run $ Pattern.makeLambda pats e

170155

171156defSet :: IParser [Def]

172157defSet = concat <$> block (do d <- anyDef ; whitespace ; return d)

@@ -182,7 +167,7 @@ caseExpr :: IParser Expr

182167caseExpr = do

183168 reserved "case"; whitespace; e <- expr; whitespace; reserved "of"; whitespace

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

185− where case_ = do p <- patternExpr; whitespace; arrow; whitespace

170+ where case_ = do p <- Pattern.expr; whitespace; arrow; whitespace

186171 (,) p <$> expr

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

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

@@ -192,15 +177,15 @@ expr = addLocation (choice [ ifExpr, letExpr, caseExpr ])

192177 <|> binaryExpr

193178 <?> "an expression"

194179

195−funcDef = try (do p1 <- try patternTerm ; infics p1 <|> func p1)

196− <|> ((:[]) <$> patternExpr)

180+funcDef = try (do p1 <- try Pattern.term ; infics p1 <|> func p1)

181+ <|> ((:[]) <$> Pattern.expr)

197182 <?> "the definition of a variable (x = ...)"

198− where func p@(PVar v) = (p:) <$> spacePrefix patternTerm

183+ where func p@(PVar v) = (p:) <$> spacePrefix Pattern.term

199184 func p = do try (lookAhead (whitespace >> string "="))

200185 return [p]

201186 infics p1 = do

202187 o:p <- try (whitespace >> anyOp)

203− p2 <- (whitespace >> patternTerm)

188+ p2 <- (whitespace >> Pattern.term)

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

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

206191

@@ -210,10 +195,10 @@ assignExpr = withPos $ do

210195 whitespace

211196 e <- string "=" >> whitespace >> expr

212197 n <- sourceLine <$> getPosition

213− runAt (1000 * n) $ flattenPatterns fDefs e

198+ runAt (1000 * n) $ Pattern.flatten fDefs e

214199

215200anyDef =

216− ((\d -> [d]) <$> typeAnnotation) <|>

201+ ((\d -> [d]) <$> Type.annotation) <|>

217202 assignExpr

218203

219204def = map Definition <$> anyDef

compiler/Parse/Foreign.hs+9−6

@@ -2,18 +2,19 @@

22module Parse.Foreign (foreignDef) where

44import Control.Applicative ((<$>), (<*>))

5−import Data.Either (partitionEithers)

65import Text.Parsec hiding (newline,spaces)

8−import Ast

9−import Parse.Library

10−import Parse.Expr (term)

11−import Parse.Types

7+import SourceSyntax.Declaration (Declaration(ExportEvent,ImportEvent))

8+import Parse.Helpers

9+import Parse.Expression (term)

10+import Parse.Type

1211import Types.Types (signalOf)

1312

13+foreignDef :: IParser Declaration

1414foreignDef = do try (reserved "foreign") ; whitespace

1515 importEvent <|> exportEvent

1616

17+exportEvent :: IParser Declaration

1718exportEvent = do

1819 try (reserved "export") >> whitespace >> reserved "jsevent" >> whitespace

1920 js <- jsVar ; whitespace

@@ -25,6 +26,7 @@ exportEvent = do

2526 either error (return . ExportEvent js elm . signalOf) (toForeignType pt)

2627 _ -> error "When exporting events, the exported value must be a Signal."

2728

29+importEvent :: IParser Declaration

2830importEvent = do

2931 try (reserved "import") >> whitespace >> reserved "jsevent" >> whitespace

3032 js <- jsVar ; whitespace

@@ -39,13 +41,14 @@ importEvent = do

3941 _ -> error "When importing events, the imported value must be a Signal."

4042

4143

42−jsVar :: (Monad m) => ParsecT [Char] u m String

44+jsVar :: IParser String

4345jsVar = betwixt '"' '"' $ do

4446 v <- (:) <$> (letter <|> char '_') <*> many (alphaNum <|> char '_')

4547 if v `notElem` jsReserveds then return v else

4648 error $ "'" ++ v ++

4749 "' is not a good name for a importing or exporting JS values."

4850

51+jsReserveds :: [String]

4952jsReserveds =

5053 [ "null", "undefined", "Nan", "Infinity", "true", "false", "eval"

5154 , "arguments", "int", "byte", "char", "goto", "long", "final", "float"

compiler/Parse/Literal.hsnew file+33

@@ -0,0 +1,33 @@

1+module Parse.Literal (literal) where

3+import Control.Applicative ((<$>), (<*>))

4+import Control.Monad

5+import Text.Parsec hiding (newline,spaces)

6+import Text.Parsec.Indent

8+import Parse.Helpers

9+import qualified Parse.Pattern as Pattern

10+import qualified Parse.Type as Type

11+import Parse.Binop

12+

13+import SourceSyntax.Pattern hiding (tuple,list)

14+import SourceSyntax.Literal

15+

16+literal = num <|> str <|> chr

17+

18+num :: IParser Literal

19+num = fmap toLit (preNum <?> "number")

20+ where toLit n | '.' `elem` n = FloatNum (read n)

21+ | otherwise = IntNum (read n)

22+ preNum = (++) <$> many1 digit <*> option "" postNum

23+ postNum = do try $ lookAhead (string "." >> digit)

24+ string "."

25+ ('.':) <$> many1 digit

26+

27+str :: IParser Literal

28+str = liftM Str . expecting "string" . betwixt '"' '"' . many $

29+ backslashed <|> satisfy (/='"')

30+

31+chr :: IParser Literal

32+chr = Chr <$> betwixt '\'' '\'' (backslashed <|> satisfy (/='\''))

33+ <?> "character"

compiler/Parse/Modules.hs → compiler/Parse/Module.hsrenamed+3−3

@@ -1,12 +1,12 @@

2−module Parse.Modules (moduleDef, imports) where

2+module Parse.Module (moduleDef, imports) where

44import Control.Applicative ((<$>), (<*>))

55import Data.List (intercalate)

66import Text.Parsec hiding (newline,spaces)

8−import Ast

9−import Parse.Library

8+import Parse.Helpers

9+import SourceSyntax.Module

1010

1111varList :: IParser [String]

1212varList = parens $ commaSep1 (var <|> parens symOp)

compiler/Parse/Patterns.hs → compiler/Parse/Pattern.hsrenamed+36−35

@@ -1,8 +1,6 @@

2−module Parse.Pattern (patternTerm, patternExpr, makeLambda, flattenPatterns) where

2+module Parse.Pattern (term, expr, makeLambda, flatten) where

4−import Ast

5−import Located

64import Control.Applicative ((<$>),(<*>),(*>),pure)

75import Control.Monad

86import Control.Monad.State

@@ -10,62 +8,65 @@ import Data.Char (isUpper)

108import Guid

119import Text.Parsec hiding (newline,spaces,State)

1210import Text.Parsec.Indent

13−import Parse.Library

11+import Parse.Helpers

1412

15−patternBasic :: IParser Pattern

16−patternBasic =

13+import SourceSyntax.Helpers (isOp)

14+import SourceSyntax.Location

15+import SourceSyntax.Pattern hiding (tuple,list)

16+import qualified SourceSyntax.Pattern as Pattern

17+import SourceSyntax.Expression (Expr(..), Def(..), LExpr)

18+

19+basic :: IParser Pattern

20+basic =

1721 choice [ char '_' >> return PAnything

1822 , do x@(c:_) <- var

1923 return $ if isUpper c then PData x [] else PVar x

2024 ]

2125

22−asPattern :: IParser Pattern -> IParser Pattern

26+asPattern :: Pattern -> IParser Pattern

2327asPattern pattern = do

24− p <- pattern

2528 var <- optionMaybe (try (whitespace >> reserved "as" >> whitespace >> lowVar))

2629 return $ case var of

27− Just v -> PAsVar v p

28− Nothing -> p

30+ Just v -> PAlias v pattern

31+ Nothing -> pattern

2932

30−patternRecord :: IParser Pattern

31−patternRecord = PRecord <$> brackets (commaSep1 lowVar)

33+record :: IParser Pattern

34+record = PRecord <$> brackets (commaSep1 lowVar)

3235

33−patternTuple :: IParser Pattern

34−patternTuple = do ps <- parens (commaSep patternExpr)

35− return $ case ps of { [p] -> p; _ -> ptuple ps }

36+tuple :: IParser Pattern

37+tuple = do ps <- parens (commaSep expr)

38+ return $ case ps of { [p] -> p; _ -> Pattern.tuple ps }

3639

37−patternList :: IParser Pattern

38−patternList = plist <$> braces (commaSep patternExpr)

40+list :: IParser Pattern

41+list = Pattern.list <$> braces (commaSep expr)

3942

40−patternTerm :: IParser Pattern

41−patternTerm = (choice [ patternRecord, patternTuple, patternList,

42− patternBasic ])

43− <?> "pattern"

43+term :: IParser Pattern

44+term = (choice [ record, tuple, list, basic ]) <?> "pattern"

4445

4546patternConstructor :: IParser Pattern

46−patternConstructor = PData <$> capVar <*> spacePrefix patternTerm

47+patternConstructor = PData <$> capVar <*> spacePrefix term

4748

48−patternExpr :: IParser Pattern

49−patternExpr =

50− asPattern (foldr1 pcons <$> consSep1 (patternConstructor <|> patternTerm))

51− <?> "pattern"

49+expr :: IParser Pattern

50+expr = do

51+ patterns <- consSep1 (patternConstructor <|> term)

52+ asPattern (foldr1 Pattern.cons patterns) <?> "pattern"

5253

53−makeLambda :: [Pattern] -> CExpr -> GuidCounter CExpr

54+makeLambda :: [Pattern] -> LExpr -> GuidCounter LExpr

5455makeLambda pats body = go (reverse pats) body

5556 where go [] body = return body

5657 go (p:ps) body@(L t s _) = do

5758 (x,e) <- extract p body

5859 go ps (L t s $ Lambda x e)

5960

60−extract :: Pattern -> CExpr -> GuidCounter (String, CExpr)

61+extract :: Pattern -> LExpr -> GuidCounter (String, LExpr)

6162extract pattern body@(L t s _) =

6263 let loc = L t s in

6364 let fn x e = (x,e) in

6465 case pattern of

6566 PAnything -> return $ fn "_" body

6667 PVar x -> return $ fn x body

67− PAsVar x PAnything -> return $ fn x body

68− PAsVar x p -> do

68+ PAlias x PAnything -> return $ fn x body

69+ PAlias x p -> do

6970 (x', body') <- extract p body

7071 return $ fn x (loc $ Let [FnDef x' [] (loc $ Var x)] body')

7172 PData name ps -> do

@@ -78,14 +79,14 @@ extract pattern body@(L t s _) =

7879 toDef f = FnDef f [] (loc $ Access (loc $ Var a) f)

7980 return . fn a . loc $ Let (map toDef fs) body

8081

81−extracts :: [Pattern] -> CExpr -> GuidCounter ([String], CExpr)

82+extracts :: [Pattern] -> LExpr -> GuidCounter ([String], LExpr)

8283extracts ps body = go [] (reverse ps) body

8384 where go args [] body = return (args, body)

8485 go args (p:ps) body = do (x,e) <- extract p body

8586 go (x:args) ps e

8687

87−flattenPatterns :: [Pattern] -> CExpr -> GuidCounter (IParser [Def])

88−flattenPatterns patterns exp@(L t s _) =

88+flatten :: [Pattern] -> LExpr -> GuidCounter (IParser [Def])

89+flatten patterns exp@(L t s _) =

8990 let loc = L t s in

9091 case patterns of

9192 PVar f : args -> do

@@ -99,7 +100,7 @@ flattenPatterns patterns exp@(L t s _) =

99100 _ -> return . fail $ "Pattern (" ++ unwords (map show patterns) ++

100101 ") cannot be used on the left-hand side of an assign statement."

101102

102−matchSingle :: Pattern -> CExpr -> Pattern -> GuidCounter [Def]

103+matchSingle :: Pattern -> LExpr -> Pattern -> GuidCounter [Def]

103104matchSingle pat exp@(L t s _) p =

104105 let loc = L t s in

105106 case p of

@@ -112,7 +113,7 @@ matchSingle pat exp@(L t s _) p =

112113 PVar x ->

113114 return [ FnDef x [] (loc $ Case exp [(pat, loc $ Var x)]) ]

114115

115− PAsVar x p' -> do

116+ PAlias x p' -> do

116117 subPat <- matchSingle p' (loc $ Var x) p'

117118 return $ (FnDef x [] (loc $ Case exp [(pat, loc $ Var x)])):subPat

118119

compiler/Parse/Types.hs → compiler/Parse/Type.hsrenamed+4−5

@@ -1,9 +1,8 @@

1−module Parse.Types where

1+module Parse.Type where

33import Control.Applicative ((<$>),(<*>))

44import Control.Monad (liftM,mapM)

5−import Data.Char (isUpper,isLower)

6−import Data.Maybe (fromMaybe)

5+import Data.Char (isLower)

76import Data.List (lookup,intercalate)

87import Text.Parsec

98import Text.Parsec.Indent

@@ -103,8 +102,8 @@ toConstructor start end alias (Just _) kvs =

103102 rec = foldl insert (Var "_ext_") (zip args (map (loc . Var) args))

104103 insert e (k,v) = Insert (loc e) k v

105104

106−typeAnnotation :: IParser Def

107−typeAnnotation = TypeAnnotation <$> try start <*> (toType <$> typeExpr)

105+annotation :: IParser Def

106+annotation = TypeAnnotation <$> try start <*> (toType <$> typeExpr)

108107 where start = do v <- lowVar <|> parens symOp

109108 whitespace ; hasType ; whitespace ; return v

110109