[hoc-cvs] [hoc commit] r378 - trunk/hoc trunk/hoc/HOC/HOC trunk/hoc/InterfaceGenerator2

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

Author: jam...@us...
Date: Mon Dec 29 07:46:35 2008
New Revision: 378

Modified:
    /   (props changed)
    trunk/hoc/HOC.cabal
    trunk/hoc/HOC/HOC/Exception.hs
    trunk/hoc/InterfaceGenerator2/Headers.hs
    trunk/hoc/InterfaceGenerator2/ParserBase.hs

Log:
Updated to build with ghc 6.10.1 (Issue 10)


Modified: trunk/hoc/HOC.cabal
==============================================================================
--- trunk/hoc/HOC.cabal	(original)
+++ trunk/hoc/HOC.cabal	Mon Dec 29 07:46:35 2008
@@ -18,7 +18,7 @@
      description: build for Objective-C 2.0

  Library
-    build-depends: base, template-haskell, unix
+    build-depends: base < 4, template-haskell, unix

      exposed-modules:
          HOC,
@@ -57,7 +57,6 @@
      hs-source-dirs: HOC

      extra-libraries: objc, ffi
-    c-sources: HOC_cbits.o
      if os(darwin)
          include-dirs: /usr/include/ffi
          frameworks: Foundation

Modified: trunk/hoc/HOC/HOC/Exception.hs
==============================================================================
--- trunk/hoc/HOC/HOC/Exception.hs	(original)
+++ trunk/hoc/HOC/HOC/Exception.hs	Mon Dec 29 07:46:35 2008
@@ -5,7 +5,7 @@
  import Foreign
  import Foreign.C.String     ( CString, withCString )
  import Prelude              hiding ( catch )
-import Control.Exception    ( evaluate, throwIO, throwDyn, catchDyn, catch  
)
+import Control.Exception    ( Exception, evaluate, throwIO, throwDyn,  
catchDyn, catch )

  import HOC.Base
  import HOC.Arguments
@@ -15,8 +15,8 @@
      deriving Typeable


-foreign import ccall unsafe wrapHaskellException :: CString -> StablePtr a  
-> IO (Ptr ObjCObject)
-foreign import ccall unsafe unwrapHaskellException :: Ptr ObjCObject -> IO  
(StablePtr a)
+foreign import ccall unsafe wrapHaskellException :: CString -> StablePtr  
Exception -> IO (Ptr ObjCObject)
+foreign import ccall unsafe unwrapHaskellException :: Ptr ObjCObject -> IO  
(StablePtr Exception)

  exceptionObjCToHaskell :: Ptr ObjCObject -> IO a


Modified: trunk/hoc/InterfaceGenerator2/Headers.hs
==============================================================================
--- trunk/hoc/InterfaceGenerator2/Headers.hs	(original)
+++ trunk/hoc/InterfaceGenerator2/Headers.hs	Mon Dec 29 07:46:35 2008
@@ -12,7 +12,7 @@
  import Control.Monad(when)
  import Data.Char(isAlphaNum, toUpper)
  import Data.List(isPrefixOf,isSuffixOf)
-import Data.Maybe(mapMaybe)
+import Data.Maybe(mapMaybe, maybeToList)
  import System.Directory(getDirectoryContents, doesDirectoryExist)
  import System.Info(os)
  import Text.Parsec( runParserT )
@@ -89,9 +89,9 @@
          graph :: Gr () ()
          graph = mkUGraph [ 0 .. length loaded - 1 ]
                           [ (to, from) | (_, name, includes, _) <- loaded,
-                                        from <- Map.lookup name  
namesToNums,
+                                        from <- maybeToList $ Map.lookup  
name namesToNums,
                                          include <- includes,
-                                        to <- Map.lookup include  
namesToNums ]
+                                        to <- maybeToList $ Map.lookup  
include namesToNums ]
          sorted = map (numsToHeaders Map.!) $ topsort graph

          process ( (headerFileName, moduleName, imports, contents) :  
moreHeaders ) env accum

Modified: trunk/hoc/InterfaceGenerator2/ParserBase.hs
==============================================================================
--- trunk/hoc/InterfaceGenerator2/ParserBase.hs	(original)
+++ trunk/hoc/InterfaceGenerator2/ParserBase.hs	Mon Dec 29 07:46:35 2008
@@ -21,7 +21,13 @@
      = fst $ runMessages $ runParserT parser emptyParseEnvironment fileName  
text

  lookupIntegerConstant :: String -> Parser Integer
-lookupIntegerConstant name = getState >>= Map.lookup name
+lookupIntegerConstant name = getState >>= mapLookup name
+    where
+        -- ghc 6.10's containers package no longer allows arbitrary
+        -- monads in its return types
+        mapLookup k v = case Map.lookup k v of
+            Nothing -> fail "Integer constant not found"
+            Just x  -> return x

  defineIntegerConstant :: String -> Integer -> Parser ()
  defineIntegerConstant name value = modifyState (Map.insert name value)