hoc-cvs

[Wolfgang T. <wth...@us...>]

Update of /cvsroot/hoc/hoc/InterfaceGenerator
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv19794/InterfaceGenerator

Modified Files:
	BindingScript.hs Enums.hs ExportModule.hs 
	PrepareDeclarations.hs 
Log Message:
Update for GHC 6.6


Index: ExportModule.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/InterfaceGenerator/ExportModule.hs,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- ExportModule.hs	20 Mar 2006 06:33:50 -0000	1.10
+++ ExportModule.hs	1 Nov 2006 15:45:05 -0000	1.11
@@ -14,7 +14,8 @@
 
 import HOC.NameCaseChange
 
-import Data.Set(setToList, unionManySets, mkSet, intersect)
+import Data.Set(Set)
+import qualified Data.Set as Set hiding (Set)
 import qualified Data.HashTable as HashTable
 import Data.List(nub, partition, isPrefixOf, group, sort)
 import Data.Maybe(fromMaybe, catMaybes, mapMaybe, maybeToList, isNothing)
@@ -30,8 +31,8 @@
     let definedClassInfos = [ ci | (_,ci) <- cleanClassInfos, ciDefinedIn ci == moduleName ]
         superClasses = nub $ catMaybes $ map ciSuper definedClassInfos
         adoptedProtocols = map (++ "Protocol") $
-                           setToList $
-                           unionManySets $
+                           Set.toList $
+                           Set.unions $
                            map ciNewProtocols $
                            definedClassInfos
     
@@ -109,8 +110,8 @@
 
     adoptedProtoImports <- makeProtocolImports $
                            map (++ "Protocol") $
-                           setToList $
-                           unionManySets $
+                           Set.toList $
+                           Set.unions $
                            map ciNewProtocols $
                            definedClassInfos
 
@@ -184,7 +185,7 @@
 
         exportedSelNames = map msMangled selsToDefineOrImport
         exportedSels = concatMap idsForSel exportedSelNames
-        exportedSelSet = mkSet exportedSelNames
+        exportedSelSet = Set.fromList exportedSelNames
 
         exportedClasses = concat [ idsForClass $ ciName ci
                                  | ci <- definedClassInfos,
@@ -196,7 +197,7 @@
             
 
         protoAdoptions = concat [ [ (proto ++ "Protocol", ciName ci)
-                                  | proto <- setToList $ ciNewProtocols ci]
+                                  | proto <- Set.toList $ ciNewProtocols ci]
                                 | ci <- definedClassInfos, not (ciProtocol ci) ]
                                 
         varDeclarations = Map.findWithDefault [] moduleName allVarDeclarations
@@ -221,7 +222,7 @@
          
     mentionedClassImports <- makeForwardClassImports mentionedClassNames
 
-    categoryImports <- makeForwardClassImports $ setToList $ mkSet $ map fst (instanceSels ++ classSels)
+    categoryImports <- makeForwardClassImports $ Set.toList $ Set.fromList $ map fst (instanceSels ++ classSels)
 
     additionalCode <- readFileOrEmpty (additionalCodePath (dotToSlash moduleName ++ ".hs"))
 
@@ -285,8 +286,8 @@
                                  ))
                     <+> text "where",
                 text "import Prelude hiding" <+>
-                    parens (sep $ punctuate comma $ map text $ setToList $
-                            bsHiddenFromPrelude bindingScript `intersect` exportedSelSet),
+                    parens (sep $ punctuate comma $ map text $ Set.toList $
+                            bsHiddenFromPrelude bindingScript `Set.intersection` exportedSelSet),
                 text "import Foreign.C.Types",
                 text "import Foreign.Ptr",
                 text "import HOC",
@@ -376,7 +377,7 @@
                                         classes) <+> text "=>"
                                        
                 | otherwise = empty
-        classes =    map (++ "Protocol") (setToList $ ciNewProtocols ci)
+        classes =    map (++ "Protocol") (Set.toList $ ciNewProtocols ci)
                   ++ map (("Has_" ++) . msMangled . fst) selsAndLocs
 
 pprSelDecl :: MangledSelector -> Doc

Index: PrepareDeclarations.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/InterfaceGenerator/PrepareDeclarations.hs,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- PrepareDeclarations.hs	5 Oct 2005 02:55:49 -0000	1.14
+++ PrepareDeclarations.hs	1 Nov 2006 15:45:05 -0000	1.15
@@ -18,8 +18,8 @@
 import HOC.SelectorNameMangling(mangleSelectorName)
 
 import Control.Monad(when)
