Posts tagged ‘haskell’

Phantom type problems

The last few days i’ve been hacking on a data encoding library in Haskell. Haskell has long been lacking in this area and receiving a double-encoded email about a week ago alerted me to this (you might have had to actually be in my head to follow that train of thought :) ). Yesterday I put up a Wiki page and posted an email to the Haskell library list. I also logged into #Haskell and asked for feedback. This was when Saizan came with an interesting suggestion:

What about using phantom types to annotate the encoding and use a typeclass to unify the interfaces?

That’s an excellent idea. One thought has been bugging me since beginning implementing the library, each module exposes the same methods, with the same type signatures, but there is no type-safe polymorphism in the API. I’ve never really understood phantom types so Saizan’s idea was a bit of an eye-opener for me. I think they can help solve the problem. Unfortunately I ran into another problem when playing.

I picked base16 encoding to play a bit with this because the implementation is fairly short and simple. I began with creating a new typeclass:

class DataEncoding d where
    encode :: [Word8] -> d String
    decode :: d String -> [Word8]
    chop :: Int -> d String -> d [String]
    unchop :: d [String] -> d String
    liberate :: d [String] -> [String]
    incarcerate :: [String] -> d [String]

I added the last two functions since it’s no good to have the encoding locked up and inaccessible all the time, at some point we might actually want to do something with the data.

The implementation in Base16 looks like this:

data B16Enc p = B16EncS String
    | B16EncLS [String]
    deriving (Eq, Show)

instance DataEncoding B16Enc where
    encode os = B16EncS $ b16Encode os
    decode (B16EncS s) = b16Decode s
    chop n (B16EncS s) = B16EncLS $ b16Chop n s
    unchop (B16EncLS ss) = B16EncS $ b16Unchop ss
    liberate (B16EncLS ss) = ss
    incarcerate ss = B16EncLS ss

Then I realised that it might be useful to be able to liberate not only the result of a chop but also the result of a plain encode. That is I want something like

    liberate :: d a -> a
    incarcerate :: a -> d a

Where ideally a can be String or [String] and nothing else (I’ll settle for a weaker type if I have to though). What I want to avoid, if possible is the need for two functions for both liberate and incarcerate:

    liberateS :: d String -> String
    incarcerateS :: String -> d String
    liberateSL :: d [String] -> [String]
    incarcerateSL :: [String] -> d [String]

I’ve tried just introducing the a like above, but that causes a failure to match types, and declaring the class on DataEncoding d a (and enabling Glasgow extensions) causes arity problems in the types that confuse me to no end.

So, introducing phantom types and a typeclass is still ongoing. Any tip on solving the immidiate issue is welcome. I’ll be back as soon as I’ve come to any conclusion as to whether it’s worth the trouble or not :-)

Haskell and C—structs

When creating Haskell bindings for a C library one will sooner or later have to deal with ’structs’. Let’s look at how it can be done using hsc2hs.

Here’s a somewhat silly struct that’ll do for this example:

typedef struct {
    int a;
    int b;
} Foo;

It goes the file foo.h. I need some way of making sure that the data was passed properly from Haskell to C so here’s a declaration for a function to print an instance of Foo:

void print_foo(Foo *);

The actual implementation of print_foo goes into foo.c:

void
print_foo(Foo *f)
{
    printf("%s\n", __FUNCTION__);
    printf("f->a: %i\n", f->a);
    printf("f->b: %i\n", f->b);
}

No surprises so far. Now onto the Haskell side of things. First some basic setup:

