GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-21 18:59:32 -06:00
Code Issues Packages Projects Releases Wiki Activity

more functions could now fail with an exception

Browse Source
This commit is contained in:
krangelov
2021-09-07 17:18:03 +02:00
parent a843ddba55
commit f741bd9332
4 changed files with 190 additions and 157 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
src/runtime/haskell/PGF2.hsc
View File

@@ -113,7 +113,7 @@ abstractName p =
unsafePerformIO $
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision ->
bracket (pgf_abstract_name c_db c_revision) free $ \c_text ->
bracket (withPgfExn (pgf_abstract_name c_db c_revision)) free $ \c_text ->
peekText c_text
-- | The start category is defined in the grammar with
@@ -127,7 +127,7 @@ startCat p =
withForeignPtr unmarshaller $ \u ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision -> do
c_typ <- pgf_start_cat c_db c_revision u
c_typ <- withPgfExn (pgf_start_cat c_db c_revision u)
typ <- deRefStablePtr c_typ
freeStablePtr c_typ
return typ
@@ -140,7 +140,7 @@ functionType p fn =
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision ->
withText fn $ \c_fn -> do
c_typ <- pgf_function_type c_db c_revision c_fn u
c_typ <- withPgfExn (pgf_function_type c_db c_revision c_fn u)
if c_typ == castPtrToStablePtr nullPtr
then return Nothing
else do typ <- deRefStablePtr c_typ
@@ -153,7 +153,7 @@ functionIsConstructor p fun =
withText fun $ \c_fun ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision ->
do res <- pgf_function_is_constructor c_db c_revision c_fun
do res <- withPgfExn (pgf_function_is_constructor c_db c_revision c_fun)
return (res /= 0)
functionProb :: PGF -> Fun -> Float
@@ -162,8 +162,7 @@ functionProb p fun =
withText fun $ \c_fun ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision ->
do c_prob <- pgf_function_prob c_db c_revision c_fun
return (realToFrac c_prob)
withPgfExn (pgf_function_prob c_db c_revision c_fun)
-- | List of all functions defined in the abstract syntax
categories :: PGF -> [Cat]
@@ -194,7 +193,7 @@ categoryContext p cat =
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision ->
mask_ $ do
c_hypos <- pgf_category_context c_db c_revision c_cat p_n_hypos u
c_hypos <- withPgfExn (pgf_category_context c_db c_revision c_cat p_n_hypos u)
if c_hypos == nullPtr
then return []
else do n_hypos <- peek p_n_hypos
@@ -221,8 +220,7 @@ categoryProb p cat =
withText cat $ \c_cat ->
withForeignPtr (a_db p) $ \c_db ->
withForeignPtr (revision p) $ \c_revision ->
do c_prob <- pgf_category_prob c_db c_revision c_cat
return (realToFrac c_prob)
withPgfExn (pgf_category_prob c_db c_revision c_cat)
-- | List of all functions defined in the abstract syntax
functions :: PGF -> [Fun]

18
src/runtime/haskell/PGF2/FFI.hsc
View File

@@ -62,7 +62,7 @@ foreign import ccall "pgf_free_revision"
pgf_free_revision :: Ptr PgfDB -> Ptr PgfRevision -> IO ()
foreign import ccall "pgf_abstract_name"
pgf_abstract_name :: Ptr PgfDB -> Ptr PgfRevision -> IO (Ptr PgfText)
pgf_abstract_name :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfExn -> IO (Ptr PgfText)
foreign import ccall "pgf_print_expr"
pgf_print_expr :: StablePtr Expr -> Ptr PgfPrintContext -> CInt -> Ptr PgfMarshaller -> IO (Ptr PgfText)
@@ -85,13 +85,13 @@ foreign import ccall "pgf_iter_categories"
pgf_iter_categories :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfItor -> Ptr PgfExn -> IO ()
foreign import ccall "pgf_start_cat"
pgf_start_cat :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfUnmarshaller -> IO (StablePtr Type)
pgf_start_cat :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (StablePtr Type)
foreign import ccall "pgf/pgf.h pgf_category_context"
pgf_category_context :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> Ptr CSize -> Ptr PgfUnmarshaller -> IO (Ptr PgfTypeHypo)
pgf_category_context :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> Ptr CSize -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (Ptr PgfTypeHypo)
foreign import ccall "pgf/pgf.h pgf_category_prob"
pgf_category_prob :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> IO (#type prob_t)
pgf_category_prob :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> Ptr PgfExn -> IO (#type prob_t)
foreign import ccall "pgf_iter_functions"
pgf_iter_functions :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfItor -> Ptr PgfExn -> IO ()
@@ -99,14 +99,14 @@ foreign import ccall "pgf_iter_functions"
foreign import ccall "pgf_iter_functions_by_cat"
pgf_iter_functions_by_cat :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> Ptr PgfItor -> Ptr PgfExn -> IO ()
foreign import ccall "pgf/pgf.h pgf_function_type"
pgf_function_type :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> Ptr PgfUnmarshaller -> IO (StablePtr Type)
foreign import ccall "pgf_function_type"
pgf_function_type :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (StablePtr Type)
foreign import ccall "pgf/expr.h pgf_function_is_constructor"
pgf_function_is_constructor :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> IO (#type int)
foreign import ccall "pgf_function_is_constructor"
pgf_function_is_constructor :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> Ptr PgfExn -> IO (#type int)
foreign import ccall "pgf_function_prob"
pgf_function_prob :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> IO (#type prob_t)
pgf_function_prob :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> Ptr PgfExn -> IO (#type prob_t)
foreign import ccall "pgf_clone_revision"
pgf_clone_revision :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfExn -> IO (Ptr PgfRevision)