6d9f01b · elk · git.iko.soy

elm-compiler.cabal−2

compare with master

unifiedsplit

@@ -63,7 +63,6 @@ Library

63 Canonicalize,

64 Canonicalize.Declaration,

65 Canonicalize.Environment,

66− Canonicalize.Port,

67 Canonicalize.Result,

66 Canonicalize.Result,

68 Canonicalize.Setup,

67 Canonicalize.Setup,

69 Canonicalize.Sort,

68 Canonicalize.Sort,

@@ -81,7 +80,6 @@ Library

81 Generate.JavaScript.Expression,

80 Generate.JavaScript.Expression,

82 Generate.JavaScript.Helpers,

81 Generate.JavaScript.Helpers,

83 Generate.JavaScript.Literal,

82 Generate.JavaScript.Literal,

84− Generate.JavaScript.Port,

85 Generate.JavaScript.Variable,

83 Generate.JavaScript.Variable,

86 Nitpick.Pattern,

84 Nitpick.Pattern,

87 Nitpick.PatternMatches,

85 Nitpick.PatternMatches,

src/AST/Declaration.hs+4−31

@@ -3,7 +3,6 @@ module AST.Declaration where

3

4import Data.Binary

5

6−import qualified AST.Expression.General as General

7import qualified AST.Expression.Source as Source

6import qualified AST.Expression.Source as Source

8import qualified AST.Expression.Valid as Valid

7import qualified AST.Expression.Valid as Valid

9import qualified AST.Expression.Canonical as Canonical

8import qualified AST.Expression.Canonical as Canonical

@@ -15,11 +14,10 @@ import qualified Reporting.Annotation as A

15-- DECLARATIONS

14-- DECLARATIONS

16

15

17

16

18−data Declaration' port def tipe expr

17+data Declaration' def tipe expr

19 = Definition def

18 = Definition def

20 | Datatype String [String] [(String, [tipe])]

19 | Datatype String [String] [(String, [tipe])]

21 | TypeAlias String [String] tipe

20 | TypeAlias String [String] tipe

22− | Port port

23 | Fixity Assoc Int String

21 | Fixity Assoc Int String

24

22

25

23

@@ -44,7 +42,7 @@ assocToString assoc =

44

42

45

43

46type SourceDecl' =

44type SourceDecl' =

47− Declaration' SourcePort Source.Def Type.Raw Source.Expr

45+ Declaration' Source.Def Type.Raw Source.Expr

48

46

49

47

50data SourceDecl

48data SourceDecl

@@ -53,36 +51,11 @@ data SourceDecl

53

51

54

52

55type ValidDecl =

53type ValidDecl =

