hoc-cvs — CVS commit log messages

[hoc-cvs] hoc/InterfaceGenerator CTypeToHaskell.hs,1.9,1.10

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

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

Modified Files:
	CTypeToHaskell.hs 
Log Message:
Allow pointers-to-pointers in ifgen.

Recently (10.4), parameters of type (NSError**) have cropped up all over Cocoa,
so we can no longer ignore this.
Dealing with a value of type Ptr (NSError ()) is inconvenient in Haskell, so
maybe some more complex marshalling should be done (e.g. returning a tuple, etc.)


Index: CTypeToHaskell.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/InterfaceGenerator/CTypeToHaskell.hs,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- CTypeToHaskell.hs	20 Mar 2006 06:32:54 -0000	1.9
+++ CTypeToHaskell.hs	5 Feb 2007 16:18:16 -0000	1.10
@@ -61,12 +61,12 @@
 cTypeToHaskell env retval tyvar (CTIDType protocols) = 
     -- (if protocols /= [] then trace (show (retval,protocols)) else id) $
 
-    Just $ HType (if retval then Nothing else Just (tyvar,[]))
+    return $ HType (if retval then Nothing else Just (tyvar,[]))
                  [] (Con "ID" :$ (if retval then Con "()" else Var tyvar))
 
 cTypeToHaskell env retval tyvar (CTPointer (CTSimple cls))
     | isClassType env cls =
-    Just $ HType (if retval then Nothing else Just (tyvar,[]))
+    return $ HType (if retval then Nothing else Just (tyvar,[]))
                  [cls] (Con (nameToUppercase cls) :$
                         (if retval then Con "()" else Var tyvar))
  
@@ -79,7 +79,7 @@
         return $ HType Nothing [] (Con typ)
 
 cTypeToHaskell env retval tyvar (CTSimple "Class") =
-    Just $ HType (if retval then Nothing else Just (tyvar,[]))
+    return $ HType (if retval then Nothing else Just (tyvar,[]))
                  [] (Con "Class" :$
                         (if retval then Con "()" else Var tyvar))
 
@@ -87,20 +87,15 @@
     | name /= "" && isPlainType env name =
         return $ HType Nothing [name]
                        (Con $ nameToUppercase name)
-    | otherwise = do typ <- simpleTypeToHaskell name
-                     return $ HType Nothing [] (Con typ)
+    | otherwise = case simpleTypeToHaskell name of
+                    Just typ -> return $ HType Nothing [] (Con typ)
+                    Nothing -> trace ("type not found: " ++ show name) Nothing
 
-cTypeToHaskell env retval tyvar (CTPointer pointed) =
-        case pointed of
-            CTSimple _ -> pointerToHaskell
-            CTBuiltin _ _ _ -> pointerToHaskell
-            _ -> Nothing -- we don't want to bother with things like "id *" right now
-    where
-        pointerToHaskell =
-            do
-                HType context mentioned ty
-                    <- cTypeToHaskell env retval tyvar pointed
-                return $ HType context mentioned (Con "Ptr" :$ ty)
+cTypeToHaskell env retval tyvar (CTPointer pointed)
+    = do
+        HType context mentioned ty
+            <- cTypeToHaskell env True tyvar pointed
+        return $ HType context mentioned (Con "Ptr" :$ ty)
 
 cTypeToHaskell env retval tyvar (CTEnum name _) 
     | name /= "" && isPlainType env name = return $ HType Nothing [name]
@@ -109,48 +104,34 @@
 
 cTypeToHaskell env retval tyvar _ = Nothing
 
-{-
-cTypeToHaskell classes retval tyvar (CTSimple str) = Nothing
-cTypeToHaskell classes retval tyvar (CTPointer x) = Nothing
-cTypeToHaskell classes retval tyvar (CTUnknown x) = Nothing
-cTypeToHaskell classes retval tyvar (CTEnum x) = Nothing
-cTypeToHaskell classes retval tyvar (CTStruct x) = Nothing
-cTypeToHaskell classes retval tyvar (CTUnion x) = Nothing
--}
-
-
-
-simpleTypeToHaskell "void" = Just "()"
-simpleTypeToHaskell "BOOL" = Just "Bool"
-simpleTypeToHaskell "SEL" = Just "SEL"
+simpleTypeToHaskell "void" = return "()"
+simpleTypeToHaskell "BOOL" = return "Bool"
+simpleTypeToHaskell "SEL" = return "SEL"
 simpleTypeToHaskell _ = Nothing
 