-import Data.Set(Set, mkSet, setToList, union, minusSet, unionManySets,
-                emptySet, elementOf)
+import Data.Set(Set)
+import qualified Data.Set as Set hiding (Set)
 import qualified Data.Map as Map
 import qualified Data.HashTable as HashTable
 import Data.Maybe(maybeToList, fromMaybe, mapMaybe)
@@ -62,7 +62,7 @@
         ciProtocol = False,
         ciName = nameToUppercase name,
         ciSuper = fmap nameToUppercase super,
-        ciProtocols = mkSet (map nameToUppercase protocols),
+        ciProtocols = Set.fromList (map nameToUppercase protocols),
         ciDefinedIn = moduleName,
         ciInstanceMethods = Map.fromList [ (sel, SelectorLocation moduleName moduleName)
                                      | InstanceMethod sel <- methods ],
@@ -77,7 +77,7 @@
         ciProtocol = True,
         ciName = nameToUppercase name ++ "Protocol",
         ciSuper = Nothing,
-        ciProtocols = mkSet (map nameToUppercase protocols),
+        ciProtocols = Set.fromList (map nameToUppercase protocols),
         ciDefinedIn = moduleName,
         ciInstanceMethods = Map.fromList [ (sel, SelectorLocation moduleName cantHappen)
                                      | InstanceMethod sel <- methods ],
@@ -102,7 +102,7 @@
                    "(" ++ catName ++ ") - class undefined"
             Just classInfo -> do                
                 let classInfo' = classInfo {
-                        ciProtocols = ciProtocols classInfo `union` mkSet moreProtocols,
+                        ciProtocols = ciProtocols classInfo `Set.union` Set.fromList moreProtocols,
                         ciInstanceMethods =
                             addListToFM_C (\old new -> old)
                                             (ciInstanceMethods classInfo)
@@ -149,7 +149,7 @@
             (protocols,protoRecheck) <- fmap unzip $
                                         mapM findOrClean $
                                         map (++"Protocol") $
-                                        setToList $
+                                        Set.toList $
                                         ciProtocols ci
             return (mbSuper, protocols, or (superRecheck : protoRecheck))
         findOrClean name = do
@@ -175,8 +175,8 @@
             ciNewClassMethods =
                 ciClassMethods info `Map.difference`
                 (unionProtocols ciClassMethods),
-            ciProtocols = ciProtocols info `union` protocolsAdoptedByAdoptedProtocols,
-            ciNewProtocols = ciProtocols info `minusSet` protocolsAdoptedByAdoptedProtocols
+            ciProtocols = ciProtocols info `Set.union` protocolsAdoptedByAdoptedProtocols,
+            ciNewProtocols = ciProtocols info `Set.difference` protocolsAdoptedByAdoptedProtocols
         }
     | otherwise =
         info {
@@ -193,11 +193,11 @@
                                     (unionProtocols ciClassMethods))
                                 `Map.difference` super ciClassMethods,
             ciProtocols = ciProtocols info
-                          `union` protocolsAdoptedByAdoptedProtocols
-                          `union` protocolsAdoptedBySuper,
+                          `Set.union` protocolsAdoptedByAdoptedProtocols
+                          `Set.union` protocolsAdoptedBySuper,
             ciNewProtocols = ciProtocols info   
-                             `union` protocolsAdoptedByAdoptedProtocols
-                             `minusSet` protocolsAdoptedBySuper
+                             `Set.union` protocolsAdoptedByAdoptedProtocols
+                             `Set.difference` protocolsAdoptedBySuper
         }
         where
             super extract = case mbSuperInfo of
@@ -218,10 +218,10 @@
                                               (Map.map (\(SelectorLocation def _)
                                                      -> (SelectorLocation def (ciDefinedIn info)))
                                                      proto)
-            protocolsAdoptedByAdoptedProtocols = unionManySets $
+            protocolsAdoptedByAdoptedProtocols = Set.unions $
                                       map ciProtocols $
                                       protocolInfos
