2e099f9 · elk · git.iko.soy

git.iko.soy/elk

Tie all the phases together

commit2e099f9777f0a337d5201219f19b291574891302 authorEvan Czaplicki <evancz@users.noreply.github.com> dateFri 8 Dec 2017, 14:02 (9 years ago) parent740341f

8 files changed+170−153

compare with master

unifiedsplit

src/Compile.hs+65−63 src/Elm/Interface.hs+34−28 src/Nitpick/TopLevelTypes.hs+26−25 src/Parse/Parse.hs+4−4 src/Parse/Primitives.hs+3−3 src/Type/Solve.hs+2−2 src/Type/Type.hs+18−9 src/Validate.hs+18−19

src/Compile.hs+65−63

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

11{-# 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 AST.Module as Module

8+import qualified Data.ByteString as BS

9+import qualified Data.Map as Map

10+

11+import qualified AST.Canonical as Can

12+import qualified AST.Optimized as Opt

913import qualified AST.Module.Name as ModuleName

10−import qualified Canonicalize

11−import qualified Elm.Package as Package

12−import qualified Nitpick.PatternMatches as Nitpick

13−import qualified Nitpick.TopLevelTypes as Nitpick

14−import qualified Optimize

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

14+import qualified Canonicalize.Module as Canonicalize

15+import qualified Elm.Interface as I

16+import qualified Elm.Name as N

17+import qualified Elm.Package as Pkg

18+import qualified Nitpick.PatternMatches as PatternMatches

19+import qualified Nitpick.TopLevelTypes as TopLevelTypes

20+import qualified Optimize.Module as Optimize

21+import qualified Parse.Parse as Parse

1622import qualified Reporting.Error as Error

17−import qualified Reporting.Render.Type as RenderType

1823import qualified Reporting.Result as Result

1924import 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)

2129

2230

2331

2432-- COMPILE

2533

2634

27−type Result =

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

35+type Result i a =

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

37+

38+

39+type ImportDict =

40+ Map.Map N.Name ModuleName.Canonical

2941

3042

31−compile

32− :: Package.Name

33− -> Map ModuleName.Raw ModuleName.Canonical

34− -> Module.Interfaces

35− -> Text

36− -> Result Module.Optimized

37−compile packageName importDict interfaces source =

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

44+compile pkg importDict interfaces source =

3845 do

39− -- Parse the source code

40− validModule <-

41− Result.format Error.Syntax $

