ANN: C->Haskell 0.8.1

Marcin 'Qrczak' Kowalczyk qrczak@knm.org.pl
15 Feb 2001 15:35:45 GMT


15 Feb 2001 08:20:00 GMT, Marcin 'Qrczak' Kowalczyk <qrczak@knm.org.pl> pisze:

> Does C2HSDeprecated export newStablePtr and freeHaskellFunPtr?
> Currently it does not, but GtkCList assumes it does.
> 
> Does C2HS export castPtrToFunPtr? Currently it does not, but GMarsh
> assumes it does.

Now I see: these functions in module C2HS are present in the released
c2hs-0.8.2, but not in the CVS. I guess you have not committed changes.

gtk+hs' examples which compile with the present interface don't link on
ghc-4.08.2, because of the ghc's bug in handling newtypes in foreign
exports which references rts_mkPtr. This is because you made Addr a
type synonym for Ptr ().

It can be "fixed" without making Addr incompatible with Ptr (which
I guess is needed because c2hs generates Addr and code uses Ptr)
by something like this:
    module PtrHack where
        import qualified Addr
        newtype Addr a = Ptr Addr.Addr
    module C2HSSomething where
        import qualified PtrHack
        type Ptr = PtrHack.Addr
        type Addr = Ptr ()
This ensures that the "real" name of the Ptr type is Addr.

I'll try this hack for QForeign to see if it can reduce the amount
of #ifdefs for broken compilers. It applies to newtypes in arguments
and results of functions in foreign export and foreign export dynamic
in ghc-4.08*.

It should be applied to CInt etc. too, to let them work there. I can
provide my own CTypes for ghc-4.08*, but at least I will get rid of
many of those stupid #ifdefs.

Unfortunately it does not help for Ptr in the result of foreign export
dynamic (ghc-4.08) nor in the argument of foreign import dynamic
(ghc-4.08*), where newtypes don't work. This means that gtk+hs does
not compile on 4.08 because of Ptr () (spelled as Addr) in the result
of foreign export dynamic.

Here is which ghc versions are broken in which ways:

            |                 newtypes work in foreign...                 |
            |                                                             |
            |   export   |  export   |   import   |  import   |           |
            | stat.& dyn.|  dynamic  | stat.& dyn.|  dynamic  |   label   |
            | (function) | (pointer) | (function) | (pointer) | (pointer) |
------------+------------+-----------+------------+-----------+-----------+
 ghc-4.08   |   hacked   |    no     |    yes     |    no     |    no     |
 ghc-4.08.1 |   hacked   |    yes    |    yes     |    no     |    yes    |
 ghc-4.08.2 |   hacked   |    yes    |    yes     |    no     |    yes    |
 ghc-4.11   |    yes     |    yes    |    yes     |    yes    |    yes    |

"Hacked" means that they work as long as the type name after expanding
type synonyms is recognized by the rts (and there is no way to #include
something in stubs I think).

-- 
 __("<  Marcin Kowalczyk * qrczak@knm.org.pl http://qrczak.ids.net.pl/
 \__/
  ^^                      SYGNATURA ZASTĘPCZA
QRCZAK