summaryrefslogtreecommitdiff
path: root/src/runtime/haskell-bind/Gu.hsc
blob: e9d060c9288137f0ebd4437abcce0800e920604b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
{-# 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


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]]