56− A.Commented (Declaration' ValidPort Valid.Def Type.Raw Valid.Expr)

54+ A.Commented (Declaration' Valid.Def Type.Raw Valid.Expr)

57

55

58

56

59type CanonicalDecl =

57type CanonicalDecl =

60− A.Commented (Declaration' CanonicalPort Canonical.Def Type.Canonical Canonical.Expr)

58+ A.Commented (Declaration' Canonical.Def Type.Canonical Canonical.Expr)

61−

62−

63−

64−-- PORTS

65−

66−

67−data SourcePort

68− = PortAnnotation String Type.Raw

69− | PortDefinition String Source.Expr

70−

71−

72−data ValidPort

73− = In String Type.Raw

74− | Out String Valid.Expr Type.Raw

75−

76−

77−newtype CanonicalPort

78− = CanonicalPort (General.PortImpl Canonical.Expr Type.Canonical)

79−

80−

81−validPortName :: ValidPort -> String

82−validPortName port =

83− case port of

84− In name _ -> name

85− Out name _ _ -> name

86

59

87

60

88

61

src/AST/Expression/General.hs−21

@@ -10,7 +10,6 @@ module AST.Expression.General where

10

11import qualified AST.Literal as Literal

12import qualified AST.Pattern as Pattern

13−import qualified AST.Type as Type

14import qualified AST.Variable as Var

13import qualified AST.Variable as Var

15import qualified Reporting.Annotation as A

14import qualified Reporting.Annotation as A

16

15

@@ -54,30 +53,10 @@ data Expr' ann def var typ

54 | Update (Expr ann def var typ) [(String, Expr ann def var typ)]

53 | Update (Expr ann def var typ) [(String, Expr ann def var typ)]

55 | Record [(String, Expr ann def var typ)]

54 | Record [(String, Expr ann def var typ)]

56 -- for type checking and code gen only

55 -- for type checking and code gen only

57− | Port (PortImpl (Expr ann def var typ) typ)

58 | GLShader String String Literal.GLShaderTipe

56 | GLShader String String Literal.GLShaderTipe

59

57

60

58

61

59

62−-- PORTS

63−

64−

65−data PortImpl expr tipe

66− = In String (Type.Port tipe)

67− | Out String expr (Type.Port tipe)

68− | Task String expr (Type.Port tipe)

69− deriving (Eq)

70−

71−

72−portName :: PortImpl expr tipe -> String

73−portName impl =

74− case impl of

75− In name _ -> name

76− Out name _ _ -> name

77− Task name _ _ -> name

78−

79−

80−

81---- UTILITIES ----

60---- UTILITIES ----

82

61

83

62

src/AST/Expression/Optimized.hs−3

@@ -5,10 +5,8 @@ module AST.Expression.Optimized

5 , Decider(..), Choice(..)

6 ) where

7

8−import qualified AST.Expression.General as General

9import qualified AST.Literal as Literal

8import qualified AST.Literal as Literal

10import qualified AST.Module.Name as ModuleName

9import qualified AST.Module.Name as ModuleName

11−import qualified AST.Type as Type

12import qualified AST.Variable as Var

10import qualified AST.Variable as Var

13import qualified Optimize.DecisionTree as DT

11import qualified Optimize.DecisionTree as DT

14import qualified Reporting.Region as R

12import qualified Reporting.Region as R

@@ -52,7 +50,6 @@ data Expr

52 | Access Expr String

50 | Access Expr String

53 | Update Expr [(String, Expr)]

51 | Update Expr [(String, Expr)]

54 | Record [(String, Expr)]

52 | Record [(String, Expr)]

55− | Port (General.PortImpl Expr Type.Canonical)

56 | GLShader String String Literal.GLShaderTipe

53 | GLShader String String Literal.GLShaderTipe

57 | Crash ModuleName.Canonical R.Region (Maybe Expr)

54 | Crash ModuleName.Canonical R.Region (Maybe Expr)

58

55

src/AST/Module.hs+1−5

@@ -98,7 +98,6 @@ data Body expr =

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

99 , aliases :: Aliases

100 , datatypes :: ADTs

101− , ports :: [String]

102 }

101 }

103

102

104

103

@@ -148,7 +147,6 @@ data Interface =

148 , iAdts :: ADTs

147 , iAdts :: ADTs

149 , iAliases :: Aliases

148 , iAliases :: Aliases

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

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

151− , iPorts :: [String]

152 }

150 }

153

151

154

152

@@ -167,13 +165,12 @@ toInterface pkgName modul =

167 , iAdts = datatypes body'

165 , iAdts = datatypes body'

168 , iAliases = aliases body'

166 , iAliases = aliases body'

169 , iFixities = fixities body'

167 , iFixities = fixities body'

170− , iPorts = ports body'

171 }

168 }

172

169

173

170

174instance Binary Interface where

171instance Binary Interface where

175 get =

172 get =

176− Interface <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get

173+ Interface <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get

177

174

178 put modul =

175 put modul =

179 do put (iVersion modul)

176 do put (iVersion modul)

@@ -184,4 +181,3 @@ instance Binary Interface where

184 put (iAdts modul)

181 put (iAdts modul)

185 put (iAliases modul)

182 put (iAliases modul)

186 put (iFixities modul)

183 put (iFixities modul)

187− put (iPorts modul)

src/AST/Type.hs−14

@@ -1,7 +1,6 @@

1module AST.Type

