New interface to gf based in Storable.

1 files changed, 111 insertions, 0 deletions

diff --git a/contrib/py-bindings/PyGF.hsc b/contrib/py-bindings/PyGF.hsc
new file mode 100644
index 000000000..7292277dd
--- /dev/null
+++ b/contrib/py-bindings/PyGF.hsc
@@ -0,0 +1,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
\ No newline at end of file