Refactored py-bindings using Storable.

contrib/py-bindings/PyGF.hsc

@@ -5,15 +5,17 @@ import PGF
 import Foreign
 import CString
 import Foreign.C.Types
+import Control.Monad
 
 #include "pygf.h"
 
--- type PyPtr = Ptr Py
 freeSp :: String -> Ptr a -> IO ()
 freeSp tname p = do
+    --DEBUG putStrLn $ "about to free pointer " ++ tname ++ " at " ++ (show p)
     sp <- (#peek PyGF, sp) p
+    --DEBUG putStrLn "peeked"
     freeStablePtr sp
-    putStrLn $ "freeing " ++ tname ++ " at " ++ (show p)
+    --DEBUG putStrLn $ "freeing " ++ tname ++ " at " ++ (show p)
 
 instance Storable PGF where
     sizeOf _ = (#size PyGF)
@@ -55,12 +57,31 @@ instance Storable Tree where
       sp <- (#peek PyGF, sp) p
       deRefStablePtr sp
 
+-- It is CId the same as Tree?
+
+{- instance Storable CId 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_freePGF :: Ptr PGF -> IO ()
 foreign export ccall gf_freeType :: Ptr Type -> IO ()
 foreign export ccall gf_freeLanguage :: Ptr Language -> IO ()
+foreign export ccall gf_freeTree :: Ptr Tree -> IO ()
+foreign export ccall gf_freeExpr :: Ptr Expr -> IO ()
+foreign export ccall gf_freeCId :: Ptr CId -> IO ()
 gf_freePGF = freeSp "pgf"
 gf_freeType = freeSp "type"
 gf_freeLanguage = freeSp "language"
+gf_freeTree = freeSp "tree"
+gf_freeExpr = freeSp "expression"
+gf_freeCId = freeSp "CId"
 
            
 {-foreign export ccall gf_printCId :: Ptr CId-> IO CString
@@ -68,6 +89,7 @@ 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)
@@ -88,29 +110,37 @@ 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)
+foreign export ccall gf_parse :: Ptr PGF -> Ptr Language -> Ptr Type -> CString -> IO  (Ptr ())
 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
+  --DEBUG putStrLn $  (show $ length  parsed) ++ " parsings"
+  listToPy pyTree 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
+listToPy :: Storable a => IO (Ptr a) -> [a] -> IO (Ptr ()) -- opaque -- IO (Ptr (Ptr Language))
+listToPy mk ls = do
+    let bufl = length ls + 1
+    -- buf <- mallocBytes $ (#size PyGF) * bufl
+    pyls <- pyList
+    -- pokeElemOff buf (length ls) nullPtr
+    mapM_ (mpoke pyls)  ls
+    return pyls
+  where  mpoke pyl l = do
+          pl <- mk
+          poke pl l
+          pyl << pl
+       
+
+-- foreign export ccall "gf_freeArray" free :: Ptr a -> IO ()
+
               
 foreign export ccall gf_showLanguage :: Ptr Language -> IO CString
 gf_showLanguage plang = do
@@ -120,4 +150,53 @@ gf_showLanguage plang = do
 foreign export ccall gf_showType :: Ptr Type -> IO CString
 gf_showType ptp = do
   t <- peek ptp
-  newCString $ showType [] t
+  newCString $ showType [] t
+
+foreign export ccall gf_showPrintName :: Ptr PGF -> Ptr Language -> Ptr CId -> IO CString
+gf_showPrintName ppgf plang pcid = do
+  pgf <- peek ppgf
+  lang <- peek plang
+  cid <- peek pcid
+  newCString (showPrintName pgf lang cid)
+
+foreign export ccall gf_abstractName :: Ptr PGF -> Ptr Language -> IO ()
+gf_abstractName ppgf pabs = do
+  pgf <- peek ppgf
+  poke pabs $ abstractName pgf
+
+foreign export ccall gf_linearize :: Ptr PGF -> Ptr Language -> Ptr Tree -> IO CString
+gf_linearize ppgf plang ptree = do
+  pgf <- peek ppgf
+  lang <- peek plang
+  tree <- peek ptree
+  newCString $ linearize pgf lang tree
+
+foreign export ccall gf_languageCode :: Ptr PGF -> Ptr Language -> IO CString
+gf_languageCode ppgf plang = do
+  pgf <- peek ppgf
+  lang <- peek plang
+  case languageCode pgf lang of
+    Just s -> newCString s
+    Nothing -> return nullPtr
+
+foreign export ccall gf_languages :: Ptr PGF -> IO (Ptr ()) -- (Ptr (Ptr Language))
+gf_languages ppgf = do
+  pgf <- peek ppgf
+  listToPy pyLang $ languages pgf
+
+foreign export ccall gf_categories :: Ptr PGF -> IO (Ptr ())
+gf_categories ppgf = do
+  pgf <- peek ppgf
+  listToPy pyCId $ categories pgf
+
+foreign export ccall gf_showCId :: Ptr CId -> IO CString
+gf_showCId pcid = do
+  cid <- peek pcid
+  newCString $ showCId cid
+
+
+foreign import ccall "newLang" pyLang :: IO (Ptr Language) 
+foreign import ccall "newTree" pyTree :: IO (Ptr Tree) 
+foreign import ccall "newCId" pyCId :: IO (Ptr CId) 
+foreign import ccall "newList" pyList :: IO (Ptr ()) 
+foreign import ccall "append" (<<) :: Ptr () -> Ptr a -> IO ()