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

4 files changed, 44 insertions, 1 deletions

diff --git a/src/runtime/c/pgf/pgf.c b/src/runtime/c/pgf/pgf.c
index 5317830fb..d7873f584 100644
--- a/src/runtime/c/pgf/pgf.c
+++ b/src/runtime/c/pgf/pgf.c
@@ -163,6 +163,20 @@ pgf_category_prob(PgfPGF* pgf, PgfCId catname)
 	return abscat->prob;
 }
 
+PGF_API GuString*
+pgf_category_fields(PgfConcr* concr, PgfCId catname, size_t *n_lins)
+{
+	PgfCncCat* cnccat =
+		gu_map_get(concr->cnccats, catname, PgfCncCat*);
+	if (!cnccat) {
+		*n_lins = 0;
+		return NULL;
+	}
+
+	*n_lins = cnccat->n_lins;
+	return &cnccat->labels;
+}
+
 PGF_API GuString
 pgf_language_code(PgfConcr* concr)
 {
diff --git a/src/runtime/c/pgf/pgf.h b/src/runtime/c/pgf/pgf.h
index c0a64f01d..5dbe2e2e1 100644
--- a/src/runtime/c/pgf/pgf.h
+++ b/src/runtime/c/pgf/pgf.h
@@ -95,6 +95,9 @@ pgf_category_context(PgfPGF *gr, PgfCId catname);
 PGF_API_DECL prob_t
 pgf_category_prob(PgfPGF* pgf, PgfCId catname);
 
+PGF_API GuString*
+pgf_category_fields(PgfConcr* concr, PgfCId catname, size_t *n_lins);
+
 PGF_API_DECL void
 pgf_iter_functions(PgfPGF* pgf, GuMapItor* itor, GuExn* err);
 
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 ()