[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