[Haskell-cafe] Dynamic types through unsafeCoerce

Alfonso Acosta alfonso.acosta at gmail.com
Wed Dec 13 08:16:36 EST 2006


I really like your approach Udo, and I would use it, but I added the
condition of not splitting the descriptor for a good reason, let me
explain it.

Let's summarize what we have first  ...

Here is my _simplified_ Descriptor

-- Descriptor, equivalent to a C struct with function pointers
-- hd is the handler of the callbacks (void *) in C
data Descriptor hd =
    Descriptor { -- create a new instance and return its handler
                instantiate            :: InstanceInitData -> hd,
                -- Run and return a new handler
                run                    :: hd   -> IO hd}


And here is Udo's proposal

-- ----------
type Descriptor = InstanceInitData -> Runner
       -- a function!  Who would have thought it?

newtype Runner = R { run :: IO Runner }
       -- could be a plain (IO Runner) instead of a newtype, if only it
       -- weren't a recursive type


On 12/13/06, Udo Stenzel <u.stenzel at web.de> wrote:
> Finished!  Look Ma, no existentials, no Typeable, no wrappers, even the
> types have become simple!

I don't quite agree with this.

I like the fact that type parameters are removed, which makes them
homegeneus and solves the problem of storing them in a list but as a
drawback the Runner type is less intuitive than the simple run
function.

There's nothing horrible about it, but considering it's a binding I
think that the types should resemble the original C types as much as
possible. That has many advantages: the original documentation of the
library would still apply and anyone who understands C code which
makes use of the original library could translate it easily to Haskell
afterwards.

> Okay, I cheated a bit: I _did_ split Descriptor in two.  That feels more
> right anyway, since 'instantiate' is only going to be called once (I
> think) and before 'instantiate' is called, there is no meaningful 'run'
> function anyway (and of that I'm sure).


As I said the example I posted is quite simplified. Actually the real
descriptor (a naive translation from a C struct) is:



-- hd and id are (void *) in C and modelled as type parameters in Haskell
data Descriptor id hd =
     Descriptor {uniqueID               :: LadspaIndex,
                          label                  :: String,
                          properties             :: LadspaProperties,
                          name, maker, copyright :: String,
                          portCount              :: LadspaIndex,
                          portDescriptors        :: [PortDescriptor],
                          portNames              :: [String],
                          portRangeHints         :: [PortRangeHint],
                          implementationData     :: id,
                          instantiate            :: Descriptor id hd
-> LadspaIndex ->
                                                   Maybe hd,
-- In this case we are using lists to represent the port I/O buffers, so the
-- port connections (buffer pointers of ports) is handled by the marshaller
--            connectPort   :: (hd -> LadspaIndex -> Ptr LadspaData -> IO hd)
              activate               :: Maybe(hd -> IO ()),
              -- (LadspaIndex,PortData) indicates the portnumber and its data
              run                    :: hd                       ->
                                         LadspaIndex              ->
                                         [(LadspaIndex,PortData)] ->
                                         ([(LadspaIndex,PortData)], hd),
-- Not yet implemented (is not mandatory for a plugin to provide them)
--            runAdding              ::
--            setAddingGain          ::
              deactivate             :: Maybe(hd -> IO ()),
              cleanup                :: hd -> IO ()}

As you can see, apart from the run function , a Descriptor has some
other data and other functions, which can be _optional_ ( see
deactivate, and activate)

Those optional funcions cause a problem when splitting the type Udo
did: The C code must know which of those are optional when calling
chooseDescriptor.

One solution would be adding some Booleans to the Descriptor,
indicating wether those functions are finally going to be used or not
... but that causes redundancy and permits  inconsistencies (Boolean
in Descriptor + Maybe value of the function itself which don't match).
That's how I actually do it right now (see
http://www.student.nada.kth.se/~alfonsoa/HLADSPA/HLADSPA-0.2.1/src/HLADSPA.hs
). But I'm not happy with it.

The only elegant solution which I could come up to solve the problem
is simply avoiding to split the Descriptor by using unsafeCoerce#
(which is not that elegant) to store the descriptors in a list.

Thats when I decided to start this thread ... and why I wrote that not
splitting the Descriptor was a must.

Any Suggestions?


More information about the Haskell-Cafe mailing list