3d94566 · elk · git.iko.soy

git.iko.soy/elk

Remove effect types

Need to capture “openness” explicitly with types like `[a .. Task]` or `[a … Task, WebSocket]` and I’d rather just not track this in the type system if it’s going to need that level of complexity.

commit3d94566bee2bc9b43864069ac78c2ba434b6cbf6 authorEvan Czaplicki <info@elm-lang.org> dateFri 19 Feb 2016, 13:25 (11 years ago) parenta44041b

14 files changed+6−105

compare with master

unifiedsplit

src/AST/Type.hs+3−16 src/Canonicalize/Setup.hs−3 src/Canonicalize/Type.hs−23 src/Elm/Compiler/Type.hs−3 src/Elm/Compiler/Type/Extract.hs−3 src/Parse/Type.hs+1−8 src/Reporting/Error/Canonicalize.hs−4 src/Reporting/Render/Type.hs+2−16 src/Type/Environment.hs−3 src/Type/Solve.hs−6 src/Type/State.hs−4 src/Type/Type.hs−8 src/Type/Unify.hs−4 src/Validate.hs−4

src/AST/Type.hs+3−16

@@ -10,7 +10,6 @@ module AST.Type

1010import Control.Arrow (second)

1111import Data.Binary

1212import qualified Data.Map as Map

13−import qualified Data.Set as Set

1413

1514import qualified AST.Module.Name as ModuleName

1615import qualified AST.Variable as Var

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

3231 | RType Var.Raw

3332 | RApp Raw [Raw]

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

35− | REffects [A.Located ModuleName.Raw]

3634

3735

3836data Canonical

@@ -41,7 +39,6 @@ data Canonical

4139 | Type Var.Canonical

4240 | App Canonical [Canonical]

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

44− | Effects (Set.Set ModuleName.Canonical)

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

4643 deriving (Eq, Ord)

4744

@@ -79,7 +76,7 @@ effect :: Var.Canonical -> ModuleName.Canonical -> String -> Canonical

7976effect effectName moduleName tipe =

8077 Lambda

8178 (App (Type (Var.fromModule moduleName tipe)) [Var "msg"])

82− (App (Type effectName) [Effects (Set.singleton moduleName), Var "msg"])

79+ (App (Type effectName) [Var "msg"])

8380

8481

8582

@@ -107,9 +104,6 @@ deepDealias tipe =

107104 App f args ->

108105 App (deepDealias f) (map deepDealias args)

109106

110− Effects _ ->

111− tipe

112−

113107

114108iteratedDealias :: Canonical -> Canonical

115109iteratedDealias tipe =

@@ -156,9 +150,6 @@ dealiasHelp typeTable tipe =

156150 App f args ->

157151 App (go f) (map go args)

158152

159− Effects _ ->

160− tipe

161−

162153

163154

164155-- COLLECT LAMBDAS

@@ -196,11 +187,8 @@ instance Binary Canonical where

196187 Record fs ext ->

197188 putWord8 4 >> put fs >> put ext

198189

199− Effects names ->

200− putWord8 5 >> put names

201−

202190 Aliased var args t ->

203− putWord8 6 >> put var >> put args >> put t

191+ putWord8 5 >> put var >> put args >> put t

204192

205193 get =

206194 do n <- getWord8

@@ -210,8 +198,7 @@ instance Binary Canonical where

210198 2 -> Type <$> get

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

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

213− 5 -> Effects <$> get

214− 6 -> Aliased <$> get <*> get <*> get

201+ 5 -> Aliased <$> get <*> get <*> get

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

216203

217204

src/Canonicalize/Setup.hs−3

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

264264 Type.RRecord fs ext ->

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

266266

267− Type.REffects _ ->

268− []

269−

270267

271268addTypeAliases

272269 :: ModuleName.Canonical

src/Canonicalize/Type.hs−23

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

