8867611 · elk · git.iko.soy

src/Canonicalize/Effects.hs+14−14

compare with master

unifiedsplit

@@ -11,10 +11,10 @@ import qualified Data.Map as Map

11import qualified Data.Set as Set

12import Data.Text (Text)

13

14−import qualified AST.Expression.Canonical as Can

14+import qualified AST.Canonical as Can

15−import qualified AST.Expression.Valid as Valid

15+import qualified AST.Valid as Valid

16import qualified AST.Module.Name as ModuleName

17−import qualified AST.Type as Type

17+import qualified AST.Utils.Type as Type

18import qualified Canonicalize.Environment as Env

19import qualified Canonicalize.Type as Type

20import qualified Elm.Name as N

@@ -80,7 +80,7 @@ canonicalizePort :: Env.Env -> Valid.Port -> Result (N.Name, Can.Port)

80canonicalizePort env (Valid.Port (A.A region portName) tipe) =

81 do ctipe <- Type.canonicalize env tipe

82 case Type.deepDealias ctipe of

83− Type.Lambda outgoingType (Type.Type home name [Type.Var _])

83+ Can.TLambda outgoingType (Can.TType home name [Can.TVar _])

84 | home == ModuleName.cmd && name == "Cmd" ->

85 case checkPayload outgoingType of

86 Left (badType, err) ->

@@ -89,7 +89,7 @@ canonicalizePort env (Valid.Port (A.A region portName) tipe) =

89 Right () ->

90 Result.ok (portName, Can.Outgoing ctipe)

91

92− Type.Lambda (Type.Lambda incomingType (Type.Var msg1)) (Type.Type home name [Type.Var msg2])

92+ Can.TLambda (Can.TLambda incomingType (Can.TVar msg1)) (Can.TType home name [Can.TVar msg2])

93 | home == ModuleName.sub && name == "Sub" && msg1 == msg2 ->

94 case checkPayload incomingType of

95 Left (badType, err) ->

@@ -133,13 +133,13 @@ verifyManager tagRegion decls name =

133-- CHECK PAYLOAD TYPES

134

135

136−checkPayload :: Type.Canonical -> Either (Type.Canonical, Error.InvalidPayload) ()

136+checkPayload :: Can.Type -> Either (Can.Type, Error.InvalidPayload) ()

137checkPayload tipe =

138 case tipe of

139− Type.Aliased _ _ args aliasedType ->

139+ Can.TAlias _ _ args aliasedType ->

140 checkPayload (Type.dealias args aliasedType)

141

142− Type.Type home name args ->

142+ Can.TType home name args ->

143 case args of

144 []

145 | isPrim home name -> Right ()

@@ -153,10 +153,10 @@ checkPayload tipe =

153 _ ->

154 Left (tipe, Error.UnsupportedType name)

155

156− Type.Unit ->

156+ Can.TUnit ->

157 Right ()

158

159− Type.Tuple a b maybeC ->

159+ Can.TTuple a b maybeC ->

160 do checkPayload a

161 checkPayload b

162 case maybeC of

@@ -166,16 +166,16 @@ checkPayload tipe =

166 Just c ->

167 checkPayload c

168

169− Type.Var name ->

169+ Can.TVar name ->

170 Left (tipe, Error.TypeVariable name)

171

172− Type.Lambda _ _ ->

172+ Can.TLambda _ _ ->

173 Left (tipe, Error.Function)

174

175− Type.Record _ (Just _) ->

175+ Can.TRecord _ (Just _) ->

176 Left (tipe, Error.ExtendedRecord)

177

178− Type.Record fields Nothing ->

178+ Can.TRecord fields Nothing ->

179 F.traverse_ checkPayload fields

180

181

src/Canonicalize/Environment/Foreign.hs+2−2

@@ -9,8 +9,8 @@ module Canonicalize.Environment.Foreign

9import qualified Data.Map.Strict as Map

10import qualified Data.Set as Set

11

12−import qualified AST.Expression.Canonical as Can

12+import qualified AST.Canonical as Can

13−import qualified AST.Expression.Source as Src

13+import qualified AST.Source as Src

14import qualified AST.Module.Name as ModuleName

15import qualified Canonicalize.Environment.Internals as Env

16import qualified Data.Bag as Bag

src/Canonicalize/Environment/Internals.hs+4−5

@@ -22,10 +22,9 @@ import qualified Data.Map.Strict as Map

22import qualified Data.Map.Merge.Strict as Map

23import qualified Data.Set as Set

24

