89ba043 · elk · git.iko.soy

git.iko.soy/elk

Merge in Parse/ changes from dependencies branch

commit89ba0437523661802d700e92f4e7c153feeccf6a authorEvan Czaplicki <info@elm-lang.org> dateTue 7 Oct 2014, 19:10 (12 years ago) parentcf12033

11 files changed+237−166

compare with master

unifiedsplit

compiler/AST/Module.hs+52−18 compiler/Docs.hs+2−2 compiler/Parse/Binop.hs+3−3 compiler/Parse/Declaration.hs+5−4 compiler/Parse/Expression.hs+44−38 compiler/Parse/Helpers.hs+57−39 compiler/Parse/Literal.hs+7−7 compiler/Parse/Module.hs+36−24 compiler/Parse/Parse.hs+16−18 compiler/Parse/Pattern.hs+14−12 compiler/Parse/Type.hs+1−1

compiler/AST/Module.hs+52−18

@@ -10,24 +10,46 @@ import qualified AST.Expression.Canonical as Canonical

1010import qualified AST.Declaration as Decl

1111import qualified AST.Type as Type

1212import qualified AST.Variable as Var

13−

1413import AST.PrettyPrint

1514import Text.PrettyPrint as P

16−

1715import qualified Elm.Internal.Version as Version

1816

19−data Module exs body = Module

