2e099f9 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Tie all the phases together

2e099f9Evan Czaplicki9 years ago

src/Compile.hs+65−63

compare with master

unifiedsplit

@@ -1,80 +1,82 @@

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

2−module Compile (compile) where

2+module Compile

3+ ( compile

4+ )

5+ where

4−import Data.Map (Map)

5−import Data.Text (Text)

7−import qualified AST.Expression.Canonical as Can

8+import qualified Data.ByteString as BS

9+import qualified Data.Map as Map

10+

11+import qualified AST.Canonical as Can

8−import qualified AST.Module as Module

12+import qualified AST.Optimized as Opt

9import qualified AST.Module.Name as ModuleName

13import qualified AST.Module.Name as ModuleName

10−import qualified Canonicalize

14+import qualified Canonicalize.Module as Canonicalize

15+import qualified Elm.Interface as I

16+import qualified Elm.Name as N

11−import qualified Elm.Package as Package

17+import qualified Elm.Package as Pkg

12−import qualified Nitpick.PatternMatches as Nitpick

18+import qualified Nitpick.PatternMatches as PatternMatches

13−import qualified Nitpick.TopLevelTypes as Nitpick

19+import qualified Nitpick.TopLevelTypes as TopLevelTypes

14−import qualified Optimize

20+import qualified Optimize.Module as Optimize

15−import qualified Parse.Parse as Parse (program)

21+import qualified Parse.Parse as Parse

16import qualified Reporting.Error as Error

22import qualified Reporting.Error as Error

17−import qualified Reporting.Render.Type as RenderType

18import qualified Reporting.Result as Result

23import qualified Reporting.Result as Result

19import qualified Reporting.Warning as Warning

24import qualified Reporting.Warning as Warning

20−import qualified Type.Inference as TI

25+import qualified Type.Constrain.Module as Type

26+import qualified Type.Solve as Type

27+

28+import System.IO.Unsafe (unsafePerformIO)

24-- COMPILE

32-- COMPILE

27−type Result =

35+type Result i a =

28− Result.Result (Result.One RenderType.Localizer) Warning.Warning Error.Error

36+ Result.Result i [Warning.Warning] Error.Error a

37+

38+

39+type ImportDict =

40+ Map.Map N.Name ModuleName.Canonical

31−compile

43+compile :: Pkg.Name -> ImportDict -> I.Interfaces -> BS.ByteString -> Result i (I.Interface, Opt.Graph)

32− :: Package.Name

33− -> Map ModuleName.Raw ModuleName.Canonical

34− -> Module.Interfaces

35− -> Text

36− -> Result Module.Optimized

37−compile packageName importDict interfaces source =

44+compile pkg importDict interfaces source =

38 do

45 do

39− -- Parse the source code

40− validModule <-

41− Result.format Error.Syntax $

46+ valid <- Result.mapError Error.Syntax $

