mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-04 00:32:51 -06:00
128 lines
3.5 KiB
Haskell
128 lines
3.5 KiB
Haskell
{-# LANGUAGE ForeignFunctionInterface #-}
|
|
#include <pgf/pgf.h>
|
|
#include <gu/enum.h>
|
|
#include <gu/exn.h>
|
|
|
|
module Gu where
|
|
|
|
import Foreign
|
|
import Foreign.C
|
|
import Foreign.C.String
|
|
import Foreign.Ptr
|
|
import Control.Exception
|
|
|
|
|
|
data GuEnum
|
|
data GuExn
|
|
data GuIn
|
|
data GuInStream
|
|
data GuKind
|
|
data GuString
|
|
data GuStringBuf
|
|
data GuMapItor
|
|
data GuOut
|
|
data GuOutStream
|
|
data GuPool
|
|
|
|
data PgfPGF
|
|
data PgfApplication
|
|
data PgfConcr
|
|
type PgfExpr = Ptr ()
|
|
data PgfExprEnum
|
|
data PgfExprProb
|
|
data PgfFullFormEntry
|
|
data PgfMorphoCallback
|
|
data PgfPrintContext
|
|
data PgfType
|
|
data PgfLexer
|
|
|
|
------------------------------------------------------------------------------
|
|
-- Mindless copypasting and translating of the C functions used in CRuntimeFFI
|
|
-- GU stuff
|
|
|
|
|
|
|
|
foreign import ccall "gu/mem.h gu_new_pool"
|
|
gu_new_pool :: IO (Ptr GuPool)
|
|
|
|
foreign import ccall "gu/mem.h gu_pool_free"
|
|
gu_pool_free :: Ptr GuPool -> IO ()
|
|
|
|
foreign import ccall "gu/mem.h &gu_pool_free"
|
|
gu_pool_free_ptr :: FunPtr (Ptr GuPool -> IO ())
|
|
|
|
foreign import ccall "gu/exn.h gu_new_exn"
|
|
gu_new_exn :: Ptr GuExn -> Ptr GuKind -> Ptr GuPool -> IO (Ptr GuExn)
|
|
|
|
foreign import ccall "gu/exn.h gu_exn_is_raised"
|
|
gu_exn_is_raised :: Ptr GuExn -> IO Bool
|
|
-- gu_ok exn = do
|
|
-- state <- (#peek GuExn, state) exn
|
|
-- return (state /= GU_EXN_RAISED)
|
|
|
|
foreign import ccall "gu/type.h &gu_type__type"
|
|
gu_type__type :: Ptr GuKind
|
|
|
|
|
|
--GuIn* gu_string_in(GuString string, GuPool* pool);
|
|
foreign import ccall "gu/string.h gu_string_in"
|
|
gu_string_in :: CString -> Ptr GuPool -> IO (Ptr GuIn)
|
|
|
|
--GuStringBuf* gu_string_buf(GuPool* pool);
|
|
foreign import ccall "gu/string.h gu_string_buf"
|
|
gu_string_buf :: Ptr GuPool -> IO (Ptr GuStringBuf)
|
|
|
|
--GuOut* gu_string_buf_out(GuStringBuf* sb);
|
|
foreign import ccall "gu/string.h gu_string_buf_out"
|
|
gu_string_buf_out :: Ptr GuStringBuf -> IO (Ptr GuOut)
|
|
|
|
|
|
--void gu_enum_next(GuEnum* en, void* to, GuPool* pool)
|
|
foreign import ccall "gu/enum.h gu_enum_next"
|
|
gu_enum_next :: Ptr a -> Ptr (Ptr b) -> Ptr GuPool -> IO ()
|
|
|
|
|
|
--GuString gu_string_buf_freeze(GuStringBuf* sb, GuPool* pool);
|
|
foreign import ccall "gu/string.h gu_string_buf_freeze"
|
|
gu_string_buf_freeze :: Ptr GuStringBuf -> Ptr GuPool -> IO CString
|
|
|
|
{-
|
|
typedef struct PgfMorphoCallback PgfMorphoCallback;
|
|
struct PgfMorphoCallback {
|
|
void (*callback)(PgfMorphoCallback* self,
|
|
PgfCId lemma, GuString analysis, prob_t prob,
|
|
GuExn* err);
|
|
};
|
|
--allocate this type of structure in haskell
|
|
--make a function and do Something
|
|
-}
|
|
|
|
{- Not used
|
|
--GuIn* gu_new_in(GuInStream* stream, GuPool* pool);
|
|
foreign import ccall "gu/in.h gu_new_in"
|
|
gu_new_in :: Ptr GuInStream -> Ptr GuPool -> Ptr GuIn
|
|
|
|
--GuOut* gu_new_out(GuOutStream* stream, GuPool* pool);
|
|
foreign import ccall "gu/mem.h gu_new_out"
|
|
gu_new_out :: Ptr GuOutStream -> Ptr GuPool -> IO (Ptr GuOut)
|
|
--TODO no idea how to get a GuOutStream
|
|
|
|
--GuOut* gu_file_out(FILE* file, GuPool* pool);
|
|
foreign import ccall "gu/file.h gu_file_out"
|
|
gu_file_out :: Ptr CString -> Ptr GuPool -> IO (Ptr GuOut) -}
|
|
|
|
|
|
--Pointer magic here, using plusPtr etc.
|
|
ptrToList :: Ptr PgfApplication -> Int -> IO [PgfExpr]
|
|
ptrToList appl arity = do
|
|
let ptr = appl `plusPtr` (#offset PgfApplication, args) --args is not an argument, it's the actual field name
|
|
sequence [peek (ptr `plusPtr` (i * (#size PgfExpr))) | i<-[0..arity-1]]
|
|
|
|
withGuPool :: (Ptr GuPool -> IO a) -> IO a
|
|
withGuPool f = do
|
|
pl <- gu_new_pool
|
|
f pl `finally` gu_pool_free pl
|
|
-- for true haskell persons
|
|
-- withGuPool f = bracket gu_new_pool gu_pool_free f
|
|
|