an API to access the names of all fields withing a category

2 files changed, 27 insertions, 1 deletions

diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc
index d3f61595c..a84f7511c 100644
--- a/src/runtime/haskell-bind/PGF2.hsc
+++ b/src/runtime/haskell-bind/PGF2.hsc
@@ -61,7 +61,7 @@ module PGF2 (-- * PGF
              -- ** Linearization
              linearize,linearizeAll,tabularLinearize,tabularLinearizeAll,bracketedLinearize,bracketedLinearizeAll,
              FId, BracketedString(..), showBracketedString, flattenBracketedString,
-             printName,
+             printName, categoryFields,
 
              alignWords,
              -- ** Parsing
@@ -988,6 +988,7 @@ tabularLinearizeAll lang e = unsafePerformIO $
     exn <- gu_new_exn tmpPl
     cts <- pgf_lzr_concretize (concr lang) (expr e) exn tmpPl
     failed <- gu_exn_is_raised exn
+    touchConcr lang
     if failed
       then throwExn exn
       else collect cts exn tmpPl
@@ -1033,6 +1034,28 @@ tabularLinearizeAll lang e = unsafePerformIO $
                 throwIO (PGFError msg)
         else do throwIO (PGFError "The abstract tree cannot be linearized")
 
+categoryFields :: Concr -> Cat -> Maybe [String]
+categoryFields lang cat =
+  unsafePerformIO $ do
+    withGuPool $ \tmpPl -> do
+      p_n_lins <- gu_malloc tmpPl (#size size_t)
+      c_cat    <- newUtf8CString cat tmpPl
+      c_fields <- pgf_category_fields (concr lang) c_cat p_n_lins
+      if c_fields == nullPtr
+        then do touchConcr lang
+                return Nothing
+        else do len <- peek p_n_lins
+                fs  <- peekFields len c_fields
+                touchConcr lang
+                return (Just fs)
+  where
+     peekFields 0   ptr = return []
+     peekFields len ptr = do
+       f  <- peek ptr >>= peekUtf8CString
+       fs <- peekFields (len-1) (ptr `plusPtr` (#size GuString))
+       return (f:fs)
+
+
 -- | BracketedString represents a sentence that is linearized
 -- as usual but we also want to retain the ''brackets'' that
 -- mark the beginning and the end of each constituent.
diff --git a/src/runtime/haskell-bind/PGF2/FFI.hsc b/src/runtime/haskell-bind/PGF2/FFI.hsc
index 2db9577a0..b348f5012 100644
--- a/src/runtime/haskell-bind/PGF2/FFI.hsc
+++ b/src/runtime/haskell-bind/PGF2/FFI.hsc
@@ -313,6 +313,9 @@ foreign import ccall "pgf/pgf.h pgf_category_context"
 foreign import ccall "pgf/pgf.h pgf_category_prob"
   pgf_category_prob :: Ptr PgfPGF -> CString -> IO (#type prob_t)
 
+foreign import ccall "pgf/pgf.h pgf_category_fields"
+  pgf_category_fields :: Ptr PgfConcr -> CString -> Ptr CSize -> IO (Ptr CString)
+
 foreign import ccall "pgf/pgf.h pgf_iter_functions"
   pgf_iter_functions :: Ptr PgfPGF -> Ptr GuMapItor -> Ptr GuExn -> IO ()