455dcb2 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Begin supporting "define" in Parse and Validate phases

455dcb2Evan Czaplicki11 years ago

src/AST/Expression/Source.hs+6

compare with master

unifiedsplit

@@ -29,3 +29,9 @@ data Def'

29 = Definition Pattern.Raw Expr

30 | Annotation String Type.Raw

32+

33+data Effect

34+ = Def Pattern.Raw Expr

35+ | Type String Type.Raw

36+ | With String Expr

37+

src/AST/Expression/Valid.hs+9

@@ -23,3 +23,12 @@ type Expr' =

23data Def

24 = Definition Pattern.Raw Expr (Maybe Type.Raw)

26+

27+data Effect

28+ = Def Pattern.Raw Expr (Maybe Type.Raw)

29+

30+

31+data Foreign

32+ = Type String Type.Raw

33+ | With String Expr

34+

src/AST/Module.hs+111−83

@@ -1,13 +1,20 @@

1module AST.Module

2− ( Interfaces

2+ ( Header(..), Module(..), Tag(..)

3− , Types, Aliases, Unions

4− , UnionInfo, CanonicalUnion

4+ , Source, SourceInfo(..)

5− , SourceModule, ValidModule, CanonicalModule, Optimized

5+ , Valid, ValidInfo(..)

6− , Module(..), Kind(..), Body(..)

6+ , Canonical, Optimized, Info(..)

7− , Header(..)

8− , Interface(..), toInterface

9 , UserImport, DefaultImport, ImportMethod(..)

8 , UserImport, DefaultImport, ImportMethod(..)

10+ , Effects(..)

11+ , Types

12+ , Aliases

13+ , Unions, UnionInfo, CanonicalUnion

14+

15+ , Interfaces, Interface(..), toInterface

16+ )

10− ) where

17+ where

12import Data.Binary

19import Data.Binary

13import qualified Data.Map as Map

20import qualified Data.Map as Map

@@ -15,6 +22,7 @@ import qualified Data.Map as Map

15import qualified AST.Declaration as Decl

22import qualified AST.Declaration as Decl

16import qualified AST.Expression.Canonical as Canonical

23import qualified AST.Expression.Canonical as Canonical

17import qualified AST.Expression.Optimized as Optimized

24import qualified AST.Expression.Optimized as Optimized

25+import qualified AST.Expression.Valid as Valid

18import qualified AST.Module.Name as Name

26import qualified AST.Module.Name as Name

19import qualified AST.Type as Type

27import qualified AST.Type as Type

20import qualified AST.Variable as Var

28import qualified AST.Variable as Var

@@ -25,118 +33,134 @@ import qualified Reporting.Annotation as A

28−-- HELPFUL TYPE ALIASES

36+-- HEADERS FOR PARSING

31−type Interfaces =

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

32− Map.Map Name.Canonical Interface

40+data Header imports =

41+ Header

42+ { _tag :: Tag

43+ , _name :: Name.Raw

44+ , _docs :: A.Located (Maybe String)

45+ , _exports :: Var.Listing (A.Located Var.Value)

46+ , _imports :: imports

47+ }

35−type Types =

36− Map.Map String Type.Canonical

51+-- MODULES

39−type Aliases =

53+

40− Map.Map String ([String], Type.Canonical)

54+data Module phase =

55+ Module

56+ { tag :: Tag

57+ , name :: Name.Canonical

58+ , path :: FilePath

59+ , info :: phase

60+ }

43−type Unions =

63+data Tag

44− Map.Map String (UnionInfo String)

64+ = None

65+ | Effect

66+ | Foreign

47−type UnionInfo v =

69+type Source =

48− ( [String], [(v, [Type.Canonical])] )

70+ Module SourceInfo

51−type CanonicalUnion =

73+data SourceInfo =

52− ( Var.Canonical, UnionInfo Var.Canonical )

74+ Source

75+ { srcDocs :: A.Located (Maybe String)

76+ , srcExports :: Var.Listing (A.Located Var.Value)

77+ , srcImports :: [UserImport]

78+ , srcDecls :: [Decl.Source]

79+ }

82+type Valid =

83+ Module ValidInfo

56−-- MODULES

86+data ValidInfo =

87+ Valid

88+ { validDocs :: A.Located (Maybe String)

89+ , validExports :: Var.Listing (A.Located Var.Value)

90+ , validImports :: ([DefaultImport], [UserImport])

91+ , validDecls :: [Decl.Valid]

92+ , validCmds :: [A.Commented Valid.Effect]

93+ , validSubs :: [A.Commented Valid.Effect]

94+ }

59−type SourceModule =

60− Module

61− String

62− [UserImport]

63− (Var.Listing (A.Located Var.Value))

64− [Decl.SourceDecl]

97+type Canonical =

98+ Module (Info Canonical.Expr)

67−type ValidModule =

68− Module

69− String

70− ([DefaultImport], [UserImport])

71− (Var.Listing (A.Located Var.Value))

72− [Decl.ValidDecl]

100

101+type Optimized =

102+ Module (Info [Optimized.Def])

103

75−type CanonicalModule =

76− Module Docs.Centralized [Name.Raw] [Var.Value] (Body Canonical.Expr)

104

105

79−type Optimized =

106+-- IMPORTS

80− Module Docs.Centralized [Name.Raw] [Var.Value] (Body [Optimized.Def])

107

108

83−data Module docs imports exports body =

109+type UserImport = A.Located (Name.Raw, ImportMethod)

84− Module

110+

85− { kind :: Kind

111+

86− , name :: Name.Canonical

112+type DefaultImport = (Name.Raw, ImportMethod)

87− , path :: FilePath

113+

88− , docs :: A.Located (Maybe docs)

114+

89− , exports :: exports

115+data ImportMethod =

90− , imports :: imports

116+ ImportMethod

91− , body :: body

117+ { alias :: Maybe String

118+ , exposedVars :: !(Var.Listing Var.Value)

92 }

119 }

120

121

95−data Kind

122+

96− = Normal

123+-- LATE PHASE MODULE INFORMATION

97− | Effect

98− | Foreign

124

100

125

101−data Body expr =

126+data Info expr =

102− Body

127+ Info

128+ { docs :: Docs.Centralized

129+ , exports :: [Var.Value]

130+ , imports :: [Name.Raw]

103− { program :: expr

131+ , program :: expr

104 , types :: Types

132 , types :: Types

105 , fixities :: [(Decl.Assoc, Int, String)]

133 , fixities :: [(Decl.Assoc, Int, String)]

106 , aliases :: Aliases

134 , aliases :: Aliases

107 , unions :: Unions

135 , unions :: Unions

136+ , effects :: Effects

108 }

137 }

109

138

110

139

140+type Types =

141+ Map.Map String Type.Canonical

111

142

112−-- HEADERS

113−

114−

115−{-| Basic info needed to identify modules and determine dependencies. -}

116−data Header imports =

117− Header

118− { _kind :: Kind

119− , _name :: Name.Raw

120− , _docs :: A.Located (Maybe String)

121− , _exports :: Var.Listing (A.Located Var.Value)

122− , _imports :: imports

123− }

124

143

144+type Aliases =

145+ Map.Map String ([String], Type.Canonical)

125

146

126

147

127−-- IMPORTs

148+type Unions =

149+ Map.Map String (UnionInfo String)

128

150

129

151

130−type UserImport = A.Located (Name.Raw, ImportMethod)

152+type UnionInfo v =

153+ ( [String], [(v, [Type.Canonical])] )

131

154

132

155

133−type DefaultImport = (Name.Raw, ImportMethod)

156+type CanonicalUnion =

157+ ( Var.Canonical, UnionInfo Var.Canonical )

134

158

135

159

136−data ImportMethod =

160+data Effects =

137− ImportMethod

161+ Effects