25−import qualified AST.Binop as Binop

25+import qualified AST.Utils.Binop as Binop

26−import qualified AST.Expression.Canonical as Can

26+import qualified AST.Canonical as Can

27import qualified AST.Module.Name as ModuleName

28−import qualified AST.Type as Type

29import qualified Data.Bag as Bag

28import qualified Data.Bag as Bag

30import qualified Data.OneOrMore as OneOrMore

29import qualified Data.OneOrMore as OneOrMore

31import qualified Elm.Name as N

30import qualified Elm.Name as N

@@ -79,7 +78,7 @@ data UnqualifiedVarHome

79

78

80

79

81data Type

80data Type

82− = Alias Int ModuleName.Canonical [N.Name] Type.Canonical

81+ = Alias Int ModuleName.Canonical [N.Name] Can.Type

83 | Union Int ModuleName.Canonical

82 | Union Int ModuleName.Canonical

84

83

85

84

@@ -88,7 +87,7 @@ data Pattern =

88 { _p_home :: ModuleName.Canonical

87 { _p_home :: ModuleName.Canonical

89 , _p_type :: N.Name

88 , _p_type :: N.Name

90 , _p_vars :: [N.Name]

89 , _p_vars :: [N.Name]

91− , _p_args :: [Type.Canonical]

90+ , _p_args :: [Can.Type]

92 }

91 }

93

92

94

93

src/Canonicalize/Environment/Local.hs+20−20

@@ -13,9 +13,9 @@ import qualified Data.Graph as Graph

13import qualified Data.Map.Strict as Map

14import qualified Data.Map.Merge.Strict as Map

15

16−import qualified AST.Expression.Canonical as Can

16+import qualified AST.Canonical as Can

17−import qualified AST.Expression.Valid as Valid

17+import qualified AST.Source as Src

18−import qualified AST.Type as Type

18+import qualified AST.Valid as Valid

19import qualified Canonicalize.Environment.Dups as Dups

20import qualified Canonicalize.Environment.Internals as Env

21import qualified Canonicalize.Type as Type

@@ -180,7 +180,7 @@ collectUpperVars (Valid.Module _ _ _ _ _ _ unions aliases _ _) =

180

181 aliasToInfos (Valid.Alias (A.A region name) _ (A.A _ tipe)) =

182 case tipe of

183− Type.RRecord _ Nothing ->

183+ Src.TRecord _ Nothing ->

184 [ Dups.info name region Error.RecordCtor () ]

185

186 _ ->

@@ -242,7 +242,7 @@ data Alias =

242 { _region :: R.Region

243 , _name :: N.Name

244 , _args :: [N.Name]

245− , _type :: Type.Raw

245+ , _type :: Src.Type

246 }

247

248

@@ -290,30 +290,30 @@ toNode alias@(Alias _ name _ tipe) =

290 ( alias, name, Bag.toList (getEdges tipe) )

291

292

293−getEdges :: Type.Raw -> Bag.Bag N.Name

293+getEdges :: Src.Type -> Bag.Bag N.Name

294getEdges (A.A _ tipe) =

295 case tipe of

296− Type.RLambda arg result ->

296+ Src.TLambda arg result ->

297 Bag.append (getEdges arg) (getEdges result)

298

299− Type.RVar _ ->

299+ Src.TVar _ ->

300 Bag.empty

301

302− Type.RType _ Nothing name args ->

302+ Src.TType _ Nothing name args ->

303 foldr Bag.append (Bag.one name) (map getEdges args)

304

305− Type.RType _ (Just _) _ args ->

305+ Src.TType _ (Just _) _ args ->

306 foldr Bag.append Bag.empty (map getEdges args)

307

308− Type.RRecord fields ext ->

308+ Src.TRecord fields ext ->

309 foldr Bag.append

310 (maybe Bag.empty getEdges ext)

311 (map (getEdges . snd) fields)

312

313− Type.RUnit ->

313+ Src.TUnit ->

314 Bag.empty

315

316− Type.RTuple a b cs ->

316+ Src.TTuple a b cs ->

317 foldr Bag.append

318 (getEdges a)

319 (getEdges b : map getEdges cs)

@@ -371,23 +371,23 @@ checkAliasFreeVars (Valid.Alias (A.A aliasRegion name) args tipe) =

371 (map toLoc (Map.toList (Map.difference freeVars boundVars)))

372

373

374−addFreeVars :: Type.Raw -> Map.Map N.Name R.Region -> Map.Map N.Name R.Region

