@@ -6,6 +6,7 @@ import qualified Data.Map as Map
66import qualified Data.Maybe as Maybe
77import qualified Data.Set as Set
88import qualified Data.Traversable as T
9+import qualified Data.Foldable as T
910
1011import AST.Expression.General (Expr'(..), dummyLet)
1112import AST.Module (Body(..))
@@ -24,6 +25,7 @@ import qualified Reporting.Annotation as A
2425import qualified Reporting.Error as Error
2526import qualified Reporting.Error.Canonicalize as CError
2627import qualified Reporting.Error.Helpers as ErrorHelp
28+import qualified Reporting.Region as Region
2729import qualified Reporting.Result as R
2830import qualified Reporting.Warning as Warning
2931import qualified Canonicalize.Declaration as Decls
@@ -116,7 +118,7 @@ moduleHelp interfaces modul@(Module.Module _ _ comment exports _ decls) =
116118 }
117119
118120
119−-- IMPORTS / EXPORTS
121+-- IMPORTS
120122
121123filterImports
122124 :: Set.Set Module.Name
@@ -132,73 +134,126 @@ filterImports uses modul@(Module.Module _ _ _ _ (defaults, imports) _) =
132134 }
133135 where
134136 checkImport (A.A region (name, _method)) =
135− if Set.member name uses
136− then
137+ if Set.member name uses then
137138 return (Just name)
138− else
139+ else
139140 do R.warn region (Warning.UnusedImport name)
140141 return Nothing
141142
142143
144+-- EXPORTS
145+
143146resolveExports
144147 :: [Var.Value]
145148 -> Var.Listing (A.Located Var.Value)
146149 -> Result.ResultErr [Var.Value]
147150resolveExports fullList (Var.Listing partialList open) =
148− if open
149− then Result.ok fullList
150− else
151− (\xs ys zs -> xs ++ ys ++ zs)
152− <$> T.traverse getValueExport values
153− <*> (concat <$> T.traverse getAliasExport aliases)
154− <*> T.traverse getAdtExport adts
155− where
156− (allValues, allAliases, allAdts) =
157− maybeUnzip3 (map splitValue fullList)
158−
159− (values, aliases, adts) =
160− maybeUnzip3 (map splitLocatedValue partialList)
161−
162− allValuesSet = Set.fromList allValues
163− adtTypes = map fst allAdts
164−
165− getValueExport (A.A region name) =
166− if Set.member name allValuesSet
167− then Result.ok (Var.Value name)
168− else manyNotFound region [name] allValues
169−
170− getAliasExport (A.A region alias)
171− | alias `elem` allAliases =
172− Result.ok $ (:) (Var.Alias alias) $
173− if alias `elem` allValues then [Var.Value alias] else []
174−
175− | List.elem alias adtTypes =
176− Result.ok [Var.Union alias (Var.Listing [] False)]
177−
178− | otherwise =
179− manyNotFound region [alias] (allAliases ++ adtTypes)
180−
181− getAdtExport (A.A region (name, Var.Listing ctors open)) =
182− case List.lookup name allAdts of
183− Nothing ->
184− manyNotFound region [name] adtTypes
185−
186− Just (Var.Listing allCtors _)
187− | open ->
188− Result.ok (Var.Union name (Var.Listing allCtors False))
189− | otherwise ->
190− case filter (`notElem` allCtors) ctors of
191− [] ->
192− Result.ok (Var.Union name (Var.Listing ctors False))
193− unfoundCtors ->
194− manyNotFound region unfoundCtors allCtors
195−
196− manyNotFound region nameList possibilities =
197− Result.errors (map (notFound region possibilities) nameList)
198−
199− notFound region possibilities name =
200− A.A region $ CError.Export name $
201− ErrorHelp.nearbyNames id name possibilities
151+ if open then
152+ Result.ok fullList
153+ else
154+ let
155+ (allValues, allAliases, allAdts) =
156+ maybeUnzip3 (map splitValue fullList)
157+
158+ (values, aliases, adts) =
159+ maybeUnzip3 (map splitLocatedValue partialList)
160+
161+ adtTypes =
162+ map fst allAdts
163+ in
164+ (\xs ys zs _ -> xs ++ ys ++ zs)
165+ <$> T.traverse (getValueExport allValues (Set.fromList allValues)) values
166+ <*> (concat <$> T.traverse (getAliasExport allValues allAliases adtTypes) aliases)
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
176+getValueExport allValues allValuesSet (A.A region name) =
177+ if Set.member name allValuesSet then
178+ Result.ok (Var.Value name)
179+ else
180+ manyNotFound region [name] allValues
181+
182+
183+getAliasExport
184+ :: [String]
185+ -> [String]
186+ -> [String]
187+ -> A.Located String
188+ -> Result.ResultErr [Var.Value]
189+getAliasExport allValues allAliases adtTypes (A.A region alias) =
190+ if alias `elem` allAliases then
191+
192+ Result.ok $ (:) (Var.Alias alias) $
193+ if alias `elem` allValues then [Var.Value alias] else []
194+
195+ else if List.elem alias adtTypes then
196+
197+ Result.ok [Var.Union alias (Var.Listing [] False)]
198+
199+ else
200+
201+ manyNotFound region [alias] (allAliases ++ adtTypes)
202+
203+
204+getAdtExport
205+ :: [(String, Var.Listing String)]
206+ -> [String]
207+ -> A.Located (String, Var.Listing String)
208+ -> Result.ResultErr Var.Value
209+getAdtExport allAdts adtTypes (A.A region (name, Var.Listing ctors open)) =
210+ case List.lookup name allAdts of
211+ Nothing ->
212+ manyNotFound region [name] adtTypes
213+
214+ Just (Var.Listing allCtors _) ->
215+ if open then
216+ Result.ok (Var.Union name (Var.Listing allCtors False))
217+ else
218+ case filter (`notElem` allCtors) ctors of
219+ [] ->
220+ Result.ok (Var.Union name (Var.Listing ctors False))
221+ unfoundCtors ->
222+ manyNotFound region unfoundCtors allCtors
223+
224+
225+manyNotFound :: Region.Region -> [String] -> [String] -> Result.ResultErr a
226+manyNotFound region nameList possibilities =
227+ Result.errors (map (notFound region possibilities) nameList)
228+
229+
230+notFound :: Region.Region -> [String] -> String -> A.Located CError.Error
231+notFound region possibilities name =
232+ A.A region $ CError.Export name $
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)
202257
203258
204259-- GROUPING VALUES