2 ( Raw, Raw'(..)

3 , Canonical(..), Aliased(..)

4− , Port(..), getPortType

5 , deepDealias, iteratedDealias, dealias

4 , deepDealias, iteratedDealias, dealias

6 , collectLambdas

5 , collectLambdas

7 , tuple

6 , tuple

@@ -48,19 +47,6 @@ data Aliased t

48 deriving (Eq, Ord)

47 deriving (Eq, Ord)

49

48

50

49

51−data Port t

52− = Normal t

53− | Signal { root :: t, arg :: t }

54− deriving (Eq)

55−

56−

57−getPortType :: Port tipe -> tipe

58−getPortType portType =

59− case portType of

60− Normal tipe -> tipe

61− Signal tipe _ -> tipe

62−

63−

64tuple :: R.Region -> [Raw] -> Raw

50tuple :: R.Region -> [Raw] -> Raw

65tuple region types =

51tuple region types =

66 let

52 let

src/Canonicalize.hs−46

@@ -31,7 +31,6 @@ import qualified Reporting.Result as R

31import qualified Reporting.Warning as Warning

32import qualified Canonicalize.Declaration as Decls

33import qualified Canonicalize.Environment as Env

34−import qualified Canonicalize.Port as Port

35import qualified Canonicalize.Result as Result

34import qualified Canonicalize.Result as Result

36import qualified Canonicalize.Setup as Setup

35import qualified Canonicalize.Setup as Setup

37import qualified Canonicalize.Sort as Sort

36import qualified Canonicalize.Sort as Sort

@@ -120,9 +119,6 @@ moduleHelp importDict interfaces modul@(Module.Module _ _ comment exports _ decl

120

119

121 , aliases =

120 , aliases =

122 Map.fromList [ (name,(tvs,alias)) | D.TypeAlias name tvs alias <- nakedDecls ]

121 Map.fromList [ (name,(tvs,alias)) | D.TypeAlias name tvs alias <- nakedDecls ]

123−

124− , ports =

125− [ E.portName impl | D.Port (D.CanonicalPort impl) <- nakedDecls ]

126 }

122 }

127

123

128

124

@@ -354,25 +350,6 @@ declaration env (A.A ann@(region,_) decl) =

354 D.TypeAlias name tvars

350 D.TypeAlias name tvars

355 <$> Canonicalize.tipe env expanded

351 <$> Canonicalize.tipe env expanded

356

352

357− D.Port validPort ->

358− Result.addModule ["Native","Port"] $

359− Result.addModule ["Native","Json"] $

360− case validPort of

361− D.In name tipe ->

362− Canonicalize.tipe env tipe

363− `Result.andThen` \canonicalType ->

364− D.Port <$> Port.check region name Nothing canonicalType

365−

366− D.Out name expr tipe ->

367− let exprTypeResult =

368− (,)

369− <$> expression env expr

370− <*> Canonicalize.tipe env tipe

371− in

372− exprTypeResult

373− `Result.andThen` \(expr', tipe') ->