374+addFreeVars :: Src.Type -> Map.Map N.Name R.Region -> Map.Map N.Name R.Region

375addFreeVars (A.A region tipe) freeVars =

376 case tipe of

377− Type.RLambda arg result ->

377+ Src.TLambda arg result ->

378 addFreeVars arg (addFreeVars result freeVars)

379

380− Type.RVar name ->

380+ Src.TVar name ->

381 Map.insert name region freeVars

382

383− Type.RType _ _ _ args ->

383+ Src.TType _ _ _ args ->

384 foldr addFreeVars freeVars args

385

386− Type.RRecord fields ext ->

386+ Src.TRecord fields ext ->

387 foldr addFreeVars (maybe id addFreeVars ext freeVars) (map snd fields)

388

389− Type.RUnit ->

389+ Src.TUnit ->

390 freeVars

391

392− Type.RTuple a b cs ->

392+ Src.TTuple a b cs ->

393 foldr addFreeVars freeVars (a:b:cs)

src/Canonicalize/Expression.hs+4−4

@@ -10,10 +10,10 @@ import qualified Data.Graph as Graph

10import qualified Data.Map.Strict as Map

11import qualified Data.Set as Set

12

13−import qualified AST.Binop as Binop

13+import qualified AST.Utils.Binop as Binop

14−import qualified AST.Expression.Canonical as Can

14+import qualified AST.Canonical as Can

15−import qualified AST.Expression.Source as Src

15+import qualified AST.Source as Src

16−import qualified AST.Expression.Valid as Valid

16+import qualified AST.Valid as Valid

17import qualified Canonicalize.Environment as Env

18import qualified Canonicalize.Environment.Dups as Dups

19import qualified Canonicalize.Pattern as Pattern

src/Canonicalize/Module.hs+7−8

@@ -9,11 +9,10 @@ import qualified Data.Graph as Graph

9import qualified Data.Map as Map

10import qualified Data.Set as Set

11

12−import qualified AST.Expression.Canonical as Can

12+import qualified AST.Canonical as Can

13−import qualified AST.Expression.Source as Src

13+import qualified AST.Source as Src

14−import qualified AST.Expression.Valid as Valid

14+import qualified AST.Valid as Valid

15import qualified AST.Module.Name as ModuleName

16−import qualified AST.Type as Type

17import qualified Canonicalize.Effects as Effects

16import qualified Canonicalize.Effects as Effects

18import qualified Canonicalize.Environment as Env

17import qualified Canonicalize.Environment as Env

19import qualified Canonicalize.Environment.Dups as Dups

18import qualified Canonicalize.Environment.Dups as Dups

@@ -99,10 +98,10 @@ canonicalizeAlias env (Valid.Alias (A.A _ name) args tipe) =

99 return (name, Can.Alias (map A.drop args) ctipe (toRecordCtorInfo tipe))

98 return (name, Can.Alias (map A.drop args) ctipe (toRecordCtorInfo tipe))

100

99

101

100

102−toRecordCtorInfo :: Type.Raw -> Maybe [N.Name]

101+toRecordCtorInfo :: Src.Type -> Maybe [N.Name]

103toRecordCtorInfo (A.A _ tipe) =

102toRecordCtorInfo (A.A _ tipe) =

104 case tipe of

103 case tipe of

105− Type.RRecord fields Nothing ->

104+ Src.TRecord fields Nothing ->

106 Just (map (A.drop . fst) fields)

105 Just (map (A.drop . fst) fields)

107

106

108 _ ->

107 _ ->

@@ -183,8 +182,8 @@ toNode env (A.A region (Valid.Decl name@(A.A _ key) args body tipe)) =

183

182

184

183

185data Decl

184data Decl

186− = Value R.Region (A.Located N.Name) Can.Expr (Maybe Type.Canonical)

185+ = Value R.Region (A.Located N.Name) Can.Expr (Maybe Can.Type)

187− | Function N.Name Can.Args Can.Expr (Maybe Type.Canonical)

186+ | Function N.Name Can.Args Can.Expr (Maybe Can.Type)

188

187

189

188

190toCanDecl :: Decl -> Can.Decl

189toCanDecl :: Decl -> Can.Decl

src/Canonicalize/Pattern.hs+4−5

@@ -11,10 +11,9 @@ module Canonicalize.Pattern

11import Control.Monad (zipWithM)

12import qualified Data.Map.Strict as Map

13

14−import qualified AST.Expression.Canonical as Can

14+import qualified AST.Canonical as Can

15−import qualified AST.Expression.Source as Src

