Posts tonen met het label haskell. Alle posts tonen
Posts tonen met het label haskell. Alle posts tonen

donderdag 8 maart 2012

Using FFI to use a LibExiv2 in haskell

Haskell has a very well developed Foreign Function Interface. But one of the problems with the FFI is that it is specialized for C.

For a project in our company we needed an alternative to libexif, because the library has problems with reading binary blobs embedded in the exif data.

LibExiv2 is a perfect candidate to use, but gave rise to some technical challenges to overcome. The biggest challenge was, how to deal with auto_ptr's. We couldn't use the auto_ptr to create a StablePtr, which we can use with FFI in haskell.

First some basics of LibExiv2:

Exiv2 can open any image format. They provide a general function for opening files. This is Exiv2::ImageFactory::open. After that we can read the metadata with an object method. readMetaData. This reads the exif data from the image file. After we have done this, we can get an Iterator (some sort of Foldable-like structure) to search for certain keys and their values.

Exiv2::ImageFactor::open gives back an auto_ptr. An auto_ptr is a template class, which behaves like a pointer. But differs when a pointer leaves it scope, then it will be destroyed automagically and more important it is not a real pointer. It only behaves as a pointer, it memory address is stored in the template class.

So when we tried to pass the auto_ptr as StablePtr to the haskell side, we got an segmentation fault. After some research we concluded the following happened:

We retrieved the pointer from the auto_ptr. Then we passed this to the haskell side. But then the auto_ptr vanished from the scope, destroying the pointer in the process. Haskell then passed the original pointer back, but at that time it didn't exist anymore.

The solution was really simple. We created a wrapper around the auto_ptr:



struct Context {
Exiv2::Image::AutoPtr autoptr;

};


By carefully code, we let the auto_ptr never escape an existing scope. And converting only the pointer of the context to a haskell stableptr. This way we could safely send it to the haskell side.

As an example of how to use this trick, I will take some excerpts from the library:


/* This function opens a new image and creates and Exiv2::Image::AutoPtr
then wrap it in a Context to protect it from vanishing
*/
HsPtr openContext(const char * f){
std::string file(f);
Exiv2::Image::AutoPtr image = Exiv2::ImageFactory::open(file);
Context * c = new Context;
assert(image.get() != 0);
// assign the auto_ptr to the new context
c->autoptr = image;
c->autoptr->readMetadata();
// Cast it to a haskell pointer
return (HsPtr)c;
}

/* Later in the code we can restore the haskell pointer back to a context */

Context * ImagefromStablePtr(HsPtr p){
return ((Context *)p);
}

/* And then use it to get all the keys from the exif data (from haskell to haskell) */

HsPtr getExifKeysIterator(HsPtr p){
assert(p != 0);
Context * ctx = ImagefromStablePtr(p);
// As long as the autoptr is not leaving his context it will exists.
Exiv2::ExifData data = ctx->autoptr->exifData();
ExifIterator * it = new ExifIterator();
size_t size = data.count();
it->data = (char **)calloc(sizeof(char *), size);
it->size = size;
it->it = 0;
size_t counter = 0;
for(Exiv2::ExifData::const_iterator i = data.begin(); i != data.end(); i++){
std::string key = i->key();
it->data[counter] = new char[key.size()+1];
strcpy(it->data[counter], key.c_str());
counter++;
}
return (HsPtr)it;
}




The rest of the job was straightforward, except for the problem to let cabal handle the build process, but I am working on that. Advice would be appreciated.


You can view the code at bitbucket: https://bitbucket.org/eklerks/libexiv2bindings/src

I haven't include the build code. But manual building is not difficult. I will update the repos if I figured out, how to let it work with cabal.

zaterdag 8 mei 2010

Making M4 into a functional language

One of the less used, but widely distributed macro processors (M4) can be transformed into a functional language. After reading http://www.cs.stir.ac.uk/~kjt/research/pdf/expl-m4.pdf

I decided to create some list processing functions (Foldr,Foldl,Head,Tail,Append,Prepend,Null,Sum,Filter)

To implement Foldr and Foldl I have used CPS (continuation passing style), so these functions are difficult to read, but easily testable. Just fireup haskell and try: foldr (-) 0 [3,2,1] -> 2 and foldl should give -6. So Foldl(`Sub',0,[3;2;1]) should give -6 too.

Some logic operators (Not,And,Or,isBool)

Adding support for 'lambdas' -not really, but it is close- and add support for currying.

Maybe I change it in a real project some day. It is rather fun and with foldl and foldr a lot of functions from Data.List can be ported. The real challenge is adding monads. I am not sure if that is possible yet, but I have the feeling it probably can.

Of course there is no type system, but it suprised me how easily most functions could be implemented.

An example:

Lambda(x,`eval($1-($2))')dnl
`foldr'(`x',0,[3;2;1]) is : Foldr(`x',0,t)
`foldl'(`x',0,[3;2;1]) is : Foldl(`x',0,t)

