added categoryProb, functionProb, functionIsConstructor

src/runtime/haskell/PGF2.hsc

@@ -19,10 +19,10 @@ module PGF2 (-- * PGF
              -- * Abstract syntax
              AbsName,abstractName,
              -- ** Categories
-             Cat,categories,categoryContext,
+             Cat,categories,categoryContext,categoryProb,
              -- ** Functions
              Fun, functions, functionsByCat,
-             functionType,
+             functionType, functionIsConstructor, functionProb,
              -- ** Expressions
              Expr(..), Literal(..),
              readExpr,
@@ -144,6 +144,22 @@ functionType p fn =
               freeStablePtr c_typ
               return (Just typ)
 
+functionIsConstructor :: PGF -> Fun -> Bool
+functionIsConstructor p fun =
+  unsafePerformIO $
+  withText fun $ \c_fun ->
+  withForeignPtr (a_pgf p) $ \c_pgf ->
+      do res <- pgf_function_is_constructor c_pgf c_fun
+         return (res /= 0)
+
+functionProb :: PGF -> Fun -> Float
+functionProb p fun =
+  unsafePerformIO $
+  withText fun $ \c_fun ->
+  withForeignPtr (a_pgf p) $ \c_pgf ->
+      do c_prob <- pgf_function_prob c_pgf c_fun
+         return (realToFrac c_prob)
+
 -- | List of all functions defined in the abstract syntax
 categories :: PGF -> [Fun]
 categories p =
@@ -191,6 +207,14 @@ categoryContext p cat =
                        return ((bt,cat,ty) : hs)
       | otherwise = return []
 
+categoryProb :: PGF -> Cat -> Float
+categoryProb p cat =
+  unsafePerformIO $
+  withText cat $ \c_cat ->
+  withForeignPtr (a_pgf p) $ \c_pgf ->
+      do c_prob <- pgf_category_prob c_pgf c_cat
+         return (realToFrac c_prob)
+
 -- | List of all functions defined in the abstract syntax
 functions :: PGF -> [Fun]
 functions p =

src/runtime/haskell/PGF2/FFI.hsc

@@ -66,6 +66,9 @@ foreign import ccall "pgf_iter_categories"
 foreign import ccall "pgf/pgf.h pgf_category_context"
   pgf_category_context :: Ptr PgfPGF -> Ptr PgfText -> Ptr CSize -> IO (Ptr PgfTypeHypo)
 
+foreign import ccall "pgf/pgf.h pgf_category_prob"
+  pgf_category_prob :: Ptr PgfPGF -> Ptr PgfText -> IO (#type prob_t)
+
 foreign import ccall "pgf_iter_functions"
   pgf_iter_functions :: Ptr PgfPGF -> Ptr PgfItor -> IO ()
 
@@ -75,6 +78,11 @@ foreign import ccall "pgf_iter_functions_by_cat"
 foreign import ccall "pgf/pgf.h pgf_function_type"
    pgf_function_type :: Ptr PgfPGF -> Ptr PgfText -> IO (StablePtr Type)
 
+foreign import ccall "pgf/expr.h pgf_function_is_constructor"
+   pgf_function_is_constructor :: Ptr PgfPGF -> Ptr PgfText -> IO (#type int)
+
+foreign import ccall "pgf/expr.h pgf_function_is_constructor"
+   pgf_function_prob :: Ptr PgfPGF -> Ptr PgfText -> IO (#type prob_t)
 
 peekText :: Ptr PgfText -> IO String
 peekText ptr =

src/runtime/haskell/tests/basic.gf

@@ -2,10 +2,10 @@ abstract basic = {
 
 cat N; S ;
 
-fun z : N ;
-    s : N -> N ;
+data z : N ;
+     s : N -> N ;
 
-fun c : N -> S ;
+data c : N -> S ;
 
 cat P N ;
 fun ind : P z -> ((x:N) -> P x -> P (s x)) -> ((x : N) -> P x) ;

src/runtime/haskell/tests/basic.hs

@@ -17,6 +17,10 @@ main = do
              ,TestCase (assertEqual "category context 1"  [] (categoryContext gr "S"))
              ,TestCase (assertEqual "category context 1"  [(Explicit,"_",DTyp [] "N" [])] (categoryContext gr "P"))
              ,TestCase (assertEqual "category context 1"  [] (categoryContext gr "X")) -- no such category
+             ,TestCase (assertEqual "function is constructor 1"  True  (functionIsConstructor gr "s"))
+             ,TestCase (assertEqual "function is constructor 2"  True  (functionIsConstructor gr "z"))
+             ,TestCase (assertEqual "function is constructor 3"  True  (functionIsConstructor gr "c"))
+             ,TestCase (assertEqual "function is constructor 4"  False (functionIsConstructor gr "ind"))
              ]
 
 eqJust (Just x) (Just y) = x == y