11{-# OPTIONS_GHC -Wall #-}

22module Canonicalize.Type (tipe) where

4−import qualified Data.Set as Set

54import qualified Data.Traversable as Trav

7−import qualified AST.Module.Name as ModuleName

86import qualified AST.Type as T

97import qualified AST.Variable as Var

108

@@ -44,9 +42,6 @@ tipe env annType@(A.A _ typ) =

4442 T.RRecord fields ext ->

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

4644

47− T.REffects rawNames ->

48− T.Effects <$> canonicalizeEffects env rawNames

49−

5045

5146canonicalizeApp

5247 :: Env.Environment

@@ -98,21 +93,3 @@ canonicalizeAlias region env (name, tvars, dealiasedTipe) types =

9893 else

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

10095

101−

102−canonicalizeEffects

103− :: Env.Environment

104− -> [A.Located ModuleName.Raw]

105− -> Result.ResultErr (Set.Set ModuleName.Canonical)

106−canonicalizeEffects env rawNames =

107− let

108− addToSet (A.A region name) set =

109− if Set.member name set then

110− Result.err (A.A region (Error.DuplicateEffect name))

111−

112− else

113− Result.ok (Set.insert name set)

114− in

115− Trav.traverse (Canonicalize.effect env) rawNames

116− `Result.andThen`

117− Result.foldl addToSet Set.empty

118−

src/Elm/Compiler/Type.hs−3

@@ -195,6 +195,3 @@ 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−3

@@ -43,6 +43,3 @@ toType useAliases astType =

4343

4444 else

4545 go (Type.dealias args t)

46−

47− Type.Effects _ ->

48− error "TODO - toType Effects"

src/Parse/Type.hs+1−8

@@ -50,13 +50,6 @@ 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−

6053capTypeVar :: IParser String

6154capTypeVar =

6255 intercalate "." <$> dotSep1 capVar

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

7164

7265term :: IParser Type.Raw

7366term =

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

67+ choice [ tuple, record, tvar, constructor0 ]

7568

7669

7770app :: IParser Type.Raw

src/Reporting/Error/Canonicalize.hs−4

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

326326 Type.RApp func args ->

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

328328

329− Type.REffects names ->

330− Type.Effects $ Set.fromList $

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

332−

333329 Type.RRecord fields ext ->

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

335331

src/Reporting/Render/Type.hs+2−16

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

1212import qualified Data.Map as Map

1313import qualified Data.Set as Set

1414import Text.PrettyPrint.ANSI.Leijen

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

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

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

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

1717 )

1818

1919import qualified AST.Helpers as Help

@@ -98,16 +98,6 @@ varToDoc localizer var =

9898 text (maybe name id (Map.lookup name localizer))

9999

100100

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

109−

110−

111101

112102-- DIFF BUILDER

113103

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

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

414404 (fmap text ext)

415405

416− Type.Effects names ->

417− brackets $ cat $ punctuate comma $

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

419−

420406 Type.Aliased name args _ ->

421407 docApp localizer context name (map snd args)

422408

src/Type/Environment.hs−3

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

237237 go extType

238238

239239 return $ TermN (Record1 tfields text)

240−

241− T.Effects names ->

242− return $ TermN (Effects1 names)

src/Type/Solve.hs−6

@@ -143,9 +143,6 @@ 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−

149146

150147

151148-- SOLVER

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

345342

346343 Record1 fields ext ->

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

348−

349− Effects1 _ ->

350− return False

src/Type/State.hs−4

@@ -325,7 +325,3 @@ 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−8

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

4646 | Fun1 a a

4747 | EmptyRecord1

4848 | Record1 (Map.Map String a) a

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

5049

5150

5251data TermN a

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

342341 _ ->

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

344343

345− Effects1 names ->

346− return $ T.Effects names

347−

348344

349345

350346-- MANAGE FRESH VARIABLE NAMES

@@ -460,7 +456,3 @@ getVarNamesTerm term =

460456 Record1 fields extension ->

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

462458 Set.union fieldVars <$> go extension

463−

464− Effects1 _ ->

465− return Set.empty

466−

src/Type/Unify.hs−4

@@ -4,7 +4,6 @@ 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

87import qualified Data.UnionFind.IO as UF

109import qualified AST.Variable as Var

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

565564 subUnify context result otherResult

566565 merge context otherContent

567566

568− (Effects1 names, Effects1 otherNames) ->

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

570−

571567 (EmptyRecord1, EmptyRecord1) ->

572568 merge context otherContent

573569

src/Validate.hs−4

@@ -578,7 +578,3 @@ freeVars (A.A region tipe) =

578578 Type.RRecord fields ext ->

579579 maybe [] freeVars ext

580580 ++ concatMap (freeVars . snd) fields

581−

582− Type.REffects _ ->

583− []

584−