20− { names :: [String]

17+

18+-- HELPFUL TYPE ALIASES

19+

20+type Interfaces = Map.Map String Interface

21+

22+type Types = Map.Map String Type.CanonicalType

23+type Aliases = Map.Map String ([String], Type.CanonicalType)

24+type ADTs = Map.Map String (AdtInfo String)

25+

26+type AdtInfo v = ( [String], [(v, [Type.CanonicalType])] )

27+type CanonicalAdt = (Var.Canonical, AdtInfo Var.Canonical)

28+

29+

30+-- MODULES

31+

32+type SourceModule =

33+ Module (Var.Listing Var.Value) [Decl.SourceDecl]

34+

35+type ValidModule =

36+ Module (Var.Listing Var.Value) [Decl.ValidDecl]

37+

38+type CanonicalModule =

39+ Module [Var.Value] CanonicalBody

40+

41+getName :: Module exs body -> String

42+getName modul =

43+ nameToString (names modul)

44+

45+data Module exports body = Module

46+ { names :: Name

2147 , path :: FilePath

22− , exports :: exs

48+ , exports :: exports

2349 , imports :: [(String, ImportMethod)]

2450 , body :: body

2551 }

2652

27−getName :: Module exs body -> String

28−getName modul =

29− List.intercalate "." (names modul)

30−

3153data CanonicalBody = CanonicalBody

3254 { program :: Canonical.Expr

3355 , types :: Types

@@ -37,19 +59,25 @@ data CanonicalBody = CanonicalBody

3759 , ports :: [String]

3860 }

3961

40−type SourceModule = Module (Var.Listing Var.Value) [Decl.SourceDecl]

41−type ValidModule = Module (Var.Listing Var.Value) [Decl.ValidDecl]

42−type CanonicalModule = Module [Var.Value] CanonicalBody

4362

44−type Interfaces = Map.Map String Interface

63+-- HEADERS

4564

46−type Types = Map.Map String Type.CanonicalType

47−type Aliases = Map.Map String ( [String], Type.CanonicalType )

48−type ADTs = Map.Map String (AdtInfo String)

65+{-| Basic info needed to identify modules and determine dependencies. -}

66+data HeaderAndImports = HeaderAndImports

67+ { _names :: Name

68+ , _exports :: Var.Listing Var.Value

69+ , _imports :: [(Name, ImportMethod)]

70+ }

4971

50−type AdtInfo v = ( [String], [(v, [Type.CanonicalType])] )

51−type CanonicalAdt = (Var.Canonical, AdtInfo Var.Canonical)

72+type Name = [String] -- must be non-empty

73+

74+nameToString :: Name -> String

75+nameToString = List.intercalate "."

76+

77+

78+-- INTERFACES

5279

80+{-| Key facts about a module, used when reading info from .elmi files. -}

5381data Interface = Interface

5482 { iVersion :: Version.Version

5583 , iExports :: [Var.Value]

@@ -87,6 +115,9 @@ instance Binary Interface where

87115 put (iFixities modul)

88116 put (iPorts modul)

89117

118+

119+-- IMPORT METHOD

120+

90121data ImportMethod

91122 = As !String

92123 | Open !(Var.Listing Var.Value)

@@ -109,6 +140,9 @@ instance Binary ImportMethod where

109140 1 -> Open <$> get

110141 _ -> error "Error reading valid ImportMethod type from serialized string"

111142

143+

144+-- PRETTY PRINTING

145+

112146instance (Pretty exs, Pretty body) => Pretty (Module exs body) where

113147 pretty (Module names _ exs ims body) =

114148 P.vcat [modul, P.text "", prettyImports, P.text "", pretty body]

compiler/Docs.hs+2−2

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

2828import Parse.Declaration (alias,datatype,infixDecl)

2929import Parse.Expression (typeAnnotation)

3030import Parse.Helpers

31−import Parse.Module (moduleDef)

31+import qualified Parse.Module as Module

3232

3333data Flags = Flags

3434 { files :: [FilePath] }

@@ -80,7 +80,7 @@ docComment = do

8080moduleDocs :: IParser (String, Var.Listing Var.Value, String)

8181moduleDocs = do

8282 optional freshLine

83− (names,exports) <- moduleDef

83+ (names,exports) <- Module.header

8484 manyTill (string " " <|> newline <?> "more whitespace")

8585 (lookAhead (string "{-|") <?> "module documentation comment")

8686 structure <- docComment

compiler/Parse/Binop.hs+3−3

@@ -4,14 +4,14 @@ module Parse.Binop (binops, OpTable) where

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

55import qualified Data.List as List

66import qualified Data.Map as Map

7+import Text.Parsec ((<|>), choice, getState, try)

89import AST.Annotation (merge)

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

10+import AST.Declaration (Assoc(L, N, R))

1011import AST.Expression.General (Expr'(Binop))

1112import qualified AST.Expression.Source as Source

1213import qualified AST.Variable as Var

13−import Text.Parsec

14−import Parse.Helpers

14+import Parse.Helpers (IParser, OpTable, commitIf, failure, whitespace)

1515

1616opLevel :: OpTable -> String -> Int

1717opLevel table op = fst $ Map.findWithDefault (9,L) op table

compiler/Parse/Declaration.hs+5−4

@@ -2,15 +2,16 @@

22module Parse.Declaration where

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

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

5+import Text.Parsec ((<|>), (<?>), choice, digit, try)

7−import Parse.Helpers

7+import qualified AST.Declaration as D

88import qualified Parse.Expression as Expr

9+import Parse.Helpers

910import qualified Parse.Type as Type

10−import qualified AST.Declaration as D

1111

1212declaration :: IParser D.SourceDecl

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

13+declaration =

14+ alias <|> datatype <|> infixDecl <|> port <|> definition

1415

1516definition :: IParser D.SourceDecl

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

compiler/Parse/Expression.hs+44−38

@@ -1,18 +1,19 @@

11module Parse.Expression (def,term,typeAnnotation,expr) where

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

4−import Data.List (foldl')

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

6−import Text.Parsec.Indent

7−

8−import Parse.Binop

9−import Parse.Helpers as Help

10−import Parse.Literal

4+import qualified Data.List as List

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

6+import Text.Parsec.Indent (block, withPos)

8+import qualified Parse.Binop as Binop

9+import Parse.Helpers

10+import qualified Parse.Helpers as Help

11+import qualified Parse.Literal as Literal

1112import qualified Parse.Pattern as Pattern

1213import qualified Parse.Type as Type

1314

14−import AST.Annotation as Annotation

15−import AST.Expression.General

15+import qualified AST.Annotation as Annotation

16+import qualified AST.Expression.General as E

1617import qualified AST.Expression.Source as Source

1718import qualified AST.Literal as L

1819import qualified AST.Pattern as P

@@ -25,45 +26,47 @@ varTerm :: IParser Source.Expr'

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

2627

2728toVar :: String -> Source.Expr'

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

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

30− _ -> rawVar v

29+toVar v =

30+ case v of

31+ "True" -> E.Literal (L.Boolean True)

32+ "False" -> E.Literal (L.Boolean False)

33+ _ -> E.rawVar v

3134

3235accessor :: IParser Source.Expr'

3336accessor = do

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

3538 let loc e = Annotation.at start end e

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

39+ return (E.Lambda (P.Var "_") (loc $ E.Access (loc $ E.rawVar "_") lbl))

3740

3841negative :: IParser Source.Expr'

3942negative = do

4043 (start, nTerm, end) <-

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

4245 let loc e = Annotation.at start end e

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

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

4447

4548

4649-------- Complex Terms --------

4750

4851listTerm :: IParser Source.Expr'

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

52+listTerm = markdown' <|> shader' <|> braces (try range <|> E.ExplicitList <$> commaSep expr)

5053 where

5154 range = do

5255 lo <- expr

5356 padded (string "..")

54− Range lo <$> expr

57+ E.Range lo <$> expr

5558

5659 markdown' = do

5760 pos <- getPosition

5861 let uid = show (sourceLine pos) ++ ":" ++ show (sourceColumn pos)

5962 (rawText, exprs) <- Help.markdown (interpolation uid)

60− return (Markdown uid (filter (/='\r') rawText) exprs)

63+ return (E.Markdown uid (filter (/='\r') rawText) exprs)

6164

6265 shader' = do

6366 pos <- getPosition

6467 let uid = show (sourceLine pos) ++ ":" ++ show (sourceColumn pos)

6568 (rawSrc, tipe) <- Help.shader

66− return $ GLShader uid (filter (/='\r') rawSrc) tipe

69+ return $ E.GLShader uid (filter (/='\r') rawSrc) tipe

6770

6871 span uid index =

6972 "<span id=\"md-" ++ uid ++ "-" ++ show index ++

@@ -81,22 +84,22 @@ parensTerm = try (parens opFn) <|> parens (tupleFn <|> parened)

8184 opFn = do

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

8386 let loc = Annotation.at start end

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

85− Binop (Var.Raw op) (loc (rawVar "x")) (loc (rawVar "y"))

87+ return . loc . E.Lambda (P.Var "x") . loc . E.Lambda (P.Var "y") . loc $

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

8689

8790 tupleFn = do

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

8992 (start, commas, end) <- located (comma >> many (whitespace >> comma))

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

9194 loc = Annotation.at start end

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

93− (loc . tuple $ map (loc . rawVar) vars) (map P.Var vars)

95+ return $ foldr (\x e -> loc $ E.Lambda x e)

96+ (loc . E.tuple $ map (loc . E.rawVar) vars) (map P.Var vars)

9497

9598 parened = do

9699 (start, es, end) <- located (commaSep expr)

97100 return $ case es of

98101 [e] -> e

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

102+ _ -> Annotation.at start end (E.tuple es)

100103

101104recordTerm :: IParser Source.Expr

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

@@ -108,24 +111,24 @@ recordTerm = brackets $ choice [ misc, addLocation record ]

108111 body <- expr

109112 return (label, makeFunction patterns body)

110113

111− record = Record <$> commaSep field

114+ record = E.Record <$> commaSep field

112115

113116 change = do

114117 lbl <- rLabel

115118 padded (string "<-")

116119 (,) lbl <$> expr

117120

118− remove r = addLocation (string "-" >> whitespace >> Remove r <$> rLabel)

121+ remove r = addLocation (string "-" >> whitespace >> E.Remove r <$> rLabel)

119122

120123 insert r = addLocation $ do

121124 string "|" >> whitespace

122− Insert r <$> rLabel <*> (padded equals >> expr)

125+ E.Insert r <$> rLabel <*> (padded equals >> expr)

123126

124127 modify r =

125− addLocation (string "|" >> whitespace >> Modify r <$> commaSep1 change)

128+ addLocation (string "|" >> whitespace >> E.Modify r <$> commaSep1 change)

126129

127130 misc = try $ do

128− record <- addLocation (rawVar <$> rLabel)

131+ record <- addLocation (E.rawVar <$> rLabel)

129132 opt <- padded (optionMaybe (remove record))

130133 case opt of

131134 Just e -> try (insert e) <|> return e

@@ -133,7 +136,7 @@ recordTerm = brackets $ choice [ misc, addLocation record ]

133136

134137

135138term :: IParser Source.Expr

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

139+term = addLocation (choice [ E.Literal <$> Literal.literal, listTerm, accessor, negative ])

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

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

139142

@@ -146,12 +149,12 @@ appExpr = do

146149 if null str then notFollowedBy (char '-') else return ()

147150 return $ case ts of

148151 [] -> t

149− _ -> foldl' (\f x -> Annotation.merge f x $ App f x) t ts

152+ _ -> List.foldl' (\f x -> Annotation.merge f x $ E.App f x) t ts

150153

151154-------- Normal Expressions --------

152155

153156binaryExpr :: IParser Source.Expr

154−binaryExpr = binops appExpr lastExpr anyOp

157+binaryExpr = Binop.binops appExpr lastExpr anyOp

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

156159 <|> lambdaExpr

157160

@@ -164,9 +167,12 @@ ifExpr = reserved "if" >> whitespace >> (normal <|> multiIf)

164167 thenBranch <- expr

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

166169 elseBranch <- expr

167− return $ MultiIf [(bool, thenBranch),

168− (Annotation.sameAs elseBranch (Literal . L.Boolean $ True), elseBranch)]

169− multiIf = MultiIf <$> spaceSep1 iff

170+ return $ E.MultiIf

171+ [ (bool, thenBranch)

172+ , (Annotation.sameAs elseBranch (E.Literal . L.Boolean $ True), elseBranch)

173+ ]

174+

175+ multiIf = E.MultiIf <$> spaceSep1 iff

170176 where iff = do string "|" ; whitespace

171177 b <- expr ; padded arrow

172178 (,) b <$> expr

@@ -187,12 +193,12 @@ letExpr = do

187193 reserved "let" ; whitespace

188194 defs <- defSet

189195 padded (reserved "in")

190− Let defs <$> expr

196+ E.Let defs <$> expr

191197

192198caseExpr :: IParser Source.Expr'

193199caseExpr = do

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

195− Case e <$> (with <|> without)

201+ E.Case e <$> (with <|> without)

196202 where case_ = do p <- Pattern.expr

197203 padded arrow

198204 (,) p <$> expr

@@ -226,8 +232,8 @@ defStart =

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

227233

228234makeFunction :: [P.RawPattern] -> Source.Expr -> Source.Expr

229−makeFunction args body@(A ann _) =

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

235+makeFunction args body@(Annotation.A ann _) =

236+ foldr (\arg body' -> Annotation.A ann $ E.Lambda arg body') body args

231237

232238definition :: IParser Source.Def

233239definition = withPos $ do

compiler/Parse/Helpers.hs+57−39

@@ -3,23 +3,23 @@ module Parse.Helpers where

44import Prelude hiding (until)

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

6−import Control.Monad

7−import Control.Monad.State

6+import Control.Monad (guard, join, mzero)

7+import Control.Monad.State (State)

88import Data.Char (isUpper)

99import qualified Data.Map as Map

1010import qualified Language.GLSL.Parser as GLP

11−import Language.GLSL.Syntax as GLS

11+import qualified Language.GLSL.Syntax as GLS

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

13−import Text.Parsec.Indent

13+import Text.Parsec.Indent (indented, runIndent)

1414import qualified Text.Parsec.Token as T

1515

16−import AST.Annotation as Annotation

17−import AST.Declaration (Assoc)

18−import AST.Expression.General

16+import qualified AST.Annotation as Annotation

17+import qualified AST.Declaration as Decl

18+import qualified AST.Expression.General as E

1919import qualified AST.Expression.Source as Source

20−import AST.Helpers as Help

21−import AST.Literal as Literal

22−import AST.PrettyPrint

20+import qualified AST.Helpers as Help

21+import qualified AST.Literal as L

22+import qualified AST.PrettyPrint as P

2323import qualified AST.Variable as Variable

2424

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

@@ -34,7 +34,7 @@ reserveds = [ "if", "then", "else"

3434

3535expecting = flip (<?>)

3636

37−type OpTable = Map.Map String (Int, Assoc)

37+type OpTable = Map.Map String (Int, Decl.Assoc)

3838type SourceM = State SourcePos

3939type IParser a = ParsecT String OpTable SourceM a

4040

@@ -171,7 +171,7 @@ parens = surround '(' ')' "paren"

171171brackets :: IParser a -> IParser a

172172brackets = surround '{' '}' "bracket"

173173

174−addLocation :: (Pretty a) => IParser a -> IParser (Annotation.Located a)

174+addLocation :: (P.Pretty a) => IParser a -> IParser (Annotation.Located a)

175175addLocation expr = do

176176 (start, e, end) <- located expr

177177 return (Annotation.at start end e)

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

186186accessible :: IParser Source.Expr -> IParser Source.Expr

187187accessible expr = do

188188 start <- getPosition

189− ce@(A _ e) <- expr

189+ ce@(Annotation.A _ e) <- expr

190190 let rest f = do

191191 let dot = char '.' >> notFollowedBy (char '.')

192192 access <- optionMaybe (try dot <?> "field access (e.g. List.map)")

@@ -197,10 +197,10 @@ accessible expr = do

197197 end <- getPosition

198198 return (Annotation.at start end (f v))

199199 case e of

200− Var (Variable.Raw (c:cs))

201− | isUpper c -> rest (\v -> rawVar (c:cs ++ '.':v))

202− | otherwise -> rest (Access ce)

203− _ -> rest (Access ce)

200+ E.Var (Variable.Raw (c:cs))

201+ | isUpper c -> rest (\v -> E.rawVar (c:cs ++ '.':v))

202+ | otherwise -> rest (E.Access ce)

203+ _ -> rest (E.Access ce)

204204

205205

206206spaces :: IParser String

@@ -307,7 +307,7 @@ markdown interpolation =

307307 closeMarkdown (markdownBuilder . (c:)) stuff

308308 ]

309309

310−shader :: IParser (String, Literal.GLShaderTipe)

310+shader :: IParser (String, L.GLShaderTipe)

311311shader =

312312 do try (string "[glsl|")

313313 rawSrc <- closeShader id

@@ -322,35 +322,53 @@ shader =

322322 closeShader (builder . (c:))

323323 ]

324324

325−glSource :: String -> Either ParseError Literal.GLShaderTipe

325+glSource :: String -> Either ParseError L.GLShaderTipe

326326glSource src =

327327 case GLP.parse src of

328− Right (TranslationUnit decls) ->

328+ Right (GLS.TranslationUnit decls) ->

329329 Right . foldr addGLinput emptyDecls . join . map extractGLinputs $ decls

330330 Left e -> Left e

331331 where

332− emptyDecls = Literal.GLShaderTipe Map.empty Map.empty Map.empty

333− addGLinput (qual,tipe,name) glDecls = case qual of

334− Attribute -> glDecls { attribute = Map.insert name tipe $ attribute glDecls }

335− Uniform -> glDecls { uniform = Map.insert name tipe $ uniform glDecls }

336− Varying -> glDecls { varying = Map.insert name tipe $ varying glDecls }

332+ emptyDecls = L.GLShaderTipe Map.empty Map.empty Map.empty

333+

334+ addGLinput (qual,tipe,name) glDecls =

335+ case qual of

336+ GLS.Attribute ->

337+ glDecls { L.attribute = Map.insert name tipe $ L.attribute glDecls }

338+

339+ GLS.Uniform ->

340+ glDecls { L.uniform = Map.insert name tipe $ L.uniform glDecls }

341+

342+ GLS.Varying ->

343+ glDecls { L.varying = Map.insert name tipe $ L.varying glDecls }

344+

337345 _ -> error "Should never happen due to below filter"

338− extractGLinputs decl = case decl of

339− Declaration (InitDeclaration (TypeDeclarator (FullType (Just (TypeQualSto qual)) (TypeSpec _prec (TypeSpecNoPrecision tipe _mexpr1)))) [InitDecl name _mexpr2 _mexpr3]) ->

340− if elem qual [Attribute, Varying, Uniform]

341− then case tipe of

342− GLS.Int -> return (qual,Literal.Int,name)

343− GLS.Float -> return (qual,Literal.Float,name)

344− GLS.Vec2 -> return (qual,V2,name)

345− GLS.Vec3 -> return (qual,V3,name)

346− GLS.Vec4 -> return (qual,V4,name)

347− GLS.Mat4 -> return (qual,M4,name)

348− GLS.Sampler2D -> return (qual,Texture,name)

349− _ -> []

350− else []

346+

347+ extractGLinputs decl =

348+ case decl of

349+ GLS.Declaration

350+ (GLS.InitDeclaration

351+ (GLS.TypeDeclarator

352+ (GLS.FullType

353+ (Just (GLS.TypeQualSto qual))

354+ (GLS.TypeSpec _prec (GLS.TypeSpecNoPrecision tipe _mexpr1))))

355+ [GLS.InitDecl name _mexpr2 _mexpr3]

356+ ) ->

357+ case elem qual [GLS.Attribute, GLS.Varying, GLS.Uniform] of

358+ False -> []

359+ True ->

360+ case tipe of

361+ GLS.Int -> return (qual, L.Int,name)

362+ GLS.Float -> return (qual, L.Float,name)

363+ GLS.Vec2 -> return (qual, L.V2,name)

364+ GLS.Vec3 -> return (qual, L.V3,name)

365+ GLS.Vec4 -> return (qual, L.V4,name)

366+ GLS.Mat4 -> return (qual, L.M4,name)

367+ GLS.Sampler2D -> return (qual, L.Texture,name)

368+ _ -> []

351369 _ -> []

352370

353−--str :: IParser String

371+str :: IParser String

354372str = expecting "String" $ do

355373 s <- choice [ multiStr, singleStr ]

356374 processAs T.stringLiteral . sandwich '\"' $ concat s

compiler/Parse/Literal.hs+7−7

@@ -3,18 +3,18 @@ module Parse.Literal (literal) where

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

55import Text.Parsec hiding (newline,spaces)

6−import Parse.Helpers

7−import AST.Literal

6+import Parse.Helpers (IParser, chr, str)

7+import qualified AST.Literal as L

9−literal :: IParser Literal

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

9+literal :: IParser L.Literal

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

1111

12−num :: IParser Literal

12+num :: IParser L.Literal

1313num = toLit <$> (number <?> "number")

1414 where

1515 toLit n

16− | any (`elem` ".eE") n = FloatNum (read n)

17− | otherwise = IntNum (read n)

16+ | any (`elem` ".eE") n = L.FloatNum (read n)

17+ | otherwise = L.IntNum (read n)

1818

1919 number = concat <$> sequence

2020 [ option "" minus

compiler/Parse/Module.hs+36−24

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

1−module Parse.Module (moduleDef, getModuleName, imports) where

1+module Parse.Module (header, headerAndImports, getModuleName) where

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

44import Data.List (intercalate)

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

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

77import Parse.Helpers

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

9−import AST.Variable (Listing(..), Value(..), openListing)

8+import qualified AST.Module as Module

9+import qualified AST.Variable as Var

1010

1111getModuleName :: String -> Maybe String

1212getModuleName source =

@@ -16,61 +16,73 @@ getModuleName source =

1616 where

1717 getModuleName = do

1818 optional freshLine

19− (names, _) <- moduleDef

19+ (names, _) <- header

2020 return (intercalate "." names)

2121

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

23−moduleDef = do

22+headerAndImports :: IParser Module.HeaderAndImports

23+headerAndImports =

24+ do optional freshLine

25+ (names, exports) <-

26+ option (["Main"], Var.openListing) (header `followedBy` freshLine)

27+ imports' <- commitToImports <|> return []

28+ return $ Module.HeaderAndImports names exports imports'

29+ where

30+ commitToImports =

31+ do try (lookAhead $ reserved "import")

32+ imports `followedBy` freshLine

33+

34+header :: IParser ([String], Var.Listing Var.Value)

35+header = do

2436 try (reserved "module")

2537 whitespace

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

2739 whitespace

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

40+ exports <- option Var.openListing (listing value)

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

3042 reserved "where"

3143 return (names, exports)

3244

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

45+imports :: IParser [(Module.Name, Module.ImportMethod)]

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

3547

36−import' :: IParser (String, ImportMethod)

48+import' :: IParser (Module.Name, Module.ImportMethod)

3749import' =

3850 do reserved "import"

3951 whitespace

40− name <- intercalate "." <$> dotSep1 capVar

41− (,) name <$> option (As name) method

52+ names <- dotSep1 capVar

53+ (,) names <$> option (Module.As (intercalate "." names)) method

4254 where

43− method :: IParser ImportMethod

55+ method :: IParser Module.ImportMethod

4456 method = as' <|> importing'

4557

46− as' :: IParser ImportMethod

58+ as' :: IParser Module.ImportMethod

4759 as' = do

4860 try (whitespace >> reserved "as")

4961 whitespace

50− As <$> capVar <?> "alias for module"

62+ Module.As <$> capVar <?> "alias for module"

5163

52− importing' :: IParser ImportMethod

53− importing' = Open <$> listing value

64+ importing' :: IParser Module.ImportMethod

65+ importing' = Module.Open <$> listing value

5466

55−listing :: IParser a -> IParser (Listing a)

67+listing :: IParser a -> IParser (Var.Listing a)

5668listing item =

5769 do try (whitespace >> char '(')

5870 whitespace

59− listing <- choice [ const openListing <$> string ".."

60− , Listing <$> commaSep1 item <*> return False

71+ listing <- choice [ const Var.openListing <$> string ".."

72+ , Var.Listing <$> commaSep1 item <*> return False

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

6274 whitespace

6375 char ')'

6476 return listing

6577

66−value :: IParser Value

78+value :: IParser Var.Value

6779value = val <|> tipe

6880 where

69− val = Value <$> (lowVar <|> parens symOp)

81+ val = Var.Value <$> (lowVar <|> parens symOp)

7082

7183 tipe = do

7284 name <- capVar

7385 maybeCtors <- optionMaybe (listing capVar)

7486 case maybeCtors of

75− Nothing -> return (Alias name)

76− Just ctors -> return (ADT name ctors)

87+ Nothing -> return (Var.Alias name)

88+ Just ctors -> return (Var.ADT name ctors)

compiler/Parse/Parse.hs+16−18

@@ -1,18 +1,18 @@

11{-# OPTIONS_GHC -W #-}

22module Parse.Parse (program, dependencies) where

4−import Control.Applicative ((<$>), (<*>))

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

5+import Control.Arrow (first)

56import qualified Data.List as List

67import qualified Data.Map as Map

7−import Text.Parsec hiding (newline,spaces)

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

89import qualified Text.PrettyPrint as P

910

1011import qualified AST.Declaration as D

1112import qualified AST.Module as M

12−import qualified AST.Variable as Var

1313import Parse.Helpers

1414import Parse.Declaration (infixDecl)

15−import Parse.Module

15+import qualified Parse.Module as Module

1616import qualified Parse.Declaration as Decl

1717import Transform.Declaration (combineAnnotations)

1818

@@ -25,30 +25,28 @@ decls = do d <- Decl.declaration <?> "at least one datatype or variable definiti

2525

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

2727program table src =

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

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

2929 setupParserWithTable table programParser src

30+

3031 decls <-

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

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

3233 return $ M.Module names filePath exs ims decls

3334

3435programParser :: IParser M.SourceModule

3536programParser =

36− do optional freshLine

37− (names,exports) <-

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

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

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

41− declarations <- decls

42− optional freshLine ; optional spaces ; eof

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

37+ do (M.HeaderAndImports names exports imports) <- Module.headerAndImports

38+ declarations <- decls

39+ optional freshLine ; optional spaces ; eof

40+ let stringyImports = map (first M.nameToString) imports

41+ return $ M.Module names "" exports stringyImports declarations

4442

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

4644dependencies =

47− let getName = List.intercalate "." . fst in

4845 setupParser $ do

49− optional freshLine

50− (,) <$> option "Main" (getName <$> moduleDef `followedBy` freshLine)

51− <*> option [] (map fst <$> imports `followedBy` freshLine)

46+ header <- Module.headerAndImports

47+ return ( M.nameToString (M._names header)

48+ , map (M.nameToString . fst) (M._imports header)

49+ )

5250

5351setupParserWithTable :: OpTable -> IParser a -> String -> Either [P.Doc] a

5452setupParserWithTable table p source =

compiler/Parse/Pattern.hs+14−12

@@ -4,25 +4,27 @@ module Parse.Pattern (term, expr) where

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

55import Data.Char (isUpper)

66import qualified Data.List as List

7−import Text.Parsec hiding (newline,spaces,State)

7+import Text.Parsec ((<|>), (<?>), char, choice, optionMaybe, try)

99import Parse.Helpers

10−import Parse.Literal

11−import AST.Literal

10+import qualified Parse.Literal as Literal

11+import qualified AST.Literal as L

1212import qualified AST.Pattern as P

1313import qualified AST.Variable as Var

1414

1515basic :: IParser P.RawPattern

1616basic = choice

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

18− , do v <- var

19− return $ case v of

20− "True" -> P.Literal (Boolean True)

21− "False" -> P.Literal (Boolean False)

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

23− _ -> P.Var v

24− , P.Literal <$> literal

18+ , stringToPattern <$> var

19+ , P.Literal <$> Literal.literal

2520 ]

21+ where

22+ stringToPattern v =

23+ case v of

24+ "True" -> P.Literal (L.Boolean True)

25+ "False" -> P.Literal (L.Boolean False)

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

27+ _ -> P.Var v

2628

2729asPattern :: P.RawPattern -> IParser P.RawPattern

2830asPattern pattern = do

@@ -52,8 +54,8 @@ patternConstructor :: IParser P.RawPattern

5254patternConstructor = do

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

5456 case v of

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

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

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

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

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

5860

5961expr :: IParser P.RawPattern

compiler/Parse/Type.hs+1−1

@@ -3,7 +3,7 @@ module Parse.Type where

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

55import Data.List (intercalate)

6−import Text.Parsec

6+import Text.Parsec ((<|>), (<?>), char, many, optionMaybe, string, try)

88import qualified AST.Type as T

99import qualified AST.Variable as Var