2cc0df4 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Clean up export canonicalization code

2cc0df4Evan Czaplicki11 years ago

src/Canonicalize.hs+113−58

compare with master

unifiedsplit

@@ -6,6 +6,7 @@ import qualified Data.Map as Map

6import qualified Data.Maybe as Maybe

7import qualified Data.Set as Set

8import qualified Data.Traversable as T

9+import qualified Data.Foldable as T

10import AST.Expression.General (Expr'(..), dummyLet)

11import AST.Expression.General (Expr'(..), dummyLet)

11import AST.Module (Body(..))

12import AST.Module (Body(..))

@@ -24,6 +25,7 @@ import qualified Reporting.Annotation as A

24import qualified Reporting.Error as Error

25import qualified Reporting.Error as Error

25import qualified Reporting.Error.Canonicalize as CError

26import qualified Reporting.Error.Canonicalize as CError

26import qualified Reporting.Error.Helpers as ErrorHelp

27import qualified Reporting.Error.Helpers as ErrorHelp

28+import qualified Reporting.Region as Region

27import qualified Reporting.Result as R

29import qualified Reporting.Result as R

28import qualified Reporting.Warning as Warning

30import qualified Reporting.Warning as Warning

29import qualified Canonicalize.Declaration as Decls

31import qualified Canonicalize.Declaration as Decls

@@ -116,7 +118,7 @@ moduleHelp interfaces modul@(Module.Module _ _ comment exports _ decls) =

116 }

118 }

117

119

118

120

119−-- IMPORTS / EXPORTS

121+-- IMPORTS

120

122

121filterImports

123filterImports

122 :: Set.Set Module.Name

124 :: Set.Set Module.Name

@@ -132,73 +134,126 @@ filterImports uses modul@(Module.Module _ _ _ _ (defaults, imports) _) =

132 }

134 }

133 where

135 where

134 checkImport (A.A region (name, _method)) =

136 checkImport (A.A region (name, _method)) =

135− if Set.member name uses

137+ if Set.member name uses then

136− then

137 return (Just name)

138 return (Just name)

138− else

139+ else

139 do R.warn region (Warning.UnusedImport name)

140 do R.warn region (Warning.UnusedImport name)

140 return Nothing

141 return Nothing

141

142

143

144+-- EXPORTS

145+

143resolveExports

146resolveExports

144 :: [Var.Value]

147 :: [Var.Value]

145 -> Var.Listing (A.Located Var.Value)

148 -> Var.Listing (A.Located Var.Value)

146 -> Result.ResultErr [Var.Value]

149 -> Result.ResultErr [Var.Value]

147resolveExports fullList (Var.Listing partialList open) =

150resolveExports fullList (Var.Listing partialList open) =

148− if open

151+ if open then

149− then Result.ok fullList

152+ Result.ok fullList

150− else

153+ else

151− (\xs ys zs -> xs ++ ys ++ zs)

154+ let

152− <$> T.traverse getValueExport values

153− <*> (concat <$> T.traverse getAliasExport aliases)

154− <*> T.traverse getAdtExport adts

155− where

156− (allValues, allAliases, allAdts) =

155+ (allValues, allAliases, allAdts) =

157− maybeUnzip3 (map splitValue fullList)

156+ maybeUnzip3 (map splitValue fullList)

158−

157+

159− (values, aliases, adts) =

158+ (values, aliases, adts) =

160− maybeUnzip3 (map splitLocatedValue partialList)

159+ maybeUnzip3 (map splitLocatedValue partialList)

161−

160+

161+ adtTypes =

162+ map fst allAdts

163+ in

164+ (\xs ys zs _ -> xs ++ ys ++ zs)

162− allValuesSet = Set.fromList allValues

165+ <$> T.traverse (getValueExport allValues (Set.fromList allValues)) values

163− adtTypes = map fst allAdts

166+ <*> (concat <$> T.traverse (getAliasExport allValues allAliases adtTypes) aliases)

164−

167+ <*> T.traverse (getAdtExport allAdts adtTypes) adts

168+ <*> allUnique partialList

169+

170+

171+getValueExport

172+ :: [String]

173+ -> Set.Set String

174+ -> A.Located String

175+ -> Result.ResultErr Var.Value

165− getValueExport (A.A region name) =

176+getValueExport allValues allValuesSet (A.A region name) =

166− if Set.member name allValuesSet

177+ if Set.member name allValuesSet then

167− then Result.ok (Var.Value name)

178+ Result.ok (Var.Value name)

179+ else

168− else manyNotFound region [name] allValues

180+ manyNotFound region [name] allValues

169−

181+

182+

183+getAliasExport

184+ :: [String]

185+ -> [String]

186+ -> [String]

187+ -> A.Located String

188+ -> Result.ResultErr [Var.Value]

170− getAliasExport (A.A region alias)

189+getAliasExport allValues allAliases adtTypes (A.A region alias) =

171− | alias `elem` allAliases =

190+ if alias `elem` allAliases then

