summaryrefslogtreecommitdiff
path: root/src/runtime/haskell-bind
diff options
context:
space:
mode:
Diffstat (limited to 'src/runtime/haskell-bind')
-rw-r--r--src/runtime/haskell-bind/PGF2.hsc12
-rw-r--r--src/runtime/haskell-bind/PGF2/FFI.hsc3
2 files changed, 5 insertions, 10 deletions
diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc
index 827e19bf4..5681f0f86 100644
--- a/src/runtime/haskell-bind/PGF2.hsc
+++ b/src/runtime/haskell-bind/PGF2.hsc
@@ -433,6 +433,7 @@ graphvizParseTree c opts e =
c_opts <- newGraphvizOptions tmpPl opts
pgf_graphviz_parse_tree (concr c) (expr e) c_opts out exn
touchExpr e
+ touchConcr c
s <- gu_string_buf_freeze sb tmpPl
peekUtf8CString s
@@ -858,16 +859,7 @@ mkCallbacksMap concr callbacks pool = do
Just (e,prob,offset') -> do poke poffset (fromIntegral offset')
-- here we copy the expression to out_pool
- c_e <- withGuPool $ \tmpPl -> do
- exn <- gu_new_exn tmpPl
-
- (sb,out) <- newOut tmpPl
- let printCtxt = nullPtr
- pgf_print_expr (expr e) printCtxt 1 out exn
- c_str <- gu_string_buf_freeze sb tmpPl
-
- guin <- gu_string_in c_str tmpPl
- pgf_read_expr guin out_pool tmpPl exn
+ c_e <- pgf_clone_expr (expr e) out_pool
ep <- gu_malloc out_pool (#size PgfExprProb)
(#poke PgfExprProb, expr) ep c_e
diff --git a/src/runtime/haskell-bind/PGF2/FFI.hsc b/src/runtime/haskell-bind/PGF2/FFI.hsc
index 082b58d36..f0a811c6d 100644
--- a/src/runtime/haskell-bind/PGF2/FFI.hsc
+++ b/src/runtime/haskell-bind/PGF2/FFI.hsc
@@ -551,3 +551,6 @@ foreign import ccall "pgf/data.h pgf_lzr_index"
foreign import ccall "pgf/data.h pgf_production_is_lexical"
pgf_production_is_lexical :: Ptr PgfProductionApply -> Ptr GuBuf -> Ptr GuPool -> IO (#type bool)
+
+foreign import ccall "pgf/expr.h pgf_clone_expr"
+ pgf_clone_expr :: PgfExpr -> Ptr GuPool -> IO PgfExpr