42− {-# SCC elm_compiler_parse #-}

43− Parse.program packageName source

47+ Parse.program source

44−

48+

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

49+ canonical <- Result.mapError Error.Canonicalize $

46− canonicalModule <-

47− {-# SCC elm_compiler_canonicalize #-}

48− Canonicalize.module' importDict interfaces validModule

50+ Canonicalize.canonicalize pkg importDict interfaces valid

49−

51+

50− -- Run type inference on the program.

51 types <-

52 types <-

52− Result.from Error.Type $

53+ runTypeInference canonical

53− {-# SCC elm_compiler_types #-}

54+

54− TI.infer interfaces canonicalModule

55−

56− -- One last round of checks

57− canonicalDefs <-

58− Result.format Error.Type $

55+ mains <- Result.mapError Error.Main $

59− {-# SCC elm_compiler_nitpick #-}

56+ TopLevelTypes.check types canonical

60− Nitpick.topLevelTypes types $

57+

61− Can.toSortedDefs (Module.program (Module.info canonicalModule))

58+ () <- exhaustivenessCheck canonical

62−

59+

63− tagDict <-

60+ let (Optimize.Graph fields graph) = Optimize.optimize canonical

64− Result.format Error.Pattern $

61+

65− {-# SCC elm_compiler_exhaustiveness #-}

62+ Result.ok (I.fromModule types canonical, Opt.Graph mains graph fields)

66− Nitpick.patternMatches interfaces canonicalModule

63+

67−

64+

68− -- Do some basic optimizations

65+runTypeInference :: Can.Module -> Result i (Map.Map N.Name Can.Annotation)

69− let optimisedDefs =

66+runTypeInference canonical =

70− {-# SCC elm_compiler_optimization #-}

67+ case unsafePerformIO (Type.run =<< Type.constrain canonical) of

71− Optimize.optimize tagDict (Module.name canonicalModule) canonicalDefs

68+ Left errors ->

72−

69+ Result.throw (Error.Type errors)

73− -- Add the real list of types

70+

74− let info =

71+ Right annotations ->

75− (Module.info canonicalModule)

72+ Result.ok annotations

76− { Module.types = types

73+

77− , Module.program = optimisedDefs

74+

78− }

75+exhaustivenessCheck :: Can.Module -> Result i ()

79−

76+exhaustivenessCheck canonical =

80− return $ canonicalModule { Module.info = info }

77+ case PatternMatches.check canonical of

78+ Left errors ->

79+ Result.throw (Error.Pattern errors)

80+

81+ Right () ->

82+ Result.ok ()

src/Elm/Interface.hs+34−28

@@ -2,19 +2,20 @@

2module Elm.Interface

3 ( Interfaces

4 , Interface(..)

5+ , Binop(..)

5 , fromModule

6 , fromModule

6− , privatize

7 )

8 where

11import Control.Monad (liftM4)

12import Data.Binary

13+import Data.Map ((!))

13import qualified Data.Map as Map

14import qualified Data.Map as Map

15−import qualified AST.Expression.Canonical as Canonical

16+import qualified AST.Canonical as Can

16import qualified AST.Module.Name as ModuleName

17import qualified AST.Module.Name as ModuleName

17−import qualified AST.Type as Type

18+import qualified AST.Utils.Binop as Binop

18import qualified Elm.Name as N

19import qualified Elm.Name as N

@@ -32,10 +33,19 @@ type Interfaces =

33data Interface =

34data Interface =

34 Interface

35 Interface

35− { _types :: Map.Map N.Name Type.Canonical

36+ { _types :: Map.Map N.Name Can.Annotation

36− , _unions :: Map.Map N.Name Canonical.Union

37+ , _unions :: Map.Map N.Name Can.Union

37− , _aliases :: Map.Map N.Name Canonical.Alias

38+ , _aliases :: Map.Map N.Name Can.Alias

38− , _binops :: Map.Map N.Name Canonical.Binop

39+ , _binops :: Map.Map N.Name Binop

40+ }

41+

42+

43+data Binop =

44+ Binop

45+ { _op_name :: N.Name

46+ , _op_annotation :: Can.Annotation

47+ , _op_associativity :: Binop.Associativity

48+ , _op_precedence :: Binop.Precedence

39 }

49 }

@@ -43,32 +53,19 @@ data Interface =

43-- FROM MODULE

53-- FROM MODULE

46−fromModule :: Canonical.Module -> Interface

56+fromModule :: Map.Map N.Name Can.Annotation -> Can.Module -> Interface

47−fromModule (Canonical.Module _ _ _ _ unions aliases binops _) =

57+fromModule types (Can.Module _ _ _ _ unions aliases binops _) =

48 Interface

58 Interface

49− { _types = error "TODO types"

59+ { _types = types

50− , _unions = unions

60+ , _unions = unions

51 , _aliases = aliases

61 , _aliases = aliases

52− , _binops = binops

62+ , _binops = Map.map (toOp types) binops

53 }

63 }

56−

66+toOp :: Map.Map N.Name Can.Annotation -> Can.Binop -> Binop

57−-- PRIVATIZE

67+toOp types (Can.Binop_ associativity precedence name) =

58−

68+ Binop name (types ! name) associativity precedence

59−

60−privatize :: Interface -> Maybe Interface

61−privatize (Interface _ unions aliases _) =

62− if Map.null unions && Map.null aliases then

63− Nothing

64−

65− else

66− Just $ Interface

67− { _types = Map.empty

68− , _unions = unions

69− , _aliases = aliases

70− , _binops = Map.empty

71− }

@@ -81,3 +78,12 @@ instance Binary Interface where

82 put (Interface a b c d) =

79 put (Interface a b c d) =

83 put a >> put b >> put c >> put d

80 put a >> put b >> put c >> put d

81+

82+

83+instance Binary Binop where

84+ get =

85+ liftM4 Binop get get get get

86+

87+ put (Binop a b c d) =

88+ put a >> put b >> put c >> put d

89+

src/Nitpick/TopLevelTypes.hs+26−25

@@ -15,11 +15,11 @@ import qualified AST.Optimized as Opt

15import qualified AST.Module.Name as ModuleName

16import qualified AST.Utils.Type as Type

17import qualified Canonicalize.Effects as Effects

18−import qualified Canonicalize.Result as Result

19import qualified Elm.Name as N

18import qualified Elm.Name as N

20import qualified Reporting.Annotation as A

19import qualified Reporting.Annotation as A

21−import qualified Reporting.Error.Canonicalize as Error

20+import qualified Reporting.Error.Main as Error

22import qualified Reporting.Region as R

21import qualified Reporting.Region as R

22+import qualified Reporting.Result as Result

23import qualified Reporting.Warning as W

@@ -31,29 +31,29 @@ type Result i w a =

31 Result.Result i w Error.Error a

34−type Types =

34+type Annotations =

35− Map.Map N.Name Can.Type

35+ Map.Map N.Name Can.Annotation

38type Mains =

39 Map.Map ModuleName.Canonical Opt.Main

42−check :: Types -> Can.Module -> Result i [W.Warning] Mains

42+check :: Annotations -> Can.Module -> Result i [W.Warning] Mains

43−check types (Can.Module home _ _ decls _ _ _ _) =

43+check annotations (Can.Module home _ _ decls _ _ _ _) =

44− checkDecls home types decls Map.empty

44+ checkDecls home annotations decls Map.empty

47−checkDecls :: ModuleName.Canonical -> Types -> Can.Decls -> Mains -> Result i [W.Warning] Mains

47+checkDecls :: ModuleName.Canonical -> Annotations -> Can.Decls -> Mains -> Result i [W.Warning] Mains

48−checkDecls home types decls mains =

48+checkDecls home annotations decls mains =

49 case decls of

50 Can.Declare def subDecls ->

51− checkDecls home types subDecls =<<

51+ checkDecls home annotations subDecls =<<

52− checkDef home types mains def

52+ checkDef home annotations mains def

54 Can.DeclareRec defs subDecls ->

55− checkDecls home types subDecls =<<

55+ checkDecls home annotations subDecls =<<

56− foldM (checkDef home types) mains defs

56+ foldM (checkDef home annotations) mains defs

58 Can.SaveTheEnvironment ->

59 Result.ok mains

@@ -63,32 +63,33 @@ checkDecls home types decls mains =

63-- MISSING ANNOTATIONS

66−checkDef :: ModuleName.Canonical -> Types -> Mains -> Can.Def -> Result i [W.Warning] Mains

66+checkDef :: ModuleName.Canonical -> Annotations -> Mains -> Can.Def -> Result i [W.Warning] Mains

67−checkDef home types mains def =

67+checkDef home annotations mains def =

68 case def of

69 Can.Def (A.At region name) _ _ ->

70+ do let (Can.Forall _ annotation) = annotations ! name

70− do Result.warn $ W.MissingTypeAnnotation region name (types ! name)

71+ Result.warn $ W.MissingTypeAnnotation region name annotation

71− checkMain region types home name mains

72+ checkMain region annotations home name mains

73 Can.TypedDef (A.At region name) _ _ _ _ ->

74 Can.TypedDef (A.At region name) _ _ _ _ ->

74− checkMain region types home name mains

75+ checkMain region annotations home name mains

78-- CHECK MAIN TYPE

79-- CHECK MAIN TYPE

81−checkMain :: R.Region -> Types -> ModuleName.Canonical -> N.Name -> Mains -> Result i w Mains

82+checkMain :: R.Region -> Annotations -> ModuleName.Canonical -> N.Name -> Mains -> Result i w Mains

82−checkMain region types home name mains =

83+checkMain region annotations home name mains =

83 if name == N.main then

84 if name == N.main then

84− do mainType <- checkMainType region (types ! name)

85+ do mainType <- checkMainType region (annotations ! name)

85 Result.ok $ Map.insert home mainType mains

86 Result.ok $ Map.insert home mainType mains

86 else

87 else

87 Result.ok mains

88 Result.ok mains

90−checkMainType :: R.Region -> Can.Type -> Result i w Opt.Main

91+checkMainType :: R.Region -> Can.Annotation -> Result i w Opt.Main

91−checkMainType region tipe =

92+checkMainType region (Can.Forall _ tipe) =

92 case Type.deepDealias tipe of

93 case Type.deepDealias tipe of

93 Can.TType home name [_]

94 Can.TType home name [_]

94 | home == ModuleName.virtualDom && name == N.node ->

95 | home == ModuleName.virtualDom && name == N.node ->

@@ -98,10 +99,10 @@ checkMainType region tipe =

98 | home == ModuleName.platform && name == N.program ->

99 | home == ModuleName.platform && name == N.program ->

99 case Effects.checkPayload flags of

100 case Effects.checkPayload flags of

100 Left (subType, invalidPayload) ->

101 Left (subType, invalidPayload) ->

101− Result.throw (Error.MainFlags region subType invalidPayload)

102+ Result.throw (Error.BadFlags region subType invalidPayload)

102

103

103 Right () ->

104 Right () ->

104 Result.ok (Opt.Dynamic flags)

105 Result.ok (Opt.Dynamic flags)

105

106

106 _ ->

107 _ ->

107− Result.throw (Error.MainType region tipe)

108+ Result.throw (Error.BadType region tipe)

src/Parse/Parse.hs+4−4

@@ -12,7 +12,7 @@ import qualified AST.Valid as Valid

12import qualified Parse.Declaration as Decl

13import qualified Parse.Module as Module

14import qualified Parse.Primitives as P

15−import qualified Reporting.Annotation as A

15+import qualified Reporting.Error.Syntax as Error

16import qualified Reporting.Result as Result

17import qualified Validate

@@ -21,14 +21,14 @@ import qualified Validate

21-- PROGRAM

24−program :: B.ByteString -> Validate.Result wrn Valid.Module

24+program :: B.ByteString -> Result.Result i w Error.Error Valid.Module

25program src =

26 case P.run chompProgram src of

27 Right modul ->

28 Validate.validate modul

30− Left (A.At region syntaxError) ->

30+ Left syntaxError ->

31− Result.throw region syntaxError

31+ Result.throw syntaxError

34chompProgram :: P.Parser (Src.Module [Src.Decl])

src/Parse/Primitives.hs+3−3

@@ -31,12 +31,12 @@ import qualified Reporting.Region as R

31-- RUN

34−run :: Parser a -> B.ByteString -> Either (A.Located E.Error) a

34+run :: Parser a -> B.ByteString -> Either E.Error a

35run parser bytes =

36 runAt 1 1 parser bytes

39−runAt :: Int -> Int -> Parser a -> B.ByteString -> Either (A.Located E.Error) a

39+runAt :: Int -> Int -> Parser a -> B.ByteString -> Either E.Error a

40runAt startRow startColumn (Parser parser) (B.PS fp offset length) =

41 case parser (State fp offset (offset + length) 0 startRow startColumn []) Ok Err Ok Err of

42 Ok value _ _ ->

@@ -46,7 +46,7 @@ runAt startRow startColumn (Parser parser) (B.PS fp offset length) =

46 let

47 pos = R.Position row col

48 mkError overallRegion subRegion =

49− Left (A.At overallRegion (E.Parse subRegion problem))

49+ Left (E.Parse overallRegion subRegion problem)

50 in

51 case problem of

52 E.BadChar endCol ->

src/Type/Solve.hs+2−2

@@ -27,7 +27,7 @@ import qualified Type.UnionFind as UF

27-- RUN SOLVER

30−run :: Constraint -> IO (Either [Error.Error] (Map.Map N.Name Can.Type))

30+run :: Constraint -> IO (Either [Error.Error] (Map.Map N.Name Can.Annotation))

31run constraint =

32 do pools <- MVector.replicate 16 []

@@ -36,7 +36,7 @@ run constraint =

37 case errors of

38 [] ->

39− Right <$> traverse toSrcType env

39+ Right <$> traverse Type.toAnnotation env

41 _ ->

42 return $ Left errors

src/Type/Type.hs+18−9

@@ -22,6 +22,7 @@ module Type.Type

22 , nameToFlex

23 , nameToRigid

24 , toSrcType

25+ , toAnnotation

25 )

26 )

26 where

27 where

@@ -308,10 +309,18 @@ toSuper name =

308

309

309-- TODO: Attach resulting type to the descriptor so that you

310-- TODO: Attach resulting type to the descriptor so that you

310-- never have to do extra work, particularly nice for aliased types

311-- never have to do extra work, particularly nice for aliased types

312+toAnnotation :: Variable -> IO Can.Annotation

313+toAnnotation variable =

314+ do userNames <- getVarNames variable Map.empty

315+ (tipe, NameState allNames _ _ _ _ _) <-

316+ State.runStateT (variableToSrcType variable) (makeNameState userNames)

317+ return $ Can.Forall (Map.map (\_ -> ()) allNames) tipe

318+

319+

311toSrcType :: Variable -> IO Can.Type

320toSrcType :: Variable -> IO Can.Type

312toSrcType variable =

321toSrcType variable =

313− do takenNames <- getVarNames variable Map.empty

322+ do userNames <- getVarNames variable Map.empty

314− State.evalStateT (variableToSrcType variable) (makeNameState takenNames)

323+ State.evalStateT (variableToSrcType variable) (makeNameState userNames)

315

324

316

325

317variableToSrcType :: Variable -> StateT NameState IO Can.Type

326variableToSrcType :: Variable -> StateT NameState IO Can.Type

@@ -423,7 +432,7 @@ data NameState =

423 }

432 }

424

433

425

434

426−type TakenNames = Map.Map Text Variable

435+type TakenNames = Map.Map N.Name Variable

427

436

428

437

429makeNameState :: TakenNames -> NameState

438makeNameState :: TakenNames -> NameState

@@ -431,7 +440,7 @@ makeNameState taken =

431 NameState taken 0 0 0 0 0

440 NameState taken 0 0 0 0 0

432

441

433

442

434−getFreshVarName :: (Monad m) => StateT NameState m Text

443+getFreshVarName :: (Monad m) => StateT NameState m N.Name

435getFreshVarName =

444getFreshVarName =

436 do index <- State.gets _normals

445 do index <- State.gets _normals

437 taken <- State.gets _taken

446 taken <- State.gets _taken

@@ -440,7 +449,7 @@ getFreshVarName =

440 return uniqueName

449 return uniqueName

441

450

442

451

443−getFreshSuperName :: (Monad m) => SuperType -> StateT NameState m Text

452+getFreshSuperName :: (Monad m) => SuperType -> StateT NameState m N.Name

444getFreshSuperName super =

453getFreshSuperName super =

445 case super of

454 case super of

446 Number ->

455 Number ->

@@ -456,7 +465,7 @@ getFreshSuperName super =

456 getFreshSuper "compappend" _compAppends (\index state -> state { _compAppends = index })

465 getFreshSuper "compappend" _compAppends (\index state -> state { _compAppends = index })

457

466

458

467

459−getFreshNormal :: Int -> TakenNames -> (Text, Int)

468+getFreshNormal :: Int -> TakenNames -> (N.Name, Int)

460getFreshNormal index taken =

469getFreshNormal index taken =

461 let

470 let

462 (postfix, letter) =

471 (postfix, letter) =

@@ -477,10 +486,10 @@ getFreshNormal index taken =

477

486

478getFreshSuper

487getFreshSuper

479 :: (Monad m)

488 :: (Monad m)

480− => Text

489+ => N.Name

481 -> (NameState -> Int)

490 -> (NameState -> Int)

482 -> (Int -> NameState -> NameState)

491 -> (Int -> NameState -> NameState)

483− -> StateT NameState m Text

492+ -> StateT NameState m N.Name

484getFreshSuper name getter setter =

493getFreshSuper name getter setter =

485 do index <- State.gets getter

494 do index <- State.gets getter

486 taken <- State.gets _taken

495 taken <- State.gets _taken

@@ -489,7 +498,7 @@ getFreshSuper name getter setter =

489 return uniqueName

498 return uniqueName

490

499

491

500

492−getFreshSuperHelp :: Text -> Int -> TakenNames -> (Text, Int)

501+getFreshSuperHelp :: N.Name -> Int -> TakenNames -> (N.Name, Int)

493getFreshSuperHelp name index taken =

502getFreshSuperHelp name index taken =

494 let

503 let

495 newName =

504 newName =

src/Validate.hs+18−19

@@ -1,8 +1,7 @@

1{-# OPTIONS_GHC -Wall #-}

2{-# LANGUAGE OverloadedStrings #-}

3module Validate

4− ( Result

5− , validate

4+ ( validate

6 )

5 )

7 where

6 where

@@ -25,11 +24,11 @@ import qualified Reporting.Result as Result

25-- VALIDATE

24-- VALIDATE

28−type Result warning a =

27+type Result i w a =

29− Result.Result () warning Error.Error a

28+ Result.Result i w Error.Error a

32−validate :: Src.Module [Src.Decl] -> Result w Valid.Module

31+validate :: Src.Module [Src.Decl] -> Result i w Valid.Module

33validate (Src.Module name srcEffects overview exports imports srcDecls) =

32validate (Src.Module name srcEffects overview exports imports srcDecls) =

34 do (Stuff decls unions aliases binops ports docs) <- validateDecls srcDecls

33 do (Stuff decls unions aliases binops ports docs) <- validateDecls srcDecls

35 effects <- validateEffects srcEffects ports

34 effects <- validateEffects srcEffects ports

@@ -51,12 +50,12 @@ data Stuff =

51 }

50 }

54−validateDecls :: [Src.Decl] -> Result w Stuff

53+validateDecls :: [Src.Decl] -> Result i w Stuff

55validateDecls decls =

54validateDecls decls =

56 vsdHelp decls (Stuff [] [] [] [] [] Map.empty)

55 vsdHelp decls (Stuff [] [] [] [] [] Map.empty)

59−vsdHelp :: [Src.Decl] -> Stuff -> Result w Stuff

58+vsdHelp :: [Src.Decl] -> Stuff -> Result i w Stuff

60vsdHelp decls stuff =

59vsdHelp decls stuff =

61 case decls of

60 case decls of

62 [] ->

61 [] ->

@@ -96,7 +95,7 @@ vsdHelp decls stuff =

96-- VALIDATE DOCS

95-- VALIDATE DOCS

99−validateDocs :: Text -> [Src.Decl] -> Stuff -> Result w Stuff

98+validateDocs :: Text -> [Src.Decl] -> Stuff -> Result i w Stuff

100validateDocs docs decls stuff =

99validateDocs docs decls stuff =

101 case decls of

100 case decls of

102 [] ->

101 [] ->

@@ -107,7 +106,7 @@ validateDocs docs decls stuff =

107 vsdHelp decls $ stuff { _docs = Map.insert name docs (_docs stuff) }

106 vsdHelp decls $ stuff { _docs = Map.insert name docs (_docs stuff) }

108

107

109

108

110−getNameForDocs :: Src.Decl_ -> Result w N.Name

109+getNameForDocs :: Src.Decl_ -> Result i w N.Name

111getNameForDocs decl =

110getNameForDocs decl =

112 case decl of

111 case decl of

113 Src.Union (A.At _ name) _ _ ->

112 Src.Union (A.At _ name) _ _ ->

@@ -136,7 +135,7 @@ getNameForDocs decl =

136-- VALIDATE ANNOTATION

135-- VALIDATE ANNOTATION

137

136

138

137

139−validateAnnotation :: R.Region -> N.Name -> Src.Type -> [Src.Decl] -> Stuff -> Result w Stuff

138+validateAnnotation :: R.Region -> N.Name -> Src.Type -> [Src.Decl] -> Stuff -> Result i w Stuff

140validateAnnotation annRegion annotationName tipe decls stuff =

139validateAnnotation annRegion annotationName tipe decls stuff =

141 case decls of

140 case decls of

142 [] ->

141 [] ->

@@ -162,7 +161,7 @@ validateAnnotation annRegion annotationName tipe decls stuff =

162-- VALIDATE EXPRESSIONS

161-- VALIDATE EXPRESSIONS

163

162

164

163

165−expression :: Src.Expr -> Result w Valid.Expr

164+expression :: Src.Expr -> Result i w Valid.Expr

166expression (A.At region sourceExpression) =

165expression (A.At region sourceExpression) =

167 A.At region <$>

166 A.At region <$>

168 case sourceExpression of

167 case sourceExpression of

@@ -245,7 +244,7 @@ expression (A.At region sourceExpression) =

245 pure (Valid.Shader uid src gltipe)

244 pure (Valid.Shader uid src gltipe)

246

245

247

246

248−both :: (Src.Expr, Src.Expr) -> Result w (Valid.Expr, Valid.Expr)

247+both :: (Src.Expr, Src.Expr) -> Result i w (Valid.Expr, Valid.Expr)

249both (a, b) =

248both (a, b) =

250 liftA2 (,) (expression a) (expression b)

249 liftA2 (,) (expression a) (expression b)

251

250

@@ -254,7 +253,7 @@ both (a, b) =

254-- VALIDATE DEFINITIONS

253-- VALIDATE DEFINITIONS

255

254

256

255

257−definitions :: [A.Located Src.Def] -> Result w [Valid.Def]

256+definitions :: [A.Located Src.Def] -> Result i w [Valid.Def]

258definitions sourceDefs =

257definitions sourceDefs =

259 case sourceDefs of

258 case sourceDefs of

260 [] ->

259 [] ->

@@ -279,16 +278,16 @@ definitions sourceDefs =

279 <*> definitions otherOtherDefs

278 <*> definitions otherOtherDefs

280

279

281 _ ->

280 _ ->

282− Result.throw annRegion (Error.TypeWithoutDefinition annotationName)

281+ Result.throw (Error.TypeWithoutDefinition annRegion annotationName)

283

282

284

283

285−validateDefinition :: R.Region -> A.Located Text -> [Src.Pattern] -> Src.Expr -> Maybe Src.Type -> Result w Valid.Def

284+validateDefinition :: R.Region -> A.Located Text -> [Src.Pattern] -> Src.Expr -> Maybe Src.Type -> Result i w Valid.Def

286validateDefinition region name args expr maybeType =

285validateDefinition region name args expr maybeType =

287 do validExpr <- expression expr

286 do validExpr <- expression expr

288 return $ Valid.Define region name args validExpr maybeType

287 return $ Valid.Define region name args validExpr maybeType

289

288

290

289

291−validateDestruct :: R.Region -> Src.Pattern -> Src.Expr -> Result w Valid.Def

290+validateDestruct :: R.Region -> Src.Pattern -> Src.Expr -> Result i w Valid.Def

292validateDestruct region pattern expr =

291validateDestruct region pattern expr =

293 Valid.Destruct region pattern <$> expression expr

292 Valid.Destruct region pattern <$> expression expr

294

293

@@ -297,7 +296,7 @@ validateDestruct region pattern expr =

297-- VALIDATE EFFECTS

296-- VALIDATE EFFECTS

298

297

299

298

300−validateEffects :: Src.Effects -> [Valid.Port] -> Result w Valid.Effects

299+validateEffects :: Src.Effects -> [Valid.Port] -> Result i w Valid.Effects

301validateEffects effects ports =

300validateEffects effects ports =

302 case effects of

301 case effects of

303 Src.NoEffects ->

302 Src.NoEffects ->

@@ -321,7 +320,7 @@ validateEffects effects ports =

321 Valid.Fx cmd sub

320 Valid.Fx cmd sub

322

321

323

322

324−noPorts :: [Valid.Port] -> Result w ()

323+noPorts :: [Valid.Port] -> Result i w ()

325noPorts ports =

324noPorts ports =

326 forM_ ports $ \(Valid.Port (A.At region name) _) ->

325 forM_ ports $ \(Valid.Port (A.At region name) _) ->

327− Result.throw region (Error.UnexpectedPort name)

326+ Result.throw (Error.UnexpectedPort region name)