cant figure out how to use c2hs, what am i doing wrong?

I have a simple fftw wrapper which c2hs builds into a .hs file, but when i try to use it i get an error: $ ghc -v --make -fffi Main.hs Glasgow Haskell Compiler, Version 6.4.2, for Haskell 98, compiled by GHC version 6.4.2 Using package config file: /usr/lib/ghc-6.4.2/package.conf Hsc static flags: -static *** Chasing dependencies: Chasing modules from: Main.hs *** Deleting temp files Deleting: Fftw.chs:2:0: parse error on input `import' here is my Fftw.chs: module Fftw (fftwNew, fftwDestroy, fftwExecute) import C2HS #include "fftw3.h" data Fftw = Fftw Integer CPtrDiff CPtrDiff CPtrDiff fftwNew::IO Integer -> Fftw fftwNew size = do input <- {#call unsafe fftw_malloc#} 8*size output <- {#call unsafe fftw_malloc#} 8*size plan <- {#call unsafe fftw_plan_r2r_1d#} size input output 0 0 return !$ Fftw size input output plan fftwSize::Fftw -> Integer fftwSize (Fftw size _ _ _ ) = size fftwDestroy::Fftw -> IO () fftwDestroy (Fftw _ input output plan) = do {#call unsafe fftw_free#} input {#call unsafe fftw_free#} output {#call unsafe fftw_destroy_plan#} plan fftwExecute::IO Fftw [Double] -> [Double] fftwExecute (Fftw size input output plan) inp = do pokeArray input (take size inp) {#call unsafe fftw_execute#} plan return !$ peekArray size output and my Main.hs: module Main where import Fftw main :: IO () main = do fft <- fftwNew 128 putStrLn $ show $ "done"

Anatoly,
I have a simple fftw wrapper which c2hs builds into a .hs file, but when i try to use it i get an error:
$ ghc -v --make -fffi Main.hs Glasgow Haskell Compiler, Version 6.4.2, for Haskell 98, compiled by GHC version 6.4.2 Using package config file: /usr/lib/ghc-6.4.2/package.conf Hsc static flags: -static *** Chasing dependencies: Chasing modules from: Main.hs *** Deleting temp files Deleting:
Fftw.chs:2:0: parse error on input `import'
here is my Fftw.chs: module Fftw (fftwNew, fftwDestroy, fftwExecute)
You need to add the keyword "where" after the export list. (This is really a Haskell error and nothing to do with c2hs).
import C2HS [..]
Manuel
participants (2)
-
Anatoly Yakovenko
-
Manuel M T Chakravarty