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

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

Author: wol...@gm...
Date: Tue Oct  7 16:35:02 2008
New Revision: 333

Modified:
    trunk/hoc/InterfaceGenerator2/ShuffleInstances.hs

Log:
bugfix: when removing superfluous selector instances,
distinguish between instance and factory methods.

@interface X
{
}
- foo;  // -> instance Has_foo (X a)
- bar;  // -> instance Has_bar (X a)
@end

@interface Y
{
}
- foo;  // -> superfluous, no additional instance declaration
+ bar;  // instance Has_bar (YClass a)  -- used to be erroneously omitted
@end


Modified: trunk/hoc/InterfaceGenerator2/ShuffleInstances.hs
==============================================================================
--- trunk/hoc/InterfaceGenerator2/ShuffleInstances.hs	(original)
+++ trunk/hoc/InterfaceGenerator2/ShuffleInstances.hs	Tue Oct  7 16:35:02  
2008
@@ -68,25 +68,25 @@
      where
          keepEntity entity
              = case isInstance entity of
-                Just (classID, adoptedID)
-                    | any (\s -> adoptedID `Set.member` instances s)
+                Just (classID, adopted)
+                    | any (\s -> adopted `Set.member` instances s)
                            (clsTree Map.! classID)
                      -> False
                  _   -> True

          isInstance (Entity { eName = ProtocolAdoptionName classID protoID  
})
-            = Just (classID, protoID)
+            = Just (classID, (protoID, False))
          isInstance (Entity { eName = SelectorInstanceName classID selID  
isFactory })
-            = Just (classID, selID)
+            = Just (classID, (selID, isFactory))
          isInstance _ = Nothing

-        instances :: EntityID -> Set.Set EntityID
+        instances :: EntityID -> Set.Set (EntityID, Bool)
          instances = fromMaybe Set.empty . flip Map.lookup instancesMap

          instancesMap =
              Map.fromListWith Set.union
-            [ (classID, Set.singleton adoptedID)
-            | Just (classID, adoptedID)
+            [ (classID, Set.singleton adopted)
+            | Just (classID, adopted)
                  <- map isInstance $ map snd $
                     entityPileToList entityPile ]