[hoc-cvs] [hoc commit] r342 - trunk/hoc/InterfaceGenerator2

[<cod...@go...>]

Author: wol...@gm...
Date: Sat Oct 25 09:13:38 2008
New Revision: 342

Modified:
    trunk/hoc/InterfaceGenerator2/Main.hs
    trunk/hoc/InterfaceGenerator2/RenameClashingIdentifiers.hs

Log:
Cleanup & activate RenameClashingIdentifiers phase


Modified: trunk/hoc/InterfaceGenerator2/Main.hs
==============================================================================
--- trunk/hoc/InterfaceGenerator2/Main.hs	(original)
+++ trunk/hoc/InterfaceGenerator2/Main.hs	Sat Oct 25 09:13:38 2008
@@ -35,6 +35,7 @@
  import ResolveAndZap
  import ShuffleInstances
  import DuplicateEntities
+import RenameClashingIdentifiers

  import DependenceGraphs
  import Output
@@ -145,6 +146,8 @@
          zapProgress       <- mkProgress "Zapping unconvertable entities"
          expandProgress    <- mkProgress "Filling in additional instance  
declarations"
          combineProgress   <- mkProgress "Combining duplicate entities"
+        renameProgress    <- mkProgress "Resolving name conflicts"
+
          eliminateProgress <- mkProgress "Eliminating redundant instances"
          outputProgress    <- mkProgress "Writing binding modules"
          masterProgress    <- mkProgress $ "Writing " ++ frameworkName  
++ ".hs"
@@ -198,7 +201,8 @@
              (zappedEntities, zapMessages) = runMessages $  
zapAndReportFailedTypes zapProgress typedEntities
              expandedEntities = monitor expandProgress $  
expandProtocolRequirements zappedEntities
              combinedEntities = monitor combineProgress $  
combineDulicateEntities expandedEntities
-            finalEntities = eliminateSubclassInstances eliminateProgress  
combinedEntities
+            renamedEntities = monitor renameProgress $  
renameClashingIdentifiers $ combinedEntities
+            finalEntities = eliminateSubclassInstances eliminateProgress  
renamedEntities

          do
              let packageName = "HOC-" ++ frameworkName

Modified: trunk/hoc/InterfaceGenerator2/RenameClashingIdentifiers.hs
==============================================================================
--- trunk/hoc/InterfaceGenerator2/RenameClashingIdentifiers.hs	(original)
+++ trunk/hoc/InterfaceGenerator2/RenameClashingIdentifiers.hs	Sat Oct 25  
09:13:38 2008
@@ -4,63 +4,11 @@
  import qualified Data.Map as Map
  import Data.List( sort, sortBy, groupBy, nub )

-import Debug.Trace
  import Data.ByteString.Char8(ByteString)
  import qualified Data.ByteString.Char8 as BS

  renameClashingIdentifiers :: EntityPile -> EntityPile

-{-data Namespace = SelectorNamespace
-               | UnimportantNamespace
-               deriving (Ord, Eq, Show)
-
-getNamespace (SelectorEntity _) = SelectorNamespace
-getNamespace _ = UnimportantNamespace
--}
-
-{-
-renameClashingIdentifiers ep
-    = ep { epEntities = Map.fromList $
-                        concat $
-                        map resolveClash $
-                        groupedByModuleAndName }
-    where
-        groupedByModuleAndName
-            = Map.toList $ Map.fromListWith (++) $
-              [ ( (eModule entity, eHaskellName entity{-, getNamespace $  
eInfo entity-} ),
-                [(entityID, entity)] )
-              | (entityID, entity) <- Map.toList $ epEntities ep ]
-
-
-        resolveClash ( _, [x] ) = [x]
-        resolveClash ( (mod, name{-, UnimportantNamespace-} ), entities )
-            = entities
-        resolveClash ( (mod, name{-, namespace-} ), entities )
-            | BS.null name = entities
-        resolveClash ( (mod, name{-, namespace-}), entities )
-            = trace (show (mod,name, map (show . eName . snd) entities)) $
-              case possibleCombos of
-                (combo : _)
-                    -> trace (show combo) $
-                       zipWith renameEntity entities combo
-            where
-                names = map possibleNamesForEntity entities
-
-                possibleNamesFor (LocalID _, e)
-                    = eHaskellName e : eAlternateHaskellNames e
-                    ++ [ eHaskellName e `BS.append` BS.pack ("_" ++ show  
i) | i <- [1..] ]
-                possibleNamesFor (_, e)
-                    = [eHaskellName e]
-
-                possibleCombos = filter checkCombo $ nameCombinations names
-
-                checkCombo = all ((==1) . length) . group . sort
-
-                renameEntity (entityID, entity) newName
-                    = (entityID, entity { eHaskellName = newName })
--}
-
-
  renameClashingIdentifiers ep
      = ep { epEntities = Map.fromList $
                          concatMap handleName $
@@ -100,25 +48,17 @@
                      filter ( (> 1) . length ) $
                      map nub $
                      map (map snd) $ groupByFst $ sort $
-                        --map fst $ (\x -> if BS.unpack hName == "action"  
then trace (show x) x else x) $
-                        [ (eModule e, index) --, (eid, e))
+                        [ (eModule e, index)
                          | (index, entities) <- zip [0..] groupedEntities,
                            (_, (eid, e)) <- entities ]

                  checkCombo newNames
                      = all checkClash clashes
                      where
-                        checkClash clash =
-                                trace (show (clash, newNames)) $ nub  
toBeTested == toBeTested
+                        checkClash clash = nub toBeTested == toBeTested
                              where toBeTested = extract clash newNames

                          extract indices xs = map (xs!!) indices
-                        {-extract [] i0 _ = []
-                        extract (index : indices) i0 xs
-                            = (xs !! (index - i0))
-                            : extract indices
-                                      (index + 1)
-                                      (drop (index - i0 + 1) xs)-}

                  renameEntity (entityID, entity) newName
                      = (entityID, entity { eHaskellName = newName })
@@ -145,4 +85,3 @@
              return (chosenName : moreChosenNames)


--- (e1_n1 | e1_n2 | e1_n3) & (e2_n1 | e2_n2) & (!e1_n1 | !e2_n1) & (!e1_n2  
| !e2_n2)
\ No newline at end of file