(i always forget to reply-to-all)

If you'd like to reference C functions with Strings, one possible way is to
use System.Posix.DynamicLinker and the wrapper over libffi that's been
uploaded to hackage recently:

[m@monire asdf]$ ghci
GHCi, version 6.10.1: http://www.haskell.org/ghc/  :? for help
Loading package ghc-prim ... linking ... done.
Loading package integer ... linking ... done.
Loading package base ... linking ... done.

ghci> :m + Foreign.LibFFI
ghci> :m + Foreign.Ptr Foreign.Storable
ghci> :m + Foreign.C.Types Foreign.C.String
ghci> :m + System.Posix.DynamicLinker

ghci> malloc <- dlsym Default "malloc"
Loading package unix-2.3.1.0 ... linking ... done.
ghci> syscall <- dlsym Default "syscall"

ghci> :! echo -ne "#include <syscall.h>\n__NR_execve\n" | cpp | tac | grep -E "^[0-9]+$" | head -1 > NOODLES
ghci> nr_execve :: CLong <- (read . head . words) `fmap` readFile "NOODLES"
ghci> :! rm -f NOODLES

ghci> let sizeOfPtrCChar = sizeOf(undefined::Ptr())
ghci> argv <- callFFI malloc (retPtr (retPtr retCChar)) [argCSize (2*fromIntegral sizeOfPtrCChar)]
Loading package bytestring-0.9.1.4 ... linking ... done.
Loading package libffi-0.1 ... linking ... done.

ghci> sh <- newCString "/bin/sh"
ghci> poke argv sh
ghci> poke (argv`plusPtr`sizeOfPtrCChar) 0

ghci> callFFI syscall retCLong [argCLong nr_execve, argPtr sh, argPtr argv, argCInt 0] {-never returns-}
sh-3.2$ echo $0
/bin/sh
sh-3.2$ exit
exit
[m@monire asdf]$

Matt

On Fri, May 29, 2009 at 11:41 AM, Khudyakov Alexey <alexey.skladnoy@gmail.com> wrote:
On Friday 29 of May 2009 19:34:44 Patrick LeBoutillier wrote:
> Hi all,
>
> Is it possible with Haskell to call a function whose name is contained
> in a String?
> Something like:
>
> five = call_func "add" [2, 3]
>
> If not, perhaps this is acheivable using FFI?
>
Or maybe you are asking for template haskell[1]. With it you can actually
generate function at compile time. It depends on waht you actually need.

> {-# LANGUAGE TemplateHaskell #-}
> import Language.Haskell.TH
>
> five = $( foldl appE (varE $ mkName "+") [ litE $ integerL 2
>                                          , litE $ integerL 3 ] )


[1] http://haskell.org/haskellwiki/Template_Haskell

--
 Khudyakov Alexey
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe