ext-core: use shorter names when combining modules

[ghc-hetmet.git] / utils / ext-core / Language / Core / Merge.hs

diff --git a/utils/ext-core/Language/Core/Merge.hs b/utils/ext-core/Language/Core/Merge.hs
index b5ffd05..0907aa7 100644 (file)
--- a/utils/ext-core/Language/Core/Merge.hs
+++ b/utils/ext-core/Language/Core/Merge.hs
@@ -2,7 +2,7 @@
    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
@@ -63,10 +63,18 @@ merge subst ms =
 -}
 uniqueNamesIn :: [Vdef] -> [Tdef] -> [Qual Var]
 uniqueNamesIn topBinds allTdefs = res
+  where vars  = vdefNamesQ 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
@@ -92,11 +100,9 @@ fixupName subst _ oldVar | Just newVar <- lookup oldVar subst = newVar
 -- We don't alter unqualified names, since we just need to make sure
 -- everything can go in the Main module.
 fixupName _ _ vr@(Nothing,_) = vr
--- Nor do we alter anything defined in the Main module
--- or in the primitive or Bool modules
--- (because we basically treat the Bool type as primitive.)
+-- Nor do we alter anything defined in the Main module or the primitive module.
 fixupName _ _ vr@(Just mn, _) | mn == mainMname || mn == wrapperMainMname ||
-                            mn == primMname || mn == boolMname = vr
+                            mn == primMname = vr
 -- For a variable that is defined by only one module in scope, we 
 -- give it a name that is just its unqualified name, without the original
 -- module and package names.