The output of this is:

foldr(x,0,[3;2;1]) is : 2
foldl(x,0,[3;2;1]) is : -6

Even cooler is that you can write your testcases in haskell. Like:

test1 = `foldr' (-) 0 [3,2,1] == Foldr(`x',0,`[3;2;1;]')

Which gives us in ghci:

test1 = foldr (-) 0 [3,2,1] == (2)
ann@ann-desktop:~$ ghci
GHCi, version 6.12.2: http://www.haskell.org/ghc/ :? for help
Loading package ghc-prim ... linking ... done.
Loading package integer-gmp ... linking ... done.
Loading package base ... linking ... done.
Loading package ffi-1.0 ... linking ... done.
Prelude> foldr (-) 0 [3,2,1] == (2)
True
Prelude>

This is the minilib, it is somewhat dense, but so I could use it in a project:
changecom(`#',`')dnl
dnl# `Id`
define(Id, $1)dnl
dnl# `Lambda'
define(Lambda, `define($1, `$2')')dnl
define(Curry1, `define($1,`$2'($3,$`'1,$`'2,$`'3,$`'4))')dnl
define(Curry2, `define($1,`$2'($3,$4,$`'1,$`'2,$`'3,$`'4))')dnl
define(Curry3, `define($1,`$2'($3,$4,$5,$`'1,$`'2,$`'3,$`'4))')dnl
define(Curry4, `define($1,`$2'($3,$4,$5,$6,$`'1,$`'2,$`'3,$`'4))')dnl
define(Curry5, `define($1,`$2'($3,$4,$5,$6,$7,$`'1,$`'2,$`'3,$`'4))')dnl
define(Curry6, `define($1,`$2'($3,$4,$5,$6,$7,$8,$`'1,$`'2,$`'3,$`'4))')dnl
dnl# `Logical operators'
define(True, 1)dnl
define(False,0)dnl
define(Not, `ifelse($1, True, False, `ifelse($1, False, True, `errprint(Not a bool)')')')dnl
define(isBool, `ifelse($1, True, True, `ifelse($1, False, True, False)')')dnl
define(And, `ifelse($1, True, `ifelse($2, True, True, False)', False)')dnl
define(Or, `ifelse($1, True, True, `ifelse($2, True, True, False)')')dnl
dnl# `List operators'
define(Empty, [])dnl
define(Prep, `ifelse($2,[],[$1;],[$1;`substr($2,1,decr(len($2)))')')dnl
define(App, `ifelse($2,[],[$1;],`substr($2, 0, decr(len($2)))'$1;])')dnl
define(Next, `substr($2,$1,1)')dnl
define(Getpos, `ifelse(Next($1,$2),$3,$1,`Getpos(incr($1), $2, $3)')')dnl
define(Head, `substr($1, 1, decr(Getpos(0, $1,;)))')dnl
define(Tail, `ifelse($1,[],`errprint(tail: empty list)',[`substr($1,incr(Getpos(0,$1,;)))')')dnl
define(Index, `ifelse($1,0,`Head($2)',`Index(decr($1), Tail($2))')')dnl
define(Null, `ifelse($1,[],True,False)')dnl
dnl# `Foldr continuation passing style'
define(_Step, `$4(`$1',$1(Head($3),$2),Tail($3))')dnl
define(Foldr, `ifelse(Null($3),True,$2,`_Step(`$1',$2,$3,`Foldr')')')dnl
dnl# `Foldl continuation passing style'
define(_Stepl, `$4(`$1',$1($2,Head($3)),Tail($3))')dnl
define(Foldl, `ifelse(Null($3),True,$2,`_Stepl(`$1',$2,$3,`Foldl')')')dnl
dnl# `Sum example usage of Foldr'
define(Plus, `eval($1+$2)')dnl
define(Sum, `Foldr(`Plus',0,$1)')dnl
dnl# `Filter'
dnl# `Filter creates an locally scoped curried function, implemented withdefine..undefine'
dnl# ` ```$1''' is just a trick to get the function unpacked at the right place. Every passing
dnl# `removes a `' from the functionname'
define(_Stepf, `ifelse($1($2), True, Prep($2, $3), $3)')dnl
define(Filter,`Curry1(__Stepf,`_Stepf',```$1''')Foldr(`__Stepf',Empty,`$2')undefine(`__Stepf')')dnl
dnl# `Example foldr and foldl'
define(t, Prep(3,Prep(2,Prep(1, Empty))))dnl
Lambda(x,`eval($1-($2))')dnl
`foldr'(`x',0,[3;2;1]) is : Foldr(`x',0,t)
`foldl'(`x',0,[3;2;1]) is : Foldl(`x',0,t)