-{-builtinTypeToHaskell (CTBuiltin Nothing Nothing "int") =
-    trace (
--}
-builtinTypeToHaskell (CTBuiltin Nothing Nothing "float") = Just "Float"
-builtinTypeToHaskell (CTBuiltin Nothing Nothing "double") = Just "Double"
+builtinTypeToHaskell (CTBuiltin Nothing Nothing "float") = return "Float"
+builtinTypeToHaskell (CTBuiltin Nothing Nothing "double") = return "Double"
 builtinTypeToHaskell (CTBuiltin signedness Nothing "int") =
     case signedness of
-        Just False -> Just "CUInt"
-        _ -> Just "Int"
+        Just False -> return "CUInt"
+        _ -> return "Int"
 builtinTypeToHaskell (CTBuiltin signedness (Just Short) "int") =
     case signedness of
-        Just False -> Just "CUShort"
-        _ -> Just "CShort"
+        Just False -> return "CUShort"
+        _ -> return "CShort"
 builtinTypeToHaskell (CTBuiltin signedness (Just Long) "int") =
     case signedness of
-        Just False -> Just "CULong"
-        _ -> Just "CLong"
+        Just False -> return "CULong"
+        _ -> return "CLong"
 builtinTypeToHaskell (CTBuiltin signedness (Just LongLong) "int") =
     case signedness of
-        Just False -> Just "CULLong"
-        _ -> Just "CLLong"
+        Just False -> return "CULLong"
+        _ -> return "CLLong"
 builtinTypeToHaskell (CTBuiltin signedness Nothing "char") =
     case signedness of
-        Just False -> Just "CUChar"
-        Just True -> Just "CSChar"
-        Nothing -> Just "CChar"
+        Just False -> return "CUChar"
+        Just True -> return "CSChar"
+        Nothing -> return "CChar"
 
 builtinTypeToHaskell bi = trace (show bi) Nothing
 

[hoc-cvs] hoc/InterfaceGenerator Parser.hs,1.3,1.4

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

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

Modified Files:
	Parser.hs 
Log Message:
Fix parsing of some C primitive integer types


Index: Parser.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/InterfaceGenerator/Parser.hs,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- Parser.hs	27 Sep 2005 11:55:22 -0000	1.3
+++ Parser.hs	5 Feb 2007 16:12:49 -0000	1.4
@@ -146,7 +146,7 @@
                 <|> (reserved objc "short" >> return (Just Short))
                 <|> return Nothing
     key <- if isJust signedness || isJust length
-        then option "int" simple_builtin
+        then option "int" (try simple_builtin)
         else simple_builtin
     return $ CTBuiltin signedness length key
     

[hoc-cvs] hoc/Bindings/AdditionalCode/Foundation NSRange.hs, 1.2, 1.3

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

Update of /cvsroot/hoc/hoc/Bindings/AdditionalCode/Foundation
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv2631/Bindings/AdditionalCode/Foundation

Modified Files:
	NSRange.hs 
Log Message:
Correctly export anonymous enum constants in the interface generator.
(and adjust NSRange.hs accordingly)


Index: NSRange.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/Bindings/AdditionalCode/Foundation/NSRange.hs,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- NSRange.hs	5 Oct 2005 03:14:39 -0000	1.2
+++ NSRange.hs	5 Feb 2007 16:11:31 -0000	1.3
@@ -7,7 +7,6 @@
 --X NSRangePointer
 --X nsMaxRange
 --X nsLocationInRange
---X nsNotFound
 
 import HOC.FFICallInterface
 import HOC.Arguments
@@ -22,7 +21,6 @@
 
 nsMaxRange (NSRange loc len) = loc + len
 nsLocationInRange x (NSRange loc len) = x >= loc && x < loc+len
-nsNotFound = 0x7fffffff :: CUInt
 
 instance Storable NSRange where
     alignment _ = alignment (undefined :: CUInt)

[hoc-cvs] hoc/InterfaceGenerator Enums.hs, 1.6, 1.7 ExportModule.hs, 1.11, 1.12

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

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

Modified Files:
	Enums.hs ExportModule.hs 
Log Message:
Correctly export anonymous enum constants in the interface generator.
(and adjust NSRange.hs accordingly)


Index: ExportModule.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/InterfaceGenerator/ExportModule.hs,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- ExportModule.hs	1 Nov 2006 15:45:05 -0000	1.11
+++ ExportModule.hs	5 Feb 2007 16:11:31 -0000	1.12
@@ -10,7 +10,7 @@
 import BindingScript
 import Utils(groupByFirst)
 import Headers(ModuleName)
-import Enums(enumName, pprEnumType)
+import Enums(enumExports, pprEnumType)
 
 import HOC.NameCaseChange
 
@@ -257,8 +257,7 @@
                 text "module " <+> text (moduleName ++ ".Forward")
                     <+> parens (sep $ punctuate comma $
                         map text (exportedClasses
-                                 ++ [ nameToUppercase enum ++ "(..)"
-                                    | enum <- mapMaybe enumName enumDefinitions ]
+                                 ++ concatMap enumExports enumDefinitions
                                  ++ additionalForwardExports
                                  ))
                     <+> text "where",

Index: Enums.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/InterfaceGenerator/Enums.hs,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- Enums.hs	1 Nov 2006 15:45:04 -0000	1.6
+++ Enums.hs	5 Feb 2007 16:11:31 -0000	1.7
@@ -2,7 +2,8 @@
         EnumType,
         extractEnums,
         pprEnumType,
-        enumName
+        enumName,
+        enumExports
     ) where
 
 import Headers(HeaderInfo(..), ModuleName)
@@ -62,6 +63,11 @@
               | otherwise = Just tag
 handleCType _ = Nothing
 