374− D.Port <$> Port.check region name (Just expr') tipe'

375−

376 D.Fixity assoc prec op ->

353 D.Fixity assoc prec op ->

377 Result.ok (D.Fixity assoc prec op)

354 Result.ok (D.Fixity assoc prec op)

378

355

@@ -462,29 +439,6 @@ expression env (A.A region validExpr) =

462 (,) <$> pattern env ptrn

439 (,) <$> pattern env ptrn

463 <*> expression (Env.addPattern ptrn env) brnch

440 <*> expression (Env.addPattern ptrn env) brnch

464

441

465− Port impl ->

466− let portType pt =

467− case pt of

468− Type.Normal t ->

469− Type.Normal

470− <$> Canonicalize.tipe env t

471−

472− Type.Signal root arg ->

473− Type.Signal

474− <$> Canonicalize.tipe env root

475− <*> Canonicalize.tipe env arg

476− in

477− Port <$>

478− case impl of

479− E.In name tipe ->

480− E.In name <$> portType tipe

481−

482− E.Out name expr tipe ->

483− E.Out name <$> go expr <*> portType tipe

484−

485− E.Task name expr tipe ->

486− E.Task name <$> go expr <*> portType tipe

487−

488 GLShader uid src tipe ->

442 GLShader uid src tipe ->

489 Result.ok (GLShader uid src tipe)

443 Result.ok (GLShader uid src tipe)

490

444

src/Canonicalize/Declaration.hs−13

@@ -60,19 +60,6 @@ toDefs moduleName (A.A (region,_) decl) =

60 D.TypeAlias _ _ _ ->

61 []

62

63− D.Port (D.CanonicalPort impl) ->

64− let body = loc (E.Port impl)

65− in

66− case impl of

67− E.In name tipe ->

68− [ definition name body region (T.getPortType tipe) ]

69−

70− E.Out name _expr tipe ->

71− [ definition name body region (T.getPortType tipe) ]

72−

73− E.Task name _expr tipe ->

74− [ definition name body region (T.getPortType tipe) ]

75−

76 -- no constraints are needed for fixity declarations

63 -- no constraints are needed for fixity declarations

77 D.Fixity _ _ _ ->

64 D.Fixity _ _ _ ->

78 []

65 []

src/Canonicalize/Setup.hs−5

@@ -351,11 +351,6 @@ declToPatches moduleName (A.A (region,_) decl) =

351 []

352 )

353

354− D.Port port ->

355− ( Nothing

356− , [topLevel Env.Value (D.validPortName port)]

357− )

358−

359 D.Fixity _ _ _ ->

354 D.Fixity _ _ _ ->

360 ( Nothing

355 ( Nothing

361 , []

356 , []

src/Canonicalize/Sort.hs+1−13

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

7import qualified Data.Maybe as Maybe

8import qualified Data.Set as Set

9

10−import AST.Expression.General (Expr'(..), PortImpl(..))

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

11import qualified AST.Expression.Canonical as Canonical

12import qualified AST.Pattern as P

13import qualified AST.Variable as V

@@ -99,18 +99,6 @@ reorder (A.A ann expression) =

99 GLShader _ _ _ ->

100 return expression

101

102− Port impl ->

103− Port <$>

104− case impl of

105− In _ _ ->

106− return impl

107−

108− Out name expr tipe ->

109− (\e -> Out name e tipe) <$> reorder expr

110−

111− Task name expr tipe ->

112− (\e -> Task name e tipe) <$> reorder expr

113−

114 -- Actually do some reordering

102 -- Actually do some reordering

115 Let defs body ->

103 Let defs body ->

116 do body' <- reorder body

104 do body' <- reorder body

src/Compile.hs+2−3

@@ -20,18 +20,17 @@ import qualified Type.Inference as TI

20

21compile

22 :: Package.Name

23− -> Bool

24 -> [ModuleName.Canonical]

23 -> [ModuleName.Canonical]

25 -> Module.Interfaces

24 -> Module.Interfaces

26 -> String

25 -> String

27 -> Result.Result Warning.Warning Error.Error Module.Optimized

26 -> Result.Result Warning.Warning Error.Error Module.Optimized

28

27

29−compile packageName isRoot canonicalImports interfaces source =

28+compile packageName canonicalImports interfaces source =

30 do

29 do

31 -- Parse the source code

30 -- Parse the source code

32 validModule <-

31 validModule <-

33 Result.mapError Error.Syntax $

32 Result.mapError Error.Syntax $

34− Parse.program packageName isRoot (getOpTable interfaces) source

33+ Parse.program packageName (getOpTable interfaces) source

35

34

36 -- Canonicalize all variables, pinning down where they came from.

35 -- Canonicalize all variables, pinning down where they came from.

37 canonicalModule <-

36 canonicalModule <-

src/Docs/Centralize.hs−3

@@ -86,9 +86,6 @@ addDeclToDocs (A.A (region,maybeComment) decl) docs =

86 in

87 docs { rawAliases = Map.insert name alias (rawAliases docs) }

88

89− D.Port _ ->

90− docs

91−

92 D.Fixity assoc precedence name ->

89 D.Fixity assoc precedence name ->

93 let

90 let

94 fixity =

91 fixity =

src/Elm/Compiler.hs+2−3

@@ -71,11 +71,11 @@ compile

71

72compile context source interfaces =

73 let

74− (Context packageName isRoot isExposed dependencies) =

74+ (Context packageName isExposed dependencies) =

75 context

76

77 (Result.Result (localizer, warnings) rawResult) =

78− do modul <- Compile.compile packageName isRoot dependencies interfaces source

78+ do modul <- Compile.compile packageName dependencies interfaces source

79 docs <- docsGen isExposed modul

80

81 let interface = Module.toInterface packageName modul

@@ -91,7 +91,6 @@ compile context source interfaces =

91

92data Context = Context

93 { _packageName :: Package.Name

94− , _isRoot :: Bool

95 , _isExposed :: Bool

94 , _isExposed :: Bool

96 , _dependencies :: [PublicModule.CanonicalName]

95 , _dependencies :: [PublicModule.CanonicalName]

97 }

96 }

src/Elm/Compiler/Module.hs−6

@@ -5,7 +5,6 @@ module Elm.Compiler.Module

5 , nameToString, nameFromString

6 , hyphenate, dehyphenate

7 , defaultImports

8− , interfacePorts

9 , interfaceAliasedTypes

8 , interfaceAliasedTypes

10 , CanonicalName, canonicalName

9 , CanonicalName, canonicalName

11 )

10 )

