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