Allocation & Marshalling Question (again)

Adrian Hey ahey at iee.org
Thu May 29 06:18:27 EDT 2003


Hello Wolfgang,

Thanks for your reply, you highlight the issues I've been trying to answer
myself, though I don't think I came to the same conclusions.

On Wednesday 28 May 2003 10:51, Wolfgang Thaller wrote:
> > So excuse me if this seems half baked, but am I the only one who
> > thinks the type signatures of utilities like this..
> >  allocaBytes :: Int -> (Ptr a -> IO b) -> IO b
> > ..are rather inconvenient?
> >
> > Wouldn't..
> >  allocaBytes :: Int -> (Ptr a -> b) -> b
> > ..be more useful?
>
> Why? 

I think it would be nice to free users from this style of programming..
	withCString s    $ \sPtr    ->
	allocaBytes n    $ \buffPtr ->
	withForeignPtr f $ \fPtr    ->
	do ...

It would be nice to just partially apply a foreign function of type..
  f :: CString -> CString -> IO CInt
.. to a Haskell string, as in..
  g :: CString -> IO CInt
  g = f <+ withCString "Hello" 

Of couse there's nothing to stop you partially applying the function
that results from the explicit lambdas code above, but only at the
expense of re-marshalling the same Haskell string every time the
underlying foreign function is called.

Another example, this foreign import seems quite legal (not necessarily
safe, but legal:-)
  foreign import ccall unsafe "cfunc" cfunc :: CString -> Word32
but its awkward to use it in conjunction with withCString.

  withCString "Hello" cfunc
gives a type error (of course), you need this instead..
  (unsafePerformIO $ withCString "Hello" (\p -> return $! cfunc p))

> What could the pure function you're passing to allocaBytes do with
> the pointer?

[My understanding of Haskell was that all functions are pure, even if
their type is (Ptr a -> IO b). What's impure is the action itself (which
always has type IO <something>).]

But who says the function is pure anyway, I never did:-) It just has some
type other than (Ptr a -> IO b), such as (Ptr a -> Word32 -> IO b).

To me, the type sigs of functions like withCString look like an (IMHO
misguided) attempt to use the type system to enforce safe useage,
at the expense of convenience for whoever it writing the binding.
The reason I think it's misguided is that pretty much all safety
with foreign interfaces is a matter of trust (not enforcable by
the Haskell type system).

Now it might well be that with current implementations it really
is unsafe to use withCString with any function that is not of
type (CString -> IO b). What I want to know is..
	* is that so? (maybe)
	* should that be so? (no IMHO)

What I want is to allow functions which take more than 1 argument
to be used as the second argument of allocaBytes, withCString..

Typically the type of these would be..
	Ptr a -> ... -> IO z  
though I'm not sure there's any good semantic reason to constrain
them this way. I don't see any significant difference between proper
treatment of pointers and proper treatment of IORefs. For example
functions of type..
	IORef a -> [IORef a] -> [IORef a]
are perfectly ok, despite the fact that they can't do anything
(I.E read or write) with their IORefs.

That said, there might well be implementation difficulties that
I'm not aware of.

> When would the storage be freed again? The original allocaBytes frees
> it after the IO action has finished, but before returing itself. How
> would that apply to the pure version?

Without understanding the technical details of various Haskell
implementations I can't say for sure, though I would imagine the
storage would be freed when the corresponding pointer became
garbage. This assumes the storage space is (haskell) heap allocated
(as I gather it is in ghc from Simon M's reply). If it was stack
allocated then I guess there would be problems.

> Also, if you're passing alloca or allocaBytes for the alloc parameter,
> how do you make sure that 'f' has been _completely_ evaluated before
> alloca deallocates the storage again?

That was one of the problems I anticipated in my original posts,
(danger of premature deallocation). I don't know the answer, that's
why I asked.

> > Possible explanations that occur to me are..
> 5- because this use of unsafePerformIO is highly dangerous (I think it
> will lead to segfaults sooner or later) and should be avoided at all
> costs.

You might well be right regarding my <+ operator, though I haven't seen
any segfaults using this with ghc. I did test it by using this with a
library binding I'm working on. I've subsequently removed all use of
<+ because I couldn't figure out for sure whether it's safe or not.

But if functions like withCString had the type sigs I'm asking for, it
wouldn't be necessary to use unsafePerformIO in the first place.

Regards
--
Adrian Hey



More information about the FFI mailing list