89ba043 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Merge in Parse/ changes from dependencies branch

89ba043Evan Czaplicki12 years ago

compiler/AST/Module.hs+52−18

compare with master

unifiedsplit

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

10import qualified AST.Declaration as Decl

11import qualified AST.Type as Type

12import qualified AST.Variable as Var

13−

14import AST.PrettyPrint

13import AST.PrettyPrint

15import Text.PrettyPrint as P

14import Text.PrettyPrint as P

16−

17import qualified Elm.Internal.Version as Version

15import qualified Elm.Internal.Version as Version

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+

19−data Module exs body = Module

45+data Module exports body = Module

20− { names :: [String]

46+ { names :: Name

21 , path :: FilePath

47 , path :: FilePath

22− , exports :: exs

48+ , exports :: exports

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

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

24 , body :: body

50 , body :: body

25 }

51 }

27−getName :: Module exs body -> String

28−getName modul =

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

30−

31data CanonicalBody = CanonicalBody

53data CanonicalBody = CanonicalBody

32 { program :: Canonical.Expr

54 { program :: Canonical.Expr

33 , types :: Types

55 , types :: Types

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

37 , ports :: [String]

59 , ports :: [String]

38 }

60 }

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

44−type Interfaces = Map.Map String Interface

63+-- HEADERS

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

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

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

66+data HeaderAndImports = HeaderAndImports

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

67+ { _names :: Name

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

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

70+ }

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

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

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

73+

74+nameToString :: Name -> String

75+nameToString = List.intercalate "."

76+

77+

78+-- INTERFACES

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

53data Interface = Interface

81data Interface = Interface

54 { iVersion :: Version.Version

82 { iVersion :: Version.Version

55 , iExports :: [Var.Value]

83 , iExports :: [Var.Value]

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

87 put (iFixities modul)

115 put (iFixities modul)

88 put (iPorts modul)

116 put (iPorts modul)

117

118+

119+-- IMPORT METHOD

120+

90data ImportMethod

121data ImportMethod

91 = As !String

122 = As !String

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

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

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

109 1 -> Open <$> get

140 1 -> Open <$> get

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

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

111

142

143+

144+-- PRETTY PRINTING

145+

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

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

113 pretty (Module names _ exs ims body) =

147 pretty (Module names _ exs ims body) =

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

148 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)

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

29import Parse.Expression (typeAnnotation)

30import Parse.Helpers

31−import Parse.Module (moduleDef)

31+import qualified Parse.Module as Module

33data Flags = Flags

34 { files :: [FilePath] }

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

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

81moduleDocs = do

82 optional freshLine

83− (names,exports) <- moduleDef

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

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

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

86 structure <- docComment

compiler/Parse/Binop.hs+3−3

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

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

5import qualified Data.List as List

6import qualified Data.Map as Map

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

8import AST.Annotation (merge)

9import AST.Annotation (merge)

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

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

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

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

11import qualified AST.Expression.Source as Source

12import qualified AST.Expression.Source as Source

12import qualified AST.Variable as Var

13import qualified AST.Variable as Var

13−import Text.Parsec

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

14−import Parse.Helpers

16opLevel :: OpTable -> String -> Int

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

compiler/Parse/Declaration.hs+5−4

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

2module Parse.Declaration where

4import 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

8import qualified Parse.Expression as Expr

9+import Parse.Helpers

9import qualified Parse.Type as Type

10import qualified Parse.Type as Type

10−import qualified AST.Declaration as D

12declaration :: IParser D.SourceDecl

13+declaration =

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

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

15definition :: IParser D.SourceDecl

16definition :: IParser D.SourceDecl

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

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

compiler/Parse/Expression.hs+44−38

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

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

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

4−import Data.List (foldl')

4+import qualified Data.List as List

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

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

6−import Text.Parsec.Indent

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

7−

8−import Parse.Binop

8+import qualified Parse.Binop as Binop

9+import Parse.Helpers

9−import Parse.Helpers as Help

10+import qualified Parse.Helpers as Help

10−import Parse.Literal

11+import qualified Parse.Literal as Literal

11import qualified Parse.Pattern as Pattern

12import qualified Parse.Pattern as Pattern

12import qualified Parse.Type as Type

13import qualified Parse.Type as Type

14−import AST.Annotation as Annotation

15+import qualified AST.Annotation as Annotation

15−import AST.Expression.General

16+import qualified AST.Expression.General as E

16import qualified AST.Expression.Source as Source

17import qualified AST.Expression.Source as Source

17import qualified AST.Literal as L

18import qualified AST.Literal as L

18import qualified AST.Pattern as P

19import qualified AST.Pattern as P

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

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

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

27toVar :: String -> Source.Expr'

28toVar :: String -> Source.Expr'

29+toVar v =

30+ case v of

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

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

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

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

30− _ -> rawVar v

33+ _ -> E.rawVar v

32accessor :: IParser Source.Expr'

35accessor :: IParser Source.Expr'

33accessor = do

36accessor = do

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

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

35 let loc e = Annotation.at start end e

38 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))