+enumExports (EnumType mbName constants)
+    = (case mbName of Just n -> ((nameToUppercase n ++ "(..)") :)
+                      Nothing -> id)
+      (map (nameToLowercase . fst) constants)
+
 pprEnumType (EnumType name constants) =
 	char '$' <> parens (
 			declare

[hoc-cvs] hoc/Bindings binding-script.txt,1.12,1.13

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

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

Modified Files:
	binding-script.txt 
Log Message:
Add NSStringEncoding type synonym

(ifgen really needs to learn how to interpret typedefs)


Index: binding-script.txt
===================================================================
RCS file: /cvsroot/hoc/hoc/Bindings/binding-script.txt,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- binding-script.txt	20 Mar 2006 06:32:54 -0000	1.12
+++ binding-script.txt	5 Feb 2007 16:08:33 -0000	1.13
@@ -70,6 +70,8 @@
 
 type NSTimeInterval Foundation.NSDate;
 
+type NSStringEncoding Foundation.NSString;
+
 -- GNUstep specifics:
 rename rawMimeData: rawMimeData_;
 rename setContent:type: setContentAndType;

[hoc-cvs] hoc/Bindings/AdditionalCode/Foundation NSString.hs, 1.2, 1.3

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

Update of /cvsroot/hoc/hoc/Bindings/AdditionalCode/Foundation
In directory sc8-pr-cvs5.sourceforge.net:/tmp/cvs-serv1358/Bindings/AdditionalCode/Foundation

Modified Files:
	NSString.hs 
Log Message:
Add NSStringEncoding type synonym

(ifgen really needs to learn how to interpret typedefs)


Index: NSString.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/Bindings/AdditionalCode/Foundation/NSString.hs,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- NSString.hs	2 Nov 2003 10:45:16 -0000	1.2
+++ NSString.hs	5 Feb 2007 16:08:33 -0000	1.3
@@ -38,3 +38,9 @@
 
 fromNSString :: NSString () -> String
 fromNSString = unsafePerformIO . haskellString
+
+-- CUT HERE
+import Foreign.C.Types
+--X NSStringEncoding
+-- CUT HERE
+type NSStringEncoding = CUInt

[hoc-cvs] hoc/HOC/HOC CEnum.hs,1.1,1.2

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

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

Modified Files:
	CEnum.hs 
Log Message:
Use overloaded (Num a =>) type for anonymous enum constants


Index: CEnum.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/HOC/HOC/CEnum.hs,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- CEnum.hs	30 Jul 2005 02:41:54 -0000	1.1
+++ CEnum.hs	5 Feb 2007 16:07:10 -0000	1.2
@@ -49,8 +49,11 @@
         values = map snd assocs
         
 declareAnonymousCEnum assocs
-    = sequence [
-            valD (varP constant) (normalB $ litE $ integerL value) []
+    = sequence $ concat [
+            [
+                sigD constant [t| forall a. Num a => a |],
+                valD (varP constant) (normalB $ litE $ integerL value) []
+            ]
             | (constant, value) <- zip constants values
         ]
     where

[hoc-cvs] hoc/AppKit Makefile.in,1.17,1.18

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

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

Modified Files:
	Makefile.in 
Log Message:
Update for GHC 6.6


Index: Makefile.in
===================================================================
RCS file: /cvsroot/hoc/hoc/AppKit/Makefile.in,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -d -r1.17 -r1.18
--- Makefile.in	6 Aug 2005 16:38:20 -0000	1.17
+++ Makefile.in	1 Nov 2006 15:45:04 -0000	1.18
@@ -45,25 +45,25 @@
 	mkdir -p build/imports
 	$(GHC) --make AppKit.hs	\
 		-O -fasm \
-		-ignore-package AppKit	\
+		-package-name AppKit	\
 		-odir build/objects \
 		-hidir build/imports	\
 		-package-conf ../inplace.conf \
-		-fglasgow-exts
+		-fglasgow-exts -fth
 	test ! -r GNUstepGUI.hs || \
 		$(GHC) --make GNUstepGUI.hs	\
-			-ignore-package AppKit	\
+			-package-name AppKit	\
 			-odir build/objects \
 			-hidir build/imports	\
 			-package-conf ../inplace.conf \
-			-fglasgow-exts
+			-fglasgow-exts -fth
 	$(GHC) -c Cocoa.hs \
-		-ignore-package AppKit	\
+		-package-name AppKit	\
 		-ibuild/imports	   \
 		-o build/objects/Cocoa.o	\
 		-ohi build/imports/Cocoa.hi \
 		-package-conf ../inplace.conf \
-		-fglasgow-exts
+		-fglasgow-exts -fth
 	touch $@
 	
 HSAppKit.o: ghcmake.build-stamp

[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

[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

[hoc-cvs] hoc/Tests Makefile,1.2,1.3 TestFoundation.hs,1.9,1.10

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

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

Modified Files:
	Makefile TestFoundation.hs 
Log Message:
Update for GHC 6.6


Index: TestFoundation.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/Tests/TestFoundation.hs,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- TestFoundation.hs	20 Mar 2006 06:25:26 -0000	1.9
+++ TestFoundation.hs	1 Nov 2006 15:45:05 -0000	1.10
@@ -1,3 +1,4 @@
+{-# OPTIONS -fth -fglasgow-exts #-}
 module Main where
 
 import Test.HUnit

Index: Makefile
===================================================================
RCS file: /cvsroot/hoc/hoc/Tests/Makefile,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- Makefile	1 Apr 2005 04:35:29 -0000	1.2
+++ Makefile	1 Nov 2006 15:45:05 -0000	1.3
@@ -9,12 +9,12 @@
 
 TestFoundation.dynamic: build TestFoundation.hs
 	ghc -dynamic -odir build/dynamic/objects -hidir build/dynamic/imports \
-	 -o $@ -fglasgow-exts -package-conf ../inplace.conf \
+	 -o $@ -package-conf ../inplace.conf \
 	 -package Foundation --make TestFoundation.hs
 
 TestFoundation.static: build TestFoundation.hs
 	ghc -odir build/static/objects -hidir build/static/imports \
-	 -o $@ -fglasgow-exts -package-conf ../inplace.conf \
+	 -o $@  -package-conf ../inplace.conf \
 	 -package Foundation --make TestFoundation.hs
 
 clean:

[hoc-cvs] hoc/Samples/Editor Makefile,1.5,1.6

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

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

Modified Files:
	Makefile 
Log Message:
Update for GHC 6.6


Index: Makefile
===================================================================
RCS file: /cvsroot/hoc/hoc/Samples/Editor/Makefile,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- Makefile	27 Jul 2005 02:53:54 -0000	1.5
+++ Makefile	1 Nov 2006 15:45:05 -0000	1.6
@@ -14,7 +14,7 @@
 
 Editor: *.hs
 	mkdir -p build
-	$(GHC) --make -fglasgow-exts Main.hs -odir build -hidir build -O -o Editor 
+	$(GHC) --make -fglasgow-exts  -fth Main.hs -odir build -hidir build -O -o Editor 
 
 interpret:
 	mkdir -p build
@@ -24,6 +24,6 @@
 
 nolink:
 	mkdir -p build
-	$(GHC) --make -fglasgow-exts Main.hs -odir build -hidir build -O -pgml true
+	$(GHC) --make -fglasgow-exts  -fth Main.hs -odir build -hidir build -O -pgml true
 clean:
 	rm -rf build Editor Editor.app 'Interpreted Haskell Application.app/'

[hoc-cvs] hoc/HOC Makefile.in,1.16,1.17

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

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

Modified Files:
	Makefile.in 
Log Message:
Update for GHC 6.6


Index: Makefile.in
===================================================================
RCS file: /cvsroot/hoc/hoc/HOC/Makefile.in,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -d -r1.16 -r1.17
--- Makefile.in	3 Aug 2005 01:48:51 -0000	1.16
+++ Makefile.in	1 Nov 2006 15:45:04 -0000	1.17
@@ -45,24 +45,9 @@
 ghcmake: ghcmake.build-stamp
 
 
-# XXX: GHC 6.4 has a really ... _weird_ bug where it won't compile
-# HOC/StdArgumentTypes.hs properly if you just try ghc --make with HOC.hs.
-# There seems to be a problem with GHC's .hi file chasing with
-# HOC/Arguments.hs; obviously the long-term solution is to fix GHC, but for
-# now, we work around it by compiling HOC/Arguments.hs first.
 ghcmake.build-stamp:
 	mkdir -p build/objects
 	mkdir -p build/imports
-	$(GHC) --make HOC/Arguments.hs	\
-		-odir build/objects -hidir build/imports	\
-		-fglasgow-exts -fth \
-		../HOC_cbits/HOC_cbits.o	\
-		-I../HOC_cbits	\
-		-I../libffi-src/build/include	\
-		-ignore-package HOC \
-		$(FOUNDATION_INCLUDES) \
-		$(FOUNDATION_LIBS)      \
-                $(DEFINES)
 	$(GHC) --make HOC.hs	\
 		-O -fasm \
 		-odir build/objects -hidir build/imports	\
@@ -70,7 +55,7 @@
 		../HOC_cbits/HOC_cbits.o	\
 		-I../HOC_cbits	\
 		-I../libffi-src/build/include	\
-		-ignore-package HOC \
+		-package-name HOC \
 		$(FOUNDATION_INCLUDES) \
 		$(FOUNDATION_LIBS)      \
                 $(DEFINES)

[hoc-cvs] hoc/Foundation Makefile.in,1.16,1.17

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

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

Modified Files:
	Makefile.in 
Log Message:
Update for GHC 6.6


Index: Makefile.in
===================================================================
RCS file: /cvsroot/hoc/hoc/Foundation/Makefile.in,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -d -r1.16 -r1.17
--- Makefile.in	6 Aug 2005 16:38:20 -0000	1.16
+++ Makefile.in	1 Nov 2006 15:45:04 -0000	1.17
@@ -45,18 +45,18 @@
 	$(GHC) --make Foundation.hs	\
 		-O -fasm \
 		-odir build/objects \
-		-ignore-package Foundation \
+		-package-name Foundation \
 		-hidir build/imports	\
 		-package-conf ../inplace.conf \
-		-fglasgow-exts
+		-fglasgow-exts -fth
                 
 	test ! -r GNUstepBase.hs || \
 		$(GHC) --make GNUstepBase.hs	\
-			-ignore-package Foundation	\
+			-package-name Foundation	\
 			-odir build/objects \
 			-hidir build/imports	\
 			-package-conf ../inplace.conf \
-			-fglasgow-exts
+			-fglasgow-exts -fth
 	touch $@
 
 HSFoundation.o: ghcmake.build-stamp

[hoc-cvs] hoc/HOC/HOC CannedCIFs.hs, 1.2, 1.3 DeclareSelector.hs, 1.12, 1.13 TH.hs, 1.3, 1.4

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

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

Modified Files:
	CannedCIFs.hs DeclareSelector.hs TH.hs 
Log Message:
Update for GHC 6.6


Index: DeclareSelector.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/HOC/HOC/DeclareSelector.hs,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- DeclareSelector.hs	12 Mar 2006 18:49:41 -0000	1.12
+++ DeclareSelector.hs	1 Nov 2006 15:45:04 -0000	1.13
@@ -188,7 +188,7 @@
                                                         then [|n|]
                                                         else stringE haskellName)
                                                 $(staticCifForSelectorType
-                                                        "HOC.DeclareSelector"
+                                                        'marshallersUpTo
                                                         cannedCIFTypeNames
                                                         (return $ simplifyType doctoredTypeSig))
                         |]) [],
@@ -213,8 +213,8 @@
                                         isUnit isPure resultRetained
                     else valD (varP $ mkName haskellName) (normalB [|
                             $(varE $ 
-                                    mkNameG_v "HOC.DeclareSelector" $
-                                    marshallerName nArgs isUnit
+                                    marshallerName nArgs isUnit `fromSameModuleAs_v`
+                                    	'marshallersUpTo
                                 )
                                 $(varE $ mkName infoName)
                         |]) []

Index: CannedCIFs.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/HOC/HOC/CannedCIFs.hs,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- CannedCIFs.hs	26 Jul 2005 05:22:18 -0000	1.2
+++ CannedCIFs.hs	1 Nov 2006 15:45:04 -0000	1.3
@@ -3,7 +3,7 @@
 import HOC.Base         ( SEL )
 import HOC.Arguments    ( getCifForSelector )
 import HOC.ID           ( ID )
-import HOC.TH           ( mkNameG_v )
+import HOC.TH           ( fromSameModuleAs_v )
 
 import Data.List        ( intersperse )
 import Data.Maybe       ( catMaybes )
@@ -111,11 +111,11 @@
             
         cannedCIFName n = mkName $ "cannedCIF_" ++ n
 
-staticCifForSelectorType mod ns t
+staticCifForSelectorType master ns t
     = do
         mbName <- getCifTypeName t
         xt <- t
         case mbName of
             Just n | n `elem` ns
-                -> varE $ mkNameG_v mod $ "cannedCIF_" ++ n
+                -> varE $ ("cannedCIF_" ++ n) `fromSameModuleAs_v` master
             _ ->   [| getCifForSelector $( [| undefined |] `sigE` t) |]

Index: TH.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/HOC/HOC/TH.hs,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- TH.hs	20 Mar 2006 06:25:26 -0000	1.3
+++ TH.hs	1 Nov 2006 15:45:04 -0000	1.4
@@ -19,6 +19,7 @@
     decls <- declsQ
     header (map return decls)
 
+{-
 fromSameModuleAs_tc :: String -> Name -> Name
 s `fromSameModuleAs_tc` n
     = case nameModule n of
@@ -30,3 +31,16 @@
     = case nameModule n of
         Nothing -> mkName s
         Just m -> mkNameG_v m s
+-}
+
+fromSameModuleAs_tc :: String -> Name -> Name
+fromSameModuleAs_tc = fromSameModule TcClsName
+fromSameModuleAs_v :: String -> Name -> Name
+fromSameModuleAs_v = fromSameModule VarName
+
+fromSameModule :: NameSpace -> String -> Name -> Name
+fromSameModule ns s n
+  = Name (mkOccName s) $
+  	case n of
+  		Name _ (NameG _ pkg mod) -> NameG ns pkg mod
+  		Name _ other -> other

[hoc-cvs] hoc/InterfaceGenerator ExportModule.hs,1.9,1.10

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

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

Modified Files:
	ExportModule.hs 
Log Message:
Add a hack to deal with the fact that NSObject is it's own meta-class.
Make all instance methods of NSObject also be class methods.


Index: ExportModule.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/InterfaceGenerator/ExportModule.hs,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- ExportModule.hs	5 Oct 2005 02:55:49 -0000	1.9
+++ ExportModule.hs	20 Mar 2006 06:33:50 -0000	1.10
@@ -16,7 +16,7 @@
 
 import Data.Set(setToList, unionManySets, mkSet, intersect)
 import qualified Data.HashTable as HashTable
-import Data.List(nub, partition, isPrefixOf)
+import Data.List(nub, partition, isPrefixOf, group, sort)
 import Data.Maybe(fromMaybe, catMaybes, mapMaybe, maybeToList, isNothing)
 import qualified Data.Map as Map (lookup, findWithDefault) 
 import Text.PrettyPrint.HughesPJ
@@ -164,12 +164,24 @@
                          | Right mangledSel <- selsToDefine ]
         
         methodInstances :: [ (String, String) ]
-        methodInstances = mkDecls id instanceSels
-                       ++ mkDecls (++ "Class") classSels
+        methodInstances = map head . group . sort $
+                          instanceDecls
+                       ++ classDecls
+                       ++ nsObjectHackDecls
             where
                 mkDecls f classesAndSels = concat [ [(msMangled sel, f cls) | sel <- sels ]
                                                   | (cls, sels) <- classesAndSels ]
-                        
+
+                instanceDecls = mkDecls id instanceSels
+                classDecls = mkDecls (++ "Class") classSels
+
+                    -- HACK for NSObject.
+                    -- NSObject is it's own meta-class; that's hard to model
+                    -- in our type system, so we just automatically make every
+                    -- instance method of NSObject a class method, too.
+                nsObjectHackDecls = [ (sel, "NSObjectClass")
+                                    | (sel, "NSObject") <- instanceDecls ]
+
         exportedSelNames = map msMangled selsToDefineOrImport
         exportedSels = concatMap idsForSel exportedSelNames
         exportedSelSet = mkSet exportedSelNames

[hoc-cvs] hoc/InterfaceGenerator CTypeToHaskell.hs,1.8,1.9

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

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

Modified Files:
	CTypeToHaskell.hs 
Log Message:
Handle the Class type.


Index: CTypeToHaskell.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/InterfaceGenerator/CTypeToHaskell.hs,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- CTypeToHaskell.hs	5 Oct 2005 02:55:49 -0000	1.8
+++ CTypeToHaskell.hs	20 Mar 2006 06:32:54 -0000	1.9
@@ -78,7 +78,12 @@
         typ <- builtinTypeToHaskell bi
         return $ HType Nothing [] (Con typ)
 
-cTypeToHaskell env retval tyvar (CTSimple name) 
+cTypeToHaskell env retval tyvar (CTSimple "Class") =
+    Just $ HType (if retval then Nothing else Just (tyvar,[]))
+                 [] (Con "Class" :$
+                        (if retval then Con "()" else Var tyvar))
+
+cTypeToHaskell env retval tyvar (CTSimple name)
     | name /= "" && isPlainType env name =
         return $ HType Nothing [name]
                        (Con $ nameToUppercase name)

[hoc-cvs] hoc/Bindings binding-script.txt,1.11,1.12

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

Update of /cvsroot/hoc/hoc/Bindings
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18040/Bindings

Modified Files:
	binding-script.txt 
Log Message:
Handle the Class type.


Index: binding-script.txt
===================================================================
RCS file: /cvsroot/hoc/hoc/Bindings/binding-script.txt,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- binding-script.txt	12 Mar 2006 18:46:11 -0000	1.11
+++ binding-script.txt	20 Mar 2006 06:32:54 -0000	1.12
@@ -1,6 +1,7 @@
 hidePrelude init error minimum maximum null concat words print length compare;
 rename data data';
 rename type type';
+rename class class';
 
 covariant stringWithCString stringWithCStringLength;
 covariant stringWithContentsOfFile stringWithContentsOfURL;

[hoc-cvs] hoc/HOC/HOC Selectors.hs,NONE,1.1

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

Update of /cvsroot/hoc/hoc/HOC/HOC
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17599/HOC/HOC

Added Files:
	Selectors.hs 
Log Message:
Add another way to get at a SEL:

$(sel 'fooBar) corresponds to @selector(foo:bar:)



--- NEW FILE: Selectors.hs ---
module HOC.Selectors where

import HOC.TH
import HOC.SelectorMarshaller ( SelectorInfo(..) )

sel n = [| selectorInfoSel $(varE selInfo) |]
    where selInfo = infoName `fromSameModuleAs_v` n
          infoName = "info_" ++ nameBase n

[hoc-cvs] hoc/HOC HOC.conf.in,1.5,1.6 HOC.hs,1.13,1.14

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

Update of /cvsroot/hoc/hoc/HOC
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17599/HOC

Modified Files:
	HOC.conf.in HOC.hs 
Log Message:
Add another way to get at a SEL:

$(sel 'fooBar) corresponds to @selector(foo:bar:)



Index: HOC.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/HOC/HOC.hs,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- HOC.hs	17 Mar 2006 04:57:36 -0000	1.13
+++ HOC.hs	20 Mar 2006 06:32:16 -0000	1.14
@@ -45,6 +45,8 @@
         declareExternConst,
         declareExternFun,
         
+        sel,
+        
         -- debugging & statistics:
         
         objectMapStatistics
@@ -67,3 +69,4 @@
 import HOC.CEnum
 import HOC.ExternConstants
 import HOC.ExternFunctions
+import HOC.Selectors

Index: HOC.conf.in
===================================================================
RCS file: /cvsroot/hoc/hoc/HOC/HOC.conf.in,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- HOC.conf.in	17 Mar 2006 05:32:04 -0000	1.5
+++ HOC.conf.in	20 Mar 2006 06:32:16 -0000	1.6
@@ -28,7 +28,8 @@
     HOC.ExternConstants,
     HOC.Exception,
     HOC.ExternFunctions,
-    HOC.Unicode
+    HOC.Unicode,
+    HOC.Selectors
 
 hs-libraries:       "HOC", "HOC_cbits"
 depends:            base, template-haskell

[hoc-cvs] hoc/HOC/HOC ExportClass.hs,1.9,1.10 TH.hs,1.2,1.3

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

Update of /cvsroot/hoc/hoc/HOC/HOC
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14320/HOC/HOC

Modified Files:
	ExportClass.hs TH.hs 
Log Message:
Use a (Template Haskell) Name rather than the selector info as a parameter
for InstanceMethod, i.e. instead of

$(exportClass ... [
        InstanceMethod info_foo
    ])

we now write

$(exportClass ... [
        InstanceMethod 'foo
    ])

Most importantly, it is no longer necessary to declare the selectors used
in exportClass in a separate file.


Index: TH.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/HOC/HOC/TH.hs,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- TH.hs	29 Jul 2005 03:39:44 -0000	1.2
+++ TH.hs	20 Mar 2006 06:25:26 -0000	1.3
@@ -3,7 +3,9 @@
         mkNameG_v,
         mkNameG_tc,
         mkNameG_d,
-        whereQ
+        whereQ,
+        fromSameModuleAs_tc,
+        fromSameModuleAs_v
     ) where
 
 import Language.Haskell.TH
@@ -17,3 +19,14 @@
     decls <- declsQ
     header (map return decls)
 
+fromSameModuleAs_tc :: String -> Name -> Name
+s `fromSameModuleAs_tc` n
+    = case nameModule n of
+        Nothing -> mkName s
+        Just m -> mkNameG_tc m s
+        
+fromSameModuleAs_v :: String -> Name -> Name
+s `fromSameModuleAs_v` n
+    = case nameModule n of
+        Nothing -> mkName s
+        Just m -> mkNameG_v m s

Index: ExportClass.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/HOC/HOC/ExportClass.hs,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- ExportClass.hs	27 Sep 2005 11:55:22 -0000	1.9
+++ ExportClass.hs	20 Mar 2006 06:25:26 -0000	1.10
@@ -19,8 +19,8 @@
 import HOC.Exception
 
 data ClassMember =
-        InstanceMethod SelectorInfo
-    |   ClassMethod SelectorInfo
+        InstanceMethod Name
+    |   ClassMethod Name
     |   Outlet String TypeQ
     |   InstanceVariable String TypeQ ExpQ
 
@@ -108,7 +108,7 @@
                 wrap = foldl appE (conE $ mkName instanceDataName) (map (varE.mkName) ivarNames)
                 initIVar (ivar,ty,initial) = bindS (varP $ mkName ivar) [| newMVar $(initial) |]
 
-data Method = ImplementedMethod SelectorInfo String
+data Method = ImplementedMethod Name
             | GetterMethod String
             | SetterMethod String
 
@@ -134,18 +134,16 @@
             `sigE` (conT ''IO `appT` conT (mkName $ name ++ "_IVARS"))
     
         outlets = [ name | Outlet name _ <- members ]
-        classMethods =    [ ImplementedMethod info (prefix ++ selectorInfoHaskellName info)
-                          | ClassMethod info <- members ] 
+        classMethods = [ ImplementedMethod n | ClassMethod n <- members ] 
 
-        explicitInstanceMethods = [ (info, prefix ++ selectorInfoHaskellName info)
-                                  | InstanceMethod info <- members ]         
-        instanceMethodNames = map (selectorInfoObjCName . fst) explicitInstanceMethods
+        explicitInstanceMethods = [ n | InstanceMethod n <- members ]         
+        instanceMethodNames = map nameBase explicitInstanceMethods
         instanceMethods =
-                [ ImplementedMethod i d | (i,d) <- explicitInstanceMethods ] 
+                map ImplementedMethod explicitInstanceMethods 
              ++ [ GetterMethod ivar | ivar <- outlets,
                                       not (ivar `elem` instanceMethodNames) ]
              ++ [ SetterMethod ivar | ivar <- outlets,
-                                      not (setterNameFor ivar
+                                      not (setterNameForH ivar
                                            `elem` instanceMethodNames) ]
   
         nIMethods = length instanceMethods
@@ -159,9 +157,9 @@
                 (zip methods [firstIdx..])
                 
         exportMethod isClassMethod objCMethodList
-                     (ImplementedMethod selectorInfo methodDefinition,num)
+                     (ImplementedMethod selName, num)
             = do
-                VarI _ t _ _ <- reify $ mkName selName
+                VarI _ t _ _ <- reify $ selName
                 let arrowsToList (AppT (AppT ArrowT a) b)
                         = a : arrowsToList b
                     arrowsToList (AppT (ConT c) b)
@@ -177,14 +175,17 @@
                 exportMethod' isClassMethod objCMethodList num methodBody
                               nArgs isUnit impTypeName selExpr cifExpr
             where
-                methodBody = varE $ mkName methodDefinition
-                selName = selectorInfoHaskellName selectorInfo
-                -- nArgs = selectorInfoNArgs selectorInfo
-                -- isUnit = selectorInfoIsUnit selectorInfo
+                methodBody = varE $ mkName $ prefix ++ nameBase selName
                 
-                impTypeName = mkName $ "ImpType_" ++ selName
-                selExpr = [| selectorInfoSel $(varE $ mkName $ "info_" ++ selName) |]
-                cifExpr = [| selectorInfoCif $(varE $ mkName $ "info_" ++ selName) |]
+                -- selName = selectorInfoHaskellName selectorInfo
+                
+                impTypeName = ("ImpType_" ++ nameBase selName)
+                                `fromSameModuleAs_tc` selName
+                infoName = ("info_" ++ nameBase selName)
+                            `fromSameModuleAs_v` selName
+                
+                selExpr = [| selectorInfoSel $(varE $ infoName) |]
+                cifExpr = [| selectorInfoCif $(varE $ infoName) |]
         
         exportMethod isClassMethod objCMethodList (GetterMethod ivarName, num) =
                 exportMethod' isClassMethod objCMethodList num
@@ -202,7 +203,8 @@
             where
                 setterName = setterNameFor ivarName
         
-        setterNameFor ivarName = "set" ++ toUpper (head ivarName) : tail ivarName ++ ":"
+        setterNameFor ivarName = setterNameForH ivarName ++ ":"
+        setterNameForH ivarName = "set" ++ toUpper (head ivarName) : tail ivarName
             
                 
         exportMethod' isClassMethod objCMethodList num methodBody

[hoc-cvs] hoc/Tests TestFoundation.hs,1.8,1.9

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

Update of /cvsroot/hoc/hoc/Tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14320/Tests

Modified Files:
	TestFoundation.hs 
Log Message:
Use a (Template Haskell) Name rather than the selector info as a parameter
for InstanceMethod, i.e. instead of

$(exportClass ... [
        InstanceMethod info_foo
    ])

we now write

$(exportClass ... [
        InstanceMethod 'foo
    ])

Most importantly, it is no longer necessary to declare the selectors used
in exportClass in a separate file.


Index: TestFoundation.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/Tests/TestFoundation.hs,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- TestFoundation.hs	17 Mar 2006 05:32:04 -0000	1.8
+++ TestFoundation.hs	20 Mar 2006 06:25:26 -0000	1.9
@@ -10,7 +10,6 @@
 import Control.Monad        ( when )
 import Control.Exception    ( try, finally )
 
-import Selectors
 
       -- garbage collect and make really sure that finalizers have time to run
 performGCAndWait targetCount time maxRepeat = do
@@ -47,7 +46,7 @@
 $(declareClass "HaskellObjectWithDescription" "NSObject")
 
 $(exportClass "HaskellObjectWithDescription" "ho2_" [
-        InstanceMethod info_description
+        InstanceMethod 'description
     ])
     
 ho2_description self
@@ -64,12 +63,15 @@
 
 $(declareClass "ExceptionThrower" "NSObject")
 
+$(declareSelector "throwHaskellException" [t| IO () |])
+$(declareSelector "throwNSException" [t| IO () |])
+
 instance Has_throwHaskellException (ExceptionThrower a)
 instance Has_throwNSException (ExceptionThrower a)
 
 $(exportClass "ExceptionThrower" "et_" [
-        InstanceMethod info_throwHaskellException,
-        InstanceMethod info_throwNSException
+        InstanceMethod 'throwHaskellException,
+        InstanceMethod 'throwNSException
     ])
 
 et_throwHaskellException self = fail "Test Exception"

[hoc-cvs] hoc/Samples/ExpressionParser EPController.hs,1.4,1.5 Selectors.hs,1.2,NONE

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

Update of /cvsroot/hoc/hoc/Samples/ExpressionParser
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14320/Samples/ExpressionParser

Modified Files:
	EPController.hs 
Removed Files:
	Selectors.hs 
Log Message:
Use a (Template Haskell) Name rather than the selector info as a parameter
for InstanceMethod, i.e. instead of

$(exportClass ... [
        InstanceMethod info_foo
    ])

we now write

$(exportClass ... [
        InstanceMethod 'foo
    ])

Most importantly, it is no longer necessary to declare the selectors used
in exportClass in a separate file.


Index: EPController.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/Samples/ExpressionParser/EPController.hs,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- EPController.hs	31 Mar 2005 16:37:59 -0000	1.4
+++ EPController.hs	20 Mar 2006 06:25:26 -0000	1.5
@@ -4,15 +4,16 @@
 
 import Cocoa hiding (parse)
 import ExpressionParser
-import Selectors
 import Text.ParserCombinators.Parsec (parse)
 
 $(declareClass "EPController" "NSObject")
 
+$(declareSelector "evaluateExpression:" [t| forall a. NSButton a -> IO () |])
+
 $(exportClass "EPController" "ep_"
   [ Outlet "expressionEntry" [t| NSTextField () |]
   , Outlet "evaluation"      [t| NSTextField () |]
-  , InstanceMethod Selectors.info_evaluateExpression
+  , InstanceMethod 'evaluateExpression
   ]
  )
 

--- Selectors.hs DELETED ---

[hoc-cvs] hoc/Samples/Editor HaskellDocument.hs,1.2,1.3 Selectors.hs,1.1,NONE

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

Update of /cvsroot/hoc/hoc/Samples/Editor
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14320/Samples/Editor

Modified Files:
	HaskellDocument.hs 
Removed Files:
	Selectors.hs 
Log Message:
Use a (Template Haskell) Name rather than the selector info as a parameter
for InstanceMethod, i.e. instead of

$(exportClass ... [
        InstanceMethod info_foo
    ])

we now write

$(exportClass ... [
        InstanceMethod 'foo
    ])

Most importantly, it is no longer necessary to declare the selectors used
in exportClass in a separate file.


Index: HaskellDocument.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/Samples/Editor/HaskellDocument.hs,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- HaskellDocument.hs	31 Mar 2005 16:37:58 -0000	1.2
+++ HaskellDocument.hs	20 Mar 2006 06:25:26 -0000	1.3
@@ -13,10 +13,10 @@
         Outlet "textView" [t| NSTextView () |],
         InstanceVariable "text" [t| Maybe (NSString ()) |] [| Nothing |],
         
-        InstanceMethod info_windowNibName,
-        InstanceMethod info_writeToFileOfType,
-        InstanceMethod info_readFromFileOfType,
-        InstanceMethod info_windowControllerDidLoadNib
+        InstanceMethod 'windowNibName,
+        InstanceMethod 'writeToFileOfType,
+        InstanceMethod 'readFromFileOfType,
+        InstanceMethod 'windowControllerDidLoadNib
     ])
     
 hd_windowNibName self =

--- Selectors.hs DELETED ---

[hoc-cvs] hoc/Samples/Browser BrowserController.hs,1.3,1.4 TVUtilities.hs,1.3,1.4 Selectors.hs,1.1,NONE

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

Update of /cvsroot/hoc/hoc/Samples/Browser
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14320/Samples/Browser

Modified Files:
	BrowserController.hs TVUtilities.hs 
Removed Files:
	Selectors.hs 
Log Message:
Use a (Template Haskell) Name rather than the selector info as a parameter
for InstanceMethod, i.e. instead of

$(exportClass ... [
        InstanceMethod info_foo
    ])

we now write

$(exportClass ... [
        InstanceMethod 'foo
    ])

Most importantly, it is no longer necessary to declare the selectors used
in exportClass in a separate file.


Index: TVUtilities.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/Samples/Browser/TVUtilities.hs,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- TVUtilities.hs	27 Jul 2005 02:52:21 -0000	1.3
+++ TVUtilities.hs	20 Mar 2006 06:25:26 -0000	1.4
@@ -63,9 +63,9 @@
         InstanceVariable "theData" [t| WrappedTVData |]
                                     [| undefined |],
         
-        InstanceMethod info_init,
-        InstanceMethod info_numberOfRowsInTableView,
-        InstanceMethod info_tableViewObjectValueForTableColumnRow
+        InstanceMethod 'init,
+        InstanceMethod 'numberOfRowsInTableView,
+        InstanceMethod 'tableViewObjectValueForTableColumnRow
     ])
 
 sds_init self = do

