fd172c9 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Mess with Canonical Env a bit to handle duplicate imports better

fd172c9Evan Czaplicki9 years ago

src/Canonicalize/Environment.hs+11−16

compare with master

unifiedsplit

@@ -5,7 +5,6 @@ module Canonicalize.Environment

5 , Exposed

6 , Qualified

7 , Var(..)

8− , ForeignVar(..)

9 , Type(..)

8 , Type(..)

10 , Ctor(..)

9 , Ctor(..)

11 , addLocals

10 , addLocals

@@ -19,14 +18,14 @@ module Canonicalize.Environment

19 where

18 where

22−import qualified Data.Map.Strict as Map

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

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

22+import qualified Data.Map.Strict as Map

23+import qualified Data.Map.Strict.Internal as I

25import qualified AST.Utils.Binop as Binop

26import qualified AST.Canonical as Can

27import qualified AST.Module.Name as ModuleName

28import qualified Data.Index as Index

29−import qualified Data.OneOrMore as OneOrMore

30import qualified Elm.Name as N

29import qualified Elm.Name as N

31import qualified Reporting.Error.Canonicalize as Error

30import qualified Reporting.Error.Canonicalize as Error

32import qualified Reporting.Region as R

31import qualified Reporting.Region as R

@@ -52,18 +51,18 @@ data Env =

52 , _types :: Exposed Type

51 , _types :: Exposed Type

53 , _ctors :: Exposed Ctor

52 , _ctors :: Exposed Ctor

54 , _binops :: Exposed Binop

53 , _binops :: Exposed Binop

55− , _q_vars :: Qualified ForeignVar

54+ , _q_vars :: Qualified Can.Annotation

56 , _q_types :: Qualified Type

55 , _q_types :: Qualified Type

57 , _q_ctors :: Qualified Ctor

56 , _q_ctors :: Qualified Ctor

58 }

57 }

61type Exposed a =

60type Exposed a =

62− Map.Map N.Name (OneOrMore.OneOrMore a)

61+ Map.Map N.Name (Map.Map ModuleName.Canonical a)

65type Qualified a =

64type Qualified a =

66− Map.Map N.Name (Map.Map N.Name (OneOrMore.OneOrMore a))

65+ Map.Map N.Name (Map.Map N.Name (Map.Map ModuleName.Canonical a))

@@ -73,11 +72,7 @@ type Qualified a =

73data Var

72data Var

74 = Local R.Region

73 = Local R.Region

75 | TopLevel R.Region

74 | TopLevel R.Region

76− | Foreign (OneOrMore.OneOrMore ForeignVar)

77−

78−

79−data ForeignVar =

80− ForeignVar ModuleName.Canonical Can.Annotation

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

@@ -161,7 +156,7 @@ addLocalBoth name region var =

161findType :: R.Region -> Env -> N.Name -> Result i w Type

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

162findType region (Env _ _ types _ _ _ _ _) name =

157findType region (Env _ _ types _ _ _ _ _) name =

163 case Map.lookup name types of

158 case Map.lookup name types of

164− Just (OneOrMore.One tipe) ->

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

165 Result.ok tipe

160 Result.ok tipe

166

161

167 Just _ ->

162 Just _ ->

@@ -176,7 +171,7 @@ findTypeQual region (Env _ _ _ _ _ _ types _) prefix name =

176 case Map.lookup prefix types of

171 case Map.lookup prefix types of

177 Just qualified ->

172 Just qualified ->

178 case Map.lookup name qualified of

173 case Map.lookup name qualified of

179− Just (OneOrMore.One tipe) ->

174+ Just (I.Bin 1 _ tipe _ _) ->

180 Result.ok tipe

175 Result.ok tipe

181

176

182 Just more ->

177 Just more ->

@@ -196,7 +191,7 @@ findTypeQual region (Env _ _ _ _ _ _ types _) prefix name =

196findCtor :: R.Region -> Env -> N.Name -> Result i w Ctor

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

197findCtor region (Env _ _ _ ctors _ _ _ _) name =