42− {-# SCC elm_compiler_parse #-}

43− Parse.program packageName source

44−

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

46− canonicalModule <-

47− {-# SCC elm_compiler_canonicalize #-}

48− Canonicalize.module' importDict interfaces validModule

49−

50− -- Run type inference on the program.

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

47+ Parse.program source

48+

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

50+ Canonicalize.canonicalize pkg importDict interfaces valid

51+

5152 types <-

52− Result.from Error.Type $

53− {-# SCC elm_compiler_types #-}

54− TI.infer interfaces canonicalModule

55−

56− -- One last round of checks

57− canonicalDefs <-

58− Result.format Error.Type $

59− {-# SCC elm_compiler_nitpick #-}

60− Nitpick.topLevelTypes types $

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

62−

63− tagDict <-

64− Result.format Error.Pattern $

65− {-# SCC elm_compiler_exhaustiveness #-}

66− Nitpick.patternMatches interfaces canonicalModule

67−

68− -- Do some basic optimizations

69− let optimisedDefs =

70− {-# SCC elm_compiler_optimization #-}

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

72−

73− -- Add the real list of types

74− let info =

75− (Module.info canonicalModule)

76− { Module.types = types

77− , Module.program = optimisedDefs

78− }

79−

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

53+ runTypeInference canonical

54+

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

56+ TopLevelTypes.check types canonical

57+

58+ () <- exhaustivenessCheck canonical

59+

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

61+

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

63+

64+

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

66+runTypeInference canonical =

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

68+ Left errors ->

69+ Result.throw (Error.Type errors)

70+

71+ Right annotations ->

72+ Result.ok annotations

73+

74+

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

76+exhaustivenessCheck canonical =

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 @@

22module Elm.Interface

33 ( Interfaces

44 , Interface(..)

5+ , Binop(..)

56 , fromModule

6− , privatize

77 )

88 where

1010

1111import Control.Monad (liftM4)

1212import Data.Binary

13+import Data.Map ((!))

1314import qualified Data.Map as Map

1415

15−import qualified AST.Expression.Canonical as Canonical

16+import qualified AST.Canonical as Can

1617import qualified AST.Module.Name as ModuleName

17−import qualified AST.Type as Type

18+import qualified AST.Utils.Binop as Binop

1819import qualified Elm.Name as N

1920

2021

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

3233

3334data Interface =

3435 Interface

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

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

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

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

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

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

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

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

3949 }

4050

4151

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

4353-- FROM MODULE

4454

4555

46−fromModule :: Canonical.Module -> Interface

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

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

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

4858 Interface

49− { _types = error "TODO types"

50− , _unions = unions

59+ { _types = types

60+ , _unions = unions

5161 , _aliases = aliases

52− , _binops = binops

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

5363 }

5464

5565

56−

57−-- PRIVATIZE

58−

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− }

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

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

68+ Binop name (types ! name) associativity precedence

7269

7370

7471

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

8178

8279 put (Interface a b c d) =

8380 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

1515import qualified AST.Module.Name as ModuleName

1616import qualified AST.Utils.Type as Type

1717import qualified Canonicalize.Effects as Effects

18−import qualified Canonicalize.Result as Result

1918import qualified Elm.Name as N

2019import qualified Reporting.Annotation as A

21−import qualified Reporting.Error.Canonicalize as Error

20+import qualified Reporting.Error.Main as Error

2221import qualified Reporting.Region as R

22+import qualified Reporting.Result as Result

2323import qualified Reporting.Warning as W

2424

2525

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

3131 Result.Result i w Error.Error a

3232

3333

34−type Types =

35− Map.Map N.Name Can.Type

34+type Annotations =

35+ Map.Map N.Name Can.Annotation

3636

3737

3838type Mains =

3939 Map.Map ModuleName.Canonical Opt.Main

4040

4141

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

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

44− checkDecls home types decls Map.empty

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

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

44+ checkDecls home annotations decls Map.empty

4545

4646

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

48−checkDecls home types decls mains =

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

48+checkDecls home annotations decls mains =

4949 case decls of

5050 Can.Declare def subDecls ->

51− checkDecls home types subDecls =<<

52− checkDef home types mains def

51+ checkDecls home annotations subDecls =<<

52+ checkDef home annotations mains def

5353

5454 Can.DeclareRec defs subDecls ->

55− checkDecls home types subDecls =<<

56− foldM (checkDef home types) mains defs

55+ checkDecls home annotations subDecls =<<

56+ foldM (checkDef home annotations) mains defs

5757

5858 Can.SaveTheEnvironment ->

5959 Result.ok mains

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

6363-- MISSING ANNOTATIONS

6464

6565

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

67−checkDef home types mains def =

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

67+checkDef home annotations mains def =

6868 case def of

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

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

71− checkMain region types home name mains

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

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

72+ checkMain region annotations home name mains

7273

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

74− checkMain region types home name mains

75+ checkMain region annotations home name mains

7576

7677

7778

7879-- CHECK MAIN TYPE

7980

8081

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

82−checkMain region types home name mains =

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

83+checkMain region annotations home name mains =

8384 if name == N.main then

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

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

8586 Result.ok $ Map.insert home mainType mains

8687 else

8788 Result.ok mains

8889

8990

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

91−checkMainType region tipe =

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

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

9293 case Type.deepDealias tipe of

9394 Can.TType home name [_]

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

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

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

99100 case Effects.checkPayload flags of

100101 Left (subType, invalidPayload) ->

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

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

102103

103104 Right () ->

104105 Result.ok (Opt.Dynamic flags)

105106

106107 _ ->

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

1212import qualified Parse.Declaration as Decl

1313import qualified Parse.Module as Module

1414import qualified Parse.Primitives as P

15−import qualified Reporting.Annotation as A

15+import qualified Reporting.Error.Syntax as Error

1616import qualified Reporting.Result as Result

1717import qualified Validate

1818

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

2121-- PROGRAM

2222

2323

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

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

2525program src =

2626 case P.run chompProgram src of

2727 Right modul ->

2828 Validate.validate modul

2929

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

31− Result.throw region syntaxError

30+ Left syntaxError ->

31+ Result.throw syntaxError

3232

3333

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

src/Parse/Primitives.hs+3−3

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

3131-- RUN

3232

3333

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

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

3535run parser bytes =

3636 runAt 1 1 parser bytes

3737

3838

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

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

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

4242 Ok value _ _ ->

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

4646 let

4747 pos = R.Position row col

4848 mkError overallRegion subRegion =

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

49+ Left (E.Parse overallRegion subRegion problem)

5050 in

5151 case problem of

5252 E.BadChar endCol ->

src/Type/Solve.hs+2−2

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

2727-- RUN SOLVER

2828

2929

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

3131run constraint =

3232 do pools <- MVector.replicate 16 []

3333

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

3636

3737 case errors of

3838 [] ->

39− Right <$> traverse toSrcType env

39+ Right <$> traverse Type.toAnnotation env

4040

4141 _ ->

4242 return $ Left errors

src/Type/Type.hs+18−9

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

2222 , nameToFlex

2323 , nameToRigid

2424 , toSrcType

25+ , toAnnotation

2526 )

2627 where

2728

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

308309

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

310311-- 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+

311320toSrcType :: Variable -> IO Can.Type

312321toSrcType variable =

313− do takenNames <- getVarNames variable Map.empty

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

322+ do userNames <- getVarNames variable Map.empty

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

315324

316325

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

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

423432 }

424433

425434

426−type TakenNames = Map.Map Text Variable

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

427436

428437

429438makeNameState :: TakenNames -> NameState

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

431440 NameState taken 0 0 0 0 0

432441

433442

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

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

435444getFreshVarName =

436445 do index <- State.gets _normals

437446 taken <- State.gets _taken

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

440449 return uniqueName

441450

442451

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

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

444453getFreshSuperName super =

445454 case super of

446455 Number ->

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

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

457466

458467

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

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

460469getFreshNormal index taken =

461470 let

462471 (postfix, letter) =

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

477486

478487getFreshSuper

479488 :: (Monad m)

480− => Text

489+ => N.Name

481490 -> (NameState -> Int)

482491 -> (Int -> NameState -> NameState)

483− -> StateT NameState m Text

492+ -> StateT NameState m N.Name

484493getFreshSuper name getter setter =

485494 do index <- State.gets getter

486495 taken <- State.gets _taken

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

489498 return uniqueName

490499

491500

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

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

493502getFreshSuperHelp name index taken =

494503 let

495504 newName =

src/Validate.hs+18−19

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

11{-# OPTIONS_GHC -Wall #-}

22{-# LANGUAGE OverloadedStrings #-}

33module Validate

4− ( Result

5− , validate

4+ ( validate

65 )

76 where

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

2524-- VALIDATE

2625

2726

28−type Result warning a =

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

27+type Result i w a =

28+ Result.Result i w Error.Error a

3029

3130

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

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

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

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

3534 effects <- validateEffects srcEffects ports

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

5150 }

5251

5352

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

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

5554validateDecls decls =

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

5756

5857

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

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

6059vsdHelp decls stuff =

6160 case decls of

6261 [] ->

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

9695-- VALIDATE DOCS

9796

9897

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

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

10099validateDocs docs decls stuff =

101100 case decls of

102101 [] ->

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

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

108107

109108

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

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

111110getNameForDocs decl =

112111 case decl of

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

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

136135-- VALIDATE ANNOTATION

137136

138137

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

140139validateAnnotation annRegion annotationName tipe decls stuff =

141140 case decls of

142141 [] ->

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

162161-- VALIDATE EXPRESSIONS

163162

164163

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

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

166165expression (A.At region sourceExpression) =

167166 A.At region <$>

168167 case sourceExpression of

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

245244 pure (Valid.Shader uid src gltipe)

246245

247246

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)

249248both (a, b) =

250249 liftA2 (,) (expression a) (expression b)

251250

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

254253-- VALIDATE DEFINITIONS

255254

256255

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

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

258257definitions sourceDefs =

259258 case sourceDefs of

260259 [] ->

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

279278 <*> definitions otherOtherDefs

280279

281280 _ ->

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

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

283282

284283

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

286285validateDefinition region name args expr maybeType =

287286 do validExpr <- expression expr

288287 return $ Valid.Define region name args validExpr maybeType

289288

290289

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

292291validateDestruct region pattern expr =

293292 Valid.Destruct region pattern <$> expression expr

294293

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

297296-- VALIDATE EFFECTS

298297

299298

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

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

301300validateEffects effects ports =

302301 case effects of

303302 Src.NoEffects ->

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

321320 Valid.Fx cmd sub

322321

323322

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

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

325324noPorts ports =

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

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

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