mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-21 09:02:50 -06:00
added exprFunctions in the Haskell binding
This commit is contained in:
@@ -1210,6 +1210,55 @@ pgf_expr_size(PgfExpr expr)
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static void
|
||||||
|
pgf_expr_functions_helper(PgfExpr expr, GuBuf* functions)
|
||||||
|
{
|
||||||
|
GuVariantInfo ei = gu_variant_open(expr);
|
||||||
|
switch (ei.tag) {
|
||||||
|
case PGF_EXPR_ABS: {
|
||||||
|
PgfExprAbs* abs = ei.data;
|
||||||
|
pgf_expr_functions_helper(abs->body, functions);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case PGF_EXPR_APP: {
|
||||||
|
PgfExprApp* app = ei.data;
|
||||||
|
pgf_expr_functions_helper(app->fun, functions);
|
||||||
|
pgf_expr_functions_helper(app->arg, functions);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case PGF_EXPR_LIT:
|
||||||
|
case PGF_EXPR_META:
|
||||||
|
case PGF_EXPR_VAR: {
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case PGF_EXPR_FUN:{
|
||||||
|
PgfExprFun* fun = ei.data;
|
||||||
|
gu_buf_push(functions, GuString, fun->fun);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case PGF_EXPR_TYPED: {
|
||||||
|
PgfExprTyped* typed = ei.data;
|
||||||
|
pgf_expr_functions_helper(typed->expr, functions);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case PGF_EXPR_IMPL_ARG: {
|
||||||
|
PgfExprImplArg* impl = ei.data;
|
||||||
|
pgf_expr_functions_helper(impl->expr, functions);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
default:
|
||||||
|
gu_impossible();
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
PGF_API GuSeq*
|
||||||
|
pgf_expr_functions(PgfExpr expr, GuPool* pool)
|
||||||
|
{
|
||||||
|
GuBuf* functions = gu_new_buf(GuString, pool);
|
||||||
|
pgf_expr_functions_helper(expr, functions);
|
||||||
|
return gu_buf_data_seq(functions);
|
||||||
|
}
|
||||||
|
|
||||||
PGF_API void
|
PGF_API void
|
||||||
pgf_print_cid(PgfCId id,
|
pgf_print_cid(PgfCId id,
|
||||||
GuOut* out, GuExn* err)
|
GuOut* out, GuExn* err)
|
||||||
|
|||||||
@@ -200,6 +200,9 @@ pgf_expr_hash(GuHash h, PgfExpr e);
|
|||||||
PGF_API size_t
|
PGF_API size_t
|
||||||
pgf_expr_size(PgfExpr expr);
|
pgf_expr_size(PgfExpr expr);
|
||||||
|
|
||||||
|
PGF_API GuSeq*
|
||||||
|
pgf_expr_functions(PgfExpr expr, GuPool* pool);
|
||||||
|
|
||||||
typedef struct PgfPrintContext PgfPrintContext;
|
typedef struct PgfPrintContext PgfPrintContext;
|
||||||
|
|
||||||
struct PgfPrintContext {
|
struct PgfPrintContext {
|
||||||
|
|||||||
@@ -39,7 +39,7 @@ module PGF2 (-- * PGF
|
|||||||
mkFloat,unFloat,
|
mkFloat,unFloat,
|
||||||
mkMeta,unMeta,
|
mkMeta,unMeta,
|
||||||
mkCId,
|
mkCId,
|
||||||
exprHash, exprSize,
|
exprHash, exprSize, exprFunctions,
|
||||||
treeProbability,
|
treeProbability,
|
||||||
|
|
||||||
-- ** Types
|
-- ** Types
|
||||||
@@ -338,6 +338,16 @@ exprSize (Expr c_expr touch1) =
|
|||||||
touch1
|
touch1
|
||||||
return (fromIntegral size)
|
return (fromIntegral size)
|
||||||
|
|
||||||
|
exprFunctions :: Expr -> [Fun]
|
||||||
|
exprFunctions (Expr c_expr touch) =
|
||||||
|
unsafePerformIO $
|
||||||
|
withGuPool $ \tmpPl -> do
|
||||||
|
seq <- pgf_expr_functions c_expr tmpPl
|
||||||
|
len <- (#peek GuSeq, len) seq
|
||||||
|
arr <- peekArray (fromIntegral (len :: CInt)) (seq `plusPtr` (#offset GuSeq, data))
|
||||||
|
funs <- mapM peekUtf8CString arr
|
||||||
|
touch
|
||||||
|
return funs
|
||||||
|
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- Graphviz
|
-- Graphviz
|
||||||
|
|||||||
@@ -334,6 +334,9 @@ foreign import ccall "pgf/expr.h pgf_expr_hash"
|
|||||||
foreign import ccall "pgf/expr.h pgf_expr_size"
|
foreign import ccall "pgf/expr.h pgf_expr_size"
|
||||||
pgf_expr_size :: PgfExpr -> IO CInt
|
pgf_expr_size :: PgfExpr -> IO CInt
|
||||||
|
|
||||||
|
foreign import ccall "pgf/expr.h pgf_expr_functions"
|
||||||
|
pgf_expr_functions :: PgfExpr -> Ptr GuPool -> IO (Ptr GuSeq)
|
||||||
|
|
||||||
foreign import ccall "pgf/expr.h pgf_compute_tree_probability"
|
foreign import ccall "pgf/expr.h pgf_compute_tree_probability"
|
||||||
pgf_compute_tree_probability :: Ptr PgfPGF -> PgfExpr -> IO CFloat
|
pgf_compute_tree_probability :: Ptr PgfPGF -> PgfExpr -> IO CFloat
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user