mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-21 09:02:50 -06:00
implemented functionType and marshalling for types and expressions
This commit is contained in:
krangelov
@@ -22,6 +22,7 @@ module PGF2 (-- * PGF
|
||||
Cat,categories,
|
||||
-- ** Functions
|
||||
Fun, functions, functionsByCat,
|
||||
functionType,
|
||||
-- ** Expressions
|
||||
Expr(..), Literal(..),
|
||||
-- ** Types
|
||||
@@ -52,15 +53,18 @@ readPGF fpath =
|
||||
withCString fpath $ \c_fpath ->
|
||||
allocaBytes (#size PgfExn) $ \c_exn ->
|
||||
mask_ $ do
|
||||
c_pgf <- pgf_read_pgf c_fpath c_exn
|
||||
u <- mkUnmarshaller
|
||||
c_pgf <- pgf_read_pgf c_fpath u c_exn
|
||||
ex_type <- (#peek PgfExn, type) c_exn :: IO (#type PgfExnType)
|
||||
if ex_type == (#const PGF_EXN_NONE)
|
||||
then do fptr <- newForeignPtr pgf_free_fptr c_pgf
|
||||
return (PGF fptr Map.empty)
|
||||
else if ex_type == (#const PGF_EXN_SYSTEM_ERROR)
|
||||
then do errno <- (#peek PgfExn, code) c_exn
|
||||
then do freeUnmarshaller u
|
||||
errno <- (#peek PgfExn, code) c_exn
|
||||
ioError (errnoToIOError "readPGF" (Errno errno) Nothing (Just fpath))
|
||||
else do c_msg <- (#peek PgfExn, msg) c_exn
|
||||
else do freeUnmarshaller u
|
||||
c_msg <- (#peek PgfExn, msg) c_exn
|
||||
msg <- peekCString c_msg
|
||||
free c_msg
|
||||
throwIO (PGFError msg)
|
||||
@@ -75,15 +79,18 @@ bootNGF pgf_path ngf_path =
|
||||
withCString ngf_path $ \c_ngf_path ->
|
||||
allocaBytes (#size PgfExn) $ \c_exn ->
|
||||
mask_ $ do
|
||||
c_pgf <- pgf_boot_ngf c_pgf_path c_ngf_path c_exn
|
||||
u <- mkUnmarshaller
|
||||
c_pgf <- pgf_boot_ngf c_pgf_path c_ngf_path u c_exn
|
||||
ex_type <- (#peek PgfExn, type) c_exn :: IO (#type PgfExnType)
|
||||
if ex_type == (#const PGF_EXN_NONE)
|
||||
then do fptr <- newForeignPtr pgf_free_fptr c_pgf
|
||||
return (PGF fptr Map.empty)
|
||||
else if ex_type == (#const PGF_EXN_SYSTEM_ERROR)
|
||||
then do errno <- (#peek PgfExn, code) c_exn
|
||||
then do freeUnmarshaller u
|
||||
errno <- (#peek PgfExn, code) c_exn
|
||||
ioError (errnoToIOError "bootNGF" (Errno errno) Nothing (Just pgf_path))
|
||||
else do c_msg <- (#peek PgfExn, msg) c_exn
|
||||
else do freeUnmarshaller u
|
||||
c_msg <- (#peek PgfExn, msg) c_exn
|
||||
msg <- peekCString c_msg
|
||||
free c_msg
|
||||
throwIO (PGFError msg)
|
||||
@@ -97,15 +104,18 @@ readNGF fpath =
|
||||
withCString fpath $ \c_fpath ->
|
||||
allocaBytes (#size PgfExn) $ \c_exn ->
|
||||
mask_ $ do
|
||||
c_pgf <- pgf_read_ngf c_fpath c_exn
|
||||
u <- mkUnmarshaller
|
||||
c_pgf <- pgf_read_ngf c_fpath u c_exn
|
||||
ex_type <- (#peek PgfExn, type) c_exn :: IO (#type PgfExnType)
|
||||
if ex_type == (#const PGF_EXN_NONE)
|
||||
then do fptr <- newForeignPtr pgf_free_fptr c_pgf
|
||||
return (PGF fptr Map.empty)
|
||||
else if ex_type == (#const PGF_EXN_SYSTEM_ERROR)
|
||||
then do errno <- (#peek PgfExn, code) c_exn
|
||||
then do freeUnmarshaller u
|
||||
errno <- (#peek PgfExn, code) c_exn
|
||||
ioError (errnoToIOError "readPGF" (Errno errno) Nothing (Just fpath))
|
||||
else do c_msg <- (#peek PgfExn, msg) c_exn
|
||||
else do freeUnmarshaller u
|
||||
c_msg <- (#peek PgfExn, msg) c_exn
|
||||
msg <- peekCString c_msg
|
||||
free c_msg
|
||||
throwIO (PGFError msg)
|
||||
@@ -119,6 +129,19 @@ abstractName p =
|
||||
bracket (pgf_abstract_name p_pgf) free $ \c_text ->
|
||||
peekText c_text
|
||||
|
||||
-- | The type of a function
|
||||
functionType :: PGF -> Fun -> Maybe Type
|
||||
functionType p fn =
|
||||
unsafePerformIO $
|
||||
withForeignPtr (a_pgf p) $ \p_pgf ->
|
||||
withText fn $ \c_fn -> do
|
||||
c_typ <- pgf_function_type p_pgf c_fn
|
||||
if c_typ == castPtrToStablePtr nullPtr
|
||||
then return Nothing
|
||||
else do typ <- deRefStablePtr c_typ
|
||||
freeStablePtr c_typ
|
||||
return (Just typ)
|
||||
|
||||
-- | List of all functions defined in the abstract syntax
|
||||
categories :: PGF -> [Fun]
|
||||
categories p =
|
||||
|
||||
@@ -6,9 +6,10 @@ import Data.Word
|
||||
import Foreign
|
||||
import Foreign.C
|
||||
import Foreign.Ptr
|
||||
import Foreign.ForeignPtr
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import PGF2.Expr
|
||||
|
||||
#include <pgf/pgf.h>
|
||||
|
||||
-- | An abstract data type representing multilingual grammar
|
||||
@@ -24,6 +25,8 @@ data PgfText
|
||||
data PgfItor
|
||||
data PgfPGF
|
||||
data PgfConcr
|
||||
data PgfTypeHypo
|
||||
data PgfUnmarshaller
|
||||
|
||||
foreign import ccall unsafe "pgf_utf8_decode"
|
||||
pgf_utf8_decode :: Ptr CString -> IO Word32
|
||||
@@ -32,13 +35,13 @@ foreign import ccall unsafe "pgf_utf8_encode"
|
||||
pgf_utf8_encode :: Word32 -> Ptr CString -> IO ()
|
||||
|
||||
foreign import ccall "pgf_read_pgf"
|
||||
pgf_read_pgf :: CString -> Ptr PgfExn -> IO (Ptr PgfPGF)
|
||||
pgf_read_pgf :: CString -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (Ptr PgfPGF)
|
||||
|
||||
foreign import ccall "pgf_boot_ngf"
|
||||
pgf_boot_ngf :: CString -> CString -> Ptr PgfExn -> IO (Ptr PgfPGF)
|
||||
pgf_boot_ngf :: CString -> CString -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (Ptr PgfPGF)
|
||||
|
||||
foreign import ccall "pgf_read_ngf"
|
||||
pgf_read_ngf :: CString -> Ptr PgfExn -> IO (Ptr PgfPGF)
|
||||
pgf_read_ngf :: CString -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (Ptr PgfPGF)
|
||||
|
||||
foreign import ccall "&pgf_free"
|
||||
pgf_free_fptr :: FinalizerPtr PgfPGF
|
||||
@@ -60,6 +63,10 @@ foreign import ccall "pgf_iter_functions"
|
||||
foreign import ccall "pgf_iter_functions_by_cat"
|
||||
pgf_iter_functions_by_cat :: Ptr PgfPGF -> Ptr PgfText -> Ptr PgfItor -> IO ()
|
||||
|
||||
foreign import ccall "pgf/pgf.h pgf_function_type"
|
||||
pgf_function_type :: Ptr PgfPGF -> Ptr PgfText -> IO (StablePtr Type)
|
||||
|
||||
|
||||
peekText :: Ptr PgfText -> IO String
|
||||
peekText ptr =
|
||||
alloca $ \pptr -> do
|
||||
@@ -107,3 +114,171 @@ withText s fn =
|
||||
| otherwise = count (c+6) xs
|
||||
where
|
||||
ucs = fromEnum x
|
||||
|
||||
|
||||
type CBindType = (#type PgfBindType)
|
||||
|
||||
type EAbsUnmarshaller = (#type PgfBindType) -> Ptr PgfText -> StablePtr Expr -> IO (StablePtr Expr)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapEAbsUnmarshaller :: EAbsUnmarshaller -> IO (FunPtr EAbsUnmarshaller)
|
||||
|
||||
type EAppUnmarshaller = StablePtr Expr -> StablePtr Expr -> IO (StablePtr Expr)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapEAppUnmarshaller :: EAppUnmarshaller -> IO (FunPtr EAppUnmarshaller)
|
||||
|
||||
type ELitUnmarshaller = StablePtr Literal -> IO (StablePtr Expr)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapELitUnmarshaller :: ELitUnmarshaller -> IO (FunPtr ELitUnmarshaller)
|
||||
|
||||
type EMetaUnmarshaller = (#type PgfMetaId) -> IO (StablePtr Expr)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapEMetaUnmarshaller :: EMetaUnmarshaller -> IO (FunPtr EMetaUnmarshaller)
|
||||
|
||||
type EFunUnmarshaller = Ptr PgfText -> IO (StablePtr Expr)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapEFunUnmarshaller :: EFunUnmarshaller -> IO (FunPtr EFunUnmarshaller)
|
||||
|
||||
type EVarUnmarshaller = CInt -> IO (StablePtr Expr)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapEVarUnmarshaller :: EVarUnmarshaller -> IO (FunPtr EVarUnmarshaller)
|
||||
|
||||
type ETypedUnmarshaller = StablePtr Expr -> StablePtr Type -> IO (StablePtr Expr)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapETypedUnmarshaller :: ETypedUnmarshaller -> IO (FunPtr ETypedUnmarshaller)
|
||||
|
||||
type EImplArgUnmarshaller = StablePtr Expr -> IO (StablePtr Expr)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapEImplArgUnmarshaller :: EImplArgUnmarshaller -> IO (FunPtr EImplArgUnmarshaller)
|
||||
|
||||
type LIntUnmarshaller = CInt -> IO (StablePtr Literal)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapLIntUnmarshaller :: LIntUnmarshaller -> IO (FunPtr LIntUnmarshaller)
|
||||
|
||||
type LFltUnmarshaller = CDouble -> IO (StablePtr Literal)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapLFltUnmarshaller :: LFltUnmarshaller -> IO (FunPtr LFltUnmarshaller)
|
||||
|
||||
type LStrUnmarshaller = Ptr PgfText -> IO (StablePtr Literal)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapLStrUnmarshaller :: LStrUnmarshaller -> IO (FunPtr LStrUnmarshaller)
|
||||
|
||||
type TypeUnmarshaller = CInt -> Ptr PgfTypeHypo -> Ptr PgfText -> CInt -> Ptr (StablePtr Expr) -> IO (StablePtr Type)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapTypeUnmarshaller :: TypeUnmarshaller -> IO (FunPtr TypeUnmarshaller)
|
||||
|
||||
foreign import ccall "&hs_free_stable_ptr" hs_free_stable_ptr :: FunPtr (StablePtr a -> IO ())
|
||||
|
||||
foreign import ccall "&hs_free_unmarshaller" hs_free_unmarshaller :: FunPtr (Ptr PgfUnmarshaller -> IO ())
|
||||
|
||||
foreign import ccall "hs_free_unmarshaller" freeUnmarshaller :: Ptr PgfUnmarshaller -> IO ()
|
||||
|
||||
mkUnmarshaller = do
|
||||
eabs <- wrapEAbsUnmarshaller unmarshalEAbs
|
||||
eapp <- wrapEAppUnmarshaller unmarshalEApp
|
||||
elit <- wrapELitUnmarshaller unmarshalELit
|
||||
emeta <- wrapEMetaUnmarshaller unmarshalEMeta
|
||||
efun <- wrapEFunUnmarshaller unmarshalEFun
|
||||
evar <- wrapEVarUnmarshaller unmarshalEVar
|
||||
etyped <- wrapETypedUnmarshaller unmarshalETyped
|
||||
eimplarg<- wrapEImplArgUnmarshaller unmarshalEImplArg
|
||||
lint <- wrapLIntUnmarshaller unmarshalLInt
|
||||
lflt <- wrapLFltUnmarshaller unmarshalLFlt
|
||||
lstr <- wrapLStrUnmarshaller unmarshalLStr
|
||||
dtyp <- wrapTypeUnmarshaller unmarshalType
|
||||
ptr <- mallocBytes (#size PgfUnmarshaller)
|
||||
(#poke PgfUnmarshaller, eabs) ptr eabs
|
||||
(#poke PgfUnmarshaller, eapp) ptr eapp
|
||||
(#poke PgfUnmarshaller, elit) ptr elit
|
||||
(#poke PgfUnmarshaller, emeta) ptr emeta
|
||||
(#poke PgfUnmarshaller, efun) ptr efun
|
||||
(#poke PgfUnmarshaller, evar) ptr evar
|
||||
(#poke PgfUnmarshaller, etyped) ptr etyped
|
||||
(#poke PgfUnmarshaller, eimplarg) ptr eimplarg
|
||||
(#poke PgfUnmarshaller, lint) ptr lint
|
||||
(#poke PgfUnmarshaller, lflt) ptr lflt
|
||||
(#poke PgfUnmarshaller, lstr) ptr lstr
|
||||
(#poke PgfUnmarshaller, dtyp) ptr dtyp
|
||||
(#poke PgfUnmarshaller, free_ref) ptr hs_free_stable_ptr
|
||||
(#poke PgfUnmarshaller, free_me) ptr hs_free_unmarshaller
|
||||
return ptr
|
||||
where
|
||||
unmarshalEAbs c_btype c_var c_body = do
|
||||
let btype = unmarshalBindType c_btype
|
||||
var <- peekText c_var
|
||||
body <- deRefStablePtr c_body
|
||||
newStablePtr (EAbs btype var body)
|
||||
|
||||
unmarshalEApp c_fun c_arg = do
|
||||
fun <- deRefStablePtr c_fun
|
||||
arg <- deRefStablePtr c_arg
|
||||
newStablePtr (EApp fun arg)
|
||||
|
||||
unmarshalELit c_lit = do
|
||||
lit <- deRefStablePtr c_lit
|
||||
newStablePtr (ELit lit)
|
||||
|
||||
unmarshalEMeta c_metaid = do
|
||||
newStablePtr (EMeta (fromIntegral c_metaid))
|
||||
|
||||
unmarshalEFun c_name = do
|
||||
name <- peekText c_name
|
||||
newStablePtr (EFun name)
|
||||
|
||||
unmarshalEVar c_var = do
|
||||
newStablePtr (EVar (fromIntegral c_var))
|
||||
|
||||
unmarshalETyped c_expr c_typ = do
|
||||
expr <- deRefStablePtr c_expr
|
||||
typ <- deRefStablePtr c_typ
|
||||
newStablePtr (ETyped expr typ)
|
||||
|
||||
unmarshalEImplArg c_expr = do
|
||||
expr <- deRefStablePtr c_expr
|
||||
newStablePtr (EImplArg expr)
|
||||
|
||||
unmarshalLInt c_v = do
|
||||
newStablePtr (LInt (fromIntegral c_v))
|
||||
|
||||
unmarshalLFlt c_v = do
|
||||
newStablePtr (LFlt (realToFrac c_v))
|
||||
|
||||
unmarshalLStr c_v = do
|
||||
s <- peekText c_v
|
||||
newStablePtr (LStr s)
|
||||
|
||||
unmarshalType n_hypos hypos c_cat n_exprs exprs = do
|
||||
hypos <- peekHypos n_hypos hypos
|
||||
cat <- peekText c_cat
|
||||
exprs <- peekExprs n_exprs exprs
|
||||
newStablePtr (DTyp hypos cat exprs)
|
||||
where
|
||||
peekHypos 0 p_hypo = return []
|
||||
peekHypos n_hypos p_hypo = do
|
||||
bt <- fmap unmarshalBindType ((#peek PgfTypeHypo, bind_type) p_hypo)
|
||||
cid <- (#peek PgfTypeHypo, cid) p_hypo >>= peekText
|
||||
ty <- (#peek PgfTypeHypo, type) p_hypo >>= deRefStablePtr
|
||||
hs <- peekExprs (n_hypos-1) (p_hypo `plusPtr` (#size PgfTypeHypo))
|
||||
return ((bt,cid,ty):hs)
|
||||
|
||||
peekExprs 0 p_expr = return []
|
||||
peekExprs n_exprs p_expr = do
|
||||
e <- peek p_expr >>= deRefStablePtr
|
||||
es <- peekExprs (n_exprs-1) (p_expr `plusPtr` (#size uintptr_t))
|
||||
return (e:es)
|
||||
|
||||
|
||||
unmarshalBindType :: (#type PgfBindType) -> BindType
|
||||
unmarshalBindType (#const PGF_BIND_TYPE_EXPLICIT) = Explicit
|
||||
unmarshalBindType (#const PGF_BIND_TYPE_IMPLICIT) = Implicit
|
||||
|
||||
@@ -25,6 +25,7 @@ library
|
||||
|
||||
extra-libraries: pgf
|
||||
cc-options: -std=c99
|
||||
c-sources: utils.c
|
||||
|
||||
test-suite basic
|
||||
type: exitcode-stdio-1.0
|
||||
|
||||
@@ -1,160 +1,19 @@
|
||||
#include <HsFFI.h>
|
||||
#include <pgf/pgf.h>
|
||||
#include <gu/utf8.h>
|
||||
|
||||
typedef struct {
|
||||
PgfLiteralCallback callback;
|
||||
PgfExprProb* (*match)(GuString ann, size_t* poffset,
|
||||
GuPool *out_pool);
|
||||
GuFinalizer fin;
|
||||
} HSPgfLiteralCallback;
|
||||
|
||||
static size_t
|
||||
hspgf_offset2hs(GuString sentence, size_t offset)
|
||||
void hs_free_unmarshaller(PgfUnmarshaller *unmarshaller)
|
||||
{
|
||||
const uint8_t *start = sentence;
|
||||
const uint8_t *end = sentence + offset;
|
||||
size_t hs_offset = 0;
|
||||
while (start < end) {
|
||||
gu_utf8_decode(&start);
|
||||
hs_offset++;
|
||||
}
|
||||
return hs_offset;
|
||||
}
|
||||
|
||||
static size_t
|
||||
hspgf_hs2offset(GuString sentence, size_t hs_offset)
|
||||
{
|
||||
const uint8_t *start = sentence;
|
||||
const uint8_t *end = start;
|
||||
while (hs_offset > 0) {
|
||||
gu_utf8_decode(&end);
|
||||
hs_offset--;
|
||||
}
|
||||
|
||||
return (end - start);
|
||||
}
|
||||
|
||||
static PgfExprProb*
|
||||
hspgf_match_callback(PgfLiteralCallback* self, PgfConcr* concr,
|
||||
GuString ann,
|
||||
GuString sentence, size_t* poffset,
|
||||
GuPool *out_pool)
|
||||
{
|
||||
HSPgfLiteralCallback* callback = (HSPgfLiteralCallback*) self;
|
||||
|
||||
size_t hs_offset =
|
||||
hspgf_offset2hs(sentence, *poffset);
|
||||
PgfExprProb* ep =
|
||||
callback->match(ann, &hs_offset, out_pool);
|
||||
*poffset = hspgf_hs2offset(sentence, hs_offset);
|
||||
|
||||
return ep;
|
||||
}
|
||||
|
||||
static void
|
||||
hspgf_literal_callback_fin(GuFinalizer* self)
|
||||
{
|
||||
HSPgfLiteralCallback* callback = gu_container(self, HSPgfLiteralCallback, fin);
|
||||
|
||||
if (callback->callback.match != NULL)
|
||||
hs_free_fun_ptr((HsFunPtr) callback->match);
|
||||
if (callback->callback.predict != NULL)
|
||||
hs_free_fun_ptr((HsFunPtr) callback->callback.predict);
|
||||
}
|
||||
|
||||
void
|
||||
hspgf_callbacks_map_add_literal(PgfConcr* concr, PgfCallbacksMap* callbacks,
|
||||
PgfCId cat, HsFunPtr match, HsFunPtr predict,
|
||||
GuPool* pool)
|
||||
{
|
||||
HSPgfLiteralCallback* callback = gu_new(HSPgfLiteralCallback, pool);
|
||||
callback->callback.match = hspgf_match_callback;
|
||||
callback->callback.predict = (void*) predict;
|
||||
callback->match = (void*) match;
|
||||
callback->fin.fn = hspgf_literal_callback_fin;
|
||||
gu_pool_finally(pool, &callback->fin);
|
||||
pgf_callbacks_map_add_literal(concr, callbacks, cat, &callback->callback);
|
||||
}
|
||||
|
||||
typedef struct {
|
||||
PgfOracleCallback oracle;
|
||||
GuString sentence;
|
||||
bool (*predict) (PgfCId cat,
|
||||
GuString label,
|
||||
size_t offset);
|
||||
bool (*complete)(PgfCId cat,
|
||||
GuString label,
|
||||
size_t offset);
|
||||
PgfExprProb* (*literal)(PgfCId cat,
|
||||
GuString label,
|
||||
size_t* poffset,
|
||||
GuPool *out_pool);
|
||||
GuFinalizer fin;
|
||||
} HSPgfOracleCallback;
|
||||
|
||||
static bool
|
||||
hspgf_predict_callback(PgfOracleCallback* self,
|
||||
PgfCId cat,
|
||||
GuString label,
|
||||
size_t offset)
|
||||
{
|
||||
HSPgfOracleCallback* oracle = gu_container(self, HSPgfOracleCallback, oracle);
|
||||
return oracle->predict(cat,label,hspgf_offset2hs(oracle->sentence, offset));
|
||||
}
|
||||
|
||||
static bool
|
||||
hspgf_complete_callback(PgfOracleCallback* self,
|
||||
PgfCId cat,
|
||||
GuString label,
|
||||
size_t offset)
|
||||
{
|
||||
HSPgfOracleCallback* oracle = gu_container(self, HSPgfOracleCallback, oracle);
|
||||
return oracle->complete(cat,label,hspgf_offset2hs(oracle->sentence, offset));
|
||||
}
|
||||
|
||||
static PgfExprProb*
|
||||
hspgf_literal_callback(PgfOracleCallback* self,
|
||||
PgfCId cat,
|
||||
GuString label,
|
||||
size_t* poffset,
|
||||
GuPool *out_pool)
|
||||
{
|
||||
HSPgfOracleCallback* oracle = gu_container(self, HSPgfOracleCallback, oracle);
|
||||
size_t hs_offset = hspgf_offset2hs(oracle->sentence, *poffset);
|
||||
PgfExprProb* ep =
|
||||
oracle->literal(cat,label,&hs_offset,out_pool);
|
||||
*poffset = hspgf_hs2offset(oracle->sentence, hs_offset);
|
||||
return ep;
|
||||
}
|
||||
|
||||
static void
|
||||
hspgf_oracle_callback_fin(GuFinalizer* self)
|
||||
{
|
||||
HSPgfOracleCallback* oracle = gu_container(self, HSPgfOracleCallback, fin);
|
||||
|
||||
if (oracle->predict != NULL)
|
||||
hs_free_fun_ptr((HsFunPtr) oracle->predict);
|
||||
if (oracle->complete != NULL)
|
||||
hs_free_fun_ptr((HsFunPtr) oracle->complete);
|
||||
if (oracle->literal != NULL)
|
||||
hs_free_fun_ptr((HsFunPtr) oracle->literal);
|
||||
}
|
||||
|
||||
PgfOracleCallback*
|
||||
hspgf_new_oracle_callback(GuString sentence,
|
||||
HsFunPtr predict, HsFunPtr complete, HsFunPtr literal,
|
||||
GuPool* pool)
|
||||
{
|
||||
HSPgfOracleCallback* oracle = gu_new(HSPgfOracleCallback, pool);
|
||||
oracle->oracle.predict = predict ? hspgf_predict_callback : NULL;
|
||||
oracle->oracle.complete = complete ? hspgf_complete_callback : NULL;
|
||||
oracle->oracle.literal = literal ? hspgf_literal_callback : NULL;
|
||||
oracle->sentence = sentence;
|
||||
oracle->predict = (void*) predict;
|
||||
oracle->complete = (void*) complete;
|
||||
oracle->literal = (void*) literal;
|
||||
oracle->fin.fn = hspgf_oracle_callback_fin;
|
||||
gu_pool_finally(pool, &oracle->fin);
|
||||
return &oracle->oracle;
|
||||
hs_free_fun_ptr(unmarshaller->eabs);
|
||||
hs_free_fun_ptr(unmarshaller->eapp);
|
||||
hs_free_fun_ptr(unmarshaller->elit);
|
||||
hs_free_fun_ptr(unmarshaller->emeta);
|
||||
hs_free_fun_ptr(unmarshaller->efun);
|
||||
hs_free_fun_ptr(unmarshaller->evar);
|
||||
hs_free_fun_ptr(unmarshaller->etyped);
|
||||
hs_free_fun_ptr(unmarshaller->eimplarg);
|
||||
hs_free_fun_ptr(unmarshaller->lint);
|
||||
hs_free_fun_ptr(unmarshaller->lflt);
|
||||
hs_free_fun_ptr(unmarshaller->lstr);
|
||||
hs_free_fun_ptr(unmarshaller->dtyp);
|
||||
free(unmarshaller);
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user