extend the abstract syntax API

src/runtime/haskell/PGF2/Expr.hsc

@@ -2,3 +2,5 @@
 
 module PGF2.Expr where
 
+type Cat = String -- ^ Name of syntactic category
+type Fun = String -- ^ Name of function

src/runtime/haskell/PGF2/FFI.hsc

@@ -3,7 +3,7 @@
 module PGF2.FFI where
 
 import Data.Word
-import Foreign ( alloca, peek, poke, peekByteOff )
+import Foreign
 import Foreign.C
 import Foreign.Ptr
 import Foreign.ForeignPtr
@@ -21,21 +21,39 @@ data Concr = Concr {c_pgf :: ForeignPtr PgfPGF, concr :: Ptr PgfConcr}
 
 data PgfExn
 data PgfText
+data PgfItor
 data PgfPGF
 data PgfConcr
 
 foreign import ccall unsafe "pgf_utf8_decode"
   pgf_utf8_decode :: Ptr CString -> IO Word32
 
-foreign import ccall "pgf.h pgf_read"
+foreign import ccall unsafe "pgf_utf8_encode"
+  pgf_utf8_encode :: Word32 -> Ptr CString -> IO ()
+
+foreign import ccall "pgf_read"
   pgf_read :: CString -> Ptr PgfExn -> IO (Ptr PgfPGF)
 
 foreign import ccall "&pgf_free"
   pgf_free_fptr :: FinalizerPtr PgfPGF
 
-foreign import ccall "pgf/pgf.h pgf_abstract_name"
+foreign import ccall "pgf_abstract_name"
   pgf_abstract_name :: Ptr PgfPGF -> IO (Ptr PgfText)
 
+type ItorCallback = Ptr PgfItor -> Ptr PgfText -> IO ()
+
+foreign import ccall "wrapper"
+  wrapItorCallback :: ItorCallback -> IO (FunPtr ItorCallback)
+
+foreign import ccall "pgf_iter_categories"
+  pgf_iter_categories :: Ptr PgfPGF -> Ptr PgfItor -> IO ()
+
+foreign import ccall "pgf_iter_functions"
+  pgf_iter_functions :: Ptr PgfPGF -> Ptr PgfItor -> IO ()
+
+foreign import ccall "pgf_iter_functions_by_cat"
+  pgf_iter_functions_by_cat :: Ptr PgfPGF -> Ptr PgfText -> Ptr PgfItor -> IO ()
+
 peekText :: Ptr PgfText -> IO String
 peekText ptr =
   alloca $ \pptr -> do
@@ -51,3 +69,35 @@ peekText ptr =
         else do x <- pgf_utf8_decode pptr
                 cs <- decode pptr end
                 return (((toEnum . fromEnum) x) : cs)
+
+withText :: String -> (Ptr PgfText -> IO a) -> IO a
+withText s fn =
+  allocaBytes ((#size PgfText) + size + 1) $ \ptr -> do
+    (#poke PgfText, size) ptr (fromIntegral size :: CSize)
+    pokeUtf8CString s (ptr `plusPtr` (#const offsetof(PgfText, text)))
+    fn ptr
+  where
+    size = utf8Length s
+
+    pokeUtf8CString s ptr =
+      alloca $ \pptr ->
+        poke pptr ptr >> encode s pptr
+      where
+        encode []     pptr = do
+          pgf_utf8_encode 0 pptr
+        encode (c:cs) pptr = do
+          pgf_utf8_encode ((toEnum . fromEnum) c) pptr
+          encode cs pptr
+
+    utf8Length s = count 0 s
+      where
+        count !c []         = c
+        count !c (x:xs)
+          | ucs < 0x80      = count (c+1) xs
+          | ucs < 0x800     = count (c+2) xs
+          | ucs < 0x10000   = count (c+3) xs
+          | ucs < 0x200000  = count (c+4) xs
+          | ucs < 0x4000000 = count (c+5) xs
+          | otherwise       = count (c+6) xs
+          where
+            ucs = fromEnum x