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/FFI.hs3
-rw-r--r--src/runtime/haskell-bind/SG.hsc18
2 files changed, 20 insertions, 1 deletions
diff --git a/src/runtime/haskell-bind/PGF2/FFI.hs b/src/runtime/haskell-bind/PGF2/FFI.hs
index 6321067c2..c6fc2e2e2 100644
--- a/src/runtime/haskell-bind/PGF2/FFI.hs
+++ b/src/runtime/haskell-bind/PGF2/FFI.hs
@@ -219,6 +219,9 @@ foreign import ccall "pgf/expr.h pgf_expr_arity"
foreign import ccall "pgf/expr.h pgf_print_expr"
pgf_print_expr :: PgfExpr -> Ptr PgfPrintContext -> CInt -> Ptr GuOut -> Ptr GuExn -> IO ()
+foreign import ccall "pgf/expr.h pgf_print_expr_tuple"
+ pgf_print_expr_tuple :: CInt -> Ptr PgfExpr -> Ptr PgfPrintContext -> Ptr GuOut -> Ptr GuExn -> IO ()
+
foreign import ccall "pgf/pgf.h pgf_generate_all"
pgf_generate_all :: Ptr PgfPGF -> CString -> Ptr GuExn -> Ptr GuPool -> Ptr GuPool -> IO (Ptr GuEnum)
diff --git a/src/runtime/haskell-bind/SG.hsc b/src/runtime/haskell-bind/SG.hsc
index 37bc074b3..3f7baa5fd 100644
--- a/src/runtime/haskell-bind/SG.hsc
+++ b/src/runtime/haskell-bind/SG.hsc
@@ -8,7 +8,8 @@ module SG( SG, openSG, closeSG
, beginTrans, commit, rollback, inTransaction
, SgId
, insertExpr, getExpr
- , readTriple, insertTriple, getTriple
+ , readTriple, showTriple
+ , insertTriple, getTriple
, queryTriple
) where
@@ -128,6 +129,21 @@ readTriple str =
else do gu_pool_free exprPl
return Nothing
+showTriple :: Expr -> Expr -> Expr -> String
+showTriple (Expr expr1 _) (Expr expr2 _) (Expr expr3 _) =
+ unsafePerformIO $
+ withGuPool $ \tmpPl ->
+ withTriple $ \triple -> do
+ (sb,out) <- newOut tmpPl
+ let printCtxt = nullPtr
+ exn <- gu_new_exn tmpPl
+ pokeElemOff triple 0 expr1
+ pokeElemOff triple 1 expr2
+ pokeElemOff triple 2 expr3
+ pgf_print_expr_tuple 3 triple printCtxt out exn
+ s <- gu_string_buf_freeze sb tmpPl
+ peekCString s
+
insertTriple :: SG -> Expr -> Expr -> Expr -> IO SgId
insertTriple (SG sg) (Expr expr1 _) (Expr expr2 _) (Expr expr3 _) =
withGuPool $ \tmpPl ->