added exprFunctions in the Haskell binding

This commit is contained in:
Krasimir Angelov
2017-09-05 10:07:43 +02:00
parent 85cf2d9f5a
commit 30b7ba04c7
4 changed files with 66 additions and 1 deletions

View File

@@ -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_print_cid(PgfCId id,
GuOut* out, GuExn* err)

View File

@@ -200,6 +200,9 @@ pgf_expr_hash(GuHash h, PgfExpr e);
PGF_API size_t
pgf_expr_size(PgfExpr expr);
PGF_API GuSeq*
pgf_expr_functions(PgfExpr expr, GuPool* pool);
typedef struct PgfPrintContext PgfPrintContext;
struct PgfPrintContext {

View File

@@ -39,7 +39,7 @@ module PGF2 (-- * PGF
mkFloat,unFloat,
mkMeta,unMeta,
mkCId,
exprHash, exprSize,
exprHash, exprSize, exprFunctions,
treeProbability,
-- ** Types
@@ -338,6 +338,16 @@ exprSize (Expr c_expr touch1) =
touch1
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

View File

@@ -334,6 +334,9 @@ foreign import ccall "pgf/expr.h pgf_expr_hash"
foreign import ccall "pgf/expr.h pgf_expr_size"
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"
pgf_compute_tree_probability :: Ptr PgfPGF -> PgfExpr -> IO CFloat