192findCtor region (Env _ _ _ ctors _ _ _ _) name =

198 case Map.lookup name ctors of

193 case Map.lookup name ctors of

199− Just (OneOrMore.One ctor) ->

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

200 Result.ok ctor

195 Result.ok ctor

201

196

202 Just _ ->

197 Just _ ->

@@ -211,7 +206,7 @@ findCtorQual region (Env _ _ _ _ _ _ _ ctors) prefix name =

211 case Map.lookup prefix ctors of

206 case Map.lookup prefix ctors of

212 Just qualified ->

207 Just qualified ->

213 case Map.lookup name qualified of

208 case Map.lookup name qualified of

214− Just (OneOrMore.One pattern) ->

209+ Just (I.Bin 1 _ pattern _ _) ->

215 Result.ok pattern

210 Result.ok pattern

216

211

217 Just _ ->

212 Just _ ->

@@ -231,7 +226,7 @@ findCtorQual region (Env _ _ _ _ _ _ _ ctors) prefix name =

231findBinop :: R.Region -> Env -> N.Name -> Result i w Binop

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

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

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

233 case Map.lookup name binops of

228 case Map.lookup name binops of

234− Just (OneOrMore.One binop) ->

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

235 Result.ok binop

230 Result.ok binop

236

231

237 Nothing ->

232 Nothing ->

src/Canonicalize/Environment/Foreign.hs+14−15

@@ -14,7 +14,6 @@ import qualified AST.Source as Src

14import qualified AST.Module.Name as ModuleName

15import qualified Canonicalize.Environment as Env

16import qualified Data.List as List

17−import qualified Data.OneOrMore as OneOrMore

18import qualified Elm.Interface as I

17import qualified Elm.Interface as I

19import qualified Elm.Name as N

18import qualified Elm.Name as N

20import qualified Reporting.Annotation as A

19import qualified Reporting.Annotation as A

@@ -58,11 +57,11 @@ isNotKernel (Src.Import (A.At _ name) _ _) =

59data State =

58data State =

60 State

59 State

61− { _vars :: Env.Exposed Env.ForeignVar

60+ { _vars :: Env.Exposed Can.Annotation

62 , _types :: Env.Exposed Env.Type

61 , _types :: Env.Exposed Env.Type

63 , _ctors :: Env.Exposed Env.Ctor

62 , _ctors :: Env.Exposed Env.Ctor

64 , _binops :: Env.Exposed Env.Binop

63 , _binops :: Env.Exposed Env.Binop

65− , _q_vars :: Env.Qualified Env.ForeignVar

64+ , _q_vars :: Env.Qualified Can.Annotation

66 , _q_types :: Env.Qualified Env.Type

65 , _q_types :: Env.Qualified Env.Type

67 , _q_ctors :: Env.Qualified Env.Ctor

66 , _q_ctors :: Env.Qualified Env.Ctor

68 }

67 }

@@ -75,7 +74,7 @@ emptyState =

76emptyTypes :: Env.Exposed Env.Type

75emptyTypes :: Env.Exposed Env.Type

77emptyTypes =

76emptyTypes =

78− Map.singleton "List" (OneOrMore.one (Env.Union 1 ModuleName.list))

77+ Map.singleton "List" (Map.singleton ModuleName.list (Env.Union 1 ModuleName.list))

