Re[2]: Haskell(GHC) FFI C
От: alexander.vladislav.popov  
Дата: 15.12.11 09:41
Оценка:
Здравствуйте, VoidEx, Вы писали:

VE>Экспортируйте функции (пишу на память, могу соврать, лучше точнее посмотреть в доках)

VE>
VE>foreign export ccall open :: CString -> IO (Ptr ())
VE>foreign export ccall need_next :: Ptr () -> IO Bool
VE>foreign export ccall next :: Ptr () -> IO CString
VE>


VE>В Ptr () запихиваете любые Haskell-данные, получив из них StablePtr a и закастив к Ptr ().

VE>Строки конвертируете через newCString, peekCString, peekCString.
VE>Придётся, правда, позаботиться об освобождении самому, написав какую-нибудь close, а строки не самому выделять, а получать и заполнять буффер.

VE>Всё, что нужно, можно смотреть здесь в модулях Foreign.


Вот наивная, но рабочая версия. Добавьте критики.

-- genexlib.hs
{-# LANGUAGE BangPatterns, ForeignFunctionInterface #-}

module GenexLib where

import Regex.Genex
import System.IO
import System.Environment
import Foreign
import Foreign.Ptr
import Foreign.C.String
import Foreign.C.Types
import Foreign.Marshal.Alloc

data CLazyList a = Empty | CLL !a [a]

instance (Show a) => Show (CLazyList a) where
  show Empty = "Empty"
  show (CLL x xs) = show x ++ ":.."

next'pure :: CLazyList a -> CLazyList a
next'pure (CLL _ [])     = Empty
next'pure (CLL _ (x:xs)) = CLL x xs

fromList :: [a] -> CLazyList a
fromList []     = Empty
fromList (x:xs) = CLL x xs

open'pure :: [String] -> CLazyList String
open'pure = fromList . genexPure

foreign export ccall open :: CString -> IO (Ptr ())
open cs = do
  s <- peekCString cs
  sptr <- newStablePtr $ open'pure [s]
  return $ castStablePtrToPtr sptr
  
foreign export ccall need_next :: Ptr () -> IO (Ptr ())
need_next ptr = do
  if ptr == nullPtr 
     then
         return nullPtr
     else do
      let stable = castPtrToStablePtr ptr
      lazylist <- deRefStablePtr stable
      let tail = next'pure lazylist
      case tail of 
        Empty -> do
            freeStablePtr stable
            return nullPtr
        _     -> do
            new'stable <- newStablePtr tail 
            freeStablePtr stable
            return $ castStablePtrToPtr new'stable

foreign export ccall next :: Ptr () -> CString -> CInt -> IO CString
next ptr str len = do
  if ptr == nullPtr 
     then 
         return nullPtr
     else do
       let stable = castPtrToStablePtr ptr
       lazylist <- deRefStablePtr stable
       case lazylist of
         Empty -> return str
         CLL x xs -> do
           c <- newCString x
           copyArray str c $ 1 + length x
           free c
           return str
            
foreign export ccall close :: Ptr () -> IO ()       
close ptr = do
  if ptr == nullPtr then return ()
  else do
    let stable = castPtrToStablePtr ptr
    freeStablePtr stable
    return ()


// genex.c
#include <stdio.h>
#include <stdlib.h>
#include "genexlib_stub.h"
 
int main(int argc, char *argv[]) {

  if(argc < 2) {
    printf("Usage: genex <regex>");
    exit(0);
  }
 
  hs_init(&argc, &argv);
 
  void *c = open(argv[1]);

  int i = 0;
  while(c = need_next(c)) {
    char buf[256];
    buf[0] = 0;
    printf("iter %d: ", ++i);
    printf("%s\n", next( c, buf, 256 ));
  }

  close( c );

  hs_exit();
}


компилировать
>ghc -c genexlib.hs
>ghc -package regex-genex genex.c genexlib.o genexlib_stub.o -o genex
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.