Re: How to add pseudo vector types

[Yuan Fu <casouri@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 930 bytes --]

I defined two pseudo vectors for tree-sitter's parser and node and packaged a dynamic module for tree-sitter’s json language definition. I also wrapped a few tree-sitter functions just to test if everything works. Please have a look. I’m sure there are some problems because I mainly wrote by copy, paste and modifying from other code I found in Emacs source.

To try out this patch, get tree-sitter from https://github.com/tree-sitter/tree-sitter.git <https://github.com/tree-sitter/tree-sitter.git>, make and make install it. Then unzip json-module.zip to get the source of the json dynamic module. If my Makefile is correct, make'ing it should produce a tree-sitter-json.so. Then if you apply ts.patch, compile emacs, and run this snippet, you should get a string representation of the root node.

(require 'tree-sitter-json)
(tree-sitter-node-string (tree-sitter-parse "[1,2]" (tree-sitter-json)))

Yuan






[-- Attachment #2.1: Type: text/html, Size: 1359 bytes --]

[-- Attachment #2.2: ts.patch --]
[-- Type: application/octet-stream, Size: 15270 bytes --]

From 85baf92975224ea99b7f68d5854342803c61f1d1 Mon Sep 17 00:00:00 2001
From: Yuan Fu <casouri@gmail.com>
Date: Wed, 14 Jul 2021 22:26:42 -0400
Subject: [PATCH] checkpoint

---
 configure.ac      |  27 ++++++++-
 src/Makefile.in   |  11 +++-
 src/alloc.c       |  13 +++++
 src/emacs.c       |   4 ++
 src/lisp.h        |   2 +
 src/print.c       |  17 ++++++
 src/tree_sitter.c | 145 ++++++++++++++++++++++++++++++++++++++++++++++
 src/tree_sitter.h |  87 ++++++++++++++++++++++++++++
 8 files changed, 302 insertions(+), 4 deletions(-)
 create mode 100644 src/tree_sitter.c
 create mode 100644 src/tree_sitter.h

diff --git a/configure.ac b/configure.ac
index 830f33844b..42d2d43455 100644
--- a/configure.ac
+++ b/configure.ac
@@ -454,6 +454,7 @@ AC_DEFUN
 OPTION_DEFAULT_OFF([imagemagick],[compile with ImageMagick image support])
 OPTION_DEFAULT_ON([native-image-api], [don't use native image APIs (GDI+ on Windows)])
 OPTION_DEFAULT_IFAVAILABLE([json], [compile with native JSON support])
+OPTION_DEFAULT_IFAVAILABLE([tree-sitter], [compile with tree-sitter])
 
 OPTION_DEFAULT_ON([xft],[don't use XFT for anti aliased fonts])
 OPTION_DEFAULT_ON([harfbuzz],[don't use HarfBuzz for text shaping])
@@ -2963,6 +2964,23 @@ AC_DEFUN
 AC_SUBST(JSON_CFLAGS)
 AC_SUBST(JSON_OBJ)
 
+HAVE_TREE_SITTER=no
+TREE_SITTER_OBJ=
+
+if test "${with_tree_sitter}" != "no"; then
+  EMACS_CHECK_MODULES([TREE_SITTER], [tree-sitter >= 0.0],
+    [HAVE_TREE_SITTER=yes], [HAVE_TREE_SITTER=no])
+  if test "${HAVE_TREE_SITTER}" = yes; then
+    AC_DEFINE(HAVE_TREE_SITTER, 1, [Define if using tree-sitter.])
+    TREE_SITTER_LIBS=-ltree-sitter
+    TREE_SITTER_OBJ="tree_sitter.o"
+  fi
+fi
+
+AC_SUBST(TREE_SITTER_LIBS)
+AC_SUBST(TREE_SITTER_CFLAGS)
+AC_SUBST(TREE_SITTER_OBJ)
+
 NOTIFY_OBJ=
 NOTIFY_SUMMARY=no
 
@@ -4028,6 +4046,12 @@ AC_DEFUN
   *) MISSING="$MISSING json"
      WITH_IFAVAILABLE="$WITH_IFAVAILABLE --with-json=ifavailable";;
 esac
+case $with_tree_sitter,$HAVE_TREE_SITTER in
+  no,* | ifavailable,* | *,yes) ;;
+  *) MISSING="$MISSING tree-sitter"
+     WITH_IFAVAILABLE="$WITH_IFAVAILABLE --with-tree-sitter=ifavailable";;
+esac
+
 if test "X${MISSING}" != X; then
   # If we have a missing library, and we don't have pkg-config installed,
   # the missing pkg-config may be the reason.  Give the user a hint.
@@ -5833,7 +5857,7 @@ AC_DEFUN
 optsep=
 emacs_config_features=
 for opt in ACL CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM GSETTINGS \
- HARFBUZZ IMAGEMAGICK JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 \
+ HARFBUZZ IMAGEMAGICK JPEG JSON TREE-SITTER LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 \
  M17N_FLT MODULES NATIVE_COMP NOTIFY NS OLDXMENU PDUMPER PNG RSVG SECCOMP \
  SOUND THREADS TIFF \
  TOOLKIT_SCROLL_BARS UNEXEC X11 XAW3D XDBE XFT XIM XPM XWIDGETS X_TOOLKIT \
@@ -5902,6 +5926,7 @@ AC_DEFUN
   Does Emacs use -lxft?                                   ${HAVE_XFT}
   Does Emacs use -lsystemd?                               ${HAVE_LIBSYSTEMD}
   Does Emacs use -ljansson?                               ${HAVE_JSON}
+  Does Emacs use -ltree-sitter?                           ${HAVE_TREE_SITTER}
   Does Emacs use the GMP library?                         ${HAVE_GMP}
   Does Emacs directly use zlib?                           ${HAVE_ZLIB}
   Does Emacs have dynamic modules support?                ${HAVE_MODULES}
diff --git a/src/Makefile.in b/src/Makefile.in
index 79cddb35b5..bfdfda566e 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -320,6 +320,10 @@ JSON_LIBS =
 JSON_CFLAGS = @JSON_CFLAGS@
 JSON_OBJ = @JSON_OBJ@
 
+TREE_SITTER_LIBS = @TREE_SITTER_LIBS@
+TREE_SITTER_FLAGS = @TREE_SITTER_FLAGS@
+TREE_SITTER_OBJ = @TREE_SITTER_OBJ@
+
 INTERVALS_H = dispextern.h intervals.h composite.h
 
 GETLOADAVG_LIBS = @GETLOADAVG_LIBS@
@@ -372,7 +376,7 @@ EMACS_CFLAGS=
   $(WEBKIT_CFLAGS) $(LCMS2_CFLAGS) \
   $(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \
   $(HARFBUZZ_CFLAGS) $(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \
-  $(LIBSYSTEMD_CFLAGS) $(JSON_CFLAGS) \
+  $(LIBSYSTEMD_CFLAGS) $(JSON_CFLAGS) $(TREE_SITTER_CFLAGS) \
   $(LIBGNUTLS_CFLAGS) $(NOTIFY_CFLAGS) $(CAIRO_CFLAGS) \
   $(WERROR_CFLAGS)
 ALL_CFLAGS = $(EMACS_CFLAGS) $(WARN_CFLAGS) $(CFLAGS)
@@ -406,7 +410,8 @@ base_obj =
 	thread.o systhread.o \
 	$(if $(HYBRID_MALLOC),sheap.o) \
 	$(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \
-	$(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ)
+	$(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ) \
+	$(TREE_SITTER_OBJ)
 obj = $(base_obj) $(NS_OBJC_OBJ)
 
 ## Object files used on some machine or other.
@@ -516,7 +521,7 @@ LIBES =
    $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(HARFBUZZ_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
    $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LCMS2_LIBS) \
    $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) \
-   $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT)
+   $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT) $(TREE_SITTER_LIBS)
 
 ## FORCE it so that admin/unidata can decide whether this file is
 ## up-to-date.  Although since charprop depends on bootstrap-emacs,
diff --git a/src/alloc.c b/src/alloc.c
index 76d8c7ddd1..f144e053f2 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -50,6 +50,10 @@ Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2021 Free Software
 #include TERM_HEADER
 #endif /* HAVE_WINDOW_SYSTEM */
 
+#ifdef HAVE_TREE_SITTER
+#include "tree_sitter.h"
+#endif
+
 #include <flexmember.h>
 #include <verify.h>
 #include <execinfo.h>           /* For backtrace.  */
@@ -3144,6 +3148,15 @@ cleanup_vector (struct Lisp_Vector *vector)
       if (uptr->finalizer)
 	uptr->finalizer (uptr->p);
     }
+#ifdef HAVE_TREE_SITTER
+  else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_TS_PARSER))
+    {
+      struct Lisp_TS_Parser *lisp_parser
+	= PSEUDOVEC_STRUCT (vector, Lisp_TS_Parser);
+      ts_tree_delete(lisp_parser->tree);
+      ts_parser_delete(lisp_parser->parser);
+    }
+#endif
 #ifdef HAVE_MODULES
   else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_MODULE_FUNCTION))
     {
diff --git a/src/emacs.c b/src/emacs.c
index 60a57a693c..ede390231d 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -85,6 +85,7 @@ #define MAIN_PROGRAM
 #include "intervals.h"
 #include "character.h"
 #include "buffer.h"
+#include "tree_sitter.h"
 #include "window.h"
 #include "xwidget.h"
 #include "atimer.h"
@@ -2057,6 +2058,9 @@ main (int argc, char **argv)
       syms_of_floatfns ();
 
       syms_of_buffer ();
+      #ifdef HAVE_TREE_SITTER
+      syms_of_tree_sitter ();
+      #endif
       syms_of_bytecode ();
       syms_of_callint ();
       syms_of_casefiddle ();
diff --git a/src/lisp.h b/src/lisp.h
index 4fb8923678..e439447283 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1070,6 +1070,8 @@ DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG)
   PVEC_CONDVAR,
   PVEC_MODULE_FUNCTION,
   PVEC_NATIVE_COMP_UNIT,
+  PVEC_TS_PARSER,
+  PVEC_TS_NODE,
 
   /* These should be last, for internal_equal and sxhash_obj.  */
   PVEC_COMPILED,
diff --git a/src/print.c b/src/print.c
index d4301fd7b6..e20a1d065a 100644
--- a/src/print.c
+++ b/src/print.c
@@ -48,6 +48,10 @@ Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2021 Free Software
 # include <sys/socket.h> /* for F_DUPFD_CLOEXEC */
 #endif
 
+#ifdef HAVE_TREE_SITTER
+#include "tree_sitter.h"
+#endif
+
 struct terminal;
 
 /* Avoid actual stack overflow in print.  */
@@ -1853,6 +1857,19 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
       }
       break;
 #endif
