added readTriple in libsg and its Haskell binding

4 files changed, 39 insertions, 3 deletions

diff --git a/src/runtime/c/pgf/expr.c b/src/runtime/c/pgf/expr.c
index d579027aa..8b34421d9 100644
--- a/src/runtime/c/pgf/expr.c
+++ b/src/runtime/c/pgf/expr.c
@@ -840,7 +840,7 @@ pgf_read_expr(GuIn* in, GuPool* pool, GuExn* err)
 
 int
 pgf_read_expr_tuple(GuIn* in,
-                    int n_exprs, PgfExpr exprs[],
+                    size_t n_exprs, PgfExpr exprs[],
                     GuPool* pool, GuExn* err)
 {
 	GuPool* tmp_pool = gu_new_pool();
@@ -1332,6 +1332,19 @@ pgf_print_type(PgfType *type, PgfPrintContext* ctxt, int prec,
 	}
 }
 
+void
+pgf_print_expr_tuple(size_t n_exprs, PgfExpr exprs[], PgfPrintContext* ctxt,
+                     GuOut* out, GuExn* err)
+{
+	gu_putc('<', out, err);
+	for (size_t i = 0; i < n_exprs; i++) {
+		if (i > 0)
+			gu_putc(',', out, err);
+		pgf_print_expr(exprs[i], ctxt, 0, out, err);
+	}
+	gu_putc('>', out, err);
+}
+
 bool
 pgf_type_eq(PgfType* t1, PgfType* t2)
 {
diff --git a/src/runtime/c/pgf/expr.h b/src/runtime/c/pgf/expr.h
index 2e76bf21d..8dd1e0d44 100644
--- a/src/runtime/c/pgf/expr.h
+++ b/src/runtime/c/pgf/expr.h
@@ -160,7 +160,7 @@ pgf_read_expr(GuIn* in, GuPool* pool, GuExn* err);
 
 int
 pgf_read_expr_tuple(GuIn* in,
-                    int n_exprs, PgfExpr exprs[],
+                    size_t n_exprs, PgfExpr exprs[],
                     GuPool* pool, GuExn* err);
 
 PgfType*
@@ -206,4 +206,8 @@ void
 pgf_print_type(PgfType *type, PgfPrintContext* ctxt, int prec,
                GuOut* out, GuExn *err);
 
+void
+pgf_print_expr_tuple(size_t n_exprs, PgfExpr exprs[], PgfPrintContext* ctxt,
+                     GuOut* out, GuExn* err);
+
 #endif /* EXPR_H_ */
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 ->