-            protocolsAdoptedBySuper = fromMaybe emptySet $ fmap ciProtocols $ mbSuperInfo
+            protocolsAdoptedBySuper = fromMaybe Set.empty $ fmap ciProtocols $ mbSuperInfo
             
                                               
 data MangledSelector = MangledSelector {
@@ -302,9 +302,9 @@
                             Just x -> x
                             Nothing -> sel
                     
-                    when (name `elementOf` soHiddenSelectors selectorOptions) $ Nothing
+                    when (name `Set.member` soHiddenSelectors selectorOptions) $ Nothing
                     
-                    let covariant = mangled `elementOf` soCovariantSelectors selectorOptions
+                    let covariant = mangled `Set.member` soCovariantSelectors selectorOptions
                         kind | covariant && factory = CovariantInstanceSelector
                              | covariant = CovariantSelector
                              | "alloc" `isFirstWordOf` name = AllocSelector

Index: BindingScript.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/InterfaceGenerator/BindingScript.hs,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- BindingScript.hs	5 Oct 2005 02:55:49 -0000	1.9
+++ BindingScript.hs	1 Nov 2006 15:45:04 -0000	1.10
@@ -13,7 +13,8 @@
 
 import Control.Monad(when)
 import qualified Data.Map as Map
-import Data.Set(Set, union, mkSet, setToList)
+import Data.Set(Set)
+import qualified Data.Set as Set hiding (Set)
 import Data.List(intersperse)
 
 import Text.ParserCombinators.Parsec.Language(haskellStyle)
@@ -43,9 +44,9 @@
                             soNameMappings = soNameMappings opt
                                     `Map.union` soNameMappings top,
                             soCovariantSelectors = soCovariantSelectors opt
-                                           `union` soCovariantSelectors top,
+                                           `Set.union` soCovariantSelectors top,
                             soHiddenSelectors = soHiddenSelectors opt
-                                        `union` soHiddenSelectors top,
+                                        `Set.union` soHiddenSelectors top,
                             soChangedSelectors = soChangedSelectors opt
                                         `Map.union` soChangedSelectors top
                         }
@@ -80,9 +81,9 @@
     SelectorOptions {
             soNameMappings = Map.fromList [ (objc, haskell)
                                       | Rename objc haskell <- statements ],
-            soCovariantSelectors = mkSet $ [ ident 
+            soCovariantSelectors = Set.fromList $ [ ident 
                                            | Covariant ident <- statements ],
-            soHiddenSelectors = mkSet $ [ ident | Hide ident <- statements ],
+            soHiddenSelectors = Set.fromList $ [ ident | Hide ident <- statements ],
             soChangedSelectors = Map.fromList [ (selName sel, sel)
                                           | ReplaceSelector sel <- statements ]
     }
@@ -140,8 +141,8 @@
     let wrongThings = [ () | ReplaceSelector _ <- statements ]
     
     return $ BindingScript {
-            bsHiddenFromPrelude = mkSet [ ident | HidePrelude ident <- statements ],
-            bsHiddenEnums = mkSet [ ident | HideEnum ident <- statements ],
+            bsHiddenFromPrelude = Set.fromList [ ident | HidePrelude ident <- statements ],
+            bsHiddenEnums = Set.fromList [ ident | HideEnum ident <- statements ],
             bsTopLevelOptions = extractSelectorOptions statements,
             bsAdditionalTypes = [ (typ, mod) | Type typ mod <- statements ],
             bsClassSpecificOptions = Map.fromList [ (cls, opt)
@@ -152,4 +153,4 @@
     either <- parseFromFile bindingScript fn
     case either of
         Left err -> error (show err)
-        Right result -> print (setToList $ bsHiddenEnums result) >> return result
+        Right result -> print (Set.toList $ bsHiddenEnums result) >> return result

Index: Enums.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/InterfaceGenerator/Enums.hs,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- Enums.hs	5 Oct 2005 02:55:49 -0000	1.5
+++ Enums.hs	1 Nov 2006 15:45:04 -0000	1.6
@@ -14,7 +14,8 @@
 import Data.Char        ( toUpper )
 import Data.Maybe       ( mapMaybe )
 import qualified Data.Map as Map   ( Map, fromList )
-import Data.Set         ( Set, mkSet, elementOf )
+import Data.Set(Set)
+import qualified Data.Set as Set hiding (Set)
 import Text.PrettyPrint.HughesPJ
 import Debug.Trace
 
@@ -33,7 +34,7 @@
 
 
 filterEnumType :: BindingScript -> Maybe EnumType -> Maybe EnumType
-filterEnumType bs (Just (EnumType (Just name) _)) | name `elementOf` bsHiddenEnums bs = Nothing
+filterEnumType bs (Just (EnumType (Just name) _)) | name `Set.member` bsHiddenEnums bs = Nothing
 filterEnumType _ mbTy = mbTy
                   
 extractEnumType :: Declaration -> Maybe EnumType