38negative :: IParser Source.Expr'

41negative :: IParser Source.Expr'

39negative = do

42negative = do

40 (start, nTerm, end) <-

43 (start, nTerm, end) <-

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

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

42 let loc e = Annotation.at start end e

45 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)

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

49-------- Complex Terms --------

48listTerm :: IParser Source.Expr'

51listTerm :: IParser Source.Expr'

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

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

50 where

53 where

51 range = do

54 range = do

52 lo <- expr

55 lo <- expr

53 padded (string "..")

56 padded (string "..")

54− Range lo <$> expr

57+ E.Range lo <$> expr

56 markdown' = do

59 markdown' = do

57 pos <- getPosition

60 pos <- getPosition

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

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

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

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

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

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

62 shader' = do

65 shader' = do

63 pos <- getPosition

66 pos <- getPosition

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

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

65 (rawSrc, tipe) <- Help.shader

68 (rawSrc, tipe) <- Help.shader

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

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

68 span uid index =

71 span uid index =

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

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

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

81 opFn = do

84 opFn = do

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

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

83 let loc = Annotation.at start end

86 let loc = Annotation.at start end

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

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

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

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

87 tupleFn = do

90 tupleFn = do

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

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

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

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

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

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

91 loc = Annotation.at start end

94 loc = Annotation.at start end

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

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

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

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

95 parened = do

98 parened = do

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

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

97 return $ case es of

100 return $ case es of

98 [e] -> e

101 [e] -> e

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

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

100

103

101recordTerm :: IParser Source.Expr

104recordTerm :: IParser Source.Expr

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

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

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

108 body <- expr

111 body <- expr

109 return (label, makeFunction patterns body)

112 return (label, makeFunction patterns body)

110

113

111− record = Record <$> commaSep field

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

112

115

113 change = do

116 change = do

114 lbl <- rLabel

117 lbl <- rLabel

115 padded (string "<-")

118 padded (string "<-")

116 (,) lbl <$> expr

119 (,) lbl <$> expr

117

120

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

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

119

122

120 insert r = addLocation $ do

123 insert r = addLocation $ do

121 string "|" >> whitespace

124 string "|" >> whitespace

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

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

123

126

124 modify r =

127 modify r =

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

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

126

129

127 misc = try $ do

130 misc = try $ do

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

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

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

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

130 case opt of

133 case opt of

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

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

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

133

136

134

137

135term :: IParser Source.Expr

138term :: IParser Source.Expr

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

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

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

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

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

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

139

142

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

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

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

147 return $ case ts of

150 return $ case ts of

148 [] -> t

151 [] -> 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

150

153

151-------- Normal Expressions --------

154-------- Normal Expressions --------

152

155

153binaryExpr :: IParser Source.Expr

156binaryExpr :: IParser Source.Expr

154−binaryExpr = binops appExpr lastExpr anyOp

157+binaryExpr = Binop.binops appExpr lastExpr anyOp

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

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

156 <|> lambdaExpr

159 <|> lambdaExpr

157

160

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

164 thenBranch <- expr

167 thenBranch <- expr

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

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

166 elseBranch <- expr

169 elseBranch <- expr

170+ return $ E.MultiIf

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

171+ [ (bool, thenBranch)

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

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

173+ ]

174+

169− multiIf = MultiIf <$> spaceSep1 iff

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

170 where iff = do string "|" ; whitespace

176 where iff = do string "|" ; whitespace

171 b <- expr ; padded arrow

177 b <- expr ; padded arrow

172 (,) b <$> expr

178 (,) b <$> expr

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

187 reserved "let" ; whitespace

193 reserved "let" ; whitespace

188 defs <- defSet

194 defs <- defSet

189 padded (reserved "in")

195 padded (reserved "in")

190− Let defs <$> expr

196+ E.Let defs <$> expr

191

197

192caseExpr :: IParser Source.Expr'

198caseExpr :: IParser Source.Expr'

