From e3aa392e63b0d0f314b286d207cd187be5837ad8 Mon Sep 17 00:00:00 2001
From: Krasimir Angelov <kr.angelov@gmail.com>
Date: Wed, 4 Oct 2017 09:45:56 +0200
Subject: further extend the API of the C runtime

---
 src/runtime/haskell-bind/PGF2.hsc | 14 +++++++++++---
 1 file changed, 11 insertions(+), 3 deletions(-)

(limited to 'src/runtime/haskell-bind/PGF2.hsc')

diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc
index 6ffa6ff37..409283981 100644
--- a/src/runtime/haskell-bind/PGF2.hsc
+++ b/src/runtime/haskell-bind/PGF2.hsc
@@ -45,7 +45,7 @@ module PGF2 (-- * PGF
 
              -- ** Types
              Type, Hypo, BindType(..), startCat,
-             readType, showType,
+             readType, showType, showContext,
              mkType, unType,
 
              -- ** Type checking
@@ -1083,8 +1083,7 @@ categoryContext :: PGF -> Cat -> [Hypo]
 categoryContext p cat =
   unsafePerformIO $
     withGuPool $ \tmpPl ->
-      do (sb,out) <- newOut tmpPl
-         c_cat <- newUtf8CString cat tmpPl
+      do c_cat <- newUtf8CString cat tmpPl
          c_hypos <- pgf_category_context (pgf p) c_cat
          if c_hypos == nullPtr
            then return []
@@ -1104,6 +1103,15 @@ categoryContext p cat =
     toBindType (#const PGF_BIND_TYPE_EXPLICIT) = Explicit
     toBindType (#const PGF_BIND_TYPE_IMPLICIT) = Implicit
 
+categoryProb :: PGF -> Cat -> Float
+categoryProb p cat =
+  unsafePerformIO $
+    withGuPool $ \tmpPl ->
+      do c_cat <- newUtf8CString cat tmpPl
+         c_prob <- pgf_category_prob (pgf p) c_cat
+         touchPGF p
+         return (realToFrac c_prob)
+
 -----------------------------------------------------------------------------
 -- Helper functions
 
-- 
cgit v1.2.3