Menu
▾
▴
[hoc-cvs] hoc/InterfaceGenerator BindingScript.hs, 1.9, 1.10 Enums.hs, 1.5, 1.6 ExportModule.hs, 1.10, 1.11 PrepareDeclarations.hs, 1.14, 1.15
|
From: Wolfgang T. <wth...@us...> - 2006-11-01 15:45:10
|
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 |
