added API for reading a list of tuples in the SG module

4 files changed, 105 insertions, 7 deletions

diff --git a/src/runtime/c/pgf/expr.c b/src/runtime/c/pgf/expr.c
index 8b34421d9..04ec64ecf 100644
--- a/src/runtime/c/pgf/expr.c
+++ b/src/runtime/c/pgf/expr.c
@@ -1,6 +1,7 @@
 #include "pgf.h"
 #include <gu/assert.h>
 #include <gu/utf8.h>
+#include <gu/seq.h>
 #include <ctype.h>
 #include <stdio.h>
 #include <stdlib.h>
@@ -156,6 +157,7 @@ typedef enum {
 	PGF_TOKEN_RTRIANGLE,
 	PGF_TOKEN_COMMA,
 	PGF_TOKEN_COLON,
+	PGF_TOKEN_SEMI,
 	PGF_TOKEN_WILD,
 	PGF_TOKEN_IDENT,
 	PGF_TOKEN_INT,
@@ -285,6 +287,10 @@ pgf_expr_parser_token(PgfExprParser* parser)
 		pgf_expr_parser_getc(parser);
 		parser->token_tag = PGF_TOKEN_COLON;
 		break;
+	case ';':
+		pgf_expr_parser_getc(parser);
+		parser->token_tag = PGF_TOKEN_SEMI;
+		break;
 	case '\'':
 		pgf_expr_parser_getc(parser);
 
@@ -638,7 +644,8 @@ pgf_expr_parser_expr(PgfExprParser* parser)
 		       parser->token_tag != PGF_TOKEN_RCURLY &&
 		       parser->token_tag != PGF_TOKEN_RTRIANGLE &&
 		       parser->token_tag != PGF_TOKEN_COLON &&
-		       parser->token_tag != PGF_TOKEN_COMMA) {
+		       parser->token_tag != PGF_TOKEN_COMMA &&
+		       parser->token_tag != PGF_TOKEN_SEMI) {
 			PgfExpr arg = pgf_expr_parser_arg(parser);
 			if (gu_variant_is_null(arg))
 				return gu_null_variant;
@@ -847,27 +854,83 @@ pgf_read_expr_tuple(GuIn* in,
 	PgfExprParser* parser =
 		pgf_new_parser(in, pool, tmp_pool, err);
 	if (parser->token_tag != PGF_TOKEN_LTRIANGLE)
-		return 0;
+		goto fail;
 	pgf_expr_parser_token(parser);
 	for (size_t i = 0; i < n_exprs; i++) {
 		if (i > 0) {
 			if (parser->token_tag != PGF_TOKEN_COMMA)
-				return 0;
+				goto fail;
 			pgf_expr_parser_token(parser);
 		}
 
 		exprs[i] = pgf_expr_parser_expr(parser);
 		if (gu_variant_is_null(exprs[i]))
-			return 0;
+			goto fail;
 	}
 	if (parser->token_tag != PGF_TOKEN_RTRIANGLE)
-		return 0;
+		goto fail;
 	pgf_expr_parser_token(parser);
 	if (parser->token_tag != PGF_TOKEN_EOF)
-		return 0;
+		goto fail;
 	gu_pool_free(tmp_pool);
 
 	return 1;
+	
+fail:
+	gu_pool_free(tmp_pool);
+	return 0;
+}
+
+GuSeq*
+pgf_read_expr_matrix(GuIn* in,
+                     size_t n_exprs,
+                     GuPool* pool, GuExn* err)
+{
+	GuPool* tmp_pool = gu_new_pool();
+	PgfExprParser* parser =
+		pgf_new_parser(in, pool, tmp_pool, err);
+	if (parser->token_tag != PGF_TOKEN_LTRIANGLE)
+		goto fail;
+	pgf_expr_parser_token(parser);
+
+	GuBuf* buf = gu_new_buf(PgfExpr, pool);
+	
+	if (parser->token_tag != PGF_TOKEN_RTRIANGLE) {	
+		for (;;) {
+			PgfExpr* exprs = gu_buf_extend_n(buf, n_exprs);
+
+			for (size_t i = 0; i < n_exprs; i++) {
+				if (i > 0) {
+					if (parser->token_tag != PGF_TOKEN_COMMA)
+						goto fail;
+					pgf_expr_parser_token(parser);
+				}
+
+				exprs[i] = pgf_expr_parser_expr(parser);
+				if (gu_variant_is_null(exprs[i]))
+					goto fail;
+			}
+
+			if (parser->token_tag != PGF_TOKEN_SEMI)
+				break;
+
+			pgf_expr_parser_token(parser);
+		}
+
+		if (parser->token_tag != PGF_TOKEN_RTRIANGLE)
+			goto fail;
+	}
+
+	pgf_expr_parser_token(parser);
+	if (parser->token_tag != PGF_TOKEN_EOF)
+		goto fail;
+	gu_pool_free(tmp_pool);
+
+	return gu_buf_data_seq(buf);
+
+fail:
+	gu_pool_free(tmp_pool);
+	return NULL;
 }
 
 PgfType*
diff --git a/src/runtime/c/pgf/expr.h b/src/runtime/c/pgf/expr.h
index 8dd1e0d44..763d1ba4f 100644
--- a/src/runtime/c/pgf/expr.h
+++ b/src/runtime/c/pgf/expr.h
@@ -163,6 +163,10 @@ pgf_read_expr_tuple(GuIn* in,
                     size_t n_exprs, PgfExpr exprs[],
                     GuPool* pool, GuExn* err);
 
+GuSeq*
+pgf_read_expr_matrix(GuIn* in, size_t n_exprs,
+                     GuPool* pool, GuExn* err);
+
 PgfType*
 pgf_read_type(GuIn* in, GuPool* pool, GuExn* err);
 
diff --git a/src/runtime/haskell-bind/PGF2/FFI.hs b/src/runtime/haskell-bind/PGF2/FFI.hs
index ee26214c7..fc658d83d 100644
--- a/src/runtime/haskell-bind/PGF2/FFI.hs
+++ b/src/runtime/haskell-bind/PGF2/FFI.hs
@@ -237,6 +237,9 @@ foreign import ccall "pgf/expr.h pgf_read_expr"
 foreign import ccall "pgf/expr.h pgf_read_expr_tuple"
   pgf_read_expr_tuple :: Ptr GuIn -> CInt -> Ptr PgfExpr -> Ptr GuPool -> Ptr GuExn -> IO CInt
 
+foreign import ccall "pgf/expr.h pgf_read_expr_matrix"
+  pgf_read_expr_matrix :: Ptr GuIn -> CInt -> Ptr GuPool -> Ptr GuExn -> IO (Ptr GuSeq)
+
 foreign import ccall "pgf/graphviz.h pgf_graphviz_abstract_tree"
   pgf_graphviz_abstract_tree :: Ptr PgfPGF -> PgfExpr -> Ptr GuOut -> Ptr GuExn -> IO ()
 
diff --git a/src/runtime/haskell-bind/SG.hsc b/src/runtime/haskell-bind/SG.hsc
index 5ee02b8b2..b6707f031 100644
--- a/src/runtime/haskell-bind/SG.hsc
+++ b/src/runtime/haskell-bind/SG.hsc
@@ -11,6 +11,7 @@ module SG( SG, openSG, closeSG
          , updateFtsIndex
          , queryLinearization
          , readTriple, showTriple
+         , readTriples
          , insertTriple, getTriple
          , queryTriple
          ) where
@@ -147,7 +148,7 @@ readTriple str =
     do exprPl <- gu_new_pool
        withGuPool $ \tmpPl ->
          withCString str $ \c_str ->
-           withTriple $ \triple -> do
+           withTriple $ \triple ->
              do guin <- gu_string_in c_str tmpPl
                 exn <- gu_new_exn tmpPl
                 ok <- pgf_read_expr_tuple guin 3 triple exprPl exn
@@ -176,6 +177,33 @@ showTriple (Expr expr1 _) (Expr expr2 _) (Expr expr3 _) =
          s <- gu_string_buf_freeze sb tmpPl
          peekCString s
 
+readTriples :: String -> Maybe [(Expr,Expr,Expr)]
+readTriples str =
+  unsafePerformIO $
+    do exprPl <- gu_new_pool
+       withGuPool $ \tmpPl ->
+         withCString str $ \c_str ->
+             do guin <- gu_string_in c_str tmpPl
+                exn <- gu_new_exn tmpPl
+                seq <- pgf_read_expr_matrix guin 3 exprPl exn
+                status <- gu_exn_is_raised exn
+                if (seq /= nullPtr && not status)
+                  then do exprFPl <- newForeignPtr gu_pool_finalizer exprPl
+                          count <- (#peek GuSeq, len) seq
+                          ts <- peekTriples exprFPl (fromIntegral (count :: CInt)) (seq `plusPtr` (#offset GuSeq, data))
+                          return (Just ts)
+                  else do gu_pool_free exprPl
+                          return Nothing
+  where
+    peekTriples exprFPl count triple
+      | count == 0 = return []
+      | otherwise  = do c_expr1 <- peekElemOff triple 0
+                        c_expr2 <- peekElemOff triple 1
+                        c_expr3 <- peekElemOff triple 2
+                        let t = (Expr c_expr1 exprFPl,Expr c_expr2 exprFPl,Expr c_expr3 exprFPl)
+                        ts <- peekTriples exprFPl (count-3) (triple `plusPtr` (3*sizeOf c_expr1))
+                        return (t:ts)
+
 insertTriple :: SG -> Expr -> Expr -> Expr -> IO SgId
 insertTriple (SG sg) (Expr expr1 _) (Expr expr2 _) (Expr expr3 _) =
   withGuPool $ \tmpPl ->