mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-13 06:49:31 -06:00
111 lines
2.8 KiB
Haskell
111 lines
2.8 KiB
Haskell
{-# 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 |