FORTRAN and HASKELL

Sigbjorn Finne sof@galois.com
Sun, 2 Dec 2001 14:18:32 -0800


Hi,

you're in luck then, as the basic ABI is identical that of C (gcc),
since g77 shares the same backend.

Here's the simple example I tested it with:

foo$ cat square.f
      SUBROUTINE SQUARE(N,M)
C     COMPUTES THE SQUARE OF N, RETURNS IN M
      M=N*N
      RETURN
      END
C
foo$ cat main.hs
module Main where

import Ptr
import Storable
import MarshalUtils
import MarshalAlloc

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

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

main = square 11 >>= print
{- --------------------- -}

foo$ g77 -c square.f
foo$ ghc -o main main.hs square.o -fglasgow-exts -package lang

To get the name mangling and the details of passing arguments to the Fortran
subroutine right, I looked at the output of "f2c -P", which gives back C
prototypes for Fortran function/subs.

You could certainly imagine a tool that would automate all this..

hth
--sigbjorn

----- Original Message -----
From: "Heron" <heron_carvalho@bol.com.br>
To: "Sigbjorn Finne" <sof@galois.com>
Sent: Sunday, December 02, 2001 02:43
Subject: Re: FORTRAN and HASKELL


> Thank you for your  comments.  Answering your question ...
>
> > you don't say what platform this is on (or what Fortran compiler
> > you're using).
>
>     We are using GNU Fortran 77 Compiler (f77) on a Linux PC cluster based
> on Red Hat 6.2. The GHC version used is 5.02.
>
> Best Regards,
> Heron de Carvalho