0725fe3 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Update Parse/ module for new AST structure

0725fe3Evan Czaplicki13 years ago

compiler/Parse/Binop.hs+19−17

compare with master

unifiedsplit

@@ -5,9 +5,11 @@ import Control.Applicative ((<$>))

5import qualified Data.List as List

6import qualified Data.Map as Map

8−import SourceSyntax.Annotation (merge)

8+import AST.Annotation (merge)

9−import qualified SourceSyntax.Expression as E

10−import SourceSyntax.Declaration (Assoc(..))

9+import AST.Declaration (Assoc(..))

10+import AST.Expression.General (Expr'(Binop))

11+import qualified AST.Expression.Source as Source

12+import qualified AST.Variable as Var

11import Text.Parsec

13import Text.Parsec

12import Parse.Helpers

14import Parse.Helpers

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

17opAssoc :: OpTable -> String -> Assoc

19opAssoc :: OpTable -> String -> Assoc

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

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

20−hasLevel :: OpTable -> Int -> (String, E.ParseExpr) -> Bool

22+hasLevel :: OpTable -> Int -> (String, Source.Expr) -> Bool

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

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

23−binops :: IParser E.ParseExpr

25+binops :: IParser Source.Expr

24− -> IParser E.ParseExpr

26+ -> IParser Source.Expr

25 -> IParser String

27 -> IParser String

26− -> IParser E.ParseExpr

28+ -> IParser Source.Expr

27binops term last anyOp =

29binops term last anyOp =

28 do e <- term

30 do e <- term

29 table <- getState

31 table <- getState

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

40split :: OpTable

42split :: OpTable

41 -> Int

43 -> Int

42− -> E.ParseExpr

44+ -> Source.Expr

43− -> [(String, E.ParseExpr)]

45+ -> [(String, Source.Expr)]

44− -> IParser E.ParseExpr

46+ -> IParser Source.Expr

45split _ _ e [] = return e

47split _ _ e [] = return e

46split table n e eops = do

48split table n e eops = do

47 assoc <- getAssoc table n eops

49 assoc <- getAssoc table n eops

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

50 case assoc of R -> joinR es ops

52 case assoc of R -> joinR es ops

51 _ -> joinL es ops

53 _ -> joinL es ops

53−splitLevel :: OpTable -> Int -> E.ParseExpr -> [(String, E.ParseExpr)]

55+splitLevel :: OpTable -> Int -> Source.Expr -> [(String, Source.Expr)]

54− -> [IParser E.ParseExpr]

56+ -> [IParser Source.Expr]

55splitLevel table n e eops =

57splitLevel table n e eops =

56 case break (hasLevel table n) eops of

58 case break (hasLevel table n) eops of

57 (lops, (_op,e'):rops) ->

59 (lops, (_op,e'):rops) ->

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

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

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

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

61−joinL :: [E.ParseExpr] -> [String] -> IParser E.ParseExpr

63+joinL :: [Source.Expr] -> [String] -> IParser Source.Expr

62joinL [e] [] = return e

64joinL [e] [] = return e

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

65+joinL (a:b:es) (op:ops) = joinL (merge a b (Binop (Var.Raw op) a b) : es) ops

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

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

66−joinR :: [E.ParseExpr] -> [String] -> IParser E.ParseExpr

68+joinR :: [Source.Expr] -> [String] -> IParser Source.Expr

67joinR [e] [] = return e

69joinR [e] [] = return e

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

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

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

71+ return (merge a e (Binop (Var.Raw op) a e))

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

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

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

74+getAssoc :: OpTable -> Int -> [(String,Source.Expr)] -> IParser Assoc

73getAssoc table n eops

75getAssoc table n eops

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

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

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

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

compiler/Parse/Declaration.hs+7−8

@@ -7,16 +7,15 @@ import Text.Parsec hiding (newline,spaces)

7import Parse.Helpers

8import qualified Parse.Expression as Expr

9import qualified Parse.Type as Type

10−import qualified SourceSyntax.Declaration as D

10+import qualified AST.Declaration as D

12−

13−declaration :: IParser D.ParseDeclaration

12+declaration :: IParser D.SourceDecl

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

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

16−definition :: IParser D.ParseDeclaration

15+definition :: IParser D.SourceDecl

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

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

19−alias :: IParser D.ParseDeclaration

18+alias :: IParser D.SourceDecl

20alias = do

19alias = do

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

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

22 forcedWS

21 forcedWS

@@ -26,7 +25,7 @@ alias = do

26 tipe <- Type.expr

25 tipe <- Type.expr

27 return (D.TypeAlias name args tipe)

26 return (D.TypeAlias name args tipe)

29−datatype :: IParser D.ParseDeclaration

28+datatype :: IParser D.SourceDecl

30datatype = do

29datatype = do

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

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

32 forcedWS

31 forcedWS

@@ -37,7 +36,7 @@ datatype = do

37 return $ D.Datatype name args tcs

36 return $ D.Datatype name args tcs

40−infixDecl :: IParser D.ParseDeclaration

39+infixDecl :: IParser D.SourceDecl

41infixDecl = do

40infixDecl = do

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

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

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

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

@@ -48,7 +47,7 @@ infixDecl = do

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

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

51−port :: IParser D.ParseDeclaration

50+port :: IParser D.SourceDecl

52port =

51port =

53 do try (reserved "port")

52 do try (reserved "port")

54 whitespace

53 whitespace

compiler/Parse/Expression.hs+31−29

@@ -11,39 +11,41 @@ import Parse.Literal

11import qualified Parse.Pattern as Pattern

12import qualified Parse.Type as Type

14−import SourceSyntax.Annotation as Annotation

14+import AST.Annotation as Annotation

15−import qualified SourceSyntax.Pattern as P

15+import AST.Expression.General

16+import qualified AST.Expression.Source as Source

17+import qualified AST.Literal as L

18+import qualified AST.Pattern as P

16−import qualified SourceSyntax.Literal as L

19+import qualified AST.Variable as Var

17−import SourceSyntax.Expression

20-------- Basic Terms --------

22-------- Basic Terms --------

22−varTerm :: IParser ParseExpr'

24+varTerm :: IParser Source.Expr'

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

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

25−toVar :: String -> ParseExpr'

27+toVar :: String -> Source.Expr'

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

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

27 "False" -> Literal (L.Boolean False)

29 "False" -> Literal (L.Boolean False)

28 _ -> rawVar v

30 _ -> rawVar v

30−accessor :: IParser ParseExpr'

32+accessor :: IParser Source.Expr'

31accessor = do

33accessor = do

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

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

33 let loc e = Annotation.at start end e

35 let loc e = Annotation.at start end e

34 return (Lambda (P.Var "_") (loc $ Access (loc $ rawVar "_") lbl))

36 return (Lambda (P.Var "_") (loc $ Access (loc $ rawVar "_") lbl))

36−negative :: IParser ParseExpr'

38+negative :: IParser Source.Expr'

37negative = do

39negative = do

38 (start, nTerm, end) <-

40 (start, nTerm, end) <-

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

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

40 let loc e = Annotation.at start end e

42 let loc e = Annotation.at start end e

41− return (Binop "-" (loc $ Literal (L.IntNum 0)) nTerm)

43+ return (Binop (Var.Raw "-") (loc $ Literal (L.IntNum 0)) nTerm)

44-------- Complex Terms --------

46-------- Complex Terms --------

46−listTerm :: IParser ParseExpr'

48+listTerm :: IParser Source.Expr'

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

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

48 where

50 where

49 range = do

51 range = do

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

66 string "}}"

68 string "}}"

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

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

69−parensTerm :: IParser ParseExpr

71+parensTerm :: IParser Source.Expr

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

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

71 where

73 where

72 opFn = do

74 opFn = do

73 (start, op, end) <- located anyOp

75 (start, op, end) <- located anyOp

74 let loc = Annotation.at start end

76 let loc = Annotation.at start end

75 return . loc . Lambda (P.Var "x") . loc . Lambda (P.Var "y") . loc $

77 return . loc . Lambda (P.Var "x") . loc . Lambda (P.Var "y") . loc $

76− Binop op (loc $ rawVar "x") (loc $ rawVar "y")

78+ Binop (Var.Raw op) (loc (rawVar "x")) (loc (rawVar "y"))

78 tupleFn = do

80 tupleFn = do

79 let comma = char ',' <?> "comma ','"

81 let comma = char ',' <?> "comma ','"

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

89 [e] -> e

91 [e] -> e

90 _ -> Annotation.at start end (tuple es)

92 _ -> Annotation.at start end (tuple es)

92−recordTerm :: IParser ParseExpr

94+recordTerm :: IParser Source.Expr

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

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

94 where

96 where

95 field = do

97 field = do

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

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

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

124

126

125

127

126−term :: IParser ParseExpr

128+term :: IParser Source.Expr

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

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

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

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

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

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

130

132

131-------- Applications --------

133-------- Applications --------

132

134

133−appExpr :: IParser ParseExpr

135+appExpr :: IParser Source.Expr

134appExpr = do

136appExpr = do

135 t <- term

137 t <- term

136 ts <- constrainedSpacePrefix term $ \str ->

138 ts <- constrainedSpacePrefix term $ \str ->

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

141

143

142-------- Normal Expressions --------

144-------- Normal Expressions --------

143

145

144−binaryExpr :: IParser ParseExpr

146+binaryExpr :: IParser Source.Expr

145binaryExpr = binops appExpr lastExpr anyOp

147binaryExpr = binops appExpr lastExpr anyOp

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

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

147 <|> lambdaExpr

149 <|> lambdaExpr

148

150

149−ifExpr :: IParser ParseExpr'

151+ifExpr :: IParser Source.Expr'

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

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

151 where

153 where

152 normal = do

154 normal = do

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

162 b <- expr ; padded arrow

164 b <- expr ; padded arrow

163 (,) b <$> expr

165 (,) b <$> expr

164

166

165−lambdaExpr :: IParser ParseExpr

167+lambdaExpr :: IParser Source.Expr

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

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

167 whitespace

169 whitespace

168 args <- spaceSep1 Pattern.term

170 args <- spaceSep1 Pattern.term

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

170 body <- expr

172 body <- expr

171 return (makeFunction args body)

173 return (makeFunction args body)

172

174

173−defSet :: IParser [ParseDef]

175+defSet :: IParser [Source.Def]

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

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

175

177

176−letExpr :: IParser ParseExpr'

178+letExpr :: IParser Source.Expr'

177letExpr = do

179letExpr = do

178 reserved "let" ; whitespace

180 reserved "let" ; whitespace

179 defs <- defSet

181 defs <- defSet

180 padded (reserved "in")

182 padded (reserved "in")

181 Let defs <$> expr

183 Let defs <$> expr

182

184

183−caseExpr :: IParser ParseExpr'

185+caseExpr :: IParser Source.Expr'

184caseExpr = do

186caseExpr = do

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

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

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

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

@@ -190,13 +192,13 @@ caseExpr = do

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

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

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

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

192

194

193−expr :: IParser ParseExpr

195+expr :: IParser Source.Expr

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

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

195 <|> lambdaExpr

197 <|> lambdaExpr

196 <|> binaryExpr

198 <|> binaryExpr

197 <?> "an expression"

199 <?> "an expression"

198

200

199−defStart :: IParser [P.Pattern]

201+defStart :: IParser [Pattern.RawPattern]

200defStart =

202defStart =

201 choice [ do p1 <- try Pattern.term

203 choice [ do p1 <- try Pattern.term

202 infics p1 <|> func p1

204 infics p1 <|> func p1

@@ -216,24 +218,24 @@ defStart =

216 return $ if o == '`' then [ P.Var $ takeWhile (/='`') p, p1, p2 ]

218 return $ if o == '`' then [ P.Var $ takeWhile (/='`') p, p1, p2 ]

217 else [ P.Var (o:p), p1, p2 ]

219 else [ P.Var (o:p), p1, p2 ]

218

220

219−makeFunction :: [P.Pattern] -> ParseExpr -> ParseExpr

221+makeFunction :: [Pattern.RawPattern] -> Source.Expr -> Source.Expr

220makeFunction args body@(A ann _) =

222makeFunction args body@(A ann _) =

221 foldr (\arg body' -> A ann $ Lambda arg body') body args

223 foldr (\arg body' -> A ann $ Lambda arg body') body args

222

224

223−definition :: IParser ParseDef

225+definition :: IParser Source.Def

224definition = withPos $ do

226definition = withPos $ do

225 (name:args) <- defStart

227 (name:args) <- defStart

226 padded equals

228 padded equals

227 body <- expr

229 body <- expr

228− return . Def name $ makeFunction args body

230+ return . Source.Definition name $ makeFunction args body

229

231

230−typeAnnotation :: IParser ParseDef

232+typeAnnotation :: IParser Source.Def

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

233+typeAnnotation = Source.TypeAnnotation <$> try start <*> Type.expr

232 where

234 where

233 start = do

235 start = do

234 v <- lowVar <|> parens symOp

236 v <- lowVar <|> parens symOp

235 padded hasType

237 padded hasType

236 return v

238 return v

237

239

238−def :: IParser ParseDef

240+def :: IParser Source.Def

239def = typeAnnotation <|> definition

241def = typeAnnotation <|> definition

compiler/Parse/Helpers.hs+8−7

@@ -12,12 +12,13 @@ import Text.Parsec hiding (newline,spaces,State)

12import Text.Parsec.Indent

13import qualified Text.Parsec.Token as T

15−import SourceSyntax.Annotation as Annotation

15+import AST.Annotation as Annotation

16−import SourceSyntax.Declaration (Assoc)

16+import AST.Declaration (Assoc)

17−import SourceSyntax.Expression

17+import AST.Expression.General

18+import qualified AST.Expression.Source as Source

18−import SourceSyntax.Helpers as Help

19+import AST.Helpers as Help

19−import SourceSyntax.PrettyPrint

20+import AST.PrettyPrint

20−import SourceSyntax.Variable as Variable

21+import qualified AST.Variable as Variable

22reserveds = [ "if", "then", "else"

23reserveds = [ "if", "then", "else"

23 , "case", "of"

24 , "case", "of"

@@ -197,7 +198,7 @@ located p = do

197 end <- getPosition

198 end <- getPosition

198 return (start, e, end)

199 return (start, e, end)

199

200

200−accessible :: IParser ParseExpr -> IParser ParseExpr

201+accessible :: IParser Source.Expr -> IParser Source.Expr

201accessible expr = do

202accessible expr = do

202 start <- getPosition

203 start <- getPosition

203 ce@(A _ e) <- expr

204 ce@(A _ e) <- expr

compiler/Parse/Literal.hs+1−1

@@ -4,7 +4,7 @@ module Parse.Literal (literal) where

4import Control.Applicative ((<$>))

5import Text.Parsec hiding (newline,spaces)

6import Parse.Helpers

7−import SourceSyntax.Literal

7+import AST.Literal

9literal :: IParser Literal

10literal = num <|> (Str <$> str) <|> (Chr <$> chr) <?> "literal"

compiler/Parse/Module.hs+18−11

@@ -5,10 +5,8 @@ import Data.List (intercalate)

5import Text.Parsec hiding (newline,spaces)

7import Parse.Helpers

8−import SourceSyntax.Module (ImportMethod(..), Imports)

8+import AST.Module (ImportMethod(..))

9−

9+import AST.Variable (Listing(..), Value(..))

10−varList :: IParser [String]

11−varList = commaSep1 (var <|> parens symOp)

13getModuleName :: String -> Maybe String

11getModuleName :: String -> Maybe String

14getModuleName source =

12getModuleName source =

@@ -21,18 +19,18 @@ getModuleName source =

21 (names, _) <- moduleDef

19 (names, _) <- moduleDef

22 return (intercalate "." names)

20 return (intercalate "." names)

24−moduleDef :: IParser ([String], [String])

22+moduleDef :: IParser ([String], Listing Value)

25moduleDef = do

23moduleDef = do

26 try (reserved "module")

24 try (reserved "module")

27 whitespace

25 whitespace

28 names <- dotSep1 capVar <?> "name of module"

26 names <- dotSep1 capVar <?> "name of module"

29 whitespace

27 whitespace

30− exports <- option [] (parens varList)

28+ exports <- option (Listing [] True) (listing value)

31 whitespace <?> "reserved word 'where'"

29 whitespace <?> "reserved word 'where'"

32 reserved "where"

30 reserved "where"

33 return (names, exports)

31 return (names, exports)

35−imports :: IParser Imports

33+imports :: IParser [(String, ImportMethod)]

36imports = option [] ((:) <$> import' <*> many (try (freshLine >> import')))

34imports = option [] ((:) <$> import' <*> many (try (freshLine >> import')))

38import' :: IParser (String, ImportMethod)

36import' :: IParser (String, ImportMethod)

@@ -53,7 +51,16 @@ import' =

53 As <$> capVar <?> "alias for module"

51 As <$> capVar <?> "alias for module"

55 importing' :: IParser ImportMethod

53 importing' :: IParser ImportMethod

56− importing' =

54+ importing' = Open <$> listing value

55+

56+listing :: IParser a -> IParser (Listing a)

57+listing item =

57− parens (choice [ const (Hiding []) <$> string ".."

58+ parens (choice [ const (Listing [] True) <$> string ".."

58− , Importing <$> varList

59+ , Listing <$> commaSep1 item <*> return False

59− ] <?> "listing of imported values (x,y,z)")

60+ ] <?> "listing of values (x,y,z)")

61+

62+value :: IParser Value

63+value = choice [ Value <$> (lowVar <|> parens symOp)

64+ , ADT <$> capVar <*> listing capVar

65+ ]

66+

compiler/Parse/Parse.hs+13−9

@@ -7,8 +7,9 @@ import qualified Data.Map as Map

7import Text.Parsec hiding (newline,spaces)

8import qualified Text.PrettyPrint as P

10−import qualified SourceSyntax.Declaration as D

10+import qualified AST.Declaration as D

11−import qualified SourceSyntax.Module as M

11+import qualified AST.Module as M

12+import qualified AST.Variable as Var

12import Parse.Helpers

13import Parse.Helpers

13import Parse.Declaration (infixDecl)

14import Parse.Declaration (infixDecl)

14import Parse.Module

15import Parse.Module

@@ -22,21 +23,24 @@ freshDef = commitIf (freshLine >> (letter <|> char '_')) $ do

22decls = do d <- Decl.declaration <?> "at least one datatype or variable definition"

23decls = do d <- Decl.declaration <?> "at least one datatype or variable definition"

23 (d:) <$> many freshDef

24 (d:) <$> many freshDef

25−program :: OpTable -> String -> Either [P.Doc] (M.Module D.Declaration)

26+program :: OpTable -> String -> Either [P.Doc] M.ValidModule

26program table src =

27program table src =

28+ do (M.Module names filePath exs ims parseDecls) <-

27− do (M.Module names exs ims parseDecls) <- setupParserWithTable table programParser src

29+ setupParserWithTable table programParser src

30+ decls <-

28− decls <- either (\err -> Left [P.text err]) Right (combineAnnotations parseDecls)

31+ either (\err -> Left [P.text err]) Right (combineAnnotations parseDecls)

29− return $ M.Module names exs ims decls

32+ return $ M.Module names filePath exs ims decls

31−programParser :: IParser (M.Module D.ParseDeclaration)

34+programParser :: IParser M.SourceModule

32programParser =

35programParser =

33 do optional freshLine

36 do optional freshLine

37+ (names,exports) <-

34− (names,exports) <- option (["Main"],[]) (moduleDef `followedBy` freshLine)

38+ option (["Main"], Var.openListing) (moduleDef `followedBy` freshLine)

35 is <- (do try (lookAhead $ reserved "import")

39 is <- (do try (lookAhead $ reserved "import")

36 imports `followedBy` freshLine) <|> return []

40 imports `followedBy` freshLine) <|> return []

37 declarations <- decls

41 declarations <- decls

38 optional freshLine ; optional spaces ; eof

42 optional freshLine ; optional spaces ; eof

39− return $ M.Module names exports is declarations

43+ return $ M.Module names "" exports is declarations

41dependencies :: String -> Either [P.Doc] (String, [String])

45dependencies :: String -> Either [P.Doc] (String, [String])

42dependencies =

46dependencies =

compiler/Parse/Pattern.hs+16−13

@@ -1,5 +1,5 @@

1{-# OPTIONS_GHC -W #-}

2−module Parse.Pattern (term, expr) where

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

4import Control.Applicative ((<$>))

5import Data.Char (isUpper)

@@ -8,54 +8,57 @@ import Text.Parsec hiding (newline,spaces,State)

9import Parse.Helpers

10import Parse.Literal

11−import SourceSyntax.Literal

11+import AST.Literal

12−import qualified SourceSyntax.Pattern as P

12+import qualified AST.Pattern as P

13+import qualified AST.Variable as Var

15+type RawPattern = P.Pattern Var.Raw

16+

14−basic :: IParser P.Pattern

17+basic :: IParser RawPattern

15basic = choice

18basic = choice

16 [ char '_' >> return P.Anything

19 [ char '_' >> return P.Anything

17 , do v <- var

20 , do v <- var

18 return $ case v of

21 return $ case v of

19 "True" -> P.Literal (Boolean True)

22 "True" -> P.Literal (Boolean True)

20 "False" -> P.Literal (Boolean False)

23 "False" -> P.Literal (Boolean False)

21− c:_ | isUpper c -> P.Data v []

24+ c:_ | isUpper c -> P.Data (Var.Raw v) []

22 _ -> P.Var v

25 _ -> P.Var v

23 , P.Literal <$> literal

26 , P.Literal <$> literal

24 ]

27 ]

26−asPattern :: P.Pattern -> IParser P.Pattern

29+asPattern :: RawPattern -> IParser RawPattern

27asPattern pattern = do

30asPattern pattern = do

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

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

29 return $ case var of

32 return $ case var of

30 Just v -> P.Alias v pattern

33 Just v -> P.Alias v pattern

31 Nothing -> pattern

34 Nothing -> pattern

33−record :: IParser P.Pattern

36+record :: IParser RawPattern

34record = P.Record <$> brackets (commaSep1 lowVar)

37record = P.Record <$> brackets (commaSep1 lowVar)

36−tuple :: IParser P.Pattern

39+tuple :: IParser RawPattern

37tuple = do

40tuple = do

38 ps <- parens (commaSep expr)

41 ps <- parens (commaSep expr)

39 return $ case ps of

42 return $ case ps of

40 [p] -> p

43 [p] -> p

41 _ -> P.tuple ps

44 _ -> P.tuple ps

43−list :: IParser P.Pattern

46+list :: IParser RawPattern

44list = P.list <$> braces (commaSep expr)

47list = P.list <$> braces (commaSep expr)

46−term :: IParser P.Pattern

49+term :: IParser RawPattern

47term =

50term =

48 (choice [ record, tuple, list, basic ]) <?> "pattern"

51 (choice [ record, tuple, list, basic ]) <?> "pattern"

50−patternConstructor :: IParser P.Pattern

53+patternConstructor :: IParser RawPattern

51patternConstructor = do

54patternConstructor = do

52 v <- List.intercalate "." <$> dotSep1 capVar

55 v <- List.intercalate "." <$> dotSep1 capVar

53 case v of

56 case v of

54 "True" -> return $ P.Literal (Boolean True)

57 "True" -> return $ P.Literal (Boolean True)

55 "False" -> return $ P.Literal (Boolean False)

58 "False" -> return $ P.Literal (Boolean False)

56− _ -> P.Data v <$> spacePrefix term

59+ _ -> P.Data (Var.Raw v) <$> spacePrefix term

58−expr :: IParser P.Pattern

61+expr :: IParser RawPattern

59expr = do

62expr = do

60 patterns <- consSep1 (patternConstructor <|> term)

63 patterns <- consSep1 (patternConstructor <|> term)

61 asPattern (foldr1 P.cons patterns) <?> "pattern"

64 asPattern (foldr1 P.cons patterns) <?> "pattern"

compiler/Parse/Type.hs+18−15

@@ -5,22 +5,25 @@ import Control.Applicative ((<$>),(<*>),(<*))

5import Data.List (intercalate)

6import Text.Parsec

8−import SourceSyntax.Type as T

8+import qualified AST.Type as T

9+import qualified AST.Variable as Var

9import Parse.Helpers

10import Parse.Helpers

12+type RawType = T.Type Var.Raw

13+

11−tvar :: IParser T.Type

14+tvar :: IParser RawType

12tvar = T.Var <$> lowVar <?> "type variable"

15tvar = T.Var <$> lowVar <?> "type variable"

14−list :: IParser T.Type

17+list :: IParser RawType

15−list = listOf <$> braces expr

18+list = T.listOf <$> braces expr

17−tuple :: IParser T.Type

20+tuple :: IParser RawType

18tuple = do ts <- parens (commaSep expr)

21tuple = do ts <- parens (commaSep expr)

19 return $ case ts of

22 return $ case ts of

20 [t] -> t

23 [t] -> t

21− _ -> tupleOf ts

24+ _ -> T.tupleOf ts

23−record :: IParser T.Type

26+record :: IParser RawType

24record =

27record =

25 do char '{' ; whitespace

28 do char '{' ; whitespace

26 rcrd <- extended <|> normal

29 rcrd <- extended <|> normal

@@ -33,7 +36,7 @@ record =

33 extended = do

36 extended = do

34 ext <- try (lowVar <* (whitespace >> string "|"))

37 ext <- try (lowVar <* (whitespace >> string "|"))

35 whitespace

38 whitespace

36− flip T.Record (Just ext) <$> commaSep1 field

39+ flip T.Record (Just (T.Var ext)) <$> commaSep1 field

38 field = do

41 field = do

39 lbl <- rLabel

42 lbl <- rLabel

@@ -43,25 +46,25 @@ record =

43capTypeVar :: IParser String

46capTypeVar :: IParser String

44capTypeVar = intercalate "." <$> dotSep1 capVar

47capTypeVar = intercalate "." <$> dotSep1 capVar

46−constructor0 :: IParser T.Type

49+constructor0 :: IParser RawType

47constructor0 =

50constructor0 =

48 do name <- capTypeVar

51 do name <- capTypeVar

49− return (T.Data name [])

52+ return (T.Data (Var.Raw name) [])

51−term :: IParser T.Type

54+term :: IParser RawType

52term = list <|> tuple <|> record <|> tvar <|> constructor0

55term = list <|> tuple <|> record <|> tvar <|> constructor0

54−app :: IParser T.Type

57+app :: IParser RawType

55app =

58app =

56 do name <- capTypeVar <|> try tupleCtor <?> "type constructor"

59 do name <- capTypeVar <|> try tupleCtor <?> "type constructor"

57 args <- spacePrefix term

60 args <- spacePrefix term

58− return (T.Data name args)

61+ return (T.Data (Var.Raw name) args)

59 where

62 where

60 tupleCtor = do

63 tupleCtor = do

61 n <- length <$> parens (many (char ','))

64 n <- length <$> parens (many (char ','))

62 return $ "_Tuple" ++ show (if n == 0 then 0 else n+1)

65 return $ "_Tuple" ++ show (if n == 0 then 0 else n+1)

64−expr :: IParser T.Type

67+expr :: IParser RawType

65expr =

68expr =

66 do t1 <- app <|> term

69 do t1 <- app <|> term

67 arr <- optionMaybe $ try (whitespace >> arrow)

70 arr <- optionMaybe $ try (whitespace >> arrow)

@@ -69,6 +72,6 @@ expr =

69 Just _ -> T.Lambda t1 <$> (whitespace >> expr)

72 Just _ -> T.Lambda t1 <$> (whitespace >> expr)

70 Nothing -> return t1

73 Nothing -> return t1

72−constructor :: IParser (String, [T.Type])

75+constructor :: IParser (String, [RawType])

73constructor = (,) <$> (capTypeVar <?> "another type constructor")

76constructor = (,) <$> (capTypeVar <?> "another type constructor")

74 <*> spacePrefix term

77 <*> spacePrefix term