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 #include +#include #include #include #include @@ -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 ->