+
+#ifdef HAVE_TREE_SITTER
+    case PVEC_TS_PARSER:
+      print_c_string ("#<tree-sitter-parser in ", printcharfun);
+      print_string (BVAR (XTS_PARSER (obj)->buffer, name), printcharfun);
+      printchar ('>', printcharfun);
+      break;
+    case PVEC_TS_NODE:
+      print_c_string ("#<tree-sitter-node", printcharfun);
+      printchar ('>', printcharfun);
+      break;
+#endif
+
     default:
       emacs_abort ();
     }
diff --git a/src/tree_sitter.c b/src/tree_sitter.c
new file mode 100644
index 0000000000..f2134c571a
--- /dev/null
+++ b/src/tree_sitter.c
@@ -0,0 +1,145 @@
+/* Tree-sitter integration for GNU Emacs.
+
+Copyright (C) 2021 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
+
+#include <config.h>
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <sys/param.h>
+#include <errno.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+
+#include "buffer.h"
+#include "coding.h"
+#include "tree_sitter.h"
+
+/* parser.h defines a macro ADVANCE that conflicts with alloc.c.   */
+#include <tree_sitter/parser.h>
+
+Lisp_Object
+make_ts_parser (struct buffer *buffer, TSParser *parser, TSTree *tree)
+{
+  struct Lisp_TS_Parser *lisp_parser
+    = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_TS_Parser, PVEC_TS_PARSER);
+  lisp_parser->buffer = buffer;
+  lisp_parser->parser = parser;
+  lisp_parser->tree = tree;
+  // TODO TSInput.
+  return make_lisp_ptr (lisp_parser, Lisp_Vectorlike);
+}
+
+Lisp_Object
+make_ts_node (Lisp_Object parser, TSNode node)
+{
+  struct Lisp_TS_Node *lisp_node
+    = ALLOCATE_PSEUDOVECTOR (struct Lisp_TS_Node, parser, PVEC_TS_NODE);
+  lisp_node->parser = parser;
+  lisp_node->node = node;
+  return make_lisp_ptr (lisp_node, Lisp_Vectorlike);
+}
+
+
+/* Tree-sitter parser.  */
+
+DEFUN ("tree-sitter-parse", Ftree_sitter_parse, Stree_sitter_parse,
+       2, 2, 0,
+       doc: /* Parse STRING and return a parser object.
+LANGUAGE should be the language provided by a tree-sitter language
+dynamic module.  */)
+  (Lisp_Object string, Lisp_Object language)
+{
+  CHECK_STRING (string);
+
+  /* LANGUAGE is a USER_PTR that contains the pointer to a
+     TSLanguage struct.  */
+  TSParser *parser = ts_parser_new ();
+  TSLanguage *lang = (XUSER_PTR (language)->p);
+  ts_parser_set_language (parser, lang);
+
+  TSTree *tree = ts_parser_parse_string (parser, NULL,
+					 SSDATA (string),
+					 strlen (SSDATA (string)));
+
+  /* See comment for ts_parser_parse in tree_sitter/api.h
+     for possible reasons for a failure.  */
+  if (tree == NULL)
+    signal_error ("Failed to parse STRING", string);
+
+  TSNode root_node = ts_tree_root_node (tree);
+
+  Lisp_Object lisp_parser = make_ts_parser (NULL, parser, tree);
+  Lisp_Object lisp_node = make_ts_node (lisp_parser, root_node);
+
+  return lisp_node;
+}
+
+DEFUN ("tree-sitter-node-string",
+       Ftree_sitter_node_string, Stree_sitter_node_string, 1, 1, 0,
+       doc: /* Return the string representation of NODE.  */)
+  (Lisp_Object node)
+{
+  TSNode ts_node = XTS_NODE (node)->node;
+  char *string = ts_node_string(ts_node);
+  return make_string(string, strlen (string));
+}
+
+DEFUN ("tree-sitter-node-parent",
+       Ftree_sitter_node_parent, Stree_sitter_node_parent, 1, 1, 0,
+       doc: /* Return the immediate parent of NODE.
+Return nil if couldn't find any.  */)
+  (Lisp_Object node)
+{
+  TSNode ts_node = XTS_NODE (node)->node;
+  TSNode parent = ts_node_parent(ts_node);
+
+  if (ts_node_is_null(parent))
+    return Qnil;
+
+  return make_ts_node(XTS_NODE (node)->parser, parent);
+}
+
+DEFUN ("tree-sitter-node-child",
+       Ftree_sitter_node_child, Stree_sitter_node_child, 2, 2, 0,
+       doc: /* Return the Nth child of NODE.
+Return nil if couldn't find any.  */)
+  (Lisp_Object node, Lisp_Object n)
+{
+  CHECK_INTEGER (n);
+  EMACS_INT idx = XFIXNUM (n);
+  TSNode ts_node = XTS_NODE (node)->node;
+  // FIXME: Is this cast ok?
+  TSNode child = ts_node_child(ts_node, (uint32_t) idx);
+
+  if (ts_node_is_null(child))
+    return Qnil;
+
+  return make_ts_node(XTS_NODE (node)->parser, child);
+}
+
+/* Initialize the tree-sitter routines.  */
+void
+syms_of_tree_sitter (void)
+{
+  defsubr (&Stree_sitter_parse);
+  defsubr (&Stree_sitter_node_string);
+  defsubr (&Stree_sitter_node_parent);
+  defsubr (&Stree_sitter_node_child);
+}
diff --git a/src/tree_sitter.h b/src/tree_sitter.h
new file mode 100644
index 0000000000..3c9e03475f
--- /dev/null
+++ b/src/tree_sitter.h
@@ -0,0 +1,87 @@
+/* Header file for the tree-sitter integration.
+
+Copyright (C) 2021 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
+
+#ifndef EMACS_TREE_SITTER_H
+#define EMACS_TREE_SITTER_H
+
+#include <sys/types.h>
+
+#include "lisp.h"
+
+#include <tree_sitter/api.h>
+
+INLINE_HEADER_BEGIN
+
+struct Lisp_TS_Parser
+{
+  union vectorlike_header header;
+  struct buffer *buffer;
+  TSParser *parser;
+  TSTree *tree;
+  TSInput input;
+};
+
+struct Lisp_TS_Node
+{
+  union vectorlike_header header;
+  /* This should prevent the gc from collecting the parser before the
+     node is done with it.  TSNode contains a pointer to the tree it
+     belongs to, and the parser object, when collected by gc, will
+     free that tree. */
+  Lisp_Object parser;
+  TSNode node;
+};
+
+INLINE bool
+TS_PARSERP (Lisp_Object x)
+{
+  return PSEUDOVECTORP (x, PVEC_TS_PARSER);
+}
+
+INLINE struct Lisp_TS_Parser *
+XTS_PARSER (Lisp_Object a)
+{
+  eassert (TS_PARSERP (a));
+  return XUNTAG (a, Lisp_Vectorlike, struct Lisp_TS_Parser);
+}
+
+INLINE bool
+TS_NODEP (Lisp_Object x)
+{
+  return PSEUDOVECTORP (x, PVEC_TS_NODE);
+}
+
+INLINE struct Lisp_TS_Node *
+XTS_NODE (Lisp_Object a)
+{
+  eassert (TS_NODEP (a));
+  return XUNTAG (a, Lisp_Vectorlike, struct Lisp_TS_Node);
+}
+
+Lisp_Object
+make_ts_parser (struct buffer *buffer, TSParser *parser, TSTree *tree);
+
+Lisp_Object
+make_ts_node (Lisp_Object parser, TSNode node);
+
+extern void syms_of_tree_sitter (void);
+
+INLINE_HEADER_END
+
+#endif /* EMACS_TREE_SITTER_H */
-- 
2.24.3 (Apple Git-128)


[-- Attachment #2.3: Type: text/html, Size: 133 bytes --]

[-- Attachment #2.4: json-module.zip --]
[-- Type: application/zip, Size: 8797 bytes --]

[-- Attachment #2.5: Type: text/html, Size: 184 bytes --]