how to call Fortran Procedures in Haskell Program?

Mike Thomas mthomas@gil.com.au
Tue, 23 Apr 2002 10:00:00 +1000


Hi there.

> >    Does anybody know how to call Fortran procedures in Haskell
> > program? I tried Green Card, but seems it only works with C codes.

Sigbjorn Finne posted a way of doing this a while back, possibly on this
list, maybe the GHC one.  He used the FFI and a simple squaring function.

Below is an extension using an integer array.  Note that I've had to double
the array size.

$ g77 -c atest.f
$ ghc -fglasgow-exts main.hs -o main.exe
$ ./main
[1,3,0,0,2,4,0,0]


If you go any further, please let me know as I want to interface to LAPACK.

Cheers

Mike Thomas.



................................................

module Main where

import Ptr
import Storable
import MarshalArray
import MarshalUtils
import MarshalAlloc

foreign import "atest_" unsafe atest_ :: Ptr Int -> Ptr Int -> IO Int

atest :: Int -> IO [Int]
atest x =
   withObject x $ \ ptr_x ->
   allocaArray  x $ \ ptr_a -> do
    atest_ ptr_x ptr_a
    peekArray (x*2) ptr_a

main = atest 4 >>= print

--square :: Int -> IO Int
--square x =
--   withObject x $ \ ptr_x   ->
--   alloca       $ \ ptr_res -> do
--    square_ ptr_x ptr_res
--    peek ptr_res

................................................

      SUBROUTINE ATEST(N,M)
      DIMENSION M(N,N)
      M(1,1)=1
      M(1,2)=2
      M(2,1)=3
      M(2,2)=4
      RETURN
      END

................................................