added exprFunctions in the Haskell binding

4 files changed, 66 insertions, 1 deletions

diff --git a/src/runtime/c/pgf/expr.c b/src/runtime/c/pgf/expr.c
index 751a7d25a..1a334a7ee 100644
--- a/src/runtime/c/pgf/expr.c
+++ b/src/runtime/c/pgf/expr.c
@@ -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)
diff --git a/src/runtime/c/pgf/expr.h b/src/runtime/c/pgf/expr.h
index 962b3173f..3dbaf83b6 100644
--- a/src/runtime/c/pgf/expr.h
+++ b/src/runtime/c/pgf/expr.h
@@ -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 {
diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc
index 4990a1926..dfddb9708 100644
--- a/src/runtime/haskell-bind/PGF2.hsc
+++ b/src/runtime/haskell-bind/PGF2.hsc
@@ -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
diff --git a/src/runtime/haskell-bind/PGF2/FFI.hs b/src/runtime/haskell-bind/PGF2/FFI.hs
index 85c3a9793..a47655d8d 100644
--- a/src/runtime/haskell-bind/PGF2/FFI.hs
+++ b/src/runtime/haskell-bind/PGF2/FFI.hs
@@ -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