ba5bfd2 · elk · git.iko.soy

git.iko.soy/elk

Add support for "effect types" that track which effects are needed

commitba5bfd26d8931bed06f5235b1e57f5d752fbee38 authorEvan Czaplicki <info@elm-lang.org> dateTue 9 Feb 2016, 18:16 (11 years ago) parentd4eb79c

17 files changed+258−56

compare with master

unifiedsplit

src/AST/Type.hs+16−2 src/Canonicalize/Environment.hs+32−9 src/Canonicalize/Setup.hs+18−11 src/Canonicalize/Type.hs+44−12 src/Canonicalize/Variable.hs+28−1 src/Elm/Compiler/Type.hs+3 src/Elm/Compiler/Type/Extract.hs+5−1 src/Parse/Type.hs+9−2 src/Reporting/Error/Canonicalize.hs+19 src/Reporting/Error/Syntax.hs+20 src/Reporting/Render/Type.hs+21−5 src/Type/Environment.hs+7−2 src/Type/Solve.hs+6 src/Type/State.hs+4 src/Type/Type.hs+19−11 src/Type/Unify.hs+4 src/Validate.hs+3

src/AST/Type.hs+16−2

@@ -9,7 +9,9 @@ module AST.Type

99import Control.Arrow (second)

1010import Data.Binary

1111import qualified Data.Map as Map

12+import qualified Data.Set as Set

1213

14+import qualified AST.Module.Name as ModuleName

1315import qualified AST.Variable as Var

1416import qualified Reporting.Annotation as A

1517import qualified Reporting.Region as R

@@ -29,6 +31,7 @@ data Raw'

2931 | RType Var.Raw

3032 | RApp Raw [Raw]

3133 | RRecord [(String, Raw)] (Maybe Raw)

34+ | REffects [A.Located ModuleName.Raw]

3235

3336

3437data Canonical

@@ -37,6 +40,7 @@ data Canonical

3740 | Type Var.Canonical

3841 | App Canonical [Canonical]

3942 | Record [(String, Canonical)] (Maybe Canonical)

43+ | Effects (Set.Set ModuleName.Canonical)

4044 | Aliased Var.Canonical [(String, Canonical)] (Aliased Canonical)

4145 deriving (Eq, Ord)

4246

@@ -81,6 +85,9 @@ deepDealias tipe =

8185 App f args ->

8286 App (deepDealias f) (map deepDealias args)

8387

88+ Effects _ ->

89+ tipe

90+

8491

8592iteratedDealias :: Canonical -> Canonical

8693iteratedDealias tipe =

@@ -127,6 +134,9 @@ dealiasHelp typeTable tipe =

127134 App f args ->

128135 App (go f) (map go args)

129136

137+ Effects _ ->

138+ tipe

139+

130140

131141

132142-- COLLECT LAMBDAS

@@ -164,8 +174,11 @@ instance Binary Canonical where

164174 Record fs ext ->

165175 putWord8 4 >> put fs >> put ext

166176

177+ Effects names ->

178+ putWord8 5 >> put names

179+

167180 Aliased var args t ->

168− putWord8 5 >> put var >> put args >> put t

181+ putWord8 6 >> put var >> put args >> put t

169182

170183 get =

171184 do n <- getWord8

@@ -175,7 +188,8 @@ instance Binary Canonical where

175188 2 -> Type <$> get

176189 3 -> App <$> get <*> get

177190 4 -> Record <$> get <*> get

178− 5 -> Aliased <$> get <*> get <*> get

191+ 5 -> Effects <$> get

192+ 6 -> Aliased <$> get <*> get <*> get

179193 _ -> error "Error reading a valid type from serialized string"

180194

181195

src/Canonicalize/Environment.hs+32−9

@@ -1,5 +1,12 @@