{-# OPTIONS -ffi #-}
module Main
    where

import Foreign
import Foreign.C.Types

That makes sure I don’t forget to tell GHC that I’m using the foreign function interface (FFI) and imports everything I need for the rest. hsc2hs needs to know about the struct so I simply include the header file. I also need the Haskell representation of Foo, called Bar here, and for convenience I add a type for a pointer to Bar:

#include "foo.h"

data Bar = Bar { a :: Int, b :: Int }
type BarPtr = Ptr (Bar)

Now I’m ready to add the declaration of the “foreign” function:

foreign import ccall "static foo.h print_foo"
    f_print_foo :: BarPtr -> IO ()

Looking through the standard modules it isn’t completely obvious how to create a BarPtr for passing to f_print_foo. Whit the help of people on #haskell I found with, which has the type Storable a => a -> (Ptr a -> IO b) -> IO b. That means I have to make Bar a Storable. According to the documentation on Storable and some experimentation I found that for this particular example I only need full implementations of sizeOf, alignment and poke:

instance Storable Bar where
    sizeOf _ = (#size Foo)
    alignment _ = alignment (undefined :: CInt)
    peek _ = error "peek is not implemented"
    poke ptr (Bar a' b') = do
        (#poke Foo, a) ptr a'
        (#poke Foo, b) ptr b'

([Edited 09-08--2007 07:43 BST] See DeeJay’s comment below for an explanation of the definition of alignment.)

Using with every time I have to call f_print_foo will get tiring so here’s a function that’s a bit more convenient to use:

printFoo b = with b f_print_foo

Now I can write a small main function to test it all:

main = printFoo $ Bar { a=17, b=47 }

It works beautifully. However it’s very limited since it only covers the cases when a C function takes a pointer to a struct as a pure in argument. What about inout? (It’ll be easy to see how to deal with out arguments once the inout case is covered.) So, here’s a C function that adds 1 to one of the members in the struct:

void
add_a(Foo *f)
{
    printf("%s\n", __FUNCTION__);
    f->a++;
}

Of course a declaration in the header file is needed as well, but that’s pretty obvious so I’ll skip it here. The declaration of the foreign function is as simple as for f_print_foo:

foreign import ccall "static foo.h add_a"
    f_add_a :: BarPtr -> IO ()

Now comes the interesting part. Writing a convenience function for f_add_a isn’t as straight forward as for f_print_foo. I think something with the type Bar -> IO Bar would be useful. with creates a temporary BarPtr for the duration of the call which means I have to have an inner function that takes the Bar part out of the BarPtr and returns it inside IO. Luckily peek does exactly that. Adding an implementation of it means that Bar as a Storable is implemented like this:

instance Storable Bar where
    sizeOf _ = (#size Foo)
    alignment _ = 1 -- ???
    peek ptr = do
        a' <- (#peek Foo, a) ptr
        b' <- (#peek Foo, b) ptr
        return Bar { a=a', b=b' }
    poke ptr (Bar a' b') = do
        (#poke Foo, a) ptr a'
        (#poke Foo, b) ptr b'

And the convenience function for f_add_a can be written like this:

addA b = with b $ \ p -> f_add_a p >> peek p

Then I can modify the main function to test this as well:

main = do
    b <- return $ Bar { a=17, b=47 }
    printFoo b
    d <- addA b
    printFoo b
    printFoo d

Indeed, produces the expected out put:

print_foo
f->a: 17
f->b: 47
add_a
print_foo
f->a: 17
f->b: 47
print_foo
f->a: 18
f->b: 47

Pure out arguments can be handled using alloca with a function similar to the one I pass to with in addA above.

OSCON videos are available

Irrefutable patterns for the ignorant

A few days ago was the first time I ever saw some code like this:

~[arg] <- getArgs

I hadn’t come across irrefutable patterns (also called lazy patterns) in Haskell before and was of course curious. This is an attempt at illustrating the difference between lazy and non-lazy pattern matching. Here’s some code not using lazy pattern matching:

main = do
    putStrLn "Before"
    [arg1] <- getArgs
    putStrLn "After"
    putStrLn arg1

Running it, without giving it any argument, results in:

Before
pattern: user error (Pattern match failure in do expression at pattern.hs:9:4-9)

Here’s almost the same code, but with lazy pattern matching:

main = do
    putStrLn "Before"
    ~[arg1] <- getArgs
    putStrLn "After"
    putStrLn arg1

Running it, again without providing any argument, results in:

Before
After
pattern: pattern.hs:(7,7)-(11,16): Irrefutable pattern failed for pattern [arg1]

Identity as a transformer: IdentityT

Here’s a somewhat “silly” transformer. I’ve been thinking about it for a few days but didn’t find the time for it until tonight. Never ever having written even a monad on my own I did find the thought of a transformer more than a little daunting. As so often before I don’t really have any novel ideas and DonS had already done the same thing (thanks to chess in #haskell for helping me find it). After seeing his code I cleaned mine up (and copied some things I had “saved for later”). Here’s the resulting monad transformer:

newtype IdentityT m a = IdentityT { runIdentityT :: m a }

instance (Monad m) => Monad (IdentityT m) where
    return = IdentityT . return
    m >>= k = IdentityT $ runIdentityT . k =<< runIdentityT m
    fail msg = IdentityT $ fail msg

instance (MonadIO m) => MonadIO (IdentityT m) where
    liftIO = IdentityT . liftIO

instance (Functor m, Monad m) => Functor (IdentityT m) where
    fmap f = IdentityT . fmap f . runIdentityT

instance MonadTrans IdentityT where
    lift = IdentityT

I’ll get back to what I think it might be useful for in a later post.