193caseExpr = do

199caseExpr = do

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

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

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

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

196 where case_ = do p <- Pattern.expr

202 where case_ = do p <- Pattern.expr

197 padded arrow

203 padded arrow

198 (,) p <$> expr

204 (,) p <$> expr

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

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

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

227

233

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

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

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

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

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

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

231

237

232definition :: IParser Source.Def

238definition :: IParser Source.Def

233definition = withPos $ do

239definition = withPos $ do

compiler/Parse/Helpers.hs+57−39

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

4import Prelude hiding (until)

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

6−import Control.Monad

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

7−import Control.Monad.State

7+import Control.Monad.State (State)

8import Data.Char (isUpper)

9import qualified Data.Map as Map

10import qualified Language.GLSL.Parser as GLP

11−import Language.GLSL.Syntax as GLS

11+import qualified Language.GLSL.Syntax as GLS

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

13−import Text.Parsec.Indent

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

14import qualified Text.Parsec.Token as T

16−import AST.Annotation as Annotation

16+import qualified AST.Annotation as Annotation

17−import AST.Declaration (Assoc)

17+import qualified AST.Declaration as Decl

18−import AST.Expression.General

18+import qualified AST.Expression.General as E

19import qualified AST.Expression.Source as Source

20−import AST.Helpers as Help

20+import qualified AST.Helpers as Help

21−import AST.Literal as Literal

21+import qualified AST.Literal as L

22−import AST.PrettyPrint

22+import qualified AST.PrettyPrint as P

23import qualified AST.Variable as Variable

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

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

35expecting = flip (<?>)

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

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

38type SourceM = State SourcePos

39type IParser a = ParsecT String OpTable SourceM a

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

171brackets :: IParser a -> IParser a

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

173

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

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

175addLocation expr = do

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

177 return (Annotation.at start end e)

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

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

187accessible expr = do

188 start <- getPosition

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

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

190 let rest f = do

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

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

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

197 end <- getPosition

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

199 case e of

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

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

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

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

202− | otherwise -> rest (Access ce)

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

203− _ -> rest (Access ce)

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

204

205

206spaces :: IParser String

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

307 closeMarkdown (markdownBuilder . (c:)) stuff

308 ]

309

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

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

311shader =

312 do try (string "[glsl|")

313 rawSrc <- closeShader id

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

322 closeShader (builder . (c:))

323 ]

324

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

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

326glSource src =

327 case GLP.parse src of

328− Right (TranslationUnit decls) ->

328+ Right (GLS.TranslationUnit decls) ->

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

330 Left e -> Left e

331 where

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

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

333+

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

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

335+ case qual of

336+ GLS.Attribute ->

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

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

338+

339+ GLS.Uniform ->

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

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

341+

342+ GLS.Varying ->

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

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

344+

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

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

346+

338− extractGLinputs decl = case decl of

347+ extractGLinputs decl =

348+ case decl of

349+ GLS.Declaration

