@@ -43,10 +43,10 @@ module' interfaces modul =
4343
4444moduleHelp :: Module.Interfaces -> Module.ValidModule
4545 -> Canonicalizer [Doc] Module.CanonicalModule
46−moduleHelp interfaces modul@(Module.Module _ _ exs _ decls) =
46+moduleHelp interfaces modul@(Module.Module _ _ exports _ decls) =
4747 do env <- Setup.environment interfaces modul
4848 canonicalDecls <- mapM (declaration env) decls
49− exports' <- delist locals exs
49+ exports' <- resolveExports locals exports
5050 return $ modul { Module.exports = exports'
5151 , Module.body = body canonicalDecls
5252 }
@@ -71,40 +71,71 @@ moduleHelp interfaces modul@(Module.Module _ _ exs _ decls) =
7171 [ D.portName port | D.Port port <- decls ]
7272 }
7373
74−delist :: [Var.Value] -> Var.Listing Var.Value -> Canonicalizer [Doc] [Var.Value]
75−delist fullList (Var.Listing partial open)
76− | open = return fullList
77− | otherwise = go [] (List.sort fullList) (List.sort partial)
74+resolveExports :: [Var.Value] -> Var.Listing Var.Value -> Canonicalizer [Doc] [Var.Value]
75+resolveExports fullList (Var.Listing partialList open) =
76+ if open
77+ then return fullList
78+ else do
79+ valueExports <- getValueExports
80+ aliasExports <- concat `fmap` mapM getAliasExport aliases
81+ adtExports <- mapM getAdtExport adts
82+ return $ valueExports ++ aliasExports ++ adtExports
7883 where
84+ (allValues, allAliases, allAdts) = splitValues fullList
85+
86+ (values, aliases, adts) = splitValues partialList
87+
88+ getValueExports =
89+ case Set.toList (Set.difference values' allValues') of
90+ [] -> return (map Var.Value values)
91+ xs -> notFound xs
92+ where
93+ allValues' = Set.fromList allValues
94+ values' = Set.fromList values
95+
96+ getAliasExport alias
97+ | alias `elem` allAliases =
98+ let recordConstructor =
99+ if alias `elem` allValues then [Var.Value alias] else []
100+ in
101+ return $ Var.Alias alias : recordConstructor
102+
103+ | otherwise =
104+ case List.find (\(name, _ctors) -> name == alias) allAdts of
105+ Nothing -> notFound [alias]
106+ Just (name, _ctor) ->
107+ return [Var.ADT name (Var.Listing [] False)]
108+
109+ getAdtExport (name, Var.Listing ctors open) =
110+ case lookup name allAdts of
111+ Nothing -> notFound [name]
112+ Just (Var.Listing allCtors _)
113+ | open -> return $ Var.ADT name (Var.Listing allCtors False)
114+ | otherwise ->
115+ case filter (`notElem` allCtors) ctors of
116+ [] -> return $ Var.ADT name (Var.Listing ctors False)
117+ unfoundCtors -> notFound unfoundCtors
118+
79119 notFound xs =
80120 throwError [ P.text "Export Error: trying to export non-existent values:" <+>
81121 commaSep (map pretty xs)
82122 ]
83123
84− go list full partial =
85− case (full, partial) of
86− (_, []) -> return list
87− ([], _) -> notFound partial
88− (x:xs, y:ys) ->
89− case (x,y) of
90− (Var.Value x', Var.Value y') | x' == y' ->
91− go (x : list) xs ys
92−
93− (Var.Alias x', Var.Alias y') | x' == y' ->
94− go (x : list) xs ys
95−
96− (Var.ADT x' _, Var.Alias y') | x' == y' ->
97− go (Var.ADT x' (Var.Listing [] False) : list) xs ys
98−
99− (Var.ADT x' (Var.Listing xctors _ ),
100− Var.ADT y' (Var.Listing yctors open)) | x' == y' ->
101− if open
102− then go (x : list) xs ys
103− else case filter (`notElem` xctors) yctors of
104− [] -> go (y : list) xs ys
105− bads -> notFound bads
106−
107− _ -> go list xs partial
124+{-| Split a list of values into categories so we can work with them
125+independently.
126+-}
127+splitValues :: [Var.Value] -> ([String], [String], [(String, Var.Listing String)])
128+splitValues mixedValues =
129+ case mixedValues of
130+ [] -> ([], [], [])
131+ x:xs ->
132+ let (values, aliases, adts) = splitValues xs in
133+ case x of
134+ Var.Value name -> (name : values, aliases, adts)
135+ Var.Alias name -> (values, name : aliases, adts)
136+ Var.ADT name listing ->
137+ (values, aliases, (name, listing) : adts)
138+
108139
109140
110141declToValue :: D.ValidDecl -> [Var.Value]