@@ -90,8 +89,8 @@ addImport (State vs ts cs bs qvs qts qcs) (Import home (I.Interface defs unions

90 (Map.mapWithKey (unionToType home) unions)

89 (Map.mapWithKey (unionToType home) unions)

91 (Map.mapWithKey (aliasToType home) aliases)

90 (Map.mapWithKey (aliasToType home) aliases)

93− !vars = Map.map (OneOrMore.one . Env.ForeignVar home) defs

92+ !vars = Map.map (Map.singleton home) defs

94− !types = Map.map (OneOrMore.one . fst) rawTypeInfo

93+ !types = Map.map (Map.singleton home . fst) rawTypeInfo

95 !ctors = Map.foldr (addExposed . snd) Map.empty rawTypeInfo

94 !ctors = Map.foldr (addExposed . snd) Map.empty rawTypeInfo

97 !qvs2 = addQualified prefix vars qvs

96 !qvs2 = addQualified prefix vars qvs

@@ -117,7 +116,7 @@ addImport (State vs ts cs bs qvs qts qcs) (Import home (I.Interface defs unions

117

116

118addExposed :: Env.Exposed a -> Env.Exposed a -> Env.Exposed a

117addExposed :: Env.Exposed a -> Env.Exposed a -> Env.Exposed a

119addExposed =

118addExposed =

120− Map.unionWith OneOrMore.more

119+ Map.unionWith Map.union

121

120

122

121

123addQualified :: N.Name -> Env.Exposed a -> Env.Qualified a -> Env.Qualified a

122addQualified :: N.Name -> Env.Exposed a -> Env.Qualified a -> Env.Qualified a

@@ -133,7 +132,7 @@ unionToType :: ModuleName.Canonical -> N.Name -> Can.Union -> (Env.Type, Env.Exp

133unionToType home name union@(Can.Union vars ctors _ _) =

132unionToType home name union@(Can.Union vars ctors _ _) =

134 let

133 let

135 addCtor dict (Can.Ctor ctor index _ args) =

134 addCtor dict (Can.Ctor ctor index _ args) =

136− Map.insert ctor (OneOrMore.one (Env.Ctor home name union index args)) dict

135+ Map.insert ctor (Map.singleton home (Env.Ctor home name union index args)) dict

137 in

136 in

138 ( Env.Union (length vars) home

137 ( Env.Union (length vars) home

139 , List.foldl' addCtor Map.empty ctors

138 , List.foldl' addCtor Map.empty ctors

@@ -150,13 +149,13 @@ aliasToType home name (Can.Alias vars tipe maybeRecordArgs) =

150 Map.empty

149 Map.empty

151

150

152 Just _ ->

151 Just _ ->

153− Map.singleton name (OneOrMore.one (Env.RecordCtor home vars tipe))

152+ Map.singleton name (Map.singleton home (Env.RecordCtor home vars tipe))

154 )

153 )

155

154

156

155

157−binopToBinop :: ModuleName.Canonical -> N.Name -> I.Binop -> OneOrMore.OneOrMore Env.Binop

156+binopToBinop :: ModuleName.Canonical -> N.Name -> I.Binop -> Map.Map ModuleName.Canonical Env.Binop

158binopToBinop home op (I.Binop name annotation associativity precedence) =

157binopToBinop home op (I.Binop name annotation associativity precedence) =

159− OneOrMore.one (Env.Binop op home name annotation associativity precedence)

158+ Map.singleton home (Env.Binop op home name annotation associativity precedence)

160

159

161

160

162

161

@@ -165,7 +164,7 @@ binopToBinop home op (I.Binop name annotation associativity precedence) =

165

164

166addExposedValue

165addExposedValue

167 :: ModuleName.Canonical

166 :: ModuleName.Canonical

168− -> Env.Exposed Env.ForeignVar

167+ -> Env.Exposed Can.Annotation

169 -> Map.Map N.Name (Env.Type, Env.Exposed Env.Ctor)

168 -> Map.Map N.Name (Env.Type, Env.Exposed Env.Ctor)

170 -> Map.Map N.Name I.Binop

169 -> Map.Map N.Name I.Binop

171 -> State

170 -> State

@@ -189,13 +188,13 @@ addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) (A.At reg

189 case tipe of

188 case tipe of

190 Env.Union _ _ ->

189 Env.Union _ _ ->

191 let

190 let

192− !ts2 = Map.insert name (OneOrMore.one tipe) ts

191+ !ts2 = Map.insert name (Map.singleton home tipe) ts

193 in

192 in

194 Result.ok (State vs ts2 cs bs qvs qts qcs)

193 Result.ok (State vs ts2 cs bs qvs qts qcs)

195

194

196 Env.Alias _ _ _ _ ->

195 Env.Alias _ _ _ _ ->

197 let

196 let

198− !ts2 = Map.insert name (OneOrMore.one tipe) ts

197+ !ts2 = Map.insert name (Map.singleton home tipe) ts

199 !cs2 = addExposed cs ctors

198 !cs2 = addExposed cs ctors

200 in

199 in

201 Result.ok (State vs ts2 cs2 bs qvs qts qcs)

200 Result.ok (State vs ts2 cs2 bs qvs qts qcs)

@@ -209,7 +208,7 @@ addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) (A.At reg

209 case tipe of

208 case tipe of

210 Env.Union _ _ ->

209 Env.Union _ _ ->

211 let

210 let

212− !ts2 = Map.insert name (OneOrMore.one tipe) ts

211+ !ts2 = Map.insert name (Map.singleton home tipe) ts

213 !cs2 = addExposed cs ctors

212 !cs2 = addExposed cs ctors

214 in

213 in

215 Result.ok (State vs ts2 cs2 bs qvs qts qcs)

214 Result.ok (State vs ts2 cs2 bs qvs qts qcs)

src/Canonicalize/Environment/Local.hs+8−9

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

19import qualified Canonicalize.Environment.Dups as Dups

20import qualified Canonicalize.Type as Type

21import qualified Data.Index as Index

22−import qualified Data.OneOrMore as OneOrMore

23import qualified Elm.Name as N

22import qualified Elm.Name as N

24import qualified Reporting.Annotation as A

23import qualified Reporting.Annotation as A

25import qualified Reporting.Error.Canonicalize as Error

24import qualified Reporting.Error.Canonicalize as Error

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

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

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

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

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

115 do arity <- checkUnionFreeVars union

114 do arity <- checkUnionFreeVars union

116− let one = OneOrMore.one (Env.Union arity home)

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

117− Result.ok $ Map.insertWith OneOrMore.more name one types

116+ Result.ok $ Map.insertWith Map.union name one types

118

117

119

118

120

119

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

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

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

137 do args <- checkAliasFreeVars alias

136 do args <- checkAliasFreeVars alias

138 ctype <- Type.canonicalize env tipe

137 ctype <- Type.canonicalize env tipe

139− let one = OneOrMore.one (Env.Alias (length args) home args ctype)

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

140− let ts1 = Map.insertWith OneOrMore.more name one ts

139+ let ts1 = Map.insertWith Map.union name one ts

141 Result.ok $ Env.Env home vs ts1 cs bs qvs qts qcs

140 Result.ok $ Env.Env home vs ts1 cs bs qvs qts qcs

142

141

143 Graph.CyclicSCC [] ->

142 Graph.CyclicSCC [] ->

@@ -274,7 +273,7 @@ addCtors (Valid.Module _ _ _ _ _ _ unions aliases _ _) env@(Env.Env home vs ts c

274 (Dups.unions (map snd unionInfo))

273 (Dups.unions (map snd unionInfo))

275 (Dups.unions (map snd aliasInfo))

274 (Dups.unions (map snd aliasInfo))

276

275

277− let cs2 = Map.unionWith OneOrMore.more cs ctors

276+ let cs2 = Map.unionWith Map.union cs ctors

278

277

279 Result.ok

278 Result.ok

280 ( Env.Env home vs ts cs2 bs qvs qts qcs

279 ( Env.Env home vs ts cs2 bs qvs qts qcs

@@ -283,7 +282,7 @@ addCtors (Valid.Module _ _ _ _ _ _ unions aliases _ _) env@(Env.Env home vs ts c

283 )

282 )

284

283

285

284

286−type CtorDups = Dups.Dict (OneOrMore.OneOrMore Env.Ctor)

285+type CtorDups = Dups.Dict (Map.Map ModuleName.Canonical Env.Ctor)

287

286

288

287

289

288

@@ -305,7 +304,7 @@ canonicalizeAlias env@(Env.Env home _ _ _ _ _ _ _) (Valid.Alias (A.At region nam

305

304

306 Result.ok

305 Result.ok

307 ( (name, alias)

306 ( (name, alias)

308− , Dups.one name region (OneOrMore.one ctor)

307+ , Dups.one name region (Map.singleton home ctor)

309 )

308 )

310

309

311 _ ->

310 _ ->

@@ -351,5 +350,5 @@ toOpts ctors =

351

350

352toCtor :: ModuleName.Canonical -> N.Name -> Can.Union -> A.Located Can.Ctor -> CtorDups

351toCtor :: ModuleName.Canonical -> N.Name -> Can.Union -> A.Located Can.Ctor -> CtorDups

353toCtor home typeName union (A.At region (Can.Ctor name index _ args)) =

352toCtor home typeName union (A.At region (Can.Ctor name index _ args)) =

354− Dups.one name region $ OneOrMore.one $

353+ Dups.one name region $ Map.singleton home $

355 Env.Ctor home typeName union index args

354 Env.Ctor home typeName union index args

src/Canonicalize/Expression.hs+10−12

@@ -14,6 +14,7 @@ import Control.Monad (foldM)

14import qualified Data.Graph as Graph

15import qualified Data.List as List

16import qualified Data.Map.Strict as Map

17+import qualified Data.Map.Strict.Internal as I

17import qualified Data.Text as Text

18import qualified Data.Text as Text

19import qualified AST.Canonical as Can

20import qualified AST.Canonical as Can

@@ -27,7 +28,6 @@ import qualified Canonicalize.Environment.Dups as Dups

27import qualified Canonicalize.Pattern as Pattern

28import qualified Canonicalize.Pattern as Pattern

28import qualified Canonicalize.Type as Type

29import qualified Canonicalize.Type as Type

29import qualified Data.Index as Index

30import qualified Data.Index as Index

30−import qualified Data.OneOrMore as OneOrMore

31import qualified Elm.Name as N

32import qualified Reporting.Annotation as A

33import qualified Reporting.Error.Canonicalize as Error

@@ -695,17 +695,15 @@ findVar region (Env.Env localHome vars _ _ _ _ _ _) name =

695 Env.TopLevel _ ->

696 logVar name (Can.VarTopLevel localHome name)

697

698− Env.Foreign bag ->

698+ Env.Foreign (I.Bin 1 home annotation _ _) ->

699− case bag of

700− OneOrMore.One (Env.ForeignVar home annotation) ->

701− Result.ok $

699+ Result.ok $

702− if home == ModuleName.debug then

700+ if home == ModuleName.debug then

703− Can.VarDebug localHome name annotation

701+ Can.VarDebug localHome name annotation

704− else

702+ else

705− Can.VarForeign home name annotation

703+ Can.VarForeign home name annotation

706

704

707− OneOrMore.More _ _ ->

705+ Env.Foreign _ ->

708− Result.throw (error ("TODO ambiguous unqualified " ++ N.toString name) region)

706+ Result.throw (error ("TODO ambiguous unqualified " ++ N.toString name) region)

709

707

710 Nothing ->

708 Nothing ->

711 Result.throw (error ("TODO no name " ++ N.toString name) region)

709 Result.throw (error ("TODO no name " ++ N.toString name) region)

@@ -716,7 +714,7 @@ findVarQual region (Env.Env localHome _ _ _ _ vars _ _) prefix name =

716 case Map.lookup prefix vars of

714 case Map.lookup prefix vars of

717 Just qualified ->

715 Just qualified ->

718 case Map.lookup name qualified of

716 case Map.lookup name qualified of

719− Just (OneOrMore.One (Env.ForeignVar home annotation)) ->

717+ Just (I.Bin 1 home annotation _ _) ->

720 Result.ok $

718 Result.ok $

721 if home == ModuleName.debug then

719 if home == ModuleName.debug then

722 Can.VarDebug localHome name annotation

720 Can.VarDebug localHome name annotation