mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-21 02:39:31 -06:00
PgfUnmarshaller now mimics a C++ class. Allows for keeping state
This commit is contained in:
krangelov
@@ -125,7 +125,7 @@ struct PgfPGF : DB {
|
||||
{ u = unmarshaller; };
|
||||
|
||||
PGF_INTERNAL_DECL ~PgfPGF()
|
||||
{ u->free_me(u); };
|
||||
{ u->free_me(); };
|
||||
|
||||
PgfUnmarshaller *u;
|
||||
};
|
||||
|
||||
@@ -76,26 +76,52 @@ typedef struct {
|
||||
* actually be a stable pointer, while for Python that would be
|
||||
* a PyObject pointer.
|
||||
*/
|
||||
#ifdef __cplusplus
|
||||
typedef struct PgfUnmarshaller PgfUnmarshaller;
|
||||
struct PgfUnmarshaller {
|
||||
uintptr_t (*eabs)(PgfBindType btype, PgfText *name, uintptr_t body);
|
||||
uintptr_t (*eapp)(uintptr_t fun, uintptr_t arg);
|
||||
uintptr_t (*elit)(uintptr_t lit);
|
||||
uintptr_t (*emeta)(PgfMetaId meta);
|
||||
uintptr_t (*efun)(PgfText *name);
|
||||
uintptr_t (*evar)(int index);
|
||||
uintptr_t (*etyped)(uintptr_t expr, uintptr_t typ);
|
||||
uintptr_t (*eimplarg)(uintptr_t expr);
|
||||
uintptr_t (*lint)(int v);
|
||||
uintptr_t (*lflt)(double v);
|
||||
uintptr_t (*lstr)(PgfText *v);
|
||||
uintptr_t (*dtyp)(int n_hypos, PgfTypeHypo *hypos,
|
||||
virtual uintptr_t eabs(PgfBindType btype, PgfText *name, uintptr_t body)=0;
|
||||
virtual uintptr_t eapp(uintptr_t fun, uintptr_t arg)=0;
|
||||
virtual uintptr_t elit(uintptr_t lit)=0;
|
||||
virtual uintptr_t emeta(PgfMetaId meta)=0;
|
||||
virtual uintptr_t efun(PgfText *name)=0;
|
||||
virtual uintptr_t evar(int index)=0;
|
||||
virtual uintptr_t etyped(uintptr_t expr, uintptr_t typ)=0;
|
||||
virtual uintptr_t eimplarg(uintptr_t expr)=0;
|
||||
virtual uintptr_t lint(int v)=0;
|
||||
virtual uintptr_t lflt(double v)=0;
|
||||
virtual uintptr_t lstr(PgfText *v)=0;
|
||||
virtual uintptr_t dtyp(int n_hypos, PgfTypeHypo *hypos,
|
||||
PgfText *cat,
|
||||
int n_exprs, uintptr_t *exprs)=0;
|
||||
virtual void free_ref(uintptr_t x)=0;
|
||||
virtual void free_me()=0;
|
||||
};
|
||||
#else
|
||||
typedef struct PgfUnmarshaller PgfUnmarshaller;
|
||||
typedef struct PgfUnmarshallerVtbl PgfUnmarshallerVtbl;
|
||||
struct PgfUnmarshallerVtbl {
|
||||
uintptr_t (*eabs)(PgfUnmarshaller *this, PgfBindType btype, PgfText *name, uintptr_t body);
|
||||
uintptr_t (*eapp)(PgfUnmarshaller *this, uintptr_t fun, uintptr_t arg);
|
||||
uintptr_t (*elit)(PgfUnmarshaller *this, uintptr_t lit);
|
||||
uintptr_t (*emeta)(PgfUnmarshaller *this, PgfMetaId meta);
|
||||
uintptr_t (*efun)(PgfUnmarshaller *this, PgfText *name);
|
||||
uintptr_t (*evar)(PgfUnmarshaller *this, int index);
|
||||
uintptr_t (*etyped)(PgfUnmarshaller *this, uintptr_t expr, uintptr_t typ);
|
||||
uintptr_t (*eimplarg)(PgfUnmarshaller *this, uintptr_t expr);
|
||||
uintptr_t (*lint)(PgfUnmarshaller *this, int v);
|
||||
uintptr_t (*lflt)(PgfUnmarshaller *this, double v);
|
||||
uintptr_t (*lstr)(PgfUnmarshaller *this, PgfText *v);
|
||||
uintptr_t (*dtyp)(PgfUnmarshaller *this,
|
||||
int n_hypos, PgfTypeHypo *hypos,
|
||||
PgfText *cat,
|
||||
int n_exprs, uintptr_t *exprs);
|
||||
void (*free_ref)(uintptr_t x);
|
||||
void (*free_me)(PgfUnmarshaller *unmarshaller);
|
||||
void (*free_ref)(PgfUnmarshaller *this, uintptr_t x);
|
||||
void (*free_me)(PgfUnmarshaller *this);
|
||||
};
|
||||
|
||||
struct PgfUnmarshaller {
|
||||
PgfUnmarshallerVtbl *vtbl;
|
||||
};
|
||||
#endif
|
||||
typedef float prob_t;
|
||||
|
||||
typedef struct PgfPGF PgfPGF;
|
||||
|
||||
@@ -138,147 +138,137 @@ withText s fn =
|
||||
|
||||
type CBindType = (#type PgfBindType)
|
||||
|
||||
type EAbsUnmarshaller = (#type PgfBindType) -> Ptr PgfText -> StablePtr Expr -> IO (StablePtr Expr)
|
||||
type EAbsFun = Ptr PgfUnmarshaller -> (#type PgfBindType) -> Ptr PgfText -> StablePtr Expr -> IO (StablePtr Expr)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapEAbsUnmarshaller :: EAbsUnmarshaller -> IO (FunPtr EAbsUnmarshaller)
|
||||
wrapEAbsFun :: EAbsFun -> IO (FunPtr EAbsFun)
|
||||
|
||||
type EAppUnmarshaller = StablePtr Expr -> StablePtr Expr -> IO (StablePtr Expr)
|
||||
type EAppFun = Ptr PgfUnmarshaller -> StablePtr Expr -> StablePtr Expr -> IO (StablePtr Expr)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapEAppUnmarshaller :: EAppUnmarshaller -> IO (FunPtr EAppUnmarshaller)
|
||||
wrapEAppFun :: EAppFun -> IO (FunPtr EAppFun)
|
||||
|
||||
type ELitUnmarshaller = StablePtr Literal -> IO (StablePtr Expr)
|
||||
type ELitFun = Ptr PgfUnmarshaller -> StablePtr Literal -> IO (StablePtr Expr)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapELitUnmarshaller :: ELitUnmarshaller -> IO (FunPtr ELitUnmarshaller)
|
||||
wrapELitFun :: ELitFun -> IO (FunPtr ELitFun)
|
||||
|
||||
type EMetaUnmarshaller = (#type PgfMetaId) -> IO (StablePtr Expr)
|
||||
type EMetaFun = Ptr PgfUnmarshaller -> (#type PgfMetaId) -> IO (StablePtr Expr)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapEMetaUnmarshaller :: EMetaUnmarshaller -> IO (FunPtr EMetaUnmarshaller)
|
||||
wrapEMetaFun :: EMetaFun -> IO (FunPtr EMetaFun)
|
||||
|
||||
type EFunUnmarshaller = Ptr PgfText -> IO (StablePtr Expr)
|
||||
type EFunFun = Ptr PgfUnmarshaller -> Ptr PgfText -> IO (StablePtr Expr)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapEFunUnmarshaller :: EFunUnmarshaller -> IO (FunPtr EFunUnmarshaller)
|
||||
wrapEFunFun :: EFunFun -> IO (FunPtr EFunFun)
|
||||
|
||||
type EVarUnmarshaller = CInt -> IO (StablePtr Expr)
|
||||
type EVarFun = Ptr PgfUnmarshaller -> CInt -> IO (StablePtr Expr)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapEVarUnmarshaller :: EVarUnmarshaller -> IO (FunPtr EVarUnmarshaller)
|
||||
wrapEVarFun :: EVarFun -> IO (FunPtr EVarFun)
|
||||
|
||||
type ETypedUnmarshaller = StablePtr Expr -> StablePtr Type -> IO (StablePtr Expr)
|
||||
type ETypedFun = Ptr PgfUnmarshaller -> StablePtr Expr -> StablePtr Type -> IO (StablePtr Expr)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapETypedUnmarshaller :: ETypedUnmarshaller -> IO (FunPtr ETypedUnmarshaller)
|
||||
wrapETypedFun :: ETypedFun -> IO (FunPtr ETypedFun)
|
||||
|
||||
type EImplArgUnmarshaller = StablePtr Expr -> IO (StablePtr Expr)
|
||||
type EImplArgFun = Ptr PgfUnmarshaller -> StablePtr Expr -> IO (StablePtr Expr)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapEImplArgUnmarshaller :: EImplArgUnmarshaller -> IO (FunPtr EImplArgUnmarshaller)
|
||||
wrapEImplArgFun :: EImplArgFun -> IO (FunPtr EImplArgFun)
|
||||
|
||||
type LIntUnmarshaller = CInt -> IO (StablePtr Literal)
|
||||
type LIntFun = Ptr PgfUnmarshaller -> CInt -> IO (StablePtr Literal)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapLIntUnmarshaller :: LIntUnmarshaller -> IO (FunPtr LIntUnmarshaller)
|
||||
wrapLIntFun :: LIntFun -> IO (FunPtr LIntFun)
|
||||
|
||||
type LFltUnmarshaller = CDouble -> IO (StablePtr Literal)
|
||||
type LFltFun = Ptr PgfUnmarshaller -> CDouble -> IO (StablePtr Literal)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapLFltUnmarshaller :: LFltUnmarshaller -> IO (FunPtr LFltUnmarshaller)
|
||||
wrapLFltFun :: LFltFun -> IO (FunPtr LFltFun)
|
||||
|
||||
type LStrUnmarshaller = Ptr PgfText -> IO (StablePtr Literal)
|
||||
type LStrFun = Ptr PgfUnmarshaller -> Ptr PgfText -> IO (StablePtr Literal)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapLStrUnmarshaller :: LStrUnmarshaller -> IO (FunPtr LStrUnmarshaller)
|
||||
wrapLStrFun :: LStrFun -> IO (FunPtr LStrFun)
|
||||
|
||||
type TypeUnmarshaller = CInt -> Ptr PgfTypeHypo -> Ptr PgfText -> CInt -> Ptr (StablePtr Expr) -> IO (StablePtr Type)
|
||||
type DTypFun = Ptr PgfUnmarshaller -> CInt -> Ptr PgfTypeHypo -> Ptr PgfText -> CInt -> Ptr (StablePtr Expr) -> IO (StablePtr Type)
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapTypeUnmarshaller :: TypeUnmarshaller -> IO (FunPtr TypeUnmarshaller)
|
||||
wrapTypeFun :: DTypFun -> IO (FunPtr DTypFun)
|
||||
|
||||
foreign import ccall "&hs_free_stable_ptr" hs_free_stable_ptr :: FunPtr (StablePtr a -> IO ())
|
||||
foreign import ccall "&hs_free_reference" hs_free_reference :: FunPtr (Ptr PgfUnmarshaller -> 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
|
||||
vtbl <- mallocBytes (#size PgfUnmarshallerVtbl)
|
||||
wrapEAbsFun unmarshalEAbs >>= (#poke PgfUnmarshallerVtbl, eabs) vtbl
|
||||
wrapEAppFun unmarshalEApp >>= (#poke PgfUnmarshallerVtbl, eapp) vtbl
|
||||
wrapELitFun unmarshalELit >>= (#poke PgfUnmarshallerVtbl, elit) vtbl
|
||||
wrapEMetaFun unmarshalEMeta >>= (#poke PgfUnmarshallerVtbl, emeta) vtbl
|
||||
wrapEFunFun unmarshalEFun >>= (#poke PgfUnmarshallerVtbl, efun) vtbl
|
||||
wrapEVarFun unmarshalEVar >>= (#poke PgfUnmarshallerVtbl, evar) vtbl
|
||||
wrapETypedFun unmarshalETyped >>= (#poke PgfUnmarshallerVtbl, etyped) vtbl
|
||||
wrapEImplArgFun unmarshalEImplArg >>= (#poke PgfUnmarshallerVtbl, eimplarg) vtbl
|
||||
wrapLIntFun unmarshalLInt >>= (#poke PgfUnmarshallerVtbl, lint) vtbl
|
||||
wrapLFltFun unmarshalLFlt >>= (#poke PgfUnmarshallerVtbl, lflt) vtbl
|
||||
wrapLStrFun unmarshalLStr >>= (#poke PgfUnmarshallerVtbl, lstr) vtbl
|
||||
wrapTypeFun unmarshalType >>= (#poke PgfUnmarshallerVtbl, dtyp) vtbl
|
||||
(#poke PgfUnmarshallerVtbl, free_ref) vtbl hs_free_reference
|
||||
(#poke PgfUnmarshallerVtbl, free_me) vtbl hs_free_unmarshaller
|
||||
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
|
||||
(#poke PgfUnmarshaller, vtbl) ptr vtbl
|
||||
return ptr
|
||||
where
|
||||
unmarshalEAbs c_btype c_var c_body = do
|
||||
unmarshalEAbs this 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
|
||||
unmarshalEApp this c_fun c_arg = do
|
||||
fun <- deRefStablePtr c_fun
|
||||
arg <- deRefStablePtr c_arg
|
||||
newStablePtr (EApp fun arg)
|
||||
|
||||
unmarshalELit c_lit = do
|
||||
unmarshalELit this c_lit = do
|
||||
lit <- deRefStablePtr c_lit
|
||||
newStablePtr (ELit lit)
|
||||
|
||||
unmarshalEMeta c_metaid = do
|
||||
unmarshalEMeta this c_metaid = do
|
||||
newStablePtr (EMeta (fromIntegral c_metaid))
|
||||
|
||||
unmarshalEFun c_name = do
|
||||
unmarshalEFun this c_name = do
|
||||
name <- peekText c_name
|
||||
newStablePtr (EFun name)
|
||||
|
||||
unmarshalEVar c_var = do
|
||||
unmarshalEVar this c_var = do
|
||||
newStablePtr (EVar (fromIntegral c_var))
|
||||
|
||||
unmarshalETyped c_expr c_typ = do
|
||||
unmarshalETyped this c_expr c_typ = do
|
||||
expr <- deRefStablePtr c_expr
|
||||
typ <- deRefStablePtr c_typ
|
||||
newStablePtr (ETyped expr typ)
|
||||
|
||||
unmarshalEImplArg c_expr = do
|
||||
unmarshalEImplArg this c_expr = do
|
||||
expr <- deRefStablePtr c_expr
|
||||
newStablePtr (EImplArg expr)
|
||||
|
||||
unmarshalLInt c_v = do
|
||||
unmarshalLInt this c_v = do
|
||||
newStablePtr (LInt (fromIntegral c_v))
|
||||
|
||||
unmarshalLFlt c_v = do
|
||||
unmarshalLFlt this c_v = do
|
||||
newStablePtr (LFlt (realToFrac c_v))
|
||||
|
||||
unmarshalLStr c_v = do
|
||||
unmarshalLStr this c_v = do
|
||||
s <- peekText c_v
|
||||
newStablePtr (LStr s)
|
||||
|
||||
unmarshalType n_hypos hypos c_cat n_exprs exprs = do
|
||||
unmarshalType this n_hypos hypos c_cat n_exprs exprs = do
|
||||
hypos <- peekHypos n_hypos hypos
|
||||
cat <- peekText c_cat
|
||||
exprs <- peekExprs n_exprs exprs
|
||||
|
||||
@@ -4,17 +4,23 @@
|
||||
|
||||
void hs_free_unmarshaller(PgfUnmarshaller *unmarshaller)
|
||||
{
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->eabs);
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->eapp);
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->elit);
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->emeta);
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->efun);
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->evar);
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->etyped);
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->eimplarg);
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->lint);
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->lflt);
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->lstr);
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->dtyp);
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->vtbl->eabs);
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->vtbl->eapp);
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->vtbl->elit);
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->vtbl->emeta);
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->vtbl->efun);
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->vtbl->evar);
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->vtbl->etyped);
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->vtbl->eimplarg);
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->vtbl->lint);
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->vtbl->lflt);
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->vtbl->lstr);
|
||||
hs_free_fun_ptr((HsFunPtr) unmarshaller->vtbl->dtyp);
|
||||
free(unmarshaller->vtbl);
|
||||
free(unmarshaller);
|
||||
}
|
||||
|
||||
void hs_free_reference(PgfUnmarshaller *unmarshaller, uintptr_t ref)
|
||||
{
|
||||
hs_free_stable_ptr((HsStablePtr) ref);
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user