350+ (GLS.InitDeclaration

351+ (GLS.TypeDeclarator

352+ (GLS.FullType

353+ (Just (GLS.TypeQualSto qual))

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

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

355+ [GLS.InitDecl name _mexpr2 _mexpr3]

356+ ) ->

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

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

358+ False -> []

359+ True ->

341− then case tipe of

360+ case tipe of

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

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

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

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

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

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

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

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

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

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

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

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

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

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

349− _ -> []

368+ _ -> []

350− else []

351 _ -> []

369 _ -> []

352

370

353−--str :: IParser String

371+str :: IParser String

354str = expecting "String" $ do

372str = expecting "String" $ do

355 s <- choice [ multiStr, singleStr ]

373 s <- choice [ multiStr, singleStr ]

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

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

compiler/Parse/Literal.hs+7−7

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

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

5import Text.Parsec hiding (newline,spaces)

6−import Parse.Helpers

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

7−import AST.Literal

7+import qualified AST.Literal as L

9−literal :: IParser Literal

9+literal :: IParser L.Literal

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

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

12−num :: IParser Literal

12+num :: IParser L.Literal

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

14 where

15 toLit n

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

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

17− | otherwise = IntNum (read n)

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

19 number = concat <$> sequence

20 [ 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

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

4import Data.List (intercalate)

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

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

7import Parse.Helpers

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

8+import qualified AST.Module as Module

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

9+import qualified AST.Variable as Var

11getModuleName :: String -> Maybe String

12getModuleName source =

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

16 where

17 getModuleName = do

18 optional freshLine

19− (names, _) <- moduleDef

19+ (names, _) <- header

20 return (intercalate "." names)

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+

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

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

23−moduleDef = do

35+header = do

24 try (reserved "module")

36 try (reserved "module")

25 whitespace

37 whitespace

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

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

27 whitespace

39 whitespace

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

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

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

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

30 reserved "where"

42 reserved "where"

31 return (names, exports)

43 return (names, exports)

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

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

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

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

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

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

37import' =

49import' =

38 do reserved "import"

50 do reserved "import"

39 whitespace

51 whitespace

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

52+ names <- dotSep1 capVar

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

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

42 where

54 where

43− method :: IParser ImportMethod

55+ method :: IParser Module.ImportMethod

44 method = as' <|> importing'

56 method = as' <|> importing'

46− as' :: IParser ImportMethod

58+ as' :: IParser Module.ImportMethod

47 as' = do

59 as' = do

48 try (whitespace >> reserved "as")

60 try (whitespace >> reserved "as")

49 whitespace

61 whitespace

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

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

52− importing' :: IParser ImportMethod

64+ importing' :: IParser Module.ImportMethod

53− importing' = Open <$> listing value

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

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

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

56listing item =

68listing item =

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

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

58 whitespace

70 whitespace

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

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

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

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

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

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

62 whitespace

74 whitespace

63 char ')'

75 char ')'

64 return listing

76 return listing

66−value :: IParser Value

78+value :: IParser Var.Value

67value = val <|> tipe

79value = val <|> tipe

68 where

80 where

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

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

71 tipe = do

83 tipe = do

72 name <- capVar

84 name <- capVar

73 maybeCtors <- optionMaybe (listing capVar)

85 maybeCtors <- optionMaybe (listing capVar)

74 case maybeCtors of

86 case maybeCtors of

75− Nothing -> return (Alias name)

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

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

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

compiler/Parse/Parse.hs+16−18

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

1{-# OPTIONS_GHC -W #-}

2module Parse.Parse (program, dependencies) where

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

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

5+import Control.Arrow (first)

5import qualified Data.List as List

6import qualified Data.List as List

6import qualified Data.Map as Map

7import qualified Data.Map as Map

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

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

8import qualified Text.PrettyPrint as P

9import qualified Text.PrettyPrint as P

10import qualified AST.Declaration as D

11import qualified AST.Declaration as D

11import qualified AST.Module as M

12import qualified AST.Module as M

12−import qualified AST.Variable as Var

13import Parse.Helpers

14import Parse.Declaration (infixDecl)

15−import Parse.Module

15+import qualified Parse.Module as Module

16import qualified Parse.Declaration as Decl

17import Transform.Declaration (combineAnnotations)

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

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

27program table src =

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

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

29 setupParserWithTable table programParser src

30+

30 decls <-

31 decls <-

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

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

32 return $ M.Module names filePath exs ims decls

33 return $ M.Module names filePath exs ims decls

34programParser :: IParser M.SourceModule

35programParser :: IParser M.SourceModule

35programParser =

36programParser =

36− do optional freshLine

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

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

38+ declarations <- decls

42− optional freshLine ; optional spaces ; eof

39+ optional freshLine ; optional spaces ; eof

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

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

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

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

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

46dependencies =

44dependencies =

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

48 setupParser $ do

45 setupParser $ do

49− optional freshLine

46+ header <- Module.headerAndImports

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

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

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

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

49+ )

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

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

54setupParserWithTable table p source =

52setupParserWithTable table p source =

compiler/Parse/Pattern.hs+14−12

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

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

5import Data.Char (isUpper)

6import qualified Data.List as List

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

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

9import Parse.Helpers

10−import Parse.Literal

10+import qualified Parse.Literal as Literal

11−import AST.Literal

11+import qualified AST.Literal as L

12import qualified AST.Pattern as P

13import qualified AST.Variable as Var

15basic :: IParser P.RawPattern

16basic = choice

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

18− , do v <- var

18+ , stringToPattern <$> 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

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

25 ]

20 ]

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

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

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

28asPattern pattern = do

30asPattern pattern = do

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

52patternConstructor = do

54patternConstructor = do

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

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

54 case v of

56 case v of

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

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

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

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

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

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

59expr :: IParser P.RawPattern

61expr :: IParser P.RawPattern

compiler/Parse/Type.hs+1−1

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

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

5import Data.List (intercalate)

6−import Text.Parsec

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

8import qualified AST.Type as T

9import qualified AST.Variable as Var