191+

172− Result.ok $ (:) (Var.Alias alias) $

192+ Result.ok $ (:) (Var.Alias alias) $

173− if alias `elem` allValues then [Var.Value alias] else []

193+ if alias `elem` allValues then [Var.Value alias] else []

174−

194+

175− | List.elem alias adtTypes =

195+ else if List.elem alias adtTypes then

196+

176− Result.ok [Var.Union alias (Var.Listing [] False)]

197+ Result.ok [Var.Union alias (Var.Listing [] False)]

177−

198+

178− | otherwise =

199+ else

200+

179− manyNotFound region [alias] (allAliases ++ adtTypes)

201+ manyNotFound region [alias] (allAliases ++ adtTypes)

180−

202+

203+

204+getAdtExport

205+ :: [(String, Var.Listing String)]

206+ -> [String]

207+ -> A.Located (String, Var.Listing String)

208+ -> Result.ResultErr Var.Value

181− getAdtExport (A.A region (name, Var.Listing ctors open)) =

209+getAdtExport allAdts adtTypes (A.A region (name, Var.Listing ctors open)) =

182− case List.lookup name allAdts of

210+ case List.lookup name allAdts of

183− Nothing ->

211+ Nothing ->

184− manyNotFound region [name] adtTypes

212+ manyNotFound region [name] adtTypes

185−

213+

186− Just (Var.Listing allCtors _)

214+ Just (Var.Listing allCtors _) ->

187− | open ->

215+ if open then

188− Result.ok (Var.Union name (Var.Listing allCtors False))

216+ Result.ok (Var.Union name (Var.Listing allCtors False))

189− | otherwise ->

217+ else

190− case filter (`notElem` allCtors) ctors of

218+ case filter (`notElem` allCtors) ctors of

191− [] ->

219+ [] ->

192− Result.ok (Var.Union name (Var.Listing ctors False))

220+ Result.ok (Var.Union name (Var.Listing ctors False))

193− unfoundCtors ->

221+ unfoundCtors ->

194− manyNotFound region unfoundCtors allCtors

222+ manyNotFound region unfoundCtors allCtors

195−

223+

224+

225+manyNotFound :: Region.Region -> [String] -> [String] -> Result.ResultErr a

196− manyNotFound region nameList possibilities =

226+manyNotFound region nameList possibilities =

197− Result.errors (map (notFound region possibilities) nameList)

227+ Result.errors (map (notFound region possibilities) nameList)

198−

228+

229+

230+notFound :: Region.Region -> [String] -> String -> A.Located CError.Error

199− notFound region possibilities name =

231+notFound region possibilities name =

200− A.A region $ CError.Export name $

232+ A.A region $ CError.Export name $

201− ErrorHelp.nearbyNames id name possibilities

233+ ErrorHelp.nearbyNames id name possibilities

234+

235+

236+allUnique :: [A.Located Var.Value] -> Result.ResultErr ()

237+allUnique statedExports =

238+ let

239+ valueToString value =

240+ case value of

241+ Var.Value name -> name

242+ Var.Alias name -> name

243+ Var.Union name _ -> name

244+

245+ locations =

246+ Map.fromListWith (++) (map (\(A.A region value) -> (value, [region])) statedExports)

247+

248+ isUnique value allRegions =

249+ case allRegions of

250+ region : _ : _ ->

251+ Result.err (A.A region (CError.DuplicateExport (valueToString value)))

252+

253+ _ ->

254+ Result.ok ()

255+ in

256+ T.traverse_ id (Map.mapWithKey isUnique locations)

202

257

203

258

204-- GROUPING VALUES

259-- GROUPING VALUES

src/Reporting/Error/Canonicalize.hs+9

@@ -18,6 +18,7 @@ data Error

18 | Alias AliasError

19 | Import Module.Name ImportError

20 | Export String [String]

21+ | DuplicateExport String

21 | Port PortError

22 | Port PortError

@@ -195,6 +196,11 @@ toReport dealiaser err =

195 ("Could not export `" ++ name ++ "` which is not defined in this module.")

196 ("Could not export `" ++ name ++ "` which is not defined in this module.")

196 (Help.maybeYouWant suggestions)

197 (Help.maybeYouWant suggestions)

197

198

199+ DuplicateExport name ->

200+ namingError

201+ ("You are trying to export `" ++ name ++ "` multiple times!")

202+ "Remove duplicates until there is only one listed."

203+

198 Port (PortError name isInbound _rootType localType maybeMessage) ->

204 Port (PortError name isInbound _rootType localType maybeMessage) ->

199 let

205 let

200 boundPort =

206 boundPort =

@@ -251,5 +257,8 @@ extractSuggestions err =

251 Export _ suggestions ->

257 Export _ suggestions ->

252 Just suggestions

258 Just suggestions

253

259

260+ DuplicateExport _ ->

261+ Nothing

262+

254 Port _ ->

263 Port _ ->

255 Nothing

264 Nothing