138− { alias :: Maybe String

162+ { cmds :: [String]

139− , exposedVars :: !(Var.Listing Var.Value)

163+ , subs :: [String]

140 }

164 }

141

165

142

166

@@ -144,14 +168,18 @@ data ImportMethod =

144-- INTERFACES

168-- INTERFACES

145

169

146

170

171+type Interfaces =

172+ Map.Map Name.Canonical Interface

173+

174+

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

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

148data Interface =

176data Interface =

149 Interface

177 Interface

150 { iVersion :: Package.Version

178 { iVersion :: Package.Version

151 , iPackage :: Package.Name

179 , iPackage :: Package.Name

152 , iExports :: [Var.Value]

180 , iExports :: [Var.Value]

153− , iTypes :: Types

154 , iImports :: [Name.Raw]

181 , iImports :: [Name.Raw]

182+ , iTypes :: Types

155 , iUnions :: Unions

183 , iUnions :: Unions

156 , iAliases :: Aliases

184 , iAliases :: Aliases

157 , iFixities :: [(Decl.Assoc, Int, String)]

185 , iFixities :: [(Decl.Assoc, Int, String)]

@@ -161,18 +189,18 @@ data Interface =

161toInterface :: Package.Name -> Optimized -> Interface

189toInterface :: Package.Name -> Optimized -> Interface

162toInterface pkgName modul =

190toInterface pkgName modul =

163 let

191 let

164− body' =

192+ myInfo =

165− body modul

193+ info modul

166 in

194 in

167 Interface

195 Interface

168 { iVersion = Compiler.version

196 { iVersion = Compiler.version

169 , iPackage = pkgName

197 , iPackage = pkgName

170− , iExports = exports modul

198+ , iExports = exports myInfo

199+ , iImports = imports myInfo

171− , iTypes = types body'

200+ , iTypes = types myInfo

172− , iImports = imports modul

173− , iUnions = unions body'

201+ , iUnions = unions myInfo

174− , iAliases = aliases body'

202+ , iAliases = aliases myInfo

175− , iFixities = fixities body'

203+ , iFixities = fixities myInfo

176 }

204 }

177

205

178

206

@@ -184,8 +212,8 @@ instance Binary Interface where

184 do put (iVersion modul)

212 do put (iVersion modul)

185 put (iPackage modul)

213 put (iPackage modul)

186 put (iExports modul)

214 put (iExports modul)

187− put (iTypes modul)

188 put (iImports modul)

215 put (iImports modul)

216+ put (iTypes modul)

189 put (iUnions modul)

217 put (iUnions modul)

190 put (iAliases modul)

218 put (iAliases modul)

191 put (iFixities modul)

219 put (iFixities modul)

src/Elm/Utils.hs+2−3

@@ -18,7 +18,6 @@ import System.FilePath ((</>))

18import System.IO.Error (tryIOError)

19import System.Process (readProcessWithExitCode)

21−import qualified AST.Expression.Source as Source

22import qualified AST.Pattern as Pattern

21import qualified AST.Pattern as Pattern

23import qualified Elm.Compiler.Version as Version

22import qualified Elm.Compiler.Version as Version

24import qualified Elm.Package as Pkg

23import qualified Elm.Package as Pkg

@@ -154,8 +153,8 @@ errorNotFound name =

154

153

155isDeclaration :: String -> Maybe String

154isDeclaration :: String -> Maybe String

156isDeclaration string =

155isDeclaration string =

157− case Parse.iParse Parse.definition string of

156+ case Parse.iParse (Parse.definition (,)) string of

158− Right (A.A _ (Source.Definition pattern _)) ->

157+ Right (A.A _ (pattern, _)) ->

159 Just (List.intercalate "$" (Pattern.boundVarList pattern))

158 Just (List.intercalate "$" (Pattern.boundVarList pattern))

160

159

161 _ ->

160 _ ->

src/Optimize.hs+24−22

@@ -23,16 +23,25 @@ import qualified Reporting.Region as R

23-- OPTIMIZE

26−optimize :: DT.VariantDict -> Module.CanonicalModule -> Module.Optimized

26+optimize :: DT.VariantDict -> Module.Canonical -> Module.Optimized

27−optimize variantDict module_@(Module.Module _ home _ _ _ _ body) =

27+optimize variantDict module_@(Module.Module _ home _ info) =

28 let

29+ (Module.Canonical docs exports imports body) =

30+ info

31+

29 (defs, _) =

32 (defs, _) =

30− flattenLets [] (Module.program body)

33+ flattenLets [] (Module.program body)

32 optDefs =

35 optDefs =

33 Env.run variantDict home (concat <$> mapM (optimizeDef True) defs)

36 Env.run variantDict home (concat <$> mapM (optimizeDef True) defs)

37+

38+ optBody =

39+ body { Module.program = optDefs }

34 in

40 in

35− module_ { Module.body = body { Module.program = optDefs } }

41+ module_

42+ { Module.info =

43+ Module.Optimized docs exports imports optBody

44+ }

38flattenLets :: [Can.Def] -> Can.Expr -> ([Can.Def], Can.Expr)

47flattenLets :: [Can.Def] -> Can.Expr -> ([Can.Def], Can.Expr)

@@ -67,8 +76,8 @@ optimizeDef isRoot (Can.Definition (Can.Facts deps) pattern expression _) =

67optimizeDefHelp

76optimizeDefHelp

68 :: Maybe ModuleName.Canonical

77 :: Maybe ModuleName.Canonical

69 -> [Var.TopLevel]

78 -> [Var.TopLevel]

70− -> P.CanonicalPattern

79+ -> P.Canonical

71− -> [P.CanonicalPattern]

80+ -> [P.Canonical]

72 -> Can.Expr

81 -> Can.Expr

73 -> Env.Optimizer [Opt.Def]

82 -> Env.Optimizer [Opt.Def]

74optimizeDefHelp home deps pattern@(A.A _ ptrn) args rawBody =

83optimizeDefHelp home deps pattern@(A.A _ ptrn) args rawBody =

@@ -118,7 +127,7 @@ optimizeDefHelp home deps pattern@(A.A _ ptrn) args rawBody =

118

127

119optimizeFunction

128optimizeFunction

120 :: Maybe String

129 :: Maybe String

121− -> [P.CanonicalPattern]

130+ -> [P.Canonical]

122 -> Can.Expr

131 -> Can.Expr

123 -> Env.Optimizer ([String], Opt.Expr)

132 -> Env.Optimizer ([String], Opt.Expr)

124optimizeFunction maybeName patterns givenBody =

133optimizeFunction maybeName patterns givenBody =

@@ -132,20 +141,13 @@ makeContext argNames name =

132 Just (name, length argNames, argNames)

141 Just (name, length argNames, argNames)

133

142

134

143

135−depatternArgs

136− :: ([String], Can.Expr)

137− -> P.CanonicalPattern

138− -> Env.Optimizer ([String], Can.Expr)

144+depatternArgs :: ([String], Can.Expr) -> P.Canonical -> Env.Optimizer ([String], Can.Expr)

139depatternArgs (names, rawExpr) ptrn =

145depatternArgs (names, rawExpr) ptrn =

140 do (name, expr) <- depattern ptrn rawExpr

146 do (name, expr) <- depattern ptrn rawExpr

141 return (name : names, expr)

147 return (name : names, expr)

142

148

143

149

144−patternToDefs

145− :: Maybe ModuleName.Canonical

150+patternToDefs :: Maybe ModuleName.Canonical -> String -> P.Canonical -> [Opt.Def]

146− -> String

147− -> P.CanonicalPattern

148− -> [Opt.Def]

149patternToDefs home rootName pattern =

151patternToDefs home rootName pattern =

150 let

152 let

151 (deps, rootExpr) =

153 (deps, rootExpr) =

@@ -170,7 +172,7 @@ patternToDefs home rootName pattern =

170-- TURN A PATTERN INTO A BUNCH OF SUBSTITUTIONS

172-- TURN A PATTERN INTO A BUNCH OF SUBSTITUTIONS

171

173

172

174

173−patternToSubstitutions :: Opt.Expr -> P.CanonicalPattern -> [(String, Opt.Expr)]

175+patternToSubstitutions :: Opt.Expr -> P.Canonical -> [(String, Opt.Expr)]

174patternToSubstitutions expr (A.A _ pattern) =

176patternToSubstitutions expr (A.A _ pattern) =

175 case pattern of

177 case pattern of

176 P.Var name ->

178 P.Var name ->

@@ -322,8 +324,8 @@ optimizeBranch

322 :: Context

324 :: Context

323 -> R.Region

325 -> R.Region

324 -> String

326 -> String

325− -> (P.CanonicalPattern, Can.Expr)

327+ -> (P.Canonical, Can.Expr)

326− -> Env.Optimizer (P.CanonicalPattern, Opt.Expr)

328+ -> Env.Optimizer (P.Canonical, Opt.Expr)

327optimizeBranch context region exprName (rawPattern, canBranch) =

329optimizeBranch context region exprName (rawPattern, canBranch) =

328 let

330 let

329 root =

331 root =

@@ -340,9 +342,9 @@ optimizeBranch context region exprName (rawPattern, canBranch) =

340

342

341tagCrashBranch

343tagCrashBranch

342 :: R.Region

344 :: R.Region

343− -> P.CanonicalPattern

345+ -> P.Canonical

344 -> Opt.Expr

346 -> Opt.Expr

345− -> Env.Optimizer (P.CanonicalPattern, Opt.Expr)

347+ -> Env.Optimizer (P.Canonical, Opt.Expr)

346tagCrashBranch region pattern@(A.A pr _) expr =

348tagCrashBranch region pattern@(A.A pr _) expr =

347 case expr of

349 case expr of

348 Opt.Call (Opt.Crash home _ _) [arg] ->

350 Opt.Call (Opt.Crash home _ _) [arg] ->

@@ -382,7 +384,7 @@ isTailCall context (A.A _ function) arity =

382-- it out from there

384-- it out from there

383

385

384

386

385−depattern :: P.CanonicalPattern -> Can.Expr -> Env.Optimizer (String, Can.Expr)

387+depattern :: P.Canonical -> Can.Expr -> Env.Optimizer (String, Can.Expr)

386depattern canPattern@(A.A _ pattern) expr =

388depattern canPattern@(A.A _ pattern) expr =

387 let

389 let

388 ann =

390 ann =

src/Parse/Declaration.hs+62−16

@@ -2,19 +2,33 @@

2module Parse.Declaration where

4import Text.Parsec ( (<|>), (<?>), choice, digit, optionMaybe, string, try )

5+import qualified Text.Parsec.Indent as Indent

6−import qualified AST.Declaration as D

7+import qualified AST.Declaration as Decl

8+import qualified AST.Expression.Source as Source

7import qualified Parse.Expression as Expr

9import qualified Parse.Expression as Expr

8import Parse.Helpers as Help

10import Parse.Helpers as Help

9import qualified Parse.Type as Type

11import qualified Parse.Type as Type

12+import qualified Reporting.Annotation as A

13−declaration :: IParser D.SourceDecl

16+declaration :: IParser Decl.Source

14declaration =

17declaration =

18+ commentOr $ addLocation $

19+ choice

20+ [ Decl.Source <$> typeDecl

21+ , Decl.Source <$> infixDecl

22+ , defineDecl

23+ , Decl.Source <$> definition

24+ ]

25+

26+

27+commentOr :: IParser a -> IParser (Decl.CommentOr a)

28+commentOr parser =

15 choice

29 choice

16− [ D.Comment <$> Help.docComment

30+ [ Decl.Comment <$> addLocation Help.docComment

17− , D.Decl <$> addLocation (typeDecl <|> infixDecl <|> definition)

31+ , Decl.Whatever <$> parser

18 ]

32 ]

@@ -22,18 +36,17 @@ declaration =

22-- TYPE ANNOTATIONS and DEFINITIONS

36-- TYPE ANNOTATIONS and DEFINITIONS

25−definition :: IParser D.SourceDecl'

39+definition :: IParser Decl.Source'

26definition =

40definition =

27− D.Definition

28− <$> (Expr.typeAnnotation <|> Expr.definition)

29− <?> "a value definition"

41+ do def <- Expr.def <?> "a value definition"

42+ return $ Decl.Def def

33-- TYPE ALIAS and UNION TYPES

46-- TYPE ALIAS and UNION TYPES

36−typeDecl :: IParser D.SourceDecl'

49+typeDecl :: IParser Decl.Source'

37typeDecl =

50typeDecl =

38 do try (reserved "type") <?> "a type declaration"

51 do try (reserved "type") <?> "a type declaration"

39 forcedWS

52 forcedWS

@@ -46,28 +59,61 @@ typeDecl =

46 case isAlias of

59 case isAlias of

47 Just _ ->

60 Just _ ->

48 do tipe <- Type.expr <?> "a type"

61 do tipe <- Type.expr <?> "a type"

49− return (D.TypeAlias name args tipe)

62+ return $ Decl.Alias name args tipe

51 Nothing ->

64 Nothing ->

52 do tcs <- pipeSep1 Type.constructor <?> "a constructor for a union type"

65 do tcs <- pipeSep1 Type.constructor <?> "a constructor for a union type"

53− return $ D.Datatype name args tcs

66+ return $ Decl.Union name args tcs

57-- INFIX

70-- INFIX

60−infixDecl :: IParser D.SourceDecl'

73+infixDecl :: IParser Decl.Source'

61infixDecl =

74infixDecl =

62 expecting "an infix declaration" $

75 expecting "an infix declaration" $

63 do assoc <-

76 do assoc <-

64 choice

77 choice

65− [ try (reserved "infixl") >> return D.L

78+ [ try (reserved "infixl") >> return Decl.L

66− , try (reserved "infixr") >> return D.R

79+ , try (reserved "infixr") >> return Decl.R

67− , try (reserved "infix") >> return D.N

80+ , try (reserved "infix") >> return Decl.N

68 ]

81 ]

69 forcedWS

82 forcedWS

70 n <- digit

83 n <- digit

71 forcedWS

84 forcedWS

85+ op <- anyOp

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

86+ return $ Decl.Fixity assoc (read [n]) op

87+

88+

89+

90+-- DEFINE

91+

92+

93+defineDecl :: IParser Decl.SourceOrDefine

94+defineDecl =

95+ do try (reserved "define")

96+ forcedWS

98+ name <-

99+ string "commands" <|> string "subscriptions"

100+

101+ padded (reserved "as")

102+

103+ effects <-

104+ Indent.block (commentOr effectDef <* whitespace)

105+

106+ return (Decl.Define name effects)

107+

108+

109+effectDef :: IParser (A.Located Source.Effect)

110+effectDef =

111+ choice

112+ [ Expr.annotation Source.Type

113+ , Expr.definition Source.Def

114+ , addLocation $

115+ do name <- lowVar

116+ padded (reserved "with")

117+ expr <- Expr.expr

118+ return (Source.With name expr)

119+ ]

src/Parse/Expression.hs+39−17

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

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

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

3import qualified Data.List as List

4import Text.Parsec hiding (newline, spaces)

@@ -15,12 +15,15 @@ import qualified AST.Expression.General as E

15import qualified AST.Expression.Source as Source

16import qualified AST.Literal as L

17import qualified AST.Pattern as P

18+import qualified AST.Type as T

18import qualified AST.Variable as Var

19import qualified AST.Variable as Var

19import qualified Reporting.Annotation as A

20import qualified Reporting.Annotation as A

23+

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

24-------- Basic Terms --------

26+

24varTerm :: IParser Source.Expr'

27varTerm :: IParser Source.Expr'

25varTerm =

28varTerm =

26 toVar <$> var

29 toVar <$> var

@@ -70,8 +73,10 @@ negative =

70 nTerm

73 nTerm

76+

73-------- Complex Terms --------

77-------- Complex Terms --------

79+

75listTerm :: IParser Source.Expr'

80listTerm :: IParser Source.Expr'

76listTerm =

81listTerm =

77 shader' <|> braces (try range <|> E.ExplicitList <$> commaSep expr)

82 shader' <|> braces (try range <|> E.ExplicitList <$> commaSep expr)

@@ -122,7 +127,6 @@ parensTerm =

122 return (mkExpr start end)

127 return (mkExpr start end)

123

128

124

129

125−

126recordTerm :: IParser Source.Expr

130recordTerm :: IParser Source.Expr

127recordTerm =

131recordTerm =

128 addLocation $ brackets $ choice $

132 addLocation $ brackets $ choice $

@@ -168,8 +172,10 @@ term =

168 <?> "an expression"

172 <?> "an expression"

169

173

170

174

175+

171-------- Applications --------

176-------- Applications --------

172

177

178+

173appExpr :: IParser Source.Expr

179appExpr :: IParser Source.Expr

174appExpr =

180appExpr =

175 expecting "an expression" $

181 expecting "an expression" $

@@ -182,8 +188,10 @@ appExpr =

182 _ -> List.foldl' (\f x -> A.merge f x $ E.App f x) t ts

188 _ -> List.foldl' (\f x -> A.merge f x $ E.App f x) t ts

183

189

184

190

191+

185-------- Normal Expressions --------

192-------- Normal Expressions --------

186

193

194+

187expr :: IParser Source.Expr

195expr :: IParser Source.Expr

188expr =

196expr =

189 addLocation (choice [ letExpr, caseExpr, ifExpr ])

197 addLocation (choice [ letExpr, caseExpr, ifExpr ])

@@ -256,51 +264,65 @@ caseExpr =

256 (,) p <$> expr

264 (,) p <$> expr

257

265

258

266

267+

259-- LET

268-- LET

260

269

270+

261letExpr :: IParser Source.Expr'

271letExpr :: IParser Source.Expr'

262letExpr =

272letExpr =

263 do try (reserved "let")

273 do try (reserved "let")

264 whitespace

274 whitespace

265 defs <-

275 defs <-

266− Indent.block $

276+ Indent.block (def <* whitespace)

267− do def <- typeAnnotation <|> definition

277+ whitespace

268− whitespace

269− return def

270− padded (reserved "in")

278+ reserved "in"

279+ whitespace

271 E.Let defs <$> expr

280 E.Let defs <$> expr

272

281

273

282

283+def :: IParser Source.Def

284+def =

285+ choice

286+ [ annotation Source.Annotation

287+ , definition Source.Definition

288+ ]

289+

290+

291+

274-- TYPE ANNOTATION

292-- TYPE ANNOTATION

275

293

276−typeAnnotation :: IParser Source.Def

294+

277−typeAnnotation =

295+annotation :: (String -> T.Raw -> a) -> IParser (A.Located a)

278− addLocation (Source.TypeAnnotation <$> try start <*> Type.expr)

296+annotation creator =

279− where

297+ let

280 start =

298 start =

281 do v <- lowVar <|> parens symOp

299 do v <- lowVar <|> parens symOp

282 padded hasType

300 padded hasType

283 return v

301 return v

302+ in

303+ addLocation (creator <$> try start <*> Type.expr)

304+

284

305

285

306

286-- DEFINITION

307-- DEFINITION

287

308

309+

288−definition :: IParser Source.Def

310+definition :: (P.Raw -> Source.Expr -> a) -> IParser (A.Located a)

289−definition =

311+definition creator =

290 addLocation $

312 addLocation $

291 Indent.withPos $

313 Indent.withPos $

292 do (name, args) <- defStart

314 do (name, args) <- defStart

293 padded equals

315 padded equals

294 body <- expr

316 body <- expr

295− return . Source.Definition name $ makeFunction args body

317+ return . creator name $ makeFunction args body

296

318

297

319

298−makeFunction :: [P.RawPattern] -> Source.Expr -> Source.Expr

320+makeFunction :: [P.Raw] -> Source.Expr -> Source.Expr

299makeFunction args body@(A.A ann _) =

321makeFunction args body@(A.A ann _) =

300− foldr (\arg body' -> A.A ann $ E.Lambda arg body') body args

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

301

323

302

324

303−defStart :: IParser (P.RawPattern, [P.RawPattern])

325+defStart :: IParser (P.Raw, [P.Raw])

304defStart =

326defStart =

305 expecting "the definition of a value (x = ...)" $

327 expecting "the definition of a value (x = ...)" $

306 do starter <- try Pattern.term <|> addLocation (P.Var <$> parens symOp)

328 do starter <- try Pattern.term <|> addLocation (P.Var <$> parens symOp)

src/Parse/Helpers.hs+3−3

@@ -29,9 +29,9 @@ reserveds =

29 , "let", "in"

30 , "type"

31 , "module", "where"

32− , "import", "as", "hiding", "exposing"

32+ , "import", "exposing", "hiding", "export"

33− , "port", "export", "foreign"

33+ , "as"

34− , "perform"

34+ , "define", "with"

35 , "deriving"

36 ]

src/Parse/Module.hs+10−9

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

1+{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}

1module Parse.Module (moduleDecl, header, getModuleName) where

2module Parse.Module (moduleDecl, header, getModuleName) where

3import Text.Parsec hiding (newline, spaces)

4import Text.Parsec hiding (newline, spaces)

@@ -12,12 +13,12 @@ import Reporting.Annotation as A

12getModuleName :: String -> Maybe String

13getModuleName :: String -> Maybe String

13getModuleName source =

14getModuleName source =

14 let

15 let

15− getModuleName =

16+ minimalParser =

16 do optional freshLine

17 do optional freshLine

17 (_, names, _) <- moduleDecl

18 (_, names, _) <- moduleDecl

18 return (ModuleName.toString names)

19 return (ModuleName.toString names)

19 in

20 in

20− case iParse getModuleName source of

21+ case iParse minimalParser source of

21 Right name ->

22 Right name ->

22 Just name

23 Just name

@@ -28,9 +29,9 @@ getModuleName source =

28header :: IParser (Module.Header [Module.UserImport])

29header :: IParser (Module.Header [Module.UserImport])

29header =

30header =

30 do optional freshLine

31 do optional freshLine

31− (kind, names, exports) <-

32+ (tag, names, exports) <-

32 option

33 option

33− (Module.Normal, ["Main"], Var.openListing)

34+ (Module.None, ["Main"], Var.openListing)

34 (moduleDecl `followedBy` freshLine)

35 (moduleDecl `followedBy` freshLine)

36 docs <-

37 docs <-

@@ -41,17 +42,17 @@ header =

42 imports' <- imports

43 imports' <- imports

44− return (Module.Header kind names docs exports imports')

45+ return (Module.Header tag names docs exports imports')

47−moduleDecl :: IParser (Module.Kind, [String], Var.Listing (A.Located Var.Value))

48+moduleDecl :: IParser (Module.Tag, [String], Var.Listing (A.Located Var.Value))

48moduleDecl =

49moduleDecl =

49 expecting "a module declaration" $

50 expecting "a module declaration" $

50 do

51 do

51 kind <-

52 kind <-

52 choice

53 choice

53 [ do try (reserved "module")

54 [ do try (reserved "module")

54− return Module.Normal

55+ return Module.None

55 , do try (reserved "effect")

56 , do try (reserved "effect")

56 whitespace

57 whitespace

57 reserved "module"

58 reserved "module"

@@ -114,14 +115,14 @@ listing item =

114 expecting "a listing of values and types to expose, like (..)" $

115 expecting "a listing of values and types to expose, like (..)" $

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

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

116 whitespace

117 whitespace

117− listing <-

118+ actualListing <-

118 choice

119 choice

119 [ const Var.openListing <$> string ".."

120 [ const Var.openListing <$> string ".."

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

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

121 ]

122 ]

122 whitespace

123 whitespace

123 char ')'

124 char ')'

124− return listing

125+ return actualListing

125

126

127

127value :: IParser Var.Value

128value :: IParser Var.Value

src/Parse/Parse.hs+62−32

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

1−{-# OPTIONS_GHC -Wall #-}

1+{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}

2module Parse.Parse (program, parse) where

4import qualified Data.Map as Map

@@ -6,14 +6,14 @@ import qualified Data.Traversable as T

6import Text.Parsec (char, eof, letter, many, putState, (<|>))

7import qualified Text.Parsec.Error as Parsec

9−import qualified AST.Declaration as D

9+import qualified AST.Declaration as Decl

10−import qualified AST.Module as M

10+import qualified AST.Module as Module

11import qualified AST.Module.Name as ModuleName

12import qualified Elm.Compiler.Imports as Imports

13import qualified Elm.Package as Package

14import Parse.Helpers

15−import qualified Parse.Module as Module

15+import qualified Parse.Module as Parse (header)

16−import qualified Parse.Declaration as Decl

16+import qualified Parse.Declaration as Parse (declaration, infixDecl)

17import qualified Reporting.Region as R

18import qualified Reporting.Error.Syntax as Error

19import qualified Reporting.Result as Result

@@ -25,50 +25,80 @@ program

25 :: Package.Name

26 -> OpTable

27 -> String

28− -> Result.Result wrn Error.Error M.ValidModule

28+ -> Result.Result wrn Error.Error Module.Valid

29program pkgName table src =

30− do (M.Module kind name filePath docs exports imports sourceDecls) <-

30+ do modul <-

31− parseWithTable table src (programParser pkgName)

31+ parseWithTable table src (programParser pkgName)

33− validDecls <- Validate.declarations sourceDecls

33+ let

34+ (Module.Source docs exports imports sourceDecls) =

35+ Module.info modul

35− -- determine if default imports should be added, only elm-lang/core is exempt

37+ validDecls <-

36− let ammendedImports =

38+ Validate.declarations sourceDecls

37− ( if pkgName == Package.coreName then [] else Imports.defaults

38− , imports

39− )

41− return (M.Module kind name filePath docs exports ammendedImports validDecls)

40+ return $

41+ modul

42+ { Module.info =

43+ Module.Valid

44+ docs

45+ exports

46+ (addDefaults pkgName imports)

47+ validDecls

48+ (error "TODO")

49+ (error "TODO")

50+ }

51+

52+

53+-- determine if default imports should be added, only elm-lang/core is exempt

54+addDefaults

55+ :: Package.Name

56+ -> [Module.UserImport]

57+ -> ([Module.DefaultImport], [Module.UserImport])

58+addDefaults pkgName imports =

59+ flip (,) imports $

60+ if pkgName == Package.coreName then

61+ []

62+

63+ else

64+ Imports.defaults

45-- HEADERS AND DECLARATIONS

68-- HEADERS AND DECLARATIONS

48−programParser :: Package.Name -> IParser M.SourceModule

71+programParser :: Package.Name -> IParser Module.Source

49programParser pkgName =

72programParser pkgName =

50− do (M.Header kind name docs exports imports) <- Module.header

73+ do (Module.Header tag name docs exports imports) <-

51− decls <- declarations

74+ Parse.header

52− _ <- many (spaces <|> newline)

53− eof

55− let canonicalName =

76+ decls <-

56− ModuleName.Canonical pkgName name

77+ declarations

78+

79+ many (spaces <|> newline)

80+

81+ eof

83+ return $

84+ Module.Module

85+ tag

86+ (ModuleName.Canonical pkgName name)

87+ ""

58− return $ M.Module kind canonicalName "" docs exports imports decls

88+ (Module.Source docs exports imports decls)

61−declarations :: IParser [D.SourceDecl]

91+declarations :: IParser [Decl.Source]

62declarations =

92declarations =

63− (:) <$> Decl.declaration

93+ (:) <$> Parse.declaration

64 <*> many freshDef

94 <*> many freshDef

67−freshDef :: IParser D.SourceDecl

97+freshDef :: IParser Decl.Source

68freshDef =

98freshDef =

69 commitIf (freshLine >> (letter <|> char '_')) $

99 commitIf (freshLine >> (letter <|> char '_')) $

70− do _ <- freshLine

100+ do freshLine

71− Decl.declaration

101+ Parse.declaration

102

103

104

@@ -108,9 +138,9 @@ parseWithTable table source parser =

108

138

109

139

110makeInfixTable

140makeInfixTable

111− :: Map.Map String (Int, D.Assoc)

141+ :: Map.Map String (Int, Decl.Assoc)

112 -> [(String, InfixInfo)]

142 -> [(String, InfixInfo)]

113− -> Result.Result wrn Error.Error (Map.Map String (Int, D.Assoc))

143+ -> Result.Result wrn Error.Error (Map.Map String (Int, Decl.Assoc))

114makeInfixTable table newInfo =

144makeInfixTable table newInfo =

115 let add (op, info) dict =

145 let add (op, info) dict =

116 Map.insertWith (++) op [info] dict

146 Map.insertWith (++) op [info] dict

@@ -140,12 +170,12 @@ parseFixities =

140 where

170 where

141 infics =

171 infics =

142 do start <- getMyPosition

172 do start <- getMyPosition

143− (D.Fixity assoc level op) <- Decl.infixDecl

173+ (Decl.Fixity assoc level op) <- Parse.infixDecl

144 end <- getMyPosition

174 end <- getMyPosition

145 return (op, InfixInfo (R.Region start end) (level, assoc))

175 return (op, InfixInfo (R.Region start end) (level, assoc))

146

176

147

177

148data InfixInfo = InfixInfo

178data InfixInfo = InfixInfo

149 { _region :: R.Region

179 { _region :: R.Region

150− , _info :: (Int, D.Assoc)

180+ , _info :: (Int, Decl.Assoc)

151 }

181 }

src/Reporting/Error/Syntax.hs+55−28

@@ -15,10 +15,13 @@ data Error

15 = Parse [Parsec.Message]

16 | BadFunctionName Int

17 | BadPattern String

18+ | CommentAfterAnnotation String

19+ | CommentOnComment

20+ | CommentOnNothing

21+ | DefineDuplicate String

22+ | DefineUnknown String

18 | InfixDuplicate String

23 | InfixDuplicate String

19 | TypeWithoutDefinition String

24 | TypeWithoutDefinition String

20− | PortWithoutAnnotation String

21− | UnexpectedPort

22 | DuplicateFieldName String

25 | DuplicateFieldName String

23 | DuplicateValueDeclaration String

26 | DuplicateValueDeclaration String

24 | DuplicateTypeDeclaration String

27 | DuplicateTypeDeclaration String

@@ -64,6 +67,52 @@ toReport _localizer err =

64 ]

67 ]

65 )

68 )

70+ CommentAfterAnnotation name ->

71+ Report.report

72+ "STRAY COMMENT"

73+ Nothing

74+ ("The type annotation for `" ++ name ++ "` is followed by a documentation comment.")

75+ ( Help.reflowParagraph $

76+ "Documentation comments need to be *before* type annotations. Furthermore,\

77+ \ type annotations need to be right above the corresponding definition, no\

78+ \ comments in between."

79+ )

80+

81+ CommentOnComment ->

82+ Report.report

83+ "STRAY COMMENT"

84+ Nothing

85+ ("This comment is followed by another documentation comment.")

86+ ( Help.reflowParagraph $

87+ "All documentation comments need to be right above the declaration they\

88+ \ describe. Maybe some code got deleted or commented out by accident?"

89+ )

90+

91+ CommentOnNothing ->

92+ Report.report

93+ "STRAY COMMENT"

94+ Nothing

95+ ("This documentation comment is not followed by anything.")

96+ ( text "What is it documenting? Maybe it should just be removed?" )

97+

98+ DefineDuplicate name ->

99+ Report.report

100+ "DUPLICATE DEFINE"

101+ Nothing

102+ ("A module can have only one `define " ++ name ++ "` declaration.")

103+ ( text "This module has two though. You should combine them or remove one." )

104+

105+ DefineUnknown name ->

106+ Report.report

107+ "UNKNOWN DEFINE"

108+ Nothing

109+ ("You are trying to `define " ++ name ++ "`, but that is not recognized.")

110+ ( Help.reflowParagraph $

111+ "You can only define `commands` and `subscriptions` with this syntax.\

112+ \ Furthermore, you must be in an `effect module` or `foreign effect module` to\

113+ \ even have access to this syntax."

114+ )

115+

67 InfixDuplicate opName ->

116 InfixDuplicate opName ->

68 Report.report

117 Report.report

69 "INFIX OVERLAP"

118 "INFIX OVERLAP"

@@ -87,28 +136,6 @@ toReport _localizer err =

87 ++ " " ++ valueName ++ " = 42"

136 ++ " " ++ valueName ++ " = 42"

88 )

137 )