11{-# OPTIONS_GHC -Wall #-}

2−module Canonicalize.Environment where

2+module Canonicalize.Environment

3+ ( Environment(..)

4+ , insert

5+ , Patch(..), fromPatches, addPattern

6+ , builtinPatches

7+ , toDealiaser

8+ )

9+ where

310

411import qualified Data.List as List

512import qualified Data.Map as Map

@@ -14,14 +21,17 @@ import qualified AST.Variable as Var

1421import Elm.Utils ((|>))

1522

1623

24+

1725-- ENVIRONMENT

1826

27+

1928data Environment = Env

2029 { _home :: ModuleName.Canonical

2130 , _values :: Dict Var.Canonical

2231 , _unions :: Dict Var.Canonical

2332 , _aliases :: Dict (Var.Canonical, [String], Type.Canonical)

2433 , _patterns :: Dict (Var.Canonical, Int)

34+ , _effects :: Map.Map String ModuleName.Canonical

2535 }

2636

2737

@@ -29,23 +39,30 @@ type Dict a =

2939 Map.Map String (Set.Set a)

3040

3141

32−fromPatches :: ModuleName.Canonical -> [Patch] -> Environment

33−fromPatches moduleName patches =

42+fromPatches

43+ :: ModuleName.Canonical

44+ -> Map.Map String ModuleName.Canonical

45+ -> [Patch]

46+ -> Environment

47+fromPatches moduleName moduleNames patches =

3448 addPatches

35− patches

36− (Env moduleName Map.empty Map.empty Map.empty Map.empty)

49+ patches

50+ (Env moduleName Map.empty Map.empty Map.empty Map.empty moduleNames)

3751

3852

3953addPattern :: P.Pattern ann var -> Environment -> Environment

4054addPattern pattern env =

41− let patches =

42− map (\x -> Value x (Var.local x)) (P.boundVarList pattern)

55+ let

56+ patches =

57+ map (\x -> Value x (Var.local x)) (P.boundVarList pattern)

4358 in

44− addPatches patches env

59+ addPatches patches env

60+

4561

4662

4763-- PATCHES

4864

65+

4966data Patch

5067 = Value String Var.Canonical

5168 | Union String Var.Canonical

@@ -53,8 +70,10 @@ data Patch

5370 | Pattern String (Var.Canonical, Int)

5471

5572

73+

5674-- ADD PATCH TO ENVIRONMENT

5775

76+

5877addPatches :: [Patch] -> Environment -> Environment

5978addPatches patches env =

6079 List.foldl' (flip addPatch) env patches

@@ -81,8 +100,10 @@ insert key value =

81100 Map.insertWith Set.union key (Set.singleton value)

82101

83102

103+

84104-- PATCH HELPERS

85105

106+

86107builtinPatches :: [Patch]

87108builtinPatches =

88109 concat

@@ -108,10 +129,12 @@ builtinPatches =

108129 ("_Tuple" ++ show n, n)

109130

110131

132+

111133-- TO TYPE DEALIASER

112134

135+

113136toDealiaser :: Environment -> Map.Map String String

114−toDealiaser (Env _ _ unions aliases _) =

137+toDealiaser (Env _ _ unions aliases _ _) =

115138 let

116139 dealiasUnion (localName, canonicalSet) =

117140 case Set.toList canonicalSet of

src/Canonicalize/Setup.hs+18−11

@@ -32,23 +32,26 @@ environment

3232 -> Result.ResultErr Env.Environment

3333environment importDict interfaces (Module.Module name _ info) =

3434 let

35− (Module.Valid _ _ (defaults, imports) decls effects) =

35+ (Module.Valid _ _ (defaults, imports) decls _) = -- TODO add foreign effects as patches?

3636 info

3737

3838 allImports =

3939 imports ++ map (A.A (error "default import not found")) defaults

4040

41− importPatchesResult =

42− concat <$> Trav.traverse (importPatches importDict interfaces) allImports

41+ importIngredients =

42+ unzip <$> Trav.traverse (importPatches importDict interfaces) allImports

4343

4444 (typeAliasNodes, declPatches) =

45− declarationsToPatches name decls

45+ declarationsToPatches name decls

4646

47− patches =

48− (++) (Env.builtinPatches ++ declPatches) <$> importPatchesResult

47+ createEnv (moduleNamePairs, patchLists) =

48+ Env.fromPatches

49+ name

50+ (Map.fromList (Maybe.catMaybes moduleNamePairs))

51+ (concat (Env.builtinPatches : declPatches : patchLists))

4952 in

50− (Env.fromPatches name <$> patches)

51− `Result.andThen` addTypeAliases name typeAliasNodes

53+ (createEnv <$> importIngredients)

54+ `Result.andThen` addTypeAliases name typeAliasNodes

5255

5356

5457

@@ -59,7 +62,7 @@ importPatches

5962 :: Map.Map ModuleName.Raw ModuleName.Canonical

6063 -> Module.Interfaces

6164 -> A.Located (ModuleName.Raw, Module.ImportMethod)

62− -> Result.ResultErr [Env.Patch]

65+ -> Result.ResultErr (Maybe (String, ModuleName.Canonical), [Env.Patch])

6366importPatches importDict allInterfaces (A.A region (rawImportName, method)) =

6467 let

6568 maybeInterface =

@@ -70,7 +73,7 @@ importPatches importDict allInterfaces (A.A region (rawImportName, method)) =

7073 case maybeInterface of

7174 Nothing ->

7275 if ModuleName.isNative rawImportName then

73− Result.ok []

76+ Result.ok (Nothing, [])

7477

7578 else

7679 allInterfaces

@@ -102,7 +105,8 @@ importPatches importDict allInterfaces (A.A region (rawImportName, method)) =

102105 else

103106 concat <$> Trav.traverse (valueToPatches region importName interface) exposedValues

104107 in

105− (++) qualifiedPatches <$> unqualifiedPatches

108+ (,) (Just (qualifier, importName)) <$>

109+ ((++) qualifiedPatches <$> unqualifiedPatches)

106110

107111

108112interfacePatches :: ModuleName.Canonical -> String -> Module.Interface -> [Env.Patch]

@@ -255,6 +259,9 @@ node region name tvars alias =

255259 Type.RRecord fs ext ->

256260 maybe [] edges ext ++ concatMap (edges . snd) fs

257261

262+ Type.REffects _ ->

263+ []

264+

258265

259266addTypeAliases

260267 :: ModuleName.Canonical

src/Canonicalize/Type.hs+44−12

@@ -1,8 +1,10 @@

11{-# OPTIONS_GHC -Wall #-}

22module Canonicalize.Type (tipe) where

4+import qualified Data.Set as Set

45import qualified Data.Traversable as Trav

7+import qualified AST.Module.Name as ModuleName

68import qualified AST.Type as T

79import qualified AST.Variable as Var

810

@@ -19,10 +21,13 @@ tipe

1921 -> T.Raw

2022 -> Result.ResultErr T.Canonical

2123tipe env typ@(A.A region typ') =

22− let go = tipe env

23− goSnd (name,t) =

24− (,) name <$> go t

25− in

24+ let

25+ go =

26+ tipe env

27+

28+ goSnd (name,t) =

29+ (,) name <$> go t

30+ in

2631 case typ' of

2732 T.RVar x ->

2833 Result.ok (T.Var x)

@@ -39,6 +44,9 @@ tipe env typ@(A.A region typ') =

3944 T.RRecord fields ext ->

4045 T.Record <$> Trav.traverse goSnd fields <*> Trav.traverse go ext

4146

47+ T.REffects rawNames ->

48+ T.Effects <$> canonicalizeEffects env rawNames

49+

4250

4351canonicalizeApp

4452 :: R.Region

@@ -49,11 +57,13 @@ canonicalizeApp

4957canonicalizeApp region env f args =

5058 case f of

5159 A.A _ (T.RType (Var.Raw rawName)) ->

52− Canonicalize.tvar region env rawName

53− `Result.andThen` canonicalizeWithTvar

60+ Canonicalize.tvar region env rawName

61+ `Result.andThen` canonicalizeWithTvar

5462

5563 _ ->

56− T.App <$> tipe env f <*> Trav.traverse (tipe env) args

64+ T.App

65+ <$> tipe env f

66+ <*> Trav.traverse (tipe env) args

5767

5868 where

5969 canonicalizeWithTvar tvar =

@@ -76,12 +86,34 @@ canonicalizeAlias

7686 -> [T.Raw]

7787 -> Result.ResultErr T.Canonical

7888canonicalizeAlias region env (name, tvars, dealiasedTipe) types =

79− if typesLen /= tvarsLen

80− then Result.err (A.A region (Error.alias name tvarsLen typesLen))

81− else toAlias <$> Trav.traverse (tipe env) types

82− where

89+ let

8390 typesLen = length types

8491 tvarsLen = length tvars

8592

8693 toAlias canonicalTypes =

87− T.Aliased name (zip tvars canonicalTypes) (T.Holey dealiasedTipe)

94+ T.Aliased name (zip tvars canonicalTypes) (T.Holey dealiasedTipe)

95+ in

96+ if typesLen /= tvarsLen then

97+ Result.err (A.A region (Error.alias name tvarsLen typesLen))

98+

99+ else

100+ toAlias <$> Trav.traverse (tipe env) types

101+

102+

103+canonicalizeEffects

104+ :: Env.Environment

105+ -> [A.Located ModuleName.Raw]

106+ -> Result.ResultErr (Set.Set ModuleName.Canonical)

107+canonicalizeEffects env rawNames =

108+ let

109+ addToSet (A.A region name) set =

110+ if Set.member name set then

111+ Result.err (A.A region (Error.DuplicateEffect name))

112+

113+ else

114+ Result.ok (Set.insert name set)

115+ in

116+ Trav.traverse (Canonicalize.effect env) rawNames

117+ `Result.andThen`

118+ Result.foldl addToSet Set.empty

119+

src/Canonicalize/Variable.hs+28−1

@@ -1,5 +1,5 @@

11{-# OPTIONS_GHC -Wall #-}

2−module Canonicalize.Variable where

2+module Canonicalize.Variable (variable, tvar, pvar, effect) where

44import qualified Data.Either as Either

55import qualified Data.Map as Map

@@ -19,6 +19,10 @@ import qualified Elm.Package as Pkg

1919import Elm.Utils ((|>))

2020

2121

22+

23+-- FINDERS

24+

25+

2226variable :: R.Region -> Env.Environment -> String -> Result.ResultErr Var.Canonical

2327variable region env var =

2428 case toVarName var of

@@ -92,8 +96,27 @@ pvar region env var actualArgs =

9296 else Result.err (A.A region (Error.argMismatch name expectedArgs actualArgs))

9397

9498

99+effect

100+ :: Env.Environment

101+ -> A.Located ModuleName.Raw

102+ -> Result.ResultErr (A.Located ModuleName.Canonical)

103+effect env (A.A region rawName) =

104+ let

105+ rawString =

106+ ModuleName.toString rawName

107+ in

108+ case Map.lookup rawString (Env._effects env) of

109+ Just name ->

110+ Result.addModule (ModuleName._module name) (Result.ok (A.A region name))

111+

112+ Nothing ->

113+ notFound region "effect type" (Map.keys (Env._effects env)) rawString

114+

115+

116+

95117-- FOUND

96118

119+

97120preferLocals

98121 :: R.Region

99122 -> Env.Environment

@@ -164,8 +187,10 @@ isTopLevel (Var.Canonical home _) =

164187 False

165188

166189

190+

167191-- NOT FOUND HELPERS

168192

193+

169194type VarName =

170195 Either String (ModuleName.Raw, String)

171196

@@ -194,8 +219,10 @@ isOp name =

194219 Help.isOp (noQualifier name)

195220

196221

222+

197223-- NOT FOUND

198224

225+

199226notFound :: R.Region -> String -> [String] -> String -> Result.ResultErr a

200227notFound region kind possibilities var =

201228 let name =

src/Elm/Compiler/Type.hs+3

@@ -195,3 +195,6 @@ fromRawType (A.A _ astType) =

195195 Type.RRecord fields ext ->

196196 Record (map (second fromRawType) fields) (fmap fromRawType ext)

197197

198+ Type.REffects _ ->

199+ error "TODO - fromRawType REffects"

200+

src/Elm/Compiler/Type/Extract.hs+5−1

@@ -40,5 +40,9 @@ toType useAliases astType =

4040 Type.Aliased name args t ->

4141 if useAliases then

4242 T.App (T.Type (Var.toString name)) (map (go . snd) args)

43+

4344 else

44− go (Type.dealias args t)

45+ go (Type.dealias args t)

46+

47+ Type.Effects _ ->

48+ error "TODO - toType Effects"

src/Parse/Type.hs+9−2

@@ -2,7 +2,7 @@

22module Parse.Type where

44import Data.List (intercalate)

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

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

77import qualified AST.Type as Type

88import qualified AST.Variable as Var

@@ -50,6 +50,13 @@ record =

5050 (,) lbl <$> expr

5151

5252

53+effects :: IParser Type.Raw

54+effects =

55+ addLocation $ braces $

56+ do names <- commaSep1 (addLocation (dotSep1 capVar))

57+ return (Type.REffects names)

58+

59+

5360capTypeVar :: IParser String

5461capTypeVar =

5562 intercalate "." <$> dotSep1 capVar

@@ -64,7 +71,7 @@ constructor0 =

6471

6572term :: IParser Type.Raw

6673term =

67− tuple <|> record <|> tvar <|> constructor0

74+ choice [ tuple, record, effects, tvar, constructor0 ]

6875

6976

7077app :: IParser Type.Raw

src/Reporting/Error/Canonicalize.hs+19

@@ -3,11 +3,13 @@ module Reporting.Error.Canonicalize where

44import Control.Arrow (second)

55import qualified Data.Char as Char

6+import qualified Data.Set as Set

67import Text.PrettyPrint.ANSI.Leijen (indent, text)

89import qualified AST.Module.Name as ModuleName

910import qualified AST.Type as Type

1011import qualified AST.Variable as Var

12+import qualified Elm.Package as Package

1113import qualified Reporting.Annotation as A

1214import qualified Reporting.Error.Helpers as Help

1315import qualified Reporting.Region as Region

@@ -22,6 +24,7 @@ data Error

2224 | Import ModuleName.Raw ImportError

2325 | Export String [String]

2426 | DuplicateExport String

27+ | DuplicateEffect ModuleName.Canonical

2528 | Port PortError

2629

2730

@@ -228,6 +231,15 @@ toReport localizer err =

228231 ("You are trying to export `" ++ name ++ "` multiple times!")

229232 "Remove duplicates until there is only one listed."

230233

234+ DuplicateEffect rawName ->

235+ let

236+ name =

237+ ModuleName.canonicalToString rawName

238+ in

239+ namingError

240+ ("This type lists the `" ++ name ++ "` effect multiple times.")

241+ "Remove duplicates until each effect is listed only once."

242+

231243 Port (PortError name isInbound _rootType localType maybeMessage) ->

232244 let

233245 boundPort =

@@ -292,6 +304,9 @@ extractSuggestions err =

292304 DuplicateExport _ ->

293305 Nothing

294306

307+ DuplicateEffect _ ->

308+ Nothing

309+

295310 Port _ ->

296311 Nothing

297312

@@ -311,6 +326,10 @@ unsafePromote (A.A _ rawType) =

311326 Type.RApp func args ->

312327 Type.App (unsafePromote func) (map unsafePromote args)

313328

329+ Type.REffects names ->

330+ Type.Effects $ Set.fromList $

331+ map (ModuleName.Canonical Package.dummyName . A.drop) names

332+

314333 Type.RRecord fields ext ->

315334 Type.Record (map (second unsafePromote) fields) (fmap unsafePromote ext)

316335

src/Reporting/Error/Syntax.hs+20

@@ -100,6 +100,26 @@ toReport _localizer err =

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

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

102102

103+ SettingsOnNormalModule ->

104+ Report.report

105+ "BAD MODULE DECLARATION"

106+ Nothing

107+ "A normal module can expose values, but not register commands and subscriptions."

108+ ( Help.reflowParagraph $

109+ "If you want a normal module, just remove this stuff. If you want to create\

110+ \ an `effect module` you just forgot to use the `effect` keyword. In that\

111+ \ case, just change `module` to `effect module` and you should be all set!"

112+ )

113+

114+ SettingsOnForeignModule ->

115+ error "TODO - SettingsOnForeignModule"

116+

117+ DuplicateSettingOnEffectModule name ->

118+ error "TODO - DuplicateSettingOnEffectModule" name

119+

120+ BadSettingOnEffectModule name ->

121+ error "TODO - BadSettingOnEffectModule" name

122+

103123 InfixDuplicate opName ->

104124 Report.report

105125 "INFIX OVERLAP"

src/Reporting/Render/Type.hs+21−5

@@ -12,11 +12,12 @@ import Control.Arrow ((***), first)

1212import qualified Data.Map as Map

1313import qualified Data.Set as Set

1414import Text.PrettyPrint.ANSI.Leijen

15− ( Doc, (<+>), cat, colon, comma, dullyellow, equals, hang, hsep

16− , lbrace, lparen, parens, rbrace, rparen, sep, text, vcat

15+ ( Doc, (<+>), brackets, cat, colon, comma, dullyellow, equals, hang, hsep

16+ , lbrace, lparen, parens, punctuate, rbrace, rparen, sep, text, vcat

1717 )

1818

1919import qualified AST.Helpers as Help

20+import qualified AST.Module.Name as ModuleName

2021import qualified AST.Type as Type

2122import qualified AST.Variable as Var

2223import qualified Reporting.Error.Helpers as Help

@@ -87,13 +88,24 @@ type Localizer =

8788varToDoc :: Localizer -> Var.Canonical -> Doc

8889varToDoc localizer var =

8990 let

90− name = Var.toString var

91+ name =

92+ Var.toString var

9193 in

9294 if name == "_Tuple0" then

93− text "()"

95+ text "()"

9496

9597 else

96− text (maybe name id (Map.lookup name localizer))

98+ text (maybe name id (Map.lookup name localizer))

99+

100+

101+-- TODO make sure that localizer contains qualifiers without variables

102+moduleNameToDoc :: Localizer -> ModuleName.Canonical -> Doc

103+moduleNameToDoc localizer var =

104+ let

105+ name =

106+ ModuleName.canonicalToString var

107+ in

108+ text (maybe name id (Map.lookup name localizer))

97109

98110

99111

@@ -401,6 +413,10 @@ docType localizer context tipe =

401413 (map (text *** docType localizer None) fields)

402414 (fmap text ext)

403415

416+ Type.Effects names ->

417+ brackets $ cat $ punctuate comma $

418+ map (moduleNameToDoc localizer) (Set.toList names)

419+

404420 Type.Aliased name args _ ->

405421 docApp localizer context name (map snd args)

406422

src/Type/Environment.hs+7−2

@@ -176,8 +176,10 @@ instantiator env sourceType =

176176

177177instantiatorHelp :: Environment -> Set.Set String -> T.Canonical -> State.StateT VarDict IO Type

178178instantiatorHelp env aliasVars sourceType =

179− let go = instantiatorHelp env aliasVars

180− in

179+ let

180+ go =

181+ instantiatorHelp env aliasVars

182+ in

181183 case sourceType of

182184 T.Lambda t1 t2 ->

183185 (==>) <$> go t1 <*> go t2

@@ -235,3 +237,6 @@ instantiatorHelp env aliasVars sourceType =

235237 go extType

236238

237239 return $ TermN (Record1 tfields text)

240+

241+ T.Effects names ->

242+ return $ TermN (Effects1 names)

src/Type/Solve.hs+6

@@ -143,6 +143,9 @@ adjustRankContent youngMark visitedMark groupRank content =

143143 Structure (Record1 fields extension) ->

144144 maximum <$> mapM go (extension : Map.elems fields)

145145

146+ Structure (Effects1 _) ->

147+ return outermostRank

148+

146149

147150

148151-- SOLVER

@@ -342,3 +345,6 @@ occursHelp seen var =

342345

343346 Record1 fields ext ->

344347 or <$> mapM go (ext : Map.elems fields)

348+

349+ Effects1 _ ->

350+ return False

src/Type/State.hs+4

@@ -325,3 +325,7 @@ traverseTerm f term =

325325

326326 Record1 fields ext ->

327327 Record1 <$> traverse f fields <*> f ext

328+

329+ Effects1 names ->

330+ return (Effects1 names)

331+

src/Type/Type.hs+19−11

@@ -9,6 +9,7 @@ import qualified Data.Set as Set

99import qualified Data.Traversable as Traverse (traverse)

1010import qualified Data.UnionFind.IO as UF

1111

12+import qualified AST.Module.Name as ModuleName

1213import qualified AST.Type as T

1314import qualified AST.Variable as Var

1415import qualified Reporting.Annotation as A

@@ -45,6 +46,7 @@ data Term1 a

4546 | Fun1 a a

4647 | EmptyRecord1

4748 | Record1 (Map.Map String a) a

49+ | Effects1 (Set.Set ModuleName.Canonical)

4850

4951

5052data TermN a

@@ -309,22 +311,22 @@ termToSrcType :: Term1 Variable -> StateT NameState IO T.Canonical

309311termToSrcType term =

310312 case term of

311313 App1 func arg ->

312− do srcFunc <- variableToSrcType func

313− srcArg <- variableToSrcType arg

314− case srcFunc of

315− T.App f args ->

316− return (T.App f (args ++ [srcArg]))

314+ do srcFunc <- variableToSrcType func

315+ srcArg <- variableToSrcType arg

316+ case srcFunc of

317+ T.App f args ->

318+ return (T.App f (args ++ [srcArg]))

317319

318− _ ->

319− return (T.App srcFunc [srcArg])

320+ _ ->

321+ return (T.App srcFunc [srcArg])

320322

321323 Fun1 a b ->

322− T.Lambda

323− <$> variableToSrcType a

324− <*> variableToSrcType b

324+ T.Lambda

325+ <$> variableToSrcType a

326+ <*> variableToSrcType b

325327

326328 EmptyRecord1 ->

327− return $ T.Record [] Nothing

329+ return $ T.Record [] Nothing

328330

329331 Record1 fields extension ->

330332 do srcFields <- Map.toList <$> Traverse.traverse variableToSrcType fields

@@ -340,6 +342,9 @@ termToSrcType term =

340342 _ ->

341343 error "Used toSrcType on a type that is not well-formed"

342344

345+ Effects1 names ->

346+ return $ T.Effects names

347+

343348

344349

345350-- MANAGE FRESH VARIABLE NAMES

@@ -456,3 +461,6 @@ getVarNamesTerm term =

456461 do fieldVars <- Set.unions <$> mapM go (Map.elems fields)

457462 Set.union fieldVars <$> go extension

458463

464+ Effects1 _ ->

465+ return Set.empty

466+

src/Type/Unify.hs+4

@@ -4,6 +4,7 @@ module Type.Unify (unify) where

44import Control.Monad (zipWithM_)

55import Control.Monad.Except (ExceptT, lift, liftIO, throwError, runExceptT)

66import qualified Data.Map as Map

7+import qualified Data.Set as Set

78import qualified Data.UnionFind.IO as UF

910import qualified AST.Variable as Var

@@ -564,6 +565,9 @@ unifyStructure context term otherContent =

564565 subUnify context result otherResult

565566 merge context otherContent

566567

568+ (Effects1 names, Effects1 otherNames) ->

569+ merge context (Structure (Effects1 (Set.union names otherNames)))

570+

567571 (EmptyRecord1, EmptyRecord1) ->

568572 merge context otherContent

569573

src/Validate.hs+3

@@ -573,3 +573,6 @@ freeVars (A.A region tipe) =

573573 maybe [] freeVars ext

574574 ++ concatMap (freeVars . snd) fields

575575

576+ Type.REffects _ ->

577+ []

578+