3d94566 · elk · git.iko.soy

src/AST/Type.hs+3−16

compare with master

unifiedsplit

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

10import Control.Arrow (second)

11import Data.Binary

12import qualified Data.Map as Map

13−import qualified Data.Set as Set

14

13

15import qualified AST.Module.Name as ModuleName

14import qualified AST.Module.Name as ModuleName

16import qualified AST.Variable as Var

15import qualified AST.Variable as Var

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

32 | RType Var.Raw

31 | RType Var.Raw

33 | RApp Raw [Raw]

32 | RApp Raw [Raw]

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

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

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

36

34

37

35

38data Canonical

36data Canonical

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

41 | Type Var.Canonical

39 | Type Var.Canonical

42 | App Canonical [Canonical]

40 | App Canonical [Canonical]

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

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

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

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

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

46 deriving (Eq, Ord)

43 deriving (Eq, Ord)

47

44

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

79effect effectName moduleName tipe =

76effect effectName moduleName tipe =

80 Lambda

77 Lambda

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

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

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

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

83

80

84

81

85

82

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

107 App f args ->

104 App f args ->

108 App (deepDealias f) (map deepDealias args)

105 App (deepDealias f) (map deepDealias args)

109

106

110− Effects _ ->

111− tipe

112−

113

107

114iteratedDealias :: Canonical -> Canonical

108iteratedDealias :: Canonical -> Canonical

115iteratedDealias tipe =

109iteratedDealias tipe =

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

156 App f args ->

150 App f args ->

157 App (go f) (map go args)

151 App (go f) (map go args)

158

152

159− Effects _ ->

160− tipe

161−

162

153

163

154

164-- COLLECT LAMBDAS

155-- COLLECT LAMBDAS

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

196 Record fs ext ->

187 Record fs ext ->

197 putWord8 4 >> put fs >> put ext

188 putWord8 4 >> put fs >> put ext

198

189

199− Effects names ->

200− putWord8 5 >> put names

201−

202 Aliased var args t ->

190 Aliased var args t ->

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

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

204

192

205 get =

193 get =

206 do n <- getWord8

194 do n <- getWord8

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

210 2 -> Type <$> get

198 2 -> Type <$> get

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

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

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

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

213− 5 -> Effects <$> get

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

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

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

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

216

203

217

204

src/Canonicalize/Setup.hs−3

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

264 Type.RRecord fs ext ->

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

266

267− Type.REffects _ ->

268− []

269−

270

267

271addTypeAliases

268addTypeAliases

272 :: ModuleName.Canonical

269 :: ModuleName.Canonical

src/Canonicalize/Type.hs−23

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

1{-# OPTIONS_GHC -Wall #-}

2module Canonicalize.Type (tipe) where

3

4−import qualified Data.Set as Set

5import qualified Data.Traversable as Trav

4import qualified Data.Traversable as Trav

6

5

7−import qualified AST.Module.Name as ModuleName

8import qualified AST.Type as T

6import qualified AST.Type as T

9import qualified AST.Variable as Var

7import qualified AST.Variable as Var

10

8

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

44 T.RRecord fields ext ->

42 T.RRecord fields ext ->

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

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

46

44

47− T.REffects rawNames ->

48− T.Effects <$> canonicalizeEffects env rawNames

49−

50

45

51canonicalizeApp

46canonicalizeApp

52 :: Env.Environment

47 :: Env.Environment

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

98 else

93 else

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

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

100

95

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

195 Type.RRecord fields ext ->

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

197

198− Type.REffects _ ->

199− error "TODO - fromRawType REffects"

200−

src/Elm/Compiler/Type/Extract.hs−3

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

43

44 else

45 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 =

50 (,) lbl <$> expr

51

52

53−effects :: IParser Type.Raw

54−effects =

55− addLocation $ braces $

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

57− return (Type.REffects names)

58−

59−

60capTypeVar :: IParser String

53capTypeVar :: IParser String

61capTypeVar =

54capTypeVar =

62 intercalate "." <$> dotSep1 capVar

55 intercalate "." <$> dotSep1 capVar

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

71

64

72term :: IParser Type.Raw

65term :: IParser Type.Raw

73term =

66term =

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

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

75

68

76

69

77app :: IParser Type.Raw

70app :: IParser Type.Raw

src/Reporting/Error/Canonicalize.hs−4

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

326 Type.RApp func args ->

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

328

329− Type.REffects names ->

330− Type.Effects $ Set.fromList $

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

332−

333 Type.RRecord fields ext ->

329 Type.RRecord fields ext ->

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

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

335

331

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

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

12import qualified Data.Map as Map

13import qualified Data.Set as Set

14import Text.PrettyPrint.ANSI.Leijen

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

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

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

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

17 )

18

19import qualified AST.Helpers as Help

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

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

109−

110−

111

101

112-- DIFF BUILDER

102-- DIFF BUILDER

113

103

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

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

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

414 (fmap text ext)

404 (fmap text ext)

415

405

416− Type.Effects names ->

417− brackets $ cat $ punctuate comma $

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

419−

420 Type.Aliased name args _ ->

406 Type.Aliased name args _ ->

421 docApp localizer context name (map snd args)

407 docApp localizer context name (map snd args)

422

408

src/Type/Environment.hs−3

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

237 go extType

238

239 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 =

143 Structure (Record1 fields extension) ->

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

145

146− Structure (Effects1 _) ->

147− return outermostRank

148−

149

146

150

147

151-- SOLVER

148-- SOLVER

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

345

342

346 Record1 fields ext ->

343 Record1 fields ext ->

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

344 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 =

325

326 Record1 fields ext ->

327 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

46 | Fun1 a a

47 | EmptyRecord1

48 | Record1 (Map.Map String a) a

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

50

49

51

50

52data TermN a

51data TermN a

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

342 _ ->

341 _ ->

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

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

344

343

345− Effects1 names ->

346− return $ T.Effects names

347−

348

344

349

345

350-- MANAGE FRESH VARIABLE NAMES

346-- MANAGE FRESH VARIABLE NAMES

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

460 Record1 fields extension ->

456 Record1 fields extension ->

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

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

462 Set.union fieldVars <$> go extension

458 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

4import Control.Monad (zipWithM_)

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

6import qualified Data.Map as Map

7−import qualified Data.Set as Set

8import qualified Data.UnionFind.IO as UF

7import qualified Data.UnionFind.IO as UF

9

8

10import qualified AST.Variable as Var

9import qualified AST.Variable as Var

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

565 subUnify context result otherResult

564 subUnify context result otherResult

566 merge context otherContent

565 merge context otherContent

567

566

568− (Effects1 names, Effects1 otherNames) ->

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

570−

571 (EmptyRecord1, EmptyRecord1) ->

567 (EmptyRecord1, EmptyRecord1) ->

572 merge context otherContent

568 merge context otherContent

573

569

src/Validate.hs−4

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

578 Type.RRecord fields ext ->

579 maybe [] freeVars ext

580 ++ concatMap (freeVars . snd) fields

581−

582− Type.REffects _ ->

583− []

584−