--- Selectors.hs DELETED ---

Index: BrowserController.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/Samples/Browser/BrowserController.hs,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- BrowserController.hs	3 Mar 2004 14:10:51 -0000	1.3
+++ BrowserController.hs	20 Mar 2006 06:25:26 -0000	1.4
@@ -5,8 +5,6 @@
 import Data.Array
 import Data.List        ( isPrefixOf, elemIndex, sort )
 
-import Selectors
-
 frameworks = ["Foundation", "AppKit"]
 
 data SelInfo = SelInfo {
@@ -26,6 +24,8 @@
 
 $(declareClass "BrowserController" "NSObject")
 
+$(declareSelector "sideBarSelection:" [t| forall a. NSTableView a -> IO () |])
+
 $(exportClass "BrowserController" "bc_" [
         Outlet "sideBarDataSource" [t| SimpleTVDataSource () |],
         Outlet "sideBarTableView" [t| NSTableView () |],
@@ -34,8 +34,8 @@
         
         InstanceVariable "allSelectors" [t| [SelInfo] |] [| [] |],
         
-        InstanceMethod info_awakeFromNib,
-        InstanceMethod info_sideBarSelection
+        InstanceMethod 'awakeFromNib,
+        InstanceMethod 'sideBarSelection
     ])
 
 mkArray xs = listArray (0, Prelude.length xs - 1) xs

[hoc-cvs] libffi/src/powerpc ffi_darwin.c,1.2,1.3

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

Update of /cvsroot/hoc/libffi/src/powerpc
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9340/src/powerpc

Modified Files:
	ffi_darwin.c 
Log Message:
Add #ifdef __ppc__ to PowerPC-specific file


Index: ffi_darwin.c
===================================================================
RCS file: /cvsroot/hoc/libffi/src/powerpc/ffi_darwin.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- ffi_darwin.c	3 Nov 2003 10:20:28 -0000	1.2
+++ ffi_darwin.c	20 Mar 2006 06:10:14 -0000	1.3
@@ -1,3 +1,4 @@
+#ifdef __ppc__
 /* -----------------------------------------------------------------------
    ffi.c - Copyright (c) 1998 Geoffrey Keating
 
@@ -721,3 +722,4 @@
   /* Tell ffi_closure_ASM to perform return type promotions.  */
   return cif->rtype->type;
 }
+#endif