15+import qualified AST.Source as Src

16−import qualified AST.Expression.Valid as Valid

16+import qualified AST.Valid as Valid

17−import qualified AST.Type as Type

18import qualified Canonicalize.Environment as Env

17import qualified Canonicalize.Environment as Env

19import qualified Canonicalize.Environment.Dups as Dups

18import qualified Canonicalize.Environment.Dups as Dups

20import qualified Data.Bag as Bag

19import qualified Data.Bag as Bag

@@ -79,7 +78,7 @@ canonicalizeMatch env pattern =

79

78

80

79

81data Binding

80data Binding

82− = Define R.Region Int (A.Located N.Name) [Src.Pattern] Valid.Expr (Maybe Type.Raw)

81+ = Define R.Region Int (A.Located N.Name) [Src.Pattern] Valid.Expr (Maybe Src.Type)

83 | Destruct R.Region Int Can.Match Valid.Expr

82 | Destruct R.Region Int Can.Match Valid.Expr

84

83

85

84

src/Canonicalize/Type.hs+16−15

@@ -8,7 +8,8 @@ module Canonicalize.Type

8

9import qualified Data.Map as Map

10

11−import qualified AST.Type as Type

11+import qualified AST.Canonical as Can

12+import qualified AST.Source as Src

12import qualified Canonicalize.Environment.Dups as Dups

13import qualified Canonicalize.Environment.Dups as Dups

13import qualified Canonicalize.Environment.Internals as Env

14import qualified Canonicalize.Environment.Internals as Env

14import qualified Elm.Name as N

15import qualified Elm.Name as N

@@ -31,40 +32,40 @@ type Result i a =

31-- CANONICALIZE TYPES

32-- CANONICALIZE TYPES

32

33

34

34−canonicalize :: Env.Env -> Type.Raw -> Result () Type.Canonical

35+canonicalize :: Env.Env -> Src.Type -> Result () Can.Type

35canonicalize env (A.A typeRegion tipe) =

36canonicalize env (A.A typeRegion tipe) =

36 case tipe of

37 case tipe of

37− Type.RVar x ->

38+ Src.TVar x ->

38− Result.ok (Type.Var x)

39+ Result.ok (Can.TVar x)

39

40

40− Type.RType region maybePrefix name args ->

41+ Src.TType region maybePrefix name args ->

41 do info <- Env.findType region env maybePrefix name

42 do info <- Env.findType region env maybePrefix name

42 cargs <- traverse (canonicalize env) args

43 cargs <- traverse (canonicalize env) args

43 case info of

44 case info of

44 Env.Alias arity home argNames aliasedType ->

45 Env.Alias arity home argNames aliasedType ->

45 checkArgs Error.AliasArgs arity typeRegion name args $

46 checkArgs Error.AliasArgs arity typeRegion name args $

46− Type.Aliased home name (zip argNames cargs) (Type.Holey aliasedType)

47+ Can.TAlias home name (zip argNames cargs) (Can.Holey aliasedType)

47

48

48 Env.Union arity home ->

49 Env.Union arity home ->

49 checkArgs Error.UnionArgs arity typeRegion name args $

50 checkArgs Error.UnionArgs arity typeRegion name args $

50− Type.Type home name cargs

51+ Can.TType home name cargs

51

52

52− Type.RLambda a b ->

53+ Src.TLambda a b ->

53− Type.Lambda

54+ Can.TLambda

54 <$> canonicalize env a

55 <$> canonicalize env a

55 <*> canonicalize env b

56 <*> canonicalize env b

56

57

57− Type.RRecord fields ext ->

58+ Src.TRecord fields ext ->

58 do fieldDict <- Dups.checkFields fields

59 do fieldDict <- Dups.checkFields fields

59− Type.Record

60+ Can.TRecord

60 <$> Map.traverseWithKey (\_ t -> canonicalize env t) fieldDict

61 <$> Map.traverseWithKey (\_ t -> canonicalize env t) fieldDict

61 <*> traverse (canonicalize env) ext

62 <*> traverse (canonicalize env) ext

62

63

63− Type.RUnit ->

64+ Src.TUnit ->

64− Result.ok Type.Unit

65+ Result.ok Can.TUnit

65

66

66− Type.RTuple a b cs ->

67+ Src.TTuple a b cs ->

67− Type.Tuple

68+ Can.TTuple

68 <$> canonicalize env a

69 <$> canonicalize env a

69 <*> canonicalize env b

70 <*> canonicalize env b

70 <*>

71 <*>