This module combines multiple External Core modules into
a single module, including both datatype and value definitions.
-}
-module Language.Core.Merge(merge) where
+module Language.Core.Merge(merge,uniqueNamesIn,nonUniqueNamesIn) where
import Language.Core.Core
import Language.Core.CoreUtils
import Data.Char
import Data.Generics
import Data.List
+import Data.Maybe
{-
merge turns a group of (possibly mutually recursive) modules
merge :: [(Qual Var, Qual Var)] -> [Module] -> Module
merge subst ms =
- zapNames subst topNames (Module mainMname newTdefs [Rec topBinds])
+ zapNames subst topNames (Module mainMname newTdefs topBinds)
where -- note: dead code elimination will later remove any names
-- that were in the domain of the substitution
newTdefs = finishTdefs deadIds $ concat allTdefs
-> (tds, vdefgs)) ms
(deadIds,_) = unzip subst
topNames = uniqueNamesIn topBinds (concat allTdefs)
- topBinds = finishVdefs deadIds $ flattenBinds (concat allVdefgs)
+ (topBinds::[Vdefg]) = finishVdefs deadIds $ concat allVdefgs
{-
This function finds all of the names in the given group of vdefs and
(Both of those would allow for more names to be shortened, but aren't
strictly necessary.)
-}
-uniqueNamesIn :: [Vdef] -> [Tdef] -> [Qual Var]
+uniqueNamesIn :: [Vdefg] -> [Tdef] -> [Qual Var]
uniqueNamesIn topBinds allTdefs = res
+ where vars = vdefNamesQ (flattenBinds topBinds)
+ dcons = tdefDcons allTdefs
+ tcons = tdefTcons allTdefs
+ uniqueVars = vars \\ dupsUnqual vars
+ uniqueDcons = dcons \\ dupsUnqual dcons
+ uniqueTcons = tcons \\ dupsUnqual tcons
+ res = uniqueVars ++ uniqueDcons ++ uniqueTcons
+
+nonUniqueNamesIn :: [Vdef] -> [Tdef] -> [Qual Var]
+nonUniqueNamesIn topBinds allTdefs = dupsUnqual allNames
where allNames = vdefNamesQ topBinds ++ tdefNames allTdefs
- dups = dupsUnqual allNames
- res = allNames \\ dups
-
+
-- This takes each top-level name of the form Foo.Bar.blah and
-- renames it to FoozuBarzublah (note we *don't* make it exported!
-- This is so we know which names were in the original program and
&& cdefsOkay cdefs
cdefsOkay = all cdefOkay
cdefOkay (Constr qdc _ _) = qdc `notElem` namesToDrop
-finishVdefs :: [Qual Var] -> [Vdef] -> [Vdef]
-finishVdefs namesToDrop = filter (\ (Vdef (qv,_,_)) -> qv `notElem` namesToDrop)
+finishVdefs :: [Qual Var] -> [Vdefg] -> [Vdefg]
+finishVdefs namesToDrop = filterVdefgs
+ (\ (Vdef (qv,_,_)) -> qv `notElem` namesToDrop)