1ae4e82 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Update Canonical/* for collapse of AST.Valid and Reporting.Region

1ae4e82Evan Czaplicki8 years ago

compiler/src/Canonicalize/Effects.hs+18−19

compare with master

unifiedsplit

@@ -11,14 +11,13 @@ import qualified Data.Map as Map

11import qualified Data.Name as Name

13import qualified AST.Canonical as Can

14−import qualified AST.Valid as Valid

14+import qualified AST.Source as Src

15import qualified AST.Utils.Type as Type

16import qualified Canonicalize.Environment as Env

17import qualified Canonicalize.Type as Type

18import qualified Elm.ModuleName as ModuleName

19import qualified Reporting.Annotation as A

20import qualified Reporting.Error.Canonicalize as Error

21−import qualified Reporting.Region as R

22import qualified Reporting.Result as Result

21import qualified Reporting.Result as Result

@@ -36,38 +35,38 @@ type Result i w a =

37canonicalize

36canonicalize

38 :: Env.Env

37 :: Env.Env

39− -> [A.Located Valid.Decl]

38+ -> [A.Located Src.Value]

40 -> Map.Map Name.Name union

39 -> Map.Map Name.Name union

41− -> Valid.Effects

40+ -> Src.Effects

42 -> Result i w Can.Effects

41 -> Result i w Can.Effects

43−canonicalize env decls unions effects =

42+canonicalize env values unions effects =

44 case effects of

43 case effects of

45− Valid.NoEffects ->

44+ Src.NoEffects ->

46 Result.ok Can.NoEffects

45 Result.ok Can.NoEffects

48− Valid.Ports ports ->

47+ Src.Ports ports ->

49 do pairs <- traverse (canonicalizePort env) ports

48 do pairs <- traverse (canonicalizePort env) ports

50 return $ Can.Ports (Map.fromList pairs)

49 return $ Can.Ports (Map.fromList pairs)

52− Valid.Manager region manager ->

51+ Src.Manager region manager ->

53− let dict = Map.fromList (map toNameRegion decls) in

52+ let dict = Map.fromList (map toNameRegion values) in

54 Can.Manager

53 Can.Manager

55 <$> verifyManager region dict "init"

54 <$> verifyManager region dict "init"

56 <*> verifyManager region dict "onEffects"

55 <*> verifyManager region dict "onEffects"

57 <*> verifyManager region dict "onSelfMsg"

56 <*> verifyManager region dict "onSelfMsg"

58 <*>

57 <*>

59 case manager of

58 case manager of

60− Valid.Cmd cmdType ->

59+ Src.Cmd cmdType ->

61 Can.Cmd

60 Can.Cmd

62 <$> verifyEffectType cmdType unions

61 <$> verifyEffectType cmdType unions

63 <* verifyManager region dict "cmdMap"

62 <* verifyManager region dict "cmdMap"

65− Valid.Sub subType ->

64+ Src.Sub subType ->

66 Can.Sub

65 Can.Sub

67 <$> verifyEffectType subType unions

66 <$> verifyEffectType subType unions

68 <* verifyManager region dict "subMap"

67 <* verifyManager region dict "subMap"

70− Valid.Fx cmdType subType ->

69+ Src.Fx cmdType subType ->

71 Can.Fx

70 Can.Fx

72 <$> verifyEffectType cmdType unions

71 <$> verifyEffectType cmdType unions

73 <*> verifyEffectType subType unions

72 <*> verifyEffectType subType unions

@@ -79,8 +78,8 @@ canonicalize env decls unions effects =

79-- CANONICALIZE PORT

78-- CANONICALIZE PORT

82−canonicalizePort :: Env.Env -> Valid.Port -> Result i w (Name.Name, Can.Port)

81+canonicalizePort :: Env.Env -> Src.Port -> Result i w (Name.Name, Can.Port)

83−canonicalizePort env (Valid.Port (A.At region portName) tipe) =

82+canonicalizePort env (Src.Port (A.At region portName) tipe) =

84 do (Can.Forall freeVars ctipe) <- Type.toAnnotation env tipe

83 do (Can.Forall freeVars ctipe) <- Type.toAnnotation env tipe

85 case reverse (Type.delambda (Type.deepDealias ctipe)) of

84 case reverse (Type.delambda (Type.deepDealias ctipe)) of

86 Can.TType home name [msg] : revArgs

85 Can.TType home name [msg] : revArgs

@@ -139,14 +138,14 @@ verifyEffectType (A.At region name) unions =

139 Result.throw (Error.EffectNotFound region name)

138 Result.throw (Error.EffectNotFound region name)

140

139

141

140

142−toNameRegion :: A.Located Valid.Decl -> (Name.Name, R.Region)

141+toNameRegion :: A.Located Src.Value -> (Name.Name, A.Region)

143−toNameRegion (A.At _ (Valid.Decl (A.At region name) _ _ _)) =

142+toNameRegion (A.At _ (Src.Value (A.At region name) _ _ _)) =

144 (name, region)

143 (name, region)

145

144

146

145

147−verifyManager :: R.Region -> Map.Map Name.Name R.Region -> Name.Name -> Result i w R.Region

146+verifyManager :: A.Region -> Map.Map Name.Name A.Region -> Name.Name -> Result i w A.Region

148−verifyManager tagRegion decls name =

147+verifyManager tagRegion values name =

149− case Map.lookup name decls of

148+ case Map.lookup name values of

150 Just region ->

149 Just region ->

151 Result.ok region

150 Result.ok region

152

151

compiler/src/Canonicalize/Environment.hs+16−16

@@ -27,8 +27,8 @@ import qualified AST.Utils.Binop as Binop

27import qualified AST.Canonical as Can

28import qualified Data.Index as Index

29import qualified Elm.ModuleName as ModuleName

30+import qualified Reporting.Annotation as A

30import qualified Reporting.Error.Canonicalize as Error

31import qualified Reporting.Error.Canonicalize as Error

31−import qualified Reporting.Region as R

32import qualified Reporting.Result as Result

@@ -70,8 +70,8 @@ type Qualified a =

72data Var

73− = Local R.Region

73+ = Local A.Region

74− | TopLevel R.Region

74+ | TopLevel A.Region

75 | Foreign (Map.Map ModuleName.Canonical Can.Annotation)

@@ -118,7 +118,7 @@ data Binop =

118-- VARIABLE -- ADD LOCALS

119

120

121−addLocals :: Map.Map Name.Name R.Region -> Env -> Result i w Env

121+addLocals :: Map.Map Name.Name A.Region -> Env -> Result i w Env

122addLocals names (Env home vars ts cs bs qvs qts qcs) =

123 do newVars <-

124 Map.mergeA

@@ -131,12 +131,12 @@ addLocals names (Env home vars ts cs bs qvs qts qcs) =

131 Result.ok (Env home newVars ts cs bs qvs qts qcs)

132

133

134−addLocalLeft :: Name.Name -> R.Region -> Var

134+addLocalLeft :: Name.Name -> A.Region -> Var

135addLocalLeft _ region =

136 Local region

137

138

139−addLocalBoth :: Name.Name -> R.Region -> Var -> Result i w Var

139+addLocalBoth :: Name.Name -> A.Region -> Var -> Result i w Var

140addLocalBoth name region var =

141 case var of

142 Foreign _ ->

@@ -153,7 +153,7 @@ addLocalBoth name region var =

153-- FIND TYPE

154

155

156−findType :: R.Region -> Env -> Name.Name -> Result i w Type

156+findType :: A.Region -> Env -> Name.Name -> Result i w Type

157findType region (Env _ _ ts _ _ _ qts _) name =

158 case Map.lookup name ts of

159 Just (I.Bin 1 _ tipe _ _) ->

@@ -166,7 +166,7 @@ findType region (Env _ _ ts _ _ _ qts _) name =

166 Result.throw (Error.NotFoundType region Nothing name (toPossibleNames ts qts))

167

168

169−findTypeQual :: R.Region -> Env -> Name.Name -> Name.Name -> Result i w Type

169+findTypeQual :: A.Region -> Env -> Name.Name -> Name.Name -> Result i w Type

170findTypeQual region (Env _ _ ts _ _ _ qts _) prefix name =

171 case Map.lookup prefix qts of

172 Just qualified ->

@@ -188,20 +188,20 @@ findTypeQual region (Env _ _ ts _ _ _ qts _) prefix name =

188-- FIND CTOR

189

190

191−findCtor :: R.Region -> Env -> Name.Name -> Result i w Ctor

191+findCtor :: A.Region -> Env -> Name.Name -> Result i w Ctor

192findCtor region (Env _ _ _ cs _ _ _ qcs) name =

193 case Map.lookup name cs of

194 Just (I.Bin 1 _ ctor _ _) ->

195 Result.ok ctor

196

197 Just homes ->

198− Result.throw (Error.AmbiguousCtor region Nothing name (Map.keys homes))

198+ Result.throw (Error.AmbiguousVariant region Nothing name (Map.keys homes))

199

200 Nothing ->

201− Result.throw (Error.NotFoundCtor region Nothing name (toPossibleNames cs qcs))

201+ Result.throw (Error.NotFoundVariant region Nothing name (toPossibleNames cs qcs))

202

203

204−findCtorQual :: R.Region -> Env -> Name.Name -> Name.Name -> Result i w Ctor

204+findCtorQual :: A.Region -> Env -> Name.Name -> Name.Name -> Result i w Ctor

205findCtorQual region (Env _ _ _ cs _ _ _ qcs) prefix name =

206 case Map.lookup prefix qcs of

207 Just qualified ->

@@ -210,20 +210,20 @@ findCtorQual region (Env _ _ _ cs _ _ _ qcs) prefix name =

210 Result.ok pattern

211

212 Just homes ->

213− Result.throw (Error.AmbiguousCtor region (Just prefix) name (Map.keys homes))

213+ Result.throw (Error.AmbiguousVariant region (Just prefix) name (Map.keys homes))

214

215 Nothing ->

216− Result.throw (Error.NotFoundCtor region (Just prefix) name (toPossibleNames cs qcs))

216+ Result.throw (Error.NotFoundVariant region (Just prefix) name (toPossibleNames cs qcs))

217

218 Nothing ->

219− Result.throw (Error.NotFoundCtor region (Just prefix) name (toPossibleNames cs qcs))

219+ Result.throw (Error.NotFoundVariant region (Just prefix) name (toPossibleNames cs qcs))

220

221

222

223-- FIND BINOP

224

225

226−findBinop :: R.Region -> Env -> Name.Name -> Result i w Binop

226+findBinop :: A.Region -> Env -> Name.Name -> Result i w Binop

227findBinop region (Env _ _ _ _ binops _ _ _) name =

228 case Map.lookup name binops of

229 Just (I.Bin 1 _ binop _ _) ->

compiler/src/Canonicalize/Environment/Dups.hs+6−7

@@ -20,7 +20,6 @@ import qualified Data.Name as Name

20import qualified Data.OneOrMore as OneOrMore

21import qualified Reporting.Annotation as A

22import qualified Reporting.Error.Canonicalize as Error

23−import qualified Reporting.Region as R

24import qualified Reporting.Result as Result

23import qualified Reporting.Result as Result

@@ -34,7 +33,7 @@ type Dict value =

35data Info value =

34data Info value =

36 Info

35 Info

37− { _region :: R.Region

36+ { _region :: A.Region

38 , _value :: value

37 , _value :: value

39 }

38 }

@@ -44,7 +43,7 @@ data Info value =

46type ToError =

45type ToError =

47− Name.Name -> R.Region -> R.Region -> Error.Error

46+ Name.Name -> A.Region -> A.Region -> Error.Error

50detect :: ToError -> Dict a -> Result.Result i w Error.Error (Map.Map Name.Name a)

49detect :: ToError -> Dict a -> Result.Result i w Error.Error (Map.Map Name.Name a)

@@ -77,12 +76,12 @@ addField (A.At region name, value) dups =

77 Map.insertWith OneOrMore.more name (OneOrMore.one (Info region value)) dups

76 Map.insertWith OneOrMore.more name (OneOrMore.one (Info region value)) dups

80−checkFields' :: (R.Region -> a -> b) -> [(A.Located Name.Name, a)] -> Result.Result i w Error.Error (Map.Map Name.Name b)

79+checkFields' :: (A.Region -> a -> b) -> [(A.Located Name.Name, a)] -> Result.Result i w Error.Error (Map.Map Name.Name b)

81checkFields' toValue fields =

80checkFields' toValue fields =

82 detect Error.DuplicateField (foldr (addField' toValue) none fields)

81 detect Error.DuplicateField (foldr (addField' toValue) none fields)

85−addField' :: (R.Region -> a -> b) -> (A.Located Name.Name, a) -> Dict b -> Dict b

84+addField' :: (A.Region -> a -> b) -> (A.Located Name.Name, a) -> Dict b -> Dict b

86addField' toValue (A.At region name, value) dups =

85addField' toValue (A.At region name, value) dups =

87 Map.insertWith OneOrMore.more name (OneOrMore.one (Info region (toValue region value))) dups

86 Map.insertWith OneOrMore.more name (OneOrMore.one (Info region (toValue region value))) dups

@@ -96,12 +95,12 @@ none =

96 Map.empty

95 Map.empty

99−one :: Name.Name -> R.Region -> value -> Dict value

98+one :: Name.Name -> A.Region -> value -> Dict value

100one name region value =

99one name region value =

101 Map.singleton name (OneOrMore.one (Info region value))

100 Map.singleton name (OneOrMore.one (Info region value))

102

101

103

102

104−insert :: Name.Name -> R.Region -> a -> Dict a -> Dict a

103+insert :: Name.Name -> A.Region -> a -> Dict a -> Dict a

105insert name region value dict =

104insert name region value dict =

106 Map.insertWith OneOrMore.more name (OneOrMore.one (Info region value)) dict

105 Map.insertWith OneOrMore.more name (OneOrMore.one (Info region value)) dict

107

106

compiler/src/Canonicalize/Environment/Local.hs+38−40

@@ -14,7 +14,6 @@ import qualified Data.Name as Name

15import qualified AST.Canonical as Can

16import qualified AST.Source as Src

17−import qualified AST.Valid as Valid

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 Canonicalize.Type as Type

19import qualified Canonicalize.Type as Type

@@ -22,7 +21,6 @@ import qualified Data.Index as Index

22import qualified Elm.ModuleName as ModuleName

21import qualified Elm.ModuleName as ModuleName

23import qualified Reporting.Annotation as A

22import qualified Reporting.Annotation as A

24import qualified Reporting.Error.Canonicalize as Error

23import qualified Reporting.Error.Canonicalize as Error

25−import qualified Reporting.Region as R

26import qualified Reporting.Result as Result

24import qualified Reporting.Result as Result

@@ -38,7 +36,7 @@ type Unions = Map.Map Name.Name Can.Union

38type Aliases = Map.Map Name.Name Can.Alias

36type Aliases = Map.Map Name.Name Can.Alias

41−add :: Valid.Module -> Env.Env -> Result i w (Env.Env, Unions, Aliases)

39+add :: Src.Module -> Env.Env -> Result i w (Env.Env, Unions, Aliases)

42add module_ env =

40add module_ env =

43 addCtors module_ =<< addVars module_ =<< addTypes module_ env

41 addCtors module_ =<< addVars module_ =<< addTypes module_ env

@@ -47,7 +45,7 @@ add module_ env =

47-- ADD VARS

45-- ADD VARS

50−addVars :: Valid.Module -> Env.Env -> Result i w Env.Env

48+addVars :: Src.Module -> Env.Env -> Result i w Env.Env

51addVars module_ (Env.Env home vs ts cs bs qvs qts qcs) =

49addVars module_ (Env.Env home vs ts cs bs qvs qts qcs) =

52 do topLevelVars <- collectVars module_

50 do topLevelVars <- collectVars module_

53 let vs2 = Map.union topLevelVars vs

51 let vs2 = Map.union topLevelVars vs

@@ -55,38 +53,38 @@ addVars module_ (Env.Env home vs ts cs bs qvs qts qcs) =

55 Result.ok $ Env.Env home vs2 ts cs bs qvs qts qcs

53 Result.ok $ Env.Env home vs2 ts cs bs qvs qts qcs

58−collectVars :: Valid.Module -> Result i w (Map.Map Name.Name Env.Var)

56+collectVars :: Src.Module -> Result i w (Map.Map Name.Name Env.Var)

59−collectVars (Valid.Module _ _ _ _ _ decls _ _ _ effects) =

57+collectVars (Src.Module _ _ _ values _ _ _ effects) =

60 let

58 let

61− addDecl dict (A.At _ (Valid.Decl (A.At region name) _ _ _)) =

59+ addDecl dict (A.At _ (Src.Value (A.At region name) _ _ _)) =

62 Dups.insert name region (Env.TopLevel region) dict

60 Dups.insert name region (Env.TopLevel region) dict

63 in

61 in

64 Dups.detect Error.DuplicateDecl $

62 Dups.detect Error.DuplicateDecl $

65− List.foldl' addDecl (toEffectDups effects) decls

63+ List.foldl' addDecl (toEffectDups effects) values

68−toEffectDups :: Valid.Effects -> Dups.Dict Env.Var

66+toEffectDups :: Src.Effects -> Dups.Dict Env.Var

69toEffectDups effects =

67toEffectDups effects =

70 case effects of

68 case effects of

71− Valid.NoEffects ->

69+ Src.NoEffects ->

72 Dups.none

70 Dups.none

74− Valid.Ports ports ->

72+ Src.Ports ports ->

75 let

73 let

76− addPort dict (Valid.Port (A.At region name) _) =

74+ addPort dict (Src.Port (A.At region name) _) =

77 Dups.insert name region (Env.TopLevel region) dict

75 Dups.insert name region (Env.TopLevel region) dict

78 in

76 in

79 List.foldl' addPort Dups.none ports

77 List.foldl' addPort Dups.none ports

81− Valid.Manager _ manager ->

79+ Src.Manager _ manager ->

82 case manager of

80 case manager of

83− Valid.Cmd (A.At region _) ->

81+ Src.Cmd (A.At region _) ->

84 Dups.one "command" region (Env.TopLevel region)

82 Dups.one "command" region (Env.TopLevel region)

86− Valid.Sub (A.At region _) ->

84+ Src.Sub (A.At region _) ->

87 Dups.one "subscription" region (Env.TopLevel region)

85 Dups.one "subscription" region (Env.TopLevel region)

89− Valid.Fx (A.At regionCmd _) (A.At regionSub _) ->

87+ Src.Fx (A.At regionCmd _) (A.At regionSub _) ->

90 Dups.union

88 Dups.union

91 (Dups.one "command" regionCmd (Env.TopLevel regionCmd))

89 (Dups.one "command" regionCmd (Env.TopLevel regionCmd))

92 (Dups.one "subscription" regionSub (Env.TopLevel regionSub))

90 (Dups.one "subscription" regionSub (Env.TopLevel regionSub))

@@ -96,11 +94,11 @@ toEffectDups effects =

96-- ADD TYPES

94-- ADD TYPES

99−addTypes :: Valid.Module -> Env.Env -> Result i w Env.Env

97+addTypes :: Src.Module -> Env.Env -> Result i w Env.Env

100−addTypes (Valid.Module _ _ _ _ _ _ unions aliases _ _) (Env.Env home vs ts cs bs qvs qts qcs) =

98+addTypes (Src.Module _ _ _ _ unions aliases _ _) (Env.Env home vs ts cs bs qvs qts qcs) =

101 let

99 let

102− addAliasDups dups (Valid.Alias _ (A.At region name) _ _) = Dups.insert name region () dups

100+ addAliasDups dups (A.At _ (Src.Alias (A.At region name) _ _)) = Dups.insert name region () dups

103− addUnionDups dups (Valid.Union _ (A.At region name) _ _) = Dups.insert name region () dups

101+ addUnionDups dups (A.At _ (Src.Union (A.At region name) _ _)) = Dups.insert name region () dups

104 typeNameDups =

102 typeNameDups =

105 List.foldl' addUnionDups (List.foldl' addAliasDups Dups.none aliases) unions

103 List.foldl' addUnionDups (List.foldl' addAliasDups Dups.none aliases) unions

106 in

104 in

@@ -109,8 +107,8 @@ addTypes (Valid.Module _ _ _ _ _ _ unions aliases _ _) (Env.Env home vs ts cs bs

109 addAliases aliases (Env.Env home vs ts1 cs bs qvs qts qcs)

107 addAliases aliases (Env.Env home vs ts1 cs bs qvs qts qcs)

110

108

111

109

112−addUnion :: ModuleName.Canonical -> Env.Exposed Env.Type -> Valid.Union -> Result i w (Env.Exposed Env.Type)

110+addUnion :: ModuleName.Canonical -> Env.Exposed Env.Type -> A.Located Src.Union -> Result i w (Env.Exposed Env.Type)

113−addUnion home types union@(Valid.Union _ (A.At _ name) _ _) =

111+addUnion home types union@(A.At _ (Src.Union (A.At _ name) _ _)) =

114 do arity <- checkUnionFreeVars union

112 do arity <- checkUnionFreeVars union

115 let one = Map.singleton home (Env.Union arity home)

113 let one = Map.singleton home (Env.Union arity home)

116 Result.ok $ Map.insert name one types

114 Result.ok $ Map.insert name one types

@@ -120,7 +118,7 @@ addUnion home types union@(Valid.Union _ (A.At _ name) _ _) =

120-- ADD TYPE ALIASES

118-- ADD TYPE ALIASES

121

119

122

120

123−addAliases :: [Valid.Alias] -> Env.Env -> Result i w Env.Env

121+addAliases :: [A.Located Src.Alias] -> Env.Env -> Result i w Env.Env

124addAliases aliases env =

122addAliases aliases env =

125 let

123 let

126 nodes = map toNode aliases

124 nodes = map toNode aliases

@@ -129,10 +127,10 @@ addAliases aliases env =

129 foldM addAlias env sccs

127 foldM addAlias env sccs

130

128

131

129

132−addAlias :: Env.Env -> Graph.SCC Valid.Alias -> Result i w Env.Env

130+addAlias :: Env.Env -> Graph.SCC (A.Located Src.Alias) -> Result i w Env.Env

133addAlias env@(Env.Env home vs ts cs bs qvs qts qcs) scc =

131addAlias env@(Env.Env home vs ts cs bs qvs qts qcs) scc =

134 case scc of

132 case scc of

135− Graph.AcyclicSCC alias@(Valid.Alias _ (A.At _ name) _ tipe) ->

133+ Graph.AcyclicSCC alias@(A.At _ (Src.Alias (A.At _ name) _ tipe)) ->

136 do args <- checkAliasFreeVars alias

134 do args <- checkAliasFreeVars alias

137 ctype <- Type.canonicalize env tipe

135 ctype <- Type.canonicalize env tipe

138 let one = Map.singleton home (Env.Alias (length args) home args ctype)

136 let one = Map.singleton home (Env.Alias (length args) home args ctype)

@@ -142,9 +140,9 @@ addAlias env@(Env.Env home vs ts cs bs qvs qts qcs) scc =

142 Graph.CyclicSCC [] ->

140 Graph.CyclicSCC [] ->

143 Result.ok env

141 Result.ok env

144

142

145− Graph.CyclicSCC (alias@(Valid.Alias _ (A.At region name1) _ tipe) : others) ->

143+ Graph.CyclicSCC (alias@(A.At _ (Src.Alias (A.At region name1) _ tipe)) : others) ->

146 do args <- checkAliasFreeVars alias

144 do args <- checkAliasFreeVars alias

147− let toName (Valid.Alias _ (A.At _ name) _ _) = name

145+ let toName (A.At _ (Src.Alias (A.At _ name) _ _)) = name

148 Result.throw (Error.RecursiveAlias region name1 args tipe (map toName others))

146 Result.throw (Error.RecursiveAlias region name1 args tipe (map toName others))

149

147

150

148

@@ -152,8 +150,8 @@ addAlias env@(Env.Env home vs ts cs bs qvs qts qcs) scc =

152-- DETECT TYPE ALIAS CYCLES

150-- DETECT TYPE ALIAS CYCLES

153

151

154

152

155−toNode :: Valid.Alias -> (Valid.Alias, Name.Name, [Name.Name])

153+toNode :: A.Located Src.Alias -> (A.Located Src.Alias, Name.Name, [Name.Name])

156−toNode alias@(Valid.Alias _ (A.At _ name) _ tipe) =

154+toNode alias@(A.At _ (Src.Alias (A.At _ name) _ tipe)) =

157 ( alias, name, getEdges [] tipe )

155 ( alias, name, getEdges [] tipe )

158

156

159

157

@@ -186,8 +184,8 @@ getEdges edges (A.At _ tipe) =

186-- CHECK FREE VARIABLES

184-- CHECK FREE VARIABLES

187

185

188

186

189−checkUnionFreeVars :: Valid.Union -> Result i w Int

187+checkUnionFreeVars :: A.Located Src.Union -> Result i w Int

190−checkUnionFreeVars (Valid.Union unionRegion (A.At _ name) args ctors) =

188+checkUnionFreeVars (A.At unionRegion (Src.Union (A.At _ name) args ctors)) =

191 let

189 let

192 addArg (A.At region arg) dict =

190 addArg (A.At region arg) dict =

193 Dups.insert arg region region dict

191 Dups.insert arg region region dict

@@ -206,8 +204,8 @@ checkUnionFreeVars (Valid.Union unionRegion (A.At _ name) args ctors) =

206 Error.TypeVarsUnboundInUnion unionRegion name (map A.toValue args) unbound unbounds

204 Error.TypeVarsUnboundInUnion unionRegion name (map A.toValue args) unbound unbounds

207

205

208

206

209−checkAliasFreeVars :: Valid.Alias -> Result i w [Name.Name]

207+checkAliasFreeVars :: A.Located Src.Alias -> Result i w [Name.Name]

210−checkAliasFreeVars (Valid.Alias aliasRegion (A.At _ name) args tipe) =

208+checkAliasFreeVars (A.At aliasRegion (Src.Alias (A.At _ name) args tipe)) =

211 let

209 let

212 addArg (A.At region arg) dict =

210 addArg (A.At region arg) dict =

213 Dups.insert arg region region dict

211 Dups.insert arg region region dict

@@ -225,7 +223,7 @@ checkAliasFreeVars (Valid.Alias aliasRegion (A.At _ name) args tipe) =

225 (Map.toList (Map.difference freeVars boundVars))

223 (Map.toList (Map.difference freeVars boundVars))

226

224

227

225

228−addFreeVars :: Map.Map Name.Name R.Region -> Src.Type -> Map.Map Name.Name R.Region

226+addFreeVars :: Map.Map Name.Name A.Region -> Src.Type -> Map.Map Name.Name A.Region

229addFreeVars freeVars (A.At region tipe) =

227addFreeVars freeVars (A.At region tipe) =

230 case tipe of

228 case tipe of

231 Src.TLambda arg result ->

229 Src.TLambda arg result ->

@@ -263,8 +261,8 @@ addFreeVars freeVars (A.At region tipe) =

263-- ADD CTORS

261-- ADD CTORS

264

262

265

263

266−addCtors :: Valid.Module -> Env.Env -> Result i w (Env.Env, Unions, Aliases)

264+addCtors :: Src.Module -> Env.Env -> Result i w (Env.Env, Unions, Aliases)

267−addCtors (Valid.Module _ _ _ _ _ _ unions aliases _ _) env@(Env.Env home vs ts cs bs qvs qts qcs) =

265+addCtors (Src.Module _ _ _ _ unions aliases _ _) env@(Env.Env home vs ts cs bs qvs qts qcs) =

268 do unionInfo <- traverse (canonicalizeUnion env) unions

266 do unionInfo <- traverse (canonicalizeUnion env) unions

269 aliasInfo <- traverse (canonicalizeAlias env) aliases

267 aliasInfo <- traverse (canonicalizeAlias env) aliases

270

268

@@ -290,8 +288,8 @@ type CtorDups = Dups.Dict (Map.Map ModuleName.Canonical Env.Ctor)

290-- CANONICALIZE ALIAS

288-- CANONICALIZE ALIAS

291

289

292

290

293−canonicalizeAlias :: Env.Env -> Valid.Alias -> Result i w ( (Name.Name, Can.Alias), CtorDups )

291+canonicalizeAlias :: Env.Env -> A.Located Src.Alias -> Result i w ( (Name.Name, Can.Alias), CtorDups )

294−canonicalizeAlias env@(Env.Env home _ _ _ _ _ _ _) (Valid.Alias _ (A.At region name) args tipe) =

292+canonicalizeAlias env@(Env.Env home _ _ _ _ _ _ _) (A.At _ (Src.Alias (A.At region name) args tipe)) =

295 do let vars = map A.toValue args

293 do let vars = map A.toValue args

296 ctipe <- Type.canonicalize env tipe

294 ctipe <- Type.canonicalize env tipe

297 Result.ok

295 Result.ok

@@ -322,8 +320,8 @@ toRecordCtor home name vars fields =

322-- CANONICALIZE UNION

320-- CANONICALIZE UNION

323

321

324

322

325−canonicalizeUnion :: Env.Env -> Valid.Union -> Result i w ( (Name.Name, Can.Union), CtorDups )

323+canonicalizeUnion :: Env.Env -> A.Located Src.Union -> Result i w ( (Name.Name, Can.Union), CtorDups )

326−canonicalizeUnion env@(Env.Env home _ _ _ _ _ _ _) (Valid.Union _ (A.At _ name) avars ctors) =

324+canonicalizeUnion env@(Env.Env home _ _ _ _ _ _ _) (A.At _ (Src.Union (A.At _ name) avars ctors)) =

327 do cctors <- Index.indexedTraverse (canonicalizeCtor env) ctors

325 do cctors <- Index.indexedTraverse (canonicalizeCtor env) ctors

328 let vars = map A.toValue avars

326 let vars = map A.toValue avars

329 let alts = map A.toValue cctors

327 let alts = map A.toValue cctors

compiler/src/Canonicalize/Expression.hs+48−50

@@ -21,7 +21,6 @@ import qualified AST.Canonical as Can

21import qualified AST.Source as Src

22import qualified AST.Utils.Binop as Binop

23import qualified AST.Utils.Type as Type

24−import qualified AST.Valid as Valid

25import qualified Canonicalize.Environment as Env

24import qualified Canonicalize.Environment as Env

26import qualified Canonicalize.Environment.Dups as Dups

25import qualified Canonicalize.Environment.Dups as Dups

27import qualified Canonicalize.Pattern as Pattern

26import qualified Canonicalize.Pattern as Pattern

@@ -31,7 +30,6 @@ import qualified Elm.ModuleName as ModuleName

31import qualified Elm.Package as Pkg

30import qualified Elm.Package as Pkg

32import qualified Reporting.Annotation as A

31import qualified Reporting.Annotation as A

33import qualified Reporting.Error.Canonicalize as Error

32import qualified Reporting.Error.Canonicalize as Error

34−import qualified Reporting.Region as R

35import qualified Reporting.Result as Result

33import qualified Reporting.Result as Result

36import qualified Reporting.Warning as W

34import qualified Reporting.Warning as W

@@ -59,46 +57,46 @@ data Uses =

59-- CANONICALIZE

57-- CANONICALIZE

62−canonicalize :: Env.Env -> Valid.Expr -> Result FreeLocals [W.Warning] Can.Expr

60+canonicalize :: Env.Env -> Src.Expr -> Result FreeLocals [W.Warning] Can.Expr

63canonicalize env (A.At region expression) =

61canonicalize env (A.At region expression) =

64 A.At region <$>

62 A.At region <$>

65 case expression of

63 case expression of

66− Valid.Str string ->

64+ Src.Str string ->

67 Result.ok (Can.Str string)

65 Result.ok (Can.Str string)

69− Valid.Chr char ->

67+ Src.Chr char ->

70 Result.ok (Can.Chr char)

68 Result.ok (Can.Chr char)

72− Valid.Int int ->

70+ Src.Int int ->

73 Result.ok (Can.Int int)

71 Result.ok (Can.Int int)

75− Valid.Float float ->

73+ Src.Float float ->

76 Result.ok (Can.Float float)

74 Result.ok (Can.Float float)

78− Valid.Var varType name ->

76+ Src.Var varType name ->

79 case varType of

77 case varType of

80− Src.Value -> findVar region env name

78+ Src.LowVar -> findVar region env name

81− Src.Ctor -> toVarCtor name <$> Env.findCtor region env name

79+ Src.CapVar -> toVarCtor name <$> Env.findCtor region env name

83− Valid.VarQual varType prefix name ->

81+ Src.VarQual varType prefix name ->

84 case varType of

82 case varType of

85− Src.Value -> findVarQual region env prefix name

83+ Src.LowVar -> findVarQual region env prefix name

86− Src.Ctor -> toVarCtor name <$> Env.findCtorQual region env prefix name

84+ Src.CapVar -> toVarCtor name <$> Env.findCtorQual region env prefix name

88− Valid.List exprs ->

86+ Src.List exprs ->

89 Can.List <$> traverse (canonicalize env) exprs

87 Can.List <$> traverse (canonicalize env) exprs

91− Valid.Op op ->

89+ Src.Op op ->

92 do (Env.Binop _ home name annotation _ _) <- Env.findBinop region env op

90 do (Env.Binop _ home name annotation _ _) <- Env.findBinop region env op

93 return (Can.VarOperator op home name annotation)

91 return (Can.VarOperator op home name annotation)

95− Valid.Negate expr ->

93+ Src.Negate expr ->

96 Can.Negate <$> canonicalize env expr

94 Can.Negate <$> canonicalize env expr

98− Valid.Binops ops final ->

96+ Src.Binops ops final ->

99 A.toValue <$> canonicalizeBinops region env ops final

97 A.toValue <$> canonicalizeBinops region env ops final

100

101− Valid.Lambda srcArgs body ->

99+ Src.Lambda srcArgs body ->

102 delayedUsage $

100 delayedUsage $

103 do (args, bindings) <-

101 do (args, bindings) <-

104 Pattern.verify Error.DPLambdaArgs $

102 Pattern.verify Error.DPLambdaArgs $

@@ -112,33 +110,33 @@ canonicalize env (A.At region expression) =

112

110

113 return (Can.Lambda args cbody, freeLocals)

111 return (Can.Lambda args cbody, freeLocals)

114

112

115− Valid.Call func args ->

113+ Src.Call func args ->

116 Can.Call

114 Can.Call

117 <$> canonicalize env func

115 <$> canonicalize env func

118 <*> traverse (canonicalize env) args

116 <*> traverse (canonicalize env) args

119

117

120− Valid.If branches finally ->

118+ Src.If branches finally ->

121 Can.If

119 Can.If

122 <$> traverse (canonicalizeIfBranch env) branches

120 <$> traverse (canonicalizeIfBranch env) branches

123 <*> canonicalize env finally

121 <*> canonicalize env finally

124

122

125− Valid.Let defs expr ->

123+ Src.Let defs expr ->

126 A.toValue <$> canonicalizeLet region env defs expr

124 A.toValue <$> canonicalizeLet region env defs expr

127

125

128− Valid.Case expr branches ->

126+ Src.Case expr branches ->

129 Can.Case

127 Can.Case

130 <$> canonicalize env expr

128 <$> canonicalize env expr

131 <*> traverse (canonicalizeCaseBranch env) branches

129 <*> traverse (canonicalizeCaseBranch env) branches

132

130

133− Valid.Accessor field ->

131+ Src.Accessor field ->

134 Result.ok $ Can.Accessor field

132 Result.ok $ Can.Accessor field

135

133

136− Valid.Access record field ->

134+ Src.Access record field ->

137 Can.Access

135 Can.Access

138 <$> canonicalize env record

136 <$> canonicalize env record

139 <*> Result.ok field

137 <*> Result.ok field

140

138

141− Valid.Update (A.At reg name) fields ->

139+ Src.Update (A.At reg name) fields ->

142 let

140 let

143 makeCanFields =

141 makeCanFields =

144 Dups.checkFields' (\r t -> Can.FieldUpdate r <$> canonicalize env t) fields

142 Dups.checkFields' (\r t -> Can.FieldUpdate r <$> canonicalize env t) fields

@@ -147,28 +145,28 @@ canonicalize env (A.At region expression) =

147 <$> (A.At reg <$> findVar reg env name)

145 <$> (A.At reg <$> findVar reg env name)

148 <*> (sequenceA =<< makeCanFields)

146 <*> (sequenceA =<< makeCanFields)

149

147

150− Valid.Record fields ->

148+ Src.Record fields ->

151 do fieldDict <- Dups.checkFields fields

149 do fieldDict <- Dups.checkFields fields

152 Can.Record <$> traverse (canonicalize env) fieldDict

150 Can.Record <$> traverse (canonicalize env) fieldDict

153

151

154− Valid.Unit ->

152+ Src.Unit ->

155 Result.ok Can.Unit

153 Result.ok Can.Unit

156

154

157− Valid.Tuple a b cs ->

155+ Src.Tuple a b cs ->

158 Can.Tuple

156 Can.Tuple

159 <$> canonicalize env a

157 <$> canonicalize env a

160 <*> canonicalize env b

158 <*> canonicalize env b

161 <*> canonicalizeTupleExtras region env cs

159 <*> canonicalizeTupleExtras region env cs

162

160

163− Valid.Shader uid src tipe ->

161+ Src.Shader src tipe ->

164− Result.ok (Can.Shader uid src tipe)

162+ Result.ok (Can.Shader src tipe)

165

163

166

164

167

165

168-- CANONICALIZE TUPLE EXTRAS

166-- CANONICALIZE TUPLE EXTRAS

169

167

170

168

171−canonicalizeTupleExtras :: R.Region -> Env.Env -> [Valid.Expr] -> Result FreeLocals [W.Warning] (Maybe Can.Expr)

169+canonicalizeTupleExtras :: A.Region -> Env.Env -> [Src.Expr] -> Result FreeLocals [W.Warning] (Maybe Can.Expr)

172canonicalizeTupleExtras region env extras =

170canonicalizeTupleExtras region env extras =

173 case extras of

171 case extras of

174 [] ->

172 [] ->

@@ -185,7 +183,7 @@ canonicalizeTupleExtras region env extras =

185-- CANONICALIZE IF BRANCH

183-- CANONICALIZE IF BRANCH

186

184

187

185

188−canonicalizeIfBranch :: Env.Env -> (Valid.Expr, Valid.Expr) -> Result FreeLocals [W.Warning] (Can.Expr, Can.Expr)

186+canonicalizeIfBranch :: Env.Env -> (Src.Expr, Src.Expr) -> Result FreeLocals [W.Warning] (Can.Expr, Can.Expr)

189canonicalizeIfBranch env (condition, branch) =

187canonicalizeIfBranch env (condition, branch) =

190 (,)

188 (,)

191 <$> canonicalize env condition

189 <$> canonicalize env condition

@@ -196,7 +194,7 @@ canonicalizeIfBranch env (condition, branch) =

196-- CANONICALIZE CASE BRANCH

194-- CANONICALIZE CASE BRANCH

197

195

198

196

199−canonicalizeCaseBranch :: Env.Env -> (Src.Pattern, Valid.Expr) -> Result FreeLocals [W.Warning] Can.CaseBranch

197+canonicalizeCaseBranch :: Env.Env -> (Src.Pattern, Src.Expr) -> Result FreeLocals [W.Warning] Can.CaseBranch

200canonicalizeCaseBranch env (pattern, expr) =

198canonicalizeCaseBranch env (pattern, expr) =

201 directUsage $

199 directUsage $

202 do (cpattern, bindings) <-

200 do (cpattern, bindings) <-

@@ -214,7 +212,7 @@ canonicalizeCaseBranch env (pattern, expr) =

214-- CANONICALIZE BINOPS

212-- CANONICALIZE BINOPS

215

213

216

214

217−canonicalizeBinops :: R.Region -> Env.Env -> [(Valid.Expr, A.Located Name.Name)] -> Valid.Expr -> Result FreeLocals [W.Warning] Can.Expr

215+canonicalizeBinops :: A.Region -> Env.Env -> [(Src.Expr, A.Located Name.Name)] -> Src.Expr -> Result FreeLocals [W.Warning] Can.Expr

218canonicalizeBinops overallRegion env ops final =

216canonicalizeBinops overallRegion env ops final =

219 let

217 let

220 canonicalizeHelp (expr, A.At region op) =

218 canonicalizeHelp (expr, A.At region op) =

@@ -235,7 +233,7 @@ data Step

235 | Error Env.Binop Env.Binop

233 | Error Env.Binop Env.Binop

236

234

237

235

238−runBinopStepper :: R.Region -> Step -> Result FreeLocals w Can.Expr

236+runBinopStepper :: A.Region -> Step -> Result FreeLocals w Can.Expr

239runBinopStepper overallRegion step =

237runBinopStepper overallRegion step =

240 case step of

238 case step of

241 Done expr ->

239 Done expr ->

@@ -297,7 +295,7 @@ toBinop (Env.Binop op home name annotation _ _) left right =

297-- CANONICALIZE LET

295-- CANONICALIZE LET

298

296

299

297

300−canonicalizeLet :: R.Region -> Env.Env -> [Valid.Def] -> Valid.Expr -> Result FreeLocals [W.Warning] Can.Expr

298+canonicalizeLet :: A.Region -> Env.Env -> [A.Located Src.Def] -> Src.Expr -> Result FreeLocals [W.Warning] Can.Expr

301canonicalizeLet letRegion env defs body =

299canonicalizeLet letRegion env defs body =

302 directUsage $

300 directUsage $

303 do bindings <-

301 do bindings <-

@@ -316,17 +314,17 @@ canonicalizeLet letRegion env defs body =

316-- ADD BINDINGS

314-- ADD BINDINGS

317

315

318

316

319−addBindings :: Dups.Dict R.Region -> Valid.Def -> Dups.Dict R.Region

317+addBindings :: Dups.Dict A.Region -> A.Located Src.Def -> Dups.Dict A.Region

320−addBindings bindings def =

318+addBindings bindings (A.At _ def) =

321 case def of

319 case def of

322− Valid.Define _ (A.At region name) _ _ _ ->

320+ Src.Define (A.At region name) _ _ _ ->

323 Dups.insert name region region bindings

321 Dups.insert name region region bindings

324

322

325− Valid.Destruct _ pattern _ ->

323+ Src.Destruct pattern _ ->

326 addBindingsHelp bindings pattern

324 addBindingsHelp bindings pattern

327

325

328

326

329−addBindingsHelp :: Dups.Dict R.Region -> Src.Pattern -> Dups.Dict R.Region

327+addBindingsHelp :: Dups.Dict A.Region -> Src.Pattern -> Dups.Dict A.Region

330addBindingsHelp bindings (A.At region pattern) =

328addBindingsHelp bindings (A.At region pattern) =

331 case pattern of

329 case pattern of

332 Src.PAnything ->

330 Src.PAnything ->

@@ -388,10 +386,10 @@ data Binding

388 | Destruct Can.Pattern Can.Expr

386 | Destruct Can.Pattern Can.Expr

389

387

390

388

391−addDefNodes :: Env.Env -> [Node] -> Valid.Def -> Result FreeLocals [W.Warning] [Node]

389+addDefNodes :: Env.Env -> [Node] -> A.Located Src.Def -> Result FreeLocals [W.Warning] [Node]

392−addDefNodes env nodes def =

390+addDefNodes env nodes (A.At _ def) =

393 case def of

391 case def of

394− Valid.Define _ aname@(A.At _ name) srcArgs body maybeType ->

392+ Src.Define aname@(A.At _ name) srcArgs body maybeType ->

395 case maybeType of

393 case maybeType of

396 Nothing ->

394 Nothing ->

397 do (args, argBindings) <-

395 do (args, argBindings) <-

@@ -424,7 +422,7 @@ addDefNodes env nodes def =

424 let node = ( Define cdef, name, Map.keys freeLocals )

422 let node = ( Define cdef, name, Map.keys freeLocals )

425 logLetLocals args freeLocals (node:nodes)

423 logLetLocals args freeLocals (node:nodes)

426

424

427− Valid.Destruct _ pattern body ->

425+ Src.Destruct pattern body ->

428 do (cpattern, _bindings) <-

426 do (cpattern, _bindings) <-

429 Pattern.verify Error.DPDestruct $

427 Pattern.verify Error.DPDestruct $

430 Pattern.canonicalize env pattern

428 Pattern.canonicalize env pattern

@@ -512,14 +510,14 @@ gatherTypedArgs env name srcArgs tipe index revTypedArgs =

512 _ ->

510 _ ->

513 let (A.At start _, A.At end _) = (head srcArgs, last srcArgs) in

511 let (A.At start _, A.At end _) = (head srcArgs, last srcArgs) in

514 Result.throw $

512 Result.throw $

515− Error.AnnotationTooShort (R.merge start end) name index (length srcArgs)

513+ Error.AnnotationTooShort (A.mergeRegions start end) name index (length srcArgs)

516

514

517

515

518

516

519-- DETECT CYCLES

517-- DETECT CYCLES

520

518

521

519

522−detectCycles :: R.Region -> [Graph.SCC Binding] -> Can.Expr -> Result i w Can.Expr

520+detectCycles :: A.Region -> [Graph.SCC Binding] -> Can.Expr -> Result i w Can.Expr

523detectCycles letRegion sccs body =

521detectCycles letRegion sccs body =

524 case sccs of

522 case sccs of

525 [] ->

523 [] ->

@@ -657,7 +655,7 @@ verifyBindings context bindings (Result.Result k) =

657 )

655 )

658

656

659

657

660−addUnusedWarning :: W.Context -> [W.Warning] -> Name.Name -> R.Region -> [W.Warning]

658+addUnusedWarning :: W.Context -> [W.Warning] -> Name.Name -> A.Region -> [W.Warning]

661addUnusedWarning context warnings name region =

659addUnusedWarning context warnings name region =

662 W.UnusedVariable region context name : warnings

660 W.UnusedVariable region context name : warnings

663

661

@@ -687,7 +685,7 @@ delayedUsage (Result.Result k) =

687-- FIND VARIABLE

685-- FIND VARIABLE

688

686

689

687

690−findVar :: R.Region -> Env.Env -> Name.Name -> Result FreeLocals w Can.Expr_

688+findVar :: A.Region -> Env.Env -> Name.Name -> Result FreeLocals w Can.Expr_

691findVar region (Env.Env localHome vs _ _ _ qvs _ _) name =

689findVar region (Env.Env localHome vs _ _ _ qvs _ _) name =

692 case Map.lookup name vs of

690 case Map.lookup name vs of

693 Just var ->

691 Just var ->

@@ -712,7 +710,7 @@ findVar region (Env.Env localHome vs _ _ _ qvs _ _) name =

712 Result.throw (Error.NotFoundVar region Nothing name (toPossibleNames vs qvs))

710 Result.throw (Error.NotFoundVar region Nothing name (toPossibleNames vs qvs))

713

711

714

712

715−findVarQual :: R.Region -> Env.Env -> Name.Name -> Name.Name -> Result FreeLocals w Can.Expr_

713+findVarQual :: A.Region -> Env.Env -> Name.Name -> Name.Name -> Result FreeLocals w Can.Expr_

716findVarQual region (Env.Env localHome vs _ _ _ qvs _ _) prefix name =

714findVarQual region (Env.Env localHome vs _ _ _ qvs _ _) prefix name =

717 case Map.lookup prefix qvs of

715 case Map.lookup prefix qvs of

718 Just qualified ->

716 Just qualified ->

compiler/src/Canonicalize/Module.hs+23−39

@@ -11,7 +11,6 @@ import qualified Data.Name as Name

12import qualified AST.Canonical as Can

13import qualified AST.Source as Src

14−import qualified AST.Valid as Valid

15import qualified Canonicalize.Effects as Effects

14import qualified Canonicalize.Effects as Effects

16import qualified Canonicalize.Environment as Env

15import qualified Canonicalize.Environment as Env

17import qualified Canonicalize.Environment.Dups as Dups

16import qualified Canonicalize.Environment.Dups as Dups

@@ -26,7 +25,6 @@ import qualified Elm.ModuleName as ModuleName

26import qualified Elm.Package as Pkg

25import qualified Elm.Package as Pkg

27import qualified Reporting.Annotation as A

26import qualified Reporting.Annotation as A

28import qualified Reporting.Error.Canonicalize as Error

27import qualified Reporting.Error.Canonicalize as Error

29−import qualified Reporting.Region as R

30import qualified Reporting.Result as Result

28import qualified Reporting.Result as Result

31import qualified Reporting.Warning as W

29import qualified Reporting.Warning as W

@@ -47,9 +45,9 @@ canonicalize

47 :: Pkg.Name

45 :: Pkg.Name

48 -> Map.Map Name.Name ModuleName.Canonical

46 -> Map.Map Name.Name ModuleName.Canonical

49 -> I.Interfaces

47 -> I.Interfaces

50− -> Valid.Module

48+ -> Src.Module

51 -> Result i [W.Warning] Can.Module

49 -> Result i [W.Warning] Can.Module

52−canonicalize pkg importDict interfaces module_@(Valid.Module name _ _ exports imports decls _ _ binops effects) =

50+canonicalize pkg importDict interfaces module_@(Src.Module name exports imports values _ _ binops effects) =

53 do let home = ModuleName.Canonical pkg name

51 do let home = ModuleName.Canonical pkg name

54 let cbinops = Map.fromList (map canonicalizeBinop binops)

52 let cbinops = Map.fromList (map canonicalizeBinop binops)

@@ -57,33 +55,19 @@ canonicalize pkg importDict interfaces module_@(Valid.Module name _ _ exports im

57 Local.add module_ =<<

55 Local.add module_ =<<

58 Foreign.createInitialEnv home importDict interfaces imports

56 Foreign.createInitialEnv home importDict interfaces imports

60− cdecls <- canonicalizeDecls env decls

58+ cvalues <- canonicalizeValues env values

61− ceffects <- Effects.canonicalize env decls cunions effects

59+ ceffects <- Effects.canonicalize env values cunions effects

62− cexports <- canonicalizeExports decls cunions caliases cbinops ceffects exports

60+ cexports <- canonicalizeExports values cunions caliases cbinops ceffects exports

64− return $ Can.Module home (toDocs module_) cexports cdecls cunions caliases cbinops ceffects

62+ return $ Can.Module home cexports cvalues cunions caliases cbinops ceffects

65−

66−

67−

68−-- DOCUMENTATION

69−

70−

71−toDocs :: Valid.Module -> Can.Docs

72−toDocs (Valid.Module _ docs comments _ _ _ _ _ _ _) =

73− case docs of

74− Src.NoDocs region ->

75− Can.NoDocs region

76−

77− Src.YesDocs region overview ->

78− Can.YesDocs region overview comments

82-- CANONICALIZE BINOP

66-- CANONICALIZE BINOP

85−canonicalizeBinop :: Valid.Binop -> ( Name.Name, Can.Binop )

69+canonicalizeBinop :: A.Located Src.Binop -> ( Name.Name, Can.Binop )

86−canonicalizeBinop (Valid.Binop op associativity precedence func) =

70+canonicalizeBinop (A.At _ (Src.Binop op associativity precedence func)) =

87 ( op, Can.Binop_ associativity precedence func )

71 ( op, Can.Binop_ associativity precedence func )

@@ -97,9 +81,9 @@ canonicalizeBinop (Valid.Binop op associativity precedence func) =

97--

81--

100−canonicalizeDecls :: Env.Env -> [A.Located Valid.Decl] -> Result i [W.Warning] Can.Decls

84+canonicalizeValues :: Env.Env -> [A.Located Src.Value] -> Result i [W.Warning] Can.Decls

101−canonicalizeDecls env decls =

85+canonicalizeValues env values =

102− do nodes <- traverse (toNodeOne env) decls

86+ do nodes <- traverse (toNodeOne env) values

103 detectCycles (Graph.stronglyConnComp nodes)

87 detectCycles (Graph.stronglyConnComp nodes)

104

105

@@ -151,8 +135,8 @@ type NodeTwo =

151 (Can.Def, Name.Name, [Name.Name])

135 (Can.Def, Name.Name, [Name.Name])

152

136

153

137

154−toNodeOne :: Env.Env -> A.Located Valid.Decl -> Result i [W.Warning] NodeOne

138+toNodeOne :: Env.Env -> A.Located Src.Value -> Result i [W.Warning] NodeOne

155−toNodeOne env (A.At _ (Valid.Decl aname@(A.At _ name) srcArgs body maybeType)) =

139+toNodeOne env (A.At _ (Src.Value aname@(A.At _ name) srcArgs body maybeType)) =

156 case maybeType of

140 case maybeType of

157 Nothing ->

141 Nothing ->

158 do (args, argBindings) <-

142 do (args, argBindings) <-

@@ -216,41 +200,41 @@ addDirects name (Expr.Uses directUses _) directDeps =

216

200

217

201

218canonicalizeExports

202canonicalizeExports

219− :: [A.Located Valid.Decl]

203+ :: [A.Located Src.Value]

220 -> Map.Map Name.Name union

204 -> Map.Map Name.Name union

221 -> Map.Map Name.Name alias

205 -> Map.Map Name.Name alias

222 -> Map.Map Name.Name binop

206 -> Map.Map Name.Name binop

223 -> Can.Effects

207 -> Can.Effects

224 -> A.Located Src.Exposing

208 -> A.Located Src.Exposing

225 -> Result i w Can.Exports

209 -> Result i w Can.Exports

226−canonicalizeExports decls unions aliases binops effects (A.At region exposing) =

210+canonicalizeExports values unions aliases binops effects (A.At region exposing) =

227 case exposing of

211 case exposing of

228 Src.Open ->

212 Src.Open ->

229 Result.ok (Can.ExportEverything region)

213 Result.ok (Can.ExportEverything region)

230

214

231 Src.Explicit exposeds ->

215 Src.Explicit exposeds ->

232− do let names = Map.fromList (map declToName decls)

216+ do let names = Map.fromList (map valueToName values)

233 infos <- traverse (checkExposed names unions aliases binops effects) exposeds

217 infos <- traverse (checkExposed names unions aliases binops effects) exposeds

234 Can.Export <$> Dups.detect Error.ExportDuplicate (Dups.unions infos)

218 Can.Export <$> Dups.detect Error.ExportDuplicate (Dups.unions infos)

235

219

236

220

237−declToName :: A.Located Valid.Decl -> ( Name.Name, () )

221+valueToName :: A.Located Src.Value -> ( Name.Name, () )

238−declToName (A.At _ (Valid.Decl (A.At _ name) _ _ _)) =

222+valueToName (A.At _ (Src.Value (A.At _ name) _ _ _)) =

239 ( name, () )

223 ( name, () )

240

224

241

225

242checkExposed

226checkExposed

243− :: Map.Map Name.Name decl

227+ :: Map.Map Name.Name value

244 -> Map.Map Name.Name union

228 -> Map.Map Name.Name union

245 -> Map.Map Name.Name alias

229 -> Map.Map Name.Name alias

246 -> Map.Map Name.Name binop

230 -> Map.Map Name.Name binop

247 -> Can.Effects

231 -> Can.Effects

248 -> A.Located Src.Exposed

232 -> A.Located Src.Exposed

249 -> Result i w (Dups.Dict (A.Located Can.Export))

233 -> Result i w (Dups.Dict (A.Located Can.Export))

250−checkExposed decls unions aliases binops effects (A.At region exposed) =

234+checkExposed values unions aliases binops effects (A.At region exposed) =

251 case exposed of

235 case exposed of

252 Src.Lower name ->

236 Src.Lower name ->

253− if Map.member name decls then

237+ if Map.member name values then

254 ok name region Can.ExportValue

238 ok name region Can.ExportValue

255 else

239 else

256 case checkPorts effects name of

240 case checkPorts effects name of

@@ -259,7 +243,7 @@ checkExposed decls unions aliases binops effects (A.At region exposed) =

259

243

260 Just ports ->

244 Just ports ->

261 Result.throw $ Error.ExportNotFound region Error.BadVar name $

245 Result.throw $ Error.ExportNotFound region Error.BadVar name $

262− ports ++ Map.keys decls

246+ ports ++ Map.keys values

263

247

264 Src.Operator name ->

248 Src.Operator name ->

265 if Map.member name binops then

249 if Map.member name binops then

@@ -300,6 +284,6 @@ checkPorts effects name =

300 Just []

284 Just []

301

285

302

286

303−ok :: Name.Name -> R.Region -> Can.Export -> Result i w (Dups.Dict (A.Located Can.Export))

287+ok :: Name.Name -> A.Region -> Can.Export -> Result i w (Dups.Dict (A.Located Can.Export))

304ok name region export =

288ok name region export =

305 Result.ok $ Dups.one name region (A.At region export)

289 Result.ok $ Dups.one name region (A.At region export)

compiler/src/Canonicalize/Pattern.hs+5−6

@@ -19,7 +19,6 @@ import qualified Data.Index as Index

19import qualified Elm.ModuleName as ModuleName

20import qualified Reporting.Annotation as A

21import qualified Reporting.Error.Canonicalize as Error

22−import qualified Reporting.Region as R

23import qualified Reporting.Result as Result

22import qualified Reporting.Result as Result

@@ -32,7 +31,7 @@ type Result i w a =

34type Bindings =

33type Bindings =

35− Map.Map Name.Name R.Region

34+ Map.Map Name.Name A.Region

@@ -60,7 +59,7 @@ verify context (Result.Result k) =

62type DupsDict =

61type DupsDict =

63− Dups.Dict R.Region

62+ Dups.Dict A.Region

66canonicalize :: Env.Env -> Src.Pattern -> Result DupsDict w Can.Pattern

65canonicalize :: Env.Env -> Src.Pattern -> Result DupsDict w Can.Pattern

@@ -113,7 +112,7 @@ canonicalize env (A.At region pattern) =

113 Result.ok (Can.PInt int)

112 Result.ok (Can.PInt int)

114

113

115

114

116−canonicalizeCtor :: Env.Env -> R.Region -> Name.Name -> [Src.Pattern] -> Env.Ctor -> Result DupsDict w Can.Pattern_

115+canonicalizeCtor :: Env.Env -> A.Region -> Name.Name -> [Src.Pattern] -> Env.Ctor -> Result DupsDict w Can.Pattern_

117canonicalizeCtor env region name patterns ctor =

116canonicalizeCtor env region name patterns ctor =

118 case ctor of

117 case ctor of

119 Env.Ctor home tipe union index args ->

118 Env.Ctor home tipe union index args ->

@@ -136,7 +135,7 @@ canonicalizeCtor env region name patterns ctor =

136 Result.throw (Error.PatternHasRecordCtor region name)

135 Result.throw (Error.PatternHasRecordCtor region name)

137

136

138

137

139−canonicalizeTuple :: R.Region -> Env.Env -> [Src.Pattern] -> Result DupsDict w (Maybe Can.Pattern)

138+canonicalizeTuple :: A.Region -> Env.Env -> [Src.Pattern] -> Result DupsDict w (Maybe Can.Pattern)

140canonicalizeTuple tupleRegion env extras =

139canonicalizeTuple tupleRegion env extras =

141 case extras of

140 case extras of

142 [] ->

141 [] ->

@@ -165,7 +164,7 @@ canonicalizeList env list =

165-- LOG BINDINGS

164-- LOG BINDINGS

166

165

167

166

168−logVar :: Name.Name -> R.Region -> a -> Result DupsDict w a

167+logVar :: Name.Name -> A.Region -> a -> Result DupsDict w a

169logVar name region value =

168logVar name region value =

170 Result.Result $ \bindings warnings _ ok ->

169 Result.Result $ \bindings warnings _ ok ->

171 ok (Dups.insert name region region bindings) warnings value

170 ok (Dups.insert name region region bindings) warnings value

compiler/src/Canonicalize/Type.hs+2−3

@@ -17,7 +17,6 @@ import qualified Canonicalize.Environment as Env

17import qualified Canonicalize.Environment.Dups as Dups

18import qualified Reporting.Annotation as A

19import qualified Reporting.Error.Canonicalize as Error

20−import qualified Reporting.Region as R

21import qualified Reporting.Result as Result

20import qualified Reporting.Result as Result

@@ -99,7 +98,7 @@ canonicalizeFields env fields =

99-- CANONICALIZE TYPE

98-- CANONICALIZE TYPE

100

101

100

102−canonicalizeType :: Env.Env -> R.Region -> Name.Name -> [Src.Type] -> Env.Type -> Result i w Can.Type

101+canonicalizeType :: Env.Env -> A.Region -> Name.Name -> [Src.Type] -> Env.Type -> Result i w Can.Type

103canonicalizeType env region name args info =

102canonicalizeType env region name args info =

104 do cargs <- traverse (canonicalize env) args

103 do cargs <- traverse (canonicalize env) args

105 case info of

104 case info of

@@ -112,7 +111,7 @@ canonicalizeType env region name args info =

112 Can.TType home name cargs

111 Can.TType home name cargs

113

112

114

113

115−checkArity :: Int -> R.Region -> Name.Name -> [A.Located arg] -> answer -> Result i w answer

114+checkArity :: Int -> A.Region -> Name.Name -> [A.Located arg] -> answer -> Result i w answer

116checkArity expected region name args answer =

115checkArity expected region name args answer =

117 let actual = length args in

116 let actual = length args in

118 if expected == actual then

117 if expected == actual then