138

90− PortWithoutAnnotation portName ->

91− Report.report

92− "PORT ERROR"

93− Nothing

94− ("Port `" ++ portName ++ "` does not have a type annotation!")

95− ( text $

96− "Directly above the port definition, I need something like this:\n\n"

97− ++ " port " ++ portName ++ " : Signal Int"

98− )

99−

100−

101− UnexpectedPort ->

102− Report.report

103− "PORT ERROR"

104− Nothing

105− "This module has ports, but ports can only appear in the main module."

106− ( Help.reflowParagraph $

107− "Ports in library code would create hidden dependencies where importing a\

108− \ module could bring in constraints not captured in the public API. Furthermore,\

109− \ if the module is imported twice, do we send values out the port twice?"

110− )

111−

112 DuplicateFieldName name ->

139 DuplicateFieldName name ->

113 Report.report

140 Report.report

114 "DUPLICATE FIELD"

141 "DUPLICATE FIELD"

@@ -191,7 +218,7 @@ toReport _localizer err =

191

218

192

219

193unboundTypeVars :: String -> String -> [String] -> [String] -> Report.Report

220unboundTypeVars :: String -> String -> [String] -> [String] -> Report.Report

194−unboundTypeVars declKind typeName givenVars unboundVars@(tvar:_) =

