ts/query.scm(ts-query-predicates-for-pattern): new procedure.

Z572 · Jun 28, 2023 · 4f0521b · 4f0521b
1 parent c9d4696
commit 4f0521b
Show file tree

Hide file tree

Showing 3 changed files with 64 additions and 1 deletion.
diff --git a/tests/query.scm b/tests/query.scm
@@ -36,7 +36,15 @@
       (test-equal "ts-query-string-count"
         0 (ts-query-string-count query)))
 
-
+    (let* ((query (ts-query-new
+                   ts-json
+                   "((document (array (number) @num (number) @num2))
+(#match \"^a\" @num)
+(#eq \"^b\" @num))")))
+      (test-equal "ts-query-predicates-for-pattern"
+        '(((string . "match") (string . "^a") (capture . "num"))
+          ((string . "eq") (string . "^b") (capture . "num")))
+        (ts-query-predicates-for-pattern query 0)))
 
     (let* ((query (ts-query-new
                    ts-json

diff --git a/ts/query.c b/ts/query.c
@@ -178,9 +178,55 @@ SCM_DEFINE(query_start_byte_for_pattern, "ts-query-start-byte-for-pattern",2,0,
   }
   return scm_from_uint32(ts_query_start_byte_for_pattern(query,pat_id));
 }
+#undef FUNC_NAME
+
+SCM_DEFINE(query_predicates_for_pattern, "%ts-query-predicates-for-pattern", 2,
+           0, 0, (SCM tsq, SCM index), "")
+#define FUNC_NAME s_query_predicates_for_pattern
+{
+  ASSERT_QUERY(tsq);
+  uint32_t length;
+  const TSQuery *self = FR(tsq);
+  const TSQueryPredicateStep *tsq_ps =
+    ts_query_predicates_for_pattern(self, scm_to_uint32(index), &length);
+  scm_remember_upto_here_2(tsq, index);
+  SCM list=scm_make_list(scm_from_uint32(length), SCM_UNSPECIFIED);
+  for (unsigned i = 0; i < length; i++) {
+    const TSQueryPredicateStep *step=&tsq_ps[i];
+    SCM sym;
+    SCM value;
+    switch (step->type) {
+    case TSQueryPredicateStepTypeString:
+      sym = scm_from_utf8_symbol("string");
+      {
+        uint32_t length;
+        const char *string =
+          ts_query_string_value_for_id(self, step->value_id, &length);
+        value = scm_from_utf8_stringn(string, length);
+      }
+      break;
+    case TSQueryPredicateStepTypeCapture:
+      sym=scm_from_utf8_symbol("capture");
+      {
+        uint32_t length;
+        const char *string =
+          ts_query_capture_name_for_id(self, step->value_id, &length);
+        value = scm_from_utf8_stringn(string, length);
+      }
+      break;
+    case TSQueryPredicateStepTypeDone:
+      sym=scm_from_utf8_symbol("done");
+      value=SCM_BOOL_F;
+      break;
 
+    }
+    scm_list_set_x(list, scm_from_unsigned_integer(i), scm_cons(sym, value));
+  }
+  return list;
+}
 #undef FUNC_NAME
 
+
 SCM_DEFINE(query_cursor_new, "ts-query-cursor-new", 0,0, 0,
            (),
            "")

diff --git a/ts/query.scm b/ts/query.scm
@@ -3,8 +3,10 @@
   #:use-module (ts util)
   #:use-module (ts language)
   #:use-module (oop goops)
+  #:use-module (srfi srfi-171)
   #:export (ts-query-new
             ts-query-pattern-rooted?
+            ts-query-predicates-for-pattern
             ts-query-cursor-new
             ts-query-cursor-exec
             ts-query-pattern-count
@@ -29,3 +31,10 @@
   (id #:getter ts-query-match-id)
   (pattern-index #:getter ts-query-match-pattern-index)
   (captures #:getter ts-query-match-captures))
+
+(define (ts-query-predicates-for-pattern self index)
+  (let ((steps (%ts-query-predicates-for-pattern self index)))
+    (list-transduce (compose
+                     (tpartition (lambda (o) (eq? (car o) 'done)))
+                     (tremove (lambda (o) (equal? o '((done . #f))))))
+                    rcons steps)))