@@ -38,11 +37,6 @@ type Interface = Module.Interface

38type Interfaces = Module.Interfaces

37type Interfaces = Module.Interfaces

39

38

40

39

41−interfacePorts :: Interface -> [String]

42−interfacePorts interface =

43− Module.iPorts interface

44−

45−

46interfaceAliasedTypes :: Interface -> Map.Map String Type.Type

40interfaceAliasedTypes :: Interface -> Map.Map String Type.Type

47interfaceAliasedTypes interface =

41interfaceAliasedTypes interface =

48 Map.map Extract.toAliasedType (Module.iTypes interface)

42 Map.map Extract.toAliasedType (Module.iTypes interface)

src/Generate/JavaScript/Expression.hs−15

@@ -6,7 +6,6 @@ import qualified Data.List as List

6import qualified Data.Map as Map

7import Language.ECMAScript3.Syntax

8

9−import qualified AST.Expression.General as Expr

10import AST.Expression.Optimized as Opt

9import AST.Expression.Optimized as Opt

11import qualified AST.Literal as L

10import qualified AST.Literal as L

12import qualified AST.Module.Name as ModuleName

11import qualified AST.Module.Name as ModuleName

@@ -14,7 +13,6 @@ import qualified AST.Variable as Var

14import Generate.JavaScript.Helpers as Help

13import Generate.JavaScript.Helpers as Help

15import qualified Generate.JavaScript.BuiltIn as BuiltIn

14import qualified Generate.JavaScript.BuiltIn as BuiltIn

16import qualified Generate.JavaScript.Literal as Literal

15import qualified Generate.JavaScript.Literal as Literal

17−import qualified Generate.JavaScript.Port as Port

18import qualified Generate.JavaScript.Variable as Var

16import qualified Generate.JavaScript.Variable as Var

19import qualified Optimize.DecisionTree as DT

17import qualified Optimize.DecisionTree as DT

20

18

@@ -196,19 +194,6 @@ generateCode expr =

196 GLShader _uid src _tipe ->

194 GLShader _uid src _tipe ->

197 jsExpr $ ObjectLit () [(PropString () "src", Literal.literal (L.Str src))]

195 jsExpr $ ObjectLit () [(PropString () "src", Literal.literal (L.Str src))]

198

196

199− Port impl ->

200− case impl of

201− Expr.In name portType ->

202− jsExpr (Port.inbound name portType)

203−

204− Expr.Out name expr portType ->

205− do expr' <- generateJsExpr expr

