summaryrefslogtreecommitdiff
path: root/src/runtime/haskell-bind/PGF2.hsc
diff options
context:
space:
mode:
authorkrangelov <kr.angelov@gmail.com>2020-03-06 12:29:08 +0100
committerkrangelov <kr.angelov@gmail.com>2020-03-06 12:29:08 +0100
commit00e25d0ccb114b5c4cce4e79e7e0ef164bf57f99 (patch)
treeb58be77ce57f5d4db6d01da4ea0b400759b72473 /src/runtime/haskell-bind/PGF2.hsc
parent9806232532b661f25e393f12ed8069085d522868 (diff)
an API to access the names of all fields withing a category
Diffstat (limited to 'src/runtime/haskell-bind/PGF2.hsc')
-rw-r--r--src/runtime/haskell-bind/PGF2.hsc25
1 files changed, 24 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.