From 82212c7d133832a8b5bc5bea15bf42cdf418ec28 Mon Sep 17 00:00:00 2001
From: Tim Chevalier <chevalier@alum.wellesley.edu>
Date: Mon, 5 Jan 2009 19:26:45 +0000
Subject: [PATCH] ext-core: use shorter names when combining modules

---
 utils/ext-core/Language/Core/CoreUtils.hs |   11 +++++++++++
 utils/ext-core/Language/Core/Merge.hs     |   16 ++++++++++++----
 2 files changed, 23 insertions(+), 4 deletions(-)

diff --git a/utils/ext-core/Language/Core/CoreUtils.hs b/utils/ext-core/Language/Core/CoreUtils.hs
index afe4039..2967cd6 100644
--- a/utils/ext-core/Language/Core/CoreUtils.hs
+++ b/utils/ext-core/Language/Core/CoreUtils.hs
@@ -82,3 +82,14 @@ tdefNames = concatMap doOne
         doOne (Newtype qtc qtc1 _ _) = [qtc, qtc1]
         doCdef (Constr qdc _ _) = [qdc]
 
+tdefDcons :: [Tdef] -> [Qual Var]
+tdefDcons = concatMap doOne
+  where doOne (Data _ _ cds) = concatMap doCdef cds
+        doOne _ = []
+        doCdef (Constr qdc _ _) = [qdc]
+
+tdefTcons :: [Tdef] -> [Qual Var]
+tdefTcons = concatMap doOne
+  where doOne (Data qtc _ _) = [qtc]
+        doOne (Newtype qtc qtc1 _ _) = [qtc, qtc1]
+
diff --git a/utils/ext-core/Language/Core/Merge.hs b/utils/ext-core/Language/Core/Merge.hs
index a71146c..0907aa7 100644
--- 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
-- 
1.7.10.4