221+unboundTypeVars declKind typeName givenVars unboundVars =

195 Report.report

222 Report.report

196 "UNBOUND TYPE VARIABLES"

223 "UNBOUND TYPE VARIABLES"

197 Nothing

224 Nothing

@@ -205,9 +232,9 @@ unboundTypeVars declKind typeName givenVars unboundVars@(tvar:_) =

205 ++ map (dullyellow . text) unboundVars

232 ++ map (dullyellow . text) unboundVars

206 ++ map text ["=", "..."]

233 ++ map text ["=", "..."]

207 , Help.reflowParagraph $

234 , Help.reflowParagraph $

208− "Here's why. Imagine one `" ++ typeName ++ "` where `" ++ tvar ++ "` is an Int and\

235+ "Here's why. Imagine one `" ++ typeName ++ "` where `" ++ head unboundVars ++

209− \ another where it is a Bool. When we explicitly list the type variables, type\

236+ "` is an Int and another where it is a Bool. When we explicitly list the type\

210− \ checker can see that they are actually different types."

237+ \ variables, type checker can see that they are actually different types."

211 ]

238 ]

212 )

239 )

213

240

src/Validate.hs+253−112

@@ -3,6 +3,7 @@ module Validate (declarations) where

4import Control.Monad (foldM)

