summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTim Chevalier <chevalier@alum.wellesley.edu>2009-01-05 19:26:45 +0000
committerTim Chevalier <chevalier@alum.wellesley.edu>2009-01-05 19:26:45 +0000
commit82212c7d133832a8b5bc5bea15bf42cdf418ec28 (patch)
tree8ba68eda45a63f8011721e9f42510d8d15466114
parent1718c708d577ddc87bd1a8774935189d4f0b418b (diff)
downloadhaskell-82212c7d133832a8b5bc5bea15bf42cdf418ec28.tar.gz
ext-core: use shorter names when combining modules
-rw-r--r--utils/ext-core/Language/Core/CoreUtils.hs11
-rw-r--r--utils/ext-core/Language/Core/Merge.hs16
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 afe4039c25..2967cd64dc 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 a71146cc33..0907aa7f6e 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