206− jsExpr (Port.outbound name expr' portType)

207−

208− Expr.Task name expr portType ->

209− do expr' <- generateJsExpr expr

210− jsExpr (Port.task name expr' portType)

211−

212 Crash home region maybeBranchProblem ->

197 Crash home region maybeBranchProblem ->

213 do maybeOptBranchProblem <- traverse generateJsExpr maybeBranchProblem

198 do maybeOptBranchProblem <- traverse generateJsExpr maybeBranchProblem

214 jsExpr $ BuiltIn.crash home region maybeOptBranchProblem

199 jsExpr $ BuiltIn.crash home region maybeOptBranchProblem

src/Nitpick/PatternMatches.hs−11

@@ -180,17 +180,6 @@ checkExpression tagDict (A.A region expression) =

180 E.Record fields ->

181 F.traverse_ (go . snd) fields

182

183− E.Port impl ->

184− case impl of

185− E.In _ _ ->

186− Result.ok ()

187−

188− E.Out _ expr _ ->

189− go expr

190−

191− E.Task _ expr _ ->

192− go expr

193−

194 E.GLShader _ _ _ ->

183 E.GLShader _ _ _ ->

195 Result.ok ()

184 Result.ok ()

196

185

src/Optimize.hs−12

@@ -308,18 +308,6 @@ optimizeExpr context annExpr@(A.A region expression) =

308 Expr.GLShader uid src gltipe ->

309 pure (Opt.GLShader uid src gltipe)

310

311− Expr.Port impl ->

312− Opt.Port <$>

313− case impl of

314− Expr.In name tipe ->

315− pure (Expr.In name tipe)

316−

317− Expr.Out name expr tipe ->

318− (\e -> Expr.Out name e tipe) <$> justConvert expr

319−

320− Expr.Task name expr tipe ->

321− (\e -> Expr.Task name e tipe) <$> justConvert expr

322−

323

311

324mapSnd :: M.Functor box => (a -> box b) -> (x, a) -> box (x, b)

312mapSnd :: M.Functor box => (a -> box b) -> (x, a) -> box (x, b)

325mapSnd func (x, a) =

313mapSnd func (x, a) =

src/Optimize/Inline.hs−24

@@ -6,7 +6,6 @@ import Control.Monad (foldM)

6import qualified Data.List as List

7import qualified Data.Map as Map

8

9−import AST.Expression.General (PortImpl(..))

10import AST.Expression.Optimized (Expr(..), Decider(..), Choice(..))

9import AST.Expression.Optimized (Expr(..), Decider(..), Choice(..))

11import qualified AST.Expression.Optimized as Opt

10import qualified AST.Expression.Optimized as Opt

12import qualified AST.Variable as Var

11import qualified AST.Variable as Var

@@ -165,17 +164,6 @@ count expression =

165 Record fields ->

164 Record fields ->

166 countMany (map snd fields)

165 countMany (map snd fields)

167

166

168− Port impl ->

169− case impl of

170− In _ _ ->

171− Map.empty

172−

173− Out _name expr _tipe ->

174− count expr

175−

176− Task _name expr _tipe ->

177− count expr

178−

179 GLShader _ _ _ ->

167 GLShader _ _ _ ->

180 Map.empty

168 Map.empty

181

169

@@ -275,18 +263,6 @@ replace substitutions expression =

275 Record fields ->

263 Record fields ->

276 Record (map (second go) fields)

264 Record (map (second go) fields)

277

265

278− Port impl ->

279− Port $

280− case impl of

281− In _ _ ->

282− impl

283−

284− Out name expr tipe ->

285− Out name (go expr) tipe

286−

287− Task name expr tipe ->

288− Task name (go expr) tipe

289−

290 GLShader _ _ _ ->

266 GLShader _ _ _ ->

291 expression

267 expression

292

268

src/Parse/Declaration.hs+1−27

@@ -14,7 +14,7 @@ declaration :: IParser D.SourceDecl

14declaration =

15 choice

16 [ D.Comment <$> Help.docComment

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

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

18 ]

19

20

@@ -71,29 +71,3 @@ infixDecl =

71 forcedWS

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

73

74−

75−

76−-- PORT

77−

78−

79−port :: IParser D.SourceDecl'

80−port =

81− expecting "a port declaration" $

82− do try (reserved "port")

83− whitespace

84− name <- lowVar

85− whitespace

86− choice [ portAnnotation name, portDefinition name ]

87− where

88− portAnnotation name =

89− do try hasType

90− whitespace

91− tipe <- Type.expr <?> "a type"

92− return (D.Port (D.PortAnnotation name tipe))

93−

94− portDefinition name =

95− do try equals

96− whitespace

97− expr <- Expr.expr

98− return (D.Port (D.PortDefinition name expr))

99−

src/Parse/Parse.hs+2−3

@@ -22,15 +22,14 @@ import qualified Validate

22

23program

24 :: Package.Name

25− -> Bool

26 -> OpTable

25 -> OpTable

27 -> String

26 -> String

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

27 -> Result.Result wrn Error.Error M.ValidModule

29−program pkgName isRoot table src =

28+program pkgName table src =

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

29 do (M.Module name filePath docs exports imports sourceDecls) <-

31 parseWithTable table src (programParser pkgName)

30 parseWithTable table src (programParser pkgName)

32

31

33− validDecls <- Validate.declarations isRoot sourceDecls

32+ validDecls <- Validate.declarations sourceDecls

34

33

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

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

36 let ammendedImports =

35 let ammendedImports =

src/Type/Constrain/Expression.hs−11

@@ -160,17 +160,6 @@ constrain env annotatedExpr@(A.A region expression) tipe =

160

161 return $ CLet schemes (CLet letScheme (c1 /\ bodyCon))

162

163− E.Port impl ->

164− case impl of

165− E.In _ _ ->

166− return CTrue

167−

168− E.Out _ expr _ ->

169− constrain env expr tipe

170−

171− E.Task _ expr _ ->

172− constrain env expr tipe

173−

174

163

175

164

176-- CONSTRAIN APP

165-- CONSTRAIN APP

src/Validate.hs+5−66

@@ -25,14 +25,13 @@ import qualified Reporting.Result as Result

25

26

27declarations

28− :: Bool

29− -> [D.SourceDecl]

28+ :: [D.SourceDecl]

30 -> Result.Result wrn Error.Error [D.ValidDecl]

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

31−declarations isRoot sourceDecls =

30+declarations sourceDecls =

32 do validDecls <- validateDecls Nothing sourceDecls

31 do validDecls <- validateDecls Nothing sourceDecls

33 (\_ _ -> validDecls)

32 (\_ _ -> validDecls)

34 <$> declDuplicates validDecls

33 <$> declDuplicates validDecls

35− <*> T.traverse (checkDecl isRoot) validDecls

34+ <*> T.traverse checkDecl validDecls

36

35

37

36

38validateDecls

37validateDecls

@@ -76,9 +75,6 @@ validateDeclsHelp comment (A.A region decl) decls =

76 D.Definition def ->

75 D.Definition def ->

77 defHelp comment def decls

76 defHelp comment def decls

78

77

79− D.Port port ->

80− portHelp comment region port decls

81−

82

78

83

79

84-- VALIDATE DEFINITIONS IN DECLARATIONS

80-- VALIDATE DEFINITIONS IN DECLARATIONS

@@ -116,37 +112,6 @@ defHelp comment (A.A region def) decls =

116

112

117

113

118

114

119−-- VALIDATE PORTS IN DECLARATIONS

120−

121−

122−portHelp

123− :: Maybe String

124− -> R.Region

125− -> D.SourcePort

126− -> [D.SourceDecl]

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

128−portHelp comment region port decls =

129− let addRest port' rest =

130− (:) (A.A (region,comment) (D.Port port'))

131− <$> validateDecls Nothing rest

132− in

133− case port of

134− D.PortDefinition name _ ->

135− Result.throw region (Error.PortWithoutAnnotation name)

136−

137− D.PortAnnotation name tipe ->

138− case decls of

139− D.Decl (A.A _ (D.Port (D.PortDefinition name' expr))) : rest

140− | name == name' ->

141− do expr' <- expression expr

142− let port' = D.Out name expr' tipe

143− addRest port' rest

144−

145− _ ->

146− addRest (D.In name tipe) decls

147−

148−

149−

150-- VALIDATE DEFINITIONS

115-- VALIDATE DEFINITIONS

151

116

152

117

@@ -283,20 +248,6 @@ expression (A.A ann sourceExpression) =

283 GLShader uid src gltipe ->

248 GLShader uid src gltipe ->

284 return (GLShader uid src gltipe)

249 return (GLShader uid src gltipe)

285

250

286− Port impl ->

287− Port <$>

288− case impl of

289− In name tipe ->

290− return (In name tipe)

291−

292− Out name expr tipe ->

293− do expr' <- expression expr

294− return (Out name expr' tipe)

295−

296− Task name expr tipe ->

297− do expr' <- expression expr

298− return (Task name expr' tipe)

299−

300

251

301second :: (a, Source.Expr) -> Result.Result wrn Error.Error (a, Valid.Expr)

252second :: (a, Source.Expr) -> Result.Result wrn Error.Error (a, Valid.Expr)

302second (value, expr) =

253second (value, expr) =

@@ -386,11 +337,6 @@ extractValues (A.A (region, _) decl) =

386 , [A.A region name]

337 , [A.A region name]

387 )

338 )

388

339

389− D.Port port ->

390− ( [A.A region (D.validPortName port)]

391− , []

392− )

393−

394 D.Fixity _ _ _ ->

340 D.Fixity _ _ _ ->

395 ( []

341 ( []

396 , []

342 , []

@@ -401,8 +347,8 @@ extractValues (A.A (region, _) decl) =

401-- UNBOUND TYPE VARIABLES

347-- UNBOUND TYPE VARIABLES

402

348

403

349

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

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

405−checkDecl isRoot (A.A (region,_) decl) =

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

406 case decl of

352 case decl of

407 D.Definition _ ->

353 D.Definition _ ->

408 return ()

354 return ()

@@ -433,13 +379,6 @@ checkDecl isRoot (A.A (region,_) decl) =

433 Result.throw region

379 Result.throw region

434 (Error.MessyTypeVarsInAlias name boundVars unused unbound)

380 (Error.MessyTypeVarsInAlias name boundVars unused unbound)

435

381

436− D.Port _ ->

437− if isRoot then

438− return ()

439−

440− else

441− Result.throw region Error.UnexpectedPort

442−

443 D.Fixity _ _ _ ->

382 D.Fixity _ _ _ ->

444 return ()

383 return ()

445

384

tests/Test/Compiler.hs+9−9

@@ -86,15 +86,15 @@ essentialInterfaces =

86

87buildCoreInterface :: [(String, Type.Canonical)] -> Module.Interface

88buildCoreInterface members =

89+ let

89− let exports = map (Variable.Value . fst) members

90+ exports = map (Variable.Value . fst) members

90− imports = []

91+ imports = []

91− types = Map.fromList members

92+ types = Map.fromList members

92− adts = Map.empty

93+ adts = Map.empty

93− aliases = Map.empty

94+ aliases = Map.empty

94− fixities = []

95+ fixities = []

95− ports = []

96 in

97− Module.Interface Compiler.version Package.coreName exports types imports adts aliases fixities ports

97+ Module.Interface Compiler.version Package.coreName exports types imports adts aliases fixities

98

99

100compileString :: FilePath -> String -> Either String Compiler.Result

@@ -102,7 +102,7 @@ compileString filePath source =

102 let dependentModuleNames =

103 Map.keys essentialInterfaces

104 context =

105− Compiler.Context Package.coreName True False dependentModuleNames

105+ Compiler.Context Package.coreName False dependentModuleNames

106 (dealiaser, _warnings, result) =

107 Compiler.compile context source essentialInterfaces

108 formatErrors errors =