5import qualified Data.Map as Map

6+import qualified Data.Maybe as Maybe

6import qualified Data.Set as Set

7import qualified Data.Set as Set

7import qualified Data.Foldable as F

8import qualified Data.Foldable as F

8import qualified Data.Traversable as T

9import qualified Data.Traversable as T

@@ -21,94 +22,225 @@ import qualified Reporting.Result as Result

24−-- VALIDATE DECLARATIONS

25+-- COLLAPSE COMMENTS

26+

27+

28+type Commented a =

29+ A.Annotated (R.Region, Maybe (A.Located String)) a

30+

31+

32+collapseComments

33+ :: [D.CommentOr (A.Located a)]

34+ -> Result.Result wrn Error.Error [Commented a]

35+collapseComments listWithComments =

36+ case listWithComments of

37+ [] ->

38+ Result.ok []

39+

40+ D.Comment msg : D.Whatever (A.A region a) : rest ->

41+ let

42+ entry =

43+ A.A (region, Just msg) a

44+ in

45+ fmap (entry:) (collapseComments rest)

46+

47+ D.Comment (A.A region _) : D.Comment _ : _ ->

48+ Result.throw region Error.CommentOnComment

49+

50+ [D.Comment (A.A region _)] ->

51+ Result.throw region Error.CommentOnNothing

