blob: 7292277dd94f9c24ec55a4573ca3899be60d33d0 (
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
|
{-# LANGUAGE ForeignFunctionInterface #-}
module PyGF where
import PGF
import Foreign
import CString
import Foreign.C.Types
#include "pygf.h"
-- type PyPtr = Ptr Py
instance Storable PGF where
sizeOf _ = (#size PyGF)
alignment _ = alignment (undefined::CInt)
poke p o = do
sp <- newStablePtr o
(#poke PyGF, sp) p sp
peek p = do
sp <- (#peek PyGF, sp) p
deRefStablePtr sp
instance Storable Type where
sizeOf _ = (#size PyGF)
alignment _ = alignment (undefined::CInt)
poke p o = do
sp <- newStablePtr o
(#poke PyGF, sp) p sp
peek p = do
sp <- (#peek PyGF, sp) p
deRefStablePtr sp
instance Storable Language where
sizeOf _ = (#size PyGF)
alignment _ = alignment (undefined::CInt)
poke p o = do
sp <- newStablePtr o
(#poke PyGF, sp) p sp
peek p = do
sp <- (#peek PyGF, sp) p
deRefStablePtr sp
instance Storable Tree where
sizeOf _ = (#size PyGF)
alignment _ = alignment (undefined::CInt)
poke p o = do
sp <- newStablePtr o
(#poke PyGF, sp) p sp
peek p = do
sp <- (#peek PyGF, sp) p
deRefStablePtr sp
{-foreign export ccall gf_printCId :: Ptr CId-> IO CString
gf_printCId p = do
c <- peek p
newCString (showCId c)
-}
foreign export ccall gf_readPGF :: Ptr PGF -> CString -> IO ()
gf_readPGF pt path = do
p <- (peekCString path)
result <- (readPGF p)
poke pt result
foreign export ccall gf_readLanguage :: Ptr Language -> CString -> IO Bool
gf_readLanguage pt str = do
s <- (peekCString str)
case (readLanguage s) of
Just x -> do
poke pt x
return True
Nothing -> return False
foreign export ccall gf_startCat :: Ptr PGF -> Ptr Type -> IO ()
gf_startCat ppgf pcat= do
pgf <- peek ppgf
poke pcat (startCat pgf)
foreign export ccall gf_parse :: Ptr PGF -> Ptr Language -> Ptr Type -> CString -> IO (Ptr Tree)
gf_parse ppgf plang pcat input = do
p <- peek ppgf
c <- peek pcat
i <- peekCString input
l <- peek plang
let parsed = parse p l c i
-- putStrLn $ (show $ length parsed) ++ " parsings"
listToArray $ parsed
foreign export ccall gf_showExpr :: Ptr Expr -> IO CString
gf_showExpr pexpr = do
e <- peek pexpr
newCString (showExpr [] e)
listToArray :: Storable a => [a] -> IO (Ptr a)
listToArray list = do
buf <- mallocBytes $ (#size PyGF) * (length list + 1)
sequence $ zipWith (dpoke buf) [0..] list
return buf
where
dpoke buf n x = do
pokeElemOff buf n x
foreign export ccall gf_showLanguage :: Ptr Language -> IO CString
gf_showLanguage plang = do
l <- peek plang
newCString $ showLanguage l
foreign export ccall gf_showType :: Ptr Type -> IO CString
gf_showType ptp = do
t <- peek ptp
newCString $ showType [] t
|
