gistfile1.txt

{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}

import qualified Language.C.Inline as C
import qualified Language.C.Inline.Unsafe as CU
import           Data.Monoid ((<>))
import           Foreign.C.Types
import           Foreign.Ptr (Ptr)
import           Foreign.Marshal.Array
import qualified Data.Vector.Storable as V

import           Data.Coerce (coerce)
import           Data.Monoid ((<>))
import qualified Data.Vector.Storable as V
import qualified Data.Vector.Storable.Mutable as VM
import           Foreign.C.Types
import           Foreign.ForeignPtr (newForeignPtr_)
import           Foreign.Ptr (Ptr)
import           Foreign.Storable (Storable)
import qualified Language.C.Inline as C
import qualified Language.C.Inline.Unsafe as CU
import           System.IO.Unsafe (unsafePerformIO)

import qualified Language.Haskell.TH as TH
import qualified Language.C.Types as CT
import qualified Data.Map as Map
import           Language.C.Inline.Context

import           Foreign.C.String
import           Foreign.Storable (peek, poke)
import           Data.Int

import           MyTypes

C.context (C.baseCtx <> C.vecCtx <> C.funCtx <> sunCtx)

-- C includes
C.include "<stdio.h>"
C.include "MyTypes.h"

bar :: Complex
bar = Complex 7.0 11.0

main = do
  foo <- [C.block| double {
                     Complex u;
                     Complex x;
                     Complex y;
                     Complex z;
                   
                     x.im = 0.0;
                     x.re = 1.0;
                     y.im = 1.0;
                     y.re = 0.0;
                     u = $(Complex bar);
                     complex_add(&x, &y, &z);
                     return z.im;
                   } |]
  putStrLn $ show foo

MyFuns.c

#include "MyTypes.h"

void complex_add(Complex *a, Complex *b, Complex *c){
  c->re = a->re + b->re;
  c->im = a->im + b->im;
}

MyTypes.h

typedef struct {double re, im;} Complex;

void complex_add(Complex *a, Complex *b, Complex *c);  

MyTypes.hs

{-# OPTIONS_GHC -Wall #-}

{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}

module MyTypes where

import           Foreign.C.Types
import           Foreign.Ptr (Ptr)

import           Foreign.Storable (Storable, sizeOf, alignment, peek, peekByteOff, poke, pokeByteOff)

import qualified Language.Haskell.TH as TH
import qualified Language.C.Types as CT
import qualified Data.Map as Map
import           Language.C.Inline.Context

data Complex = Complex
  { complRe :: {-# UNPACK #-} !CDouble
  , complIm :: {-# UNPACK #-} !CDouble
  } deriving (Show, Read, Eq, Ord)

instance Storable Complex where
  sizeOf _ = 2 * sizeOf (undefined :: Double)
  alignment _ = alignment (undefined :: Ptr CDouble)
  peek ptr = do
    real <- peekByteOff ptr 0
    img  <- peekByteOff ptr (sizeOf real)
    return $ Complex real img
  poke ptr (Complex real img) = do
    pokeByteOff ptr 0 img
    pokeByteOff ptr (sizeOf real) img

sunTypesTable :: Map.Map CT.TypeSpecifier TH.TypeQ
sunTypesTable = Map.fromList
  [
    (CT.TypeName "Complex", [t| Complex |] )
  ]

sunCtx :: Context
sunCtx = mempty {ctxTypesTable = sunTypesTable}

gcc -Wall -c MyFuns.c
ghc MyMain.hs MyFuns.o