52+

53+ D.Whatever (A.A region a) : rest ->

54+ let

55+ entry =

56+ A.A (region, Nothing) a

57+ in

58+ fmap (entry:) (collapseComments rest)

59+

60+

61+

62+-- EXTRACT DEFINES

63+

65+data StructuredSource =

66+ Src

67+ { _decls :: [Commented D.Source']

68+ , _cmds :: Maybe [Commented Source.Effect]

69+ , _subs :: Maybe [Commented Source.Effect]

70+ }

27−declarations

72+

28− :: [D.SourceDecl]

73+extractEffects :: [Commented D.SourceOrDefine] -> Result.Result wrn Error.Error StructuredSource

74+extractEffects commentedDecls =

75+ case commentedDecls of

76+ [] ->

77+ Result.ok (Src [] Nothing Nothing)

78+

79+ A.A ann (D.Source decl) : rest ->

80+ do restSrc <- extractEffects rest

81+ return $ restSrc { _decls = A.A ann decl : _decls restSrc }

82+

83+ A.A (region, _) (D.Define name commentOrEffects) : rest ->

84+ do restSrc <- extractEffects rest

85+ case name of

86+ "commands" ->

87+ case _cmds restSrc of

88+ Nothing ->

89+ do effects <- collapseComments commentOrEffects

90+ Result.ok $ restSrc { _cmds = Just effects }

91+

92+ Just _ ->

93+ Result.throw region (Error.DefineDuplicate name)

94+

95+ "subscriptions" ->

96+ case _subs restSrc of

97+ Nothing ->

98+ do effects <- collapseComments commentOrEffects

99+ Result.ok $ restSrc { _subs = Just effects }

100+

101+ Just _ ->

102+ Result.throw region (Error.DefineDuplicate name)

103+

104+ _ ->

105+ Result.throw region (Error.DefineUnknown name)

106+

107+

108+

109+-- VALIDATE STRUCTURED SOURCE

110+

111+

29− -> Result.Result wrn Error.Error [D.ValidDecl]

112+declarations :: [D.Source] -> Result.Result wrn Error.Error [D.Valid]

30declarations sourceDecls =

113declarations sourceDecls =

114+ do (Src decls cmds subs) <-

115+ extractEffects =<< collapseComments sourceDecls

116+

117+ validDecls <-

31− do validDecls <- validateDecls Nothing sourceDecls

118+ validateDecls decls

119+

120+ validCmds <-

121+ validateEffects (Maybe.fromMaybe [] cmds)

122+

123+ validSubs <-

124+ validateEffects (Maybe.fromMaybe [] subs)

125+

32 (\_ _ -> validDecls)

126 (\_ _ -> validDecls)

33 <$> declDuplicates validDecls

127 <$> declDuplicates validDecls

34 <*> T.traverse checkDecl validDecls

128 <*> T.traverse checkDecl validDecls

129

130

131+

132+-- VALIDATE DECLARATIONS

133+

134+

37validateDecls

135validateDecls

38− :: Maybe String

136+ :: [Commented D.Source']

39− -> [D.SourceDecl]

40− -> Result.Result wrn Error.Error [D.ValidDecl]

137+ -> Result.Result wrn Error.Error [D.Valid]

41−validateDecls maybeComment sourceDecls =

138+validateDecls commentedDecls =

42− case sourceDecls of

139+ case commentedDecls of

43 [] ->

140 [] ->

44− return []

141+ Result.ok []

142

46− sourceDecl : decls ->

143+ A.A (region, maybeComment) decl : rest ->

144+ let

145+ addRest validDecl =

146+ let

147+ entry =

148+ A.A (region, fmap A.drop maybeComment) validDecl

149+ in

150+ fmap (entry:) (validateDecls rest)

151+ in

47− case sourceDecl of

152+ case decl of

48− D.Comment comment ->

153+ D.Union name tvars ctors ->

49− validateDecls (Just comment) decls

154+ addRest (D.Union name tvars ctors)

155

51− D.Decl decl ->

156+ D.Alias name tvars alias ->

157+ addRest (D.Alias name tvars alias)

158+

159+ D.Fixity assoc prec op ->

160+ addRest (D.Fixity assoc prec op)

161+

162+ D.Def def ->

52− validateDeclsHelp maybeComment decl decls

163+ validateDeclsHelp maybeComment def rest

164

165

55validateDeclsHelp

166validateDeclsHelp

56− :: Maybe String

167+ :: Maybe (A.Located String)

57− -> A.Located D.SourceDecl'

168+ -> Source.Def

58− -> [D.SourceDecl]

169+ -> [Commented D.Source']

59− -> Result.Result wrn Error.Error [D.ValidDecl]

170+ -> Result.Result wrn Error.Error [D.Valid]

60−validateDeclsHelp comment (A.A region decl) decls =

171+validateDeclsHelp maybeComment (A.A region def) decls =

61− let addRest validDecl =

172+ let

62− (:) (A.A (region, comment) validDecl)

173+ makeDef pat expr maybeType =

63− <$> validateDecls Nothing decls

174+ D.Def (Valid.Definition pat expr maybeType)

175+

176+ ann =

177+ (region, fmap A.drop maybeComment)

64 in

178 in

65− case decl of

179+ case def of

66− D.Datatype name tvars ctors ->

180+ Source.Definition pat expr ->

67− addRest (D.Datatype name tvars ctors)

181+ (:)

182+ <$> validateDef makeDef ann pat expr Nothing

183+ <*> validateDecls decls

184+

185+ Source.Annotation name tipe ->

186+ case decls of

187+ A.A (_, Just (A.A commentRegion _)) _ : _ ->

188+ Result.throw commentRegion (Error.CommentAfterAnnotation name)

189

69− D.TypeAlias name tvars alias ->

190+ A.A _ (D.Def (A.A _ (Source.Definition pat expr))) : rest

70− addRest (D.TypeAlias name tvars alias)

191+ | Pattern.isVar name pat ->

192+ (:)

193+ <$> validateDef makeDef ann pat expr (Just tipe)

194+ <*> validateDecls rest

195

72− D.Fixity assoc prec op ->

196+ _ ->

73− addRest (D.Fixity assoc prec op)

197+ Result.throw region (Error.TypeWithoutDefinition name)

198

75− D.Definition def ->

76− defHelp comment def decls

199

200

201+-- VALIDATE EFFECTS

202

80−-- VALIDATE DEFINITIONS IN DECLARATIONS

203

204+validateEffects

205+ :: [Commented Source.Effect]

206+ -> Result.Result wrn Error.Error [A.Commented Valid.Effect]

207+validateEffects effects =

208+ case effects of

209+ [] ->

210+ Result.ok []

211

83−defHelp

212+ A.A (region, maybeComment) effect : rest ->

84− :: Maybe String

213+ validateEffectsHelp (region, fmap A.drop maybeComment) effect rest

85− -> Source.Def

86− -> [D.SourceDecl]

87− -> Result.Result wrn Error.Error [D.ValidDecl]

88−defHelp comment (A.A region def) decls =

89− let addRest def' rest =

90− (:) (A.A (region, comment) (D.Definition def'))

91− <$> validateDecls Nothing rest

92− in

93− case def of

94− Source.Definition pat expr ->

95− do expr' <- expression expr

96− let def' = Valid.Definition pat expr' Nothing

97− checkDefinition def'

98− addRest def' decls

99−

100− Source.TypeAnnotation name tipe ->

101− case decls of

102− D.Decl (A.A _ (D.Definition (A.A _

103− (Source.Definition pat@(A.A _ (Pattern.Var name')) expr)))) : rest

104− | name == name' ->

105− do expr' <- expression expr

106− let def' = Valid.Definition pat expr' (Just tipe)

107− checkDefinition def'

108− addRest def' rest

109

214

110− _ ->

215+

216+validateEffectsHelp

217+ :: (R.Region, Maybe String)

218+ -> Source.Effect

219+ -> [Commented Source.Effect]

220+ -> Result.Result wrn Error.Error [A.Commented Valid.Effect]

221+validateEffectsHelp ann effect remainingEffects =

222+ case effect of

223+ Source.With _ _ ->

224+ Result.throw (fst ann) (error "TODO")

225+

226+ Source.Def pat expr ->

227+ (:)

228+ <$> validateDef Valid.Def ann pat expr Nothing

229+ <*> validateEffects remainingEffects

230+

231+ Source.Type name tipe ->

232+ case remainingEffects of

233+ A.A (_, Just (A.A commentRegion _)) _ : _ ->

234+ Result.throw commentRegion (Error.CommentAfterAnnotation name)

235+

236+ A.A _ (Source.Def pat expr) : rest

237+ | Pattern.isVar name pat ->

238+ (:)

239+ <$> validateDef Valid.Def ann pat expr (Just tipe)

240+ <*> validateEffects rest

241+

242+ _ ->

111− Result.throw region (Error.TypeWithoutDefinition name)

243+ Result.throw (fst ann) (Error.TypeWithoutDefinition name)

112

244

113

245

114

246

@@ -127,29 +259,40 @@ definitionsHelp :: [Source.Def] -> Result.Result wrn Error.Error [Valid.Def]

127definitionsHelp sourceDefs =

259definitionsHelp sourceDefs =

128 case sourceDefs of

260 case sourceDefs of

129 [] ->

261 [] ->

130− return []

262+ return []

131−

263+

132− A.A _ (Source.Definition pat expr) : rest ->

264+ A.A region (Source.Definition pat expr) : rest ->

133− do expr' <- expression expr

265+ (:)

134− let def = Valid.Definition pat expr' Nothing

266+ <$> fmap A.drop (validateDef Valid.Definition region pat expr Nothing)

135− checkDefinition def

136− (:) def <$> definitionsHelp rest

267+ <*> definitionsHelp rest

137−

268+

138− A.A region (Source.TypeAnnotation name tipe) : rest ->

269+ A.A r1 (Source.Annotation name tipe) : rest ->

139− case rest of

270+ case rest of

140− A.A _ (Source.Definition pat@(A.A _ (Pattern.Var name')) expr) : rest'

271+ A.A r2 (Source.Definition pat expr) : rest'

141− | name == name' ->

272+ | Pattern.isVar name pat ->

142− do expr' <- expression expr

273+ (:)

143− let def = Valid.Definition pat expr' (Just tipe)

274+ <$> fmap A.drop (validateDef Valid.Definition (R.merge r1 r2) pat expr (Just tipe))

144− checkDefinition def

145− (:) def <$> definitionsHelp rest'

275+ <*> definitionsHelp rest'

146−

276+

147− _ ->

277+ _ ->

148− Result.throw region (Error.TypeWithoutDefinition name)

278+ Result.throw r1 (Error.TypeWithoutDefinition name)

149−

279+

150−

280+

281+validateDef

282+ :: (Pattern.Raw -> Valid.Expr -> Maybe Type.Raw -> def)

283+ -> annotation

284+ -> Pattern.Raw

285+ -> Source.Expr

286+ -> Maybe Type.Raw

151−checkDefinition :: Valid.Def -> Result.Result wrn Error.Error ()

287+ -> Result.Result wrn Error.Error (A.Annotated annotation def)

152−checkDefinition (Valid.Definition pattern body _) =

288+validateDef makeDef annotation pat expr maybeType =

289+ do validExpr <- expression expr

290+ validateDefPattern pat validExpr

291+ return $ A.A annotation (makeDef pat validExpr maybeType)

292+

293+

294+validateDefPattern :: Pattern.Raw -> Valid.Expr -> Result.Result wrn Error.Error ()

295+validateDefPattern pattern body =

153 case fst (Expr.collectLambdas body) of

296 case fst (Expr.collectLambdas body) of

154 [] ->

297 [] ->

155 return ()

298 return ()

@@ -265,7 +408,7 @@ both (expr1, expr2) =

265-- VALIDATE PATTERNS

408-- VALIDATE PATTERNS

266

409

267

410

268−validatePattern :: Pattern.RawPattern -> Result.Result wrn Error.Error Pattern.RawPattern

411+validatePattern :: Pattern.Raw -> Result.Result wrn Error.Error Pattern.Raw

269validatePattern pattern =

412validatePattern pattern =

270 do detectDuplicates Error.BadPattern (Pattern.boundVars pattern)

413 do detectDuplicates Error.BadPattern (Pattern.boundVars pattern)

271 return pattern

414 return pattern

@@ -297,15 +440,13 @@ detectDuplicates tag names =

297 F.traverse_ check (makeGroups names)

440 F.traverse_ check (makeGroups names)

298

441

299

442

300−defDuplicates

301− :: [Pattern.RawPattern]

302− -> Result.Result wrn Error.Error ()

443+defDuplicates :: [Pattern.Raw] -> Result.Result wrn Error.Error ()

303defDuplicates patterns =

444defDuplicates patterns =

304 concatMap Pattern.boundVars patterns

445 concatMap Pattern.boundVars patterns

305 |> detectDuplicates Error.DuplicateDefinition

446 |> detectDuplicates Error.DuplicateDefinition

306

447

307

448

308−declDuplicates :: [D.ValidDecl] -> Result.Result wrn Error.Error ()

449+declDuplicates :: [D.Valid] -> Result.Result wrn Error.Error ()

309declDuplicates decls =

450declDuplicates decls =

310 let (valueLists, typeLists) = unzip (map extractValues decls)

451 let (valueLists, typeLists) = unzip (map extractValues decls)

311 in

452 in

@@ -314,25 +455,25 @@ declDuplicates decls =

314 <*> detectDuplicates Error.DuplicateTypeDeclaration (concat typeLists)

455 <*> detectDuplicates Error.DuplicateTypeDeclaration (concat typeLists)

315

456

316

457

317−extractValues :: D.ValidDecl -> ([A.Located String], [A.Located String])

458+extractValues :: D.Valid -> ([A.Located String], [A.Located String])

318extractValues (A.A (region, _) decl) =

459extractValues (A.A (region, _) decl) =

319 case decl of

460 case decl of

320− D.Definition (Valid.Definition pattern _ _) ->

461+ D.Def (Valid.Definition pattern _ _) ->

321 ( Pattern.boundVars pattern

462 ( Pattern.boundVars pattern

322 , []

463 , []

323 )

464 )

324

465

325− D.Datatype name _ ctors ->

466+ D.Union name _ ctors ->

326 ( map (A.A region . fst) ctors

467 ( map (A.A region . fst) ctors

327 , [A.A region name]

468 , [A.A region name]

328 )

469 )

329

470

330− D.TypeAlias name _ (A.A _ (Type.RRecord _ _)) ->

471+ D.Alias name _ (A.A _ (Type.RRecord _ _)) ->

331 ( [A.A region name]

472 ( [A.A region name]

332 , [A.A region name]

473 , [A.A region name]

333 )

474 )

334

475

335− D.TypeAlias name _ _ ->

476+ D.Alias name _ _ ->

336 ( []

477 ( []

337 , [A.A region name]

478 , [A.A region name]

338 )

479 )

@@ -347,13 +488,13 @@ extractValues (A.A (region, _) decl) =

347-- UNBOUND TYPE VARIABLES

488-- UNBOUND TYPE VARIABLES

348

489

349

490

350−checkDecl :: D.ValidDecl -> Result.Result wrn Error.Error ()

491+checkDecl :: D.Valid -> Result.Result wrn Error.Error ()

351checkDecl (A.A (region,_) decl) =

492checkDecl (A.A (region,_) decl) =

352 case decl of

493 case decl of

353− D.Definition _ ->

494+ D.Def _ ->

354 return ()

495 return ()

355

496

356− D.Datatype name boundVars ctors ->

497+ D.Union name boundVars ctors ->

357 case diff boundVars (concatMap freeVars (concatMap snd ctors)) of

498 case diff boundVars (concatMap freeVars (concatMap snd ctors)) of

358 (_, []) ->

499 (_, []) ->

359 return ()

500 return ()

@@ -362,7 +503,7 @@ checkDecl (A.A (region,_) decl) =

362 Result.throw region

503 Result.throw region

363 (Error.UnboundTypeVarsInUnion name boundVars unbound)

504 (Error.UnboundTypeVarsInUnion name boundVars unbound)

364

505

365− D.TypeAlias name boundVars tipe ->

506+ D.Alias name boundVars tipe ->

366 case diff boundVars (freeVars tipe) of

507 case diff boundVars (freeVars tipe) of

367 ([], []) ->

508 ([], []) ->

368 return ()

509 return ()

@@ -400,20 +541,20 @@ diff left right =

400

541

401freeVars :: Type.Raw -> [A.Located String]

542freeVars :: Type.Raw -> [A.Located String]

402freeVars (A.A region tipe) =

543freeVars (A.A region tipe) =

403− case tipe of

544+ case tipe of

404− Type.RLambda t1 t2 ->

545+ Type.RLambda t1 t2 ->

405− freeVars t1 ++ freeVars t2

546+ freeVars t1 ++ freeVars t2

406

547

407− Type.RVar x ->

548+ Type.RVar x ->

408− [A.A region x]

549+ [A.A region x]

409

550

410− Type.RType _ ->

551+ Type.RType _ ->

411− []

552+ []

412

553

413− Type.RApp t ts ->

554+ Type.RApp t ts ->

414− concatMap freeVars (t:ts)

555+ concatMap freeVars (t:ts)

415

556

416− Type.RRecord fields ext ->

557+ Type.RRecord fields ext ->

417− maybe [] freeVars ext

558+ maybe [] freeVars ext

418− ++ concatMap (freeVars . snd) fields

559+ ++ concatMap (freeVars . snd) fields

419

560