From 180aea41cdce11b9b4bdc7da0964c14c0bf8a5f0 Mon Sep 17 00:00:00 2001
From: Yuan Fu <casouri@gmail.com>
Date: Fri, 16 Jul 2021 21:11:29 -0400
Subject: [PATCH] checkpoint 2: add change-hooks

---
 src/insdel.c      |  16 +++++
 src/tree_sitter.c | 163 ++++++++++++++++++++++++++++++++++++++++++++--
 src/tree_sitter.h |  10 +++
 3 files changed, 182 insertions(+), 7 deletions(-)

diff --git a/src/insdel.c b/src/insdel.c
index e38b091f54..3c1e13d38b 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -31,6 +31,10 @@
 #include "region-cache.h"
 #include "pdumper.h"
 
+#ifdef HAVE_TREE_SITTER
+#include "tree_sitter.h"
+#endif
+
 static void insert_from_string_1 (Lisp_Object, ptrdiff_t, ptrdiff_t, ptrdiff_t,
 				  ptrdiff_t, bool, bool);
 static void insert_from_buffer_1 (struct buffer *, ptrdiff_t, ptrdiff_t, bool);
@@ -2152,6 +2156,11 @@ signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int,
       run_hook (Qfirst_change_hook);
     }
 
+#ifdef HAVE_TREE_SITTER
+  /* FIXME: Is this the best place?  */
+  ts_before_change (start_int, end_int);
+#endif
+
   /* Now run the before-change-functions if any.  */
   if (!NILP (Vbefore_change_functions))
     {
@@ -2205,6 +2214,13 @@ signal_after_change (ptrdiff_t charpos, ptrdiff_t lendel, ptrdiff_t lenins)
   if (inhibit_modification_hooks)
     return;
 
+#ifdef HAVE_TREE_SITTER
+  /* We disrespect combine-after-change, because if we don't record
+     this change, the information that we need (the end byte position
+     of the change) will be lost.  */
+  ts_after_change (charpos, lendel, lenins);
+#endif
+
   /* If we are deferring calls to the after-change functions
      and there are no before-change functions,
      just record the args that we were going to use.  */
diff --git a/src/tree_sitter.c b/src/tree_sitter.c
index f2134c571a..7d1225161c 100644
--- a/src/tree_sitter.c
+++ b/src/tree_sitter.c
@@ -27,6 +27,7 @@ Copyright (C) 2021 Free Software Foundation, Inc.
 #include <stdlib.h>
 #include <unistd.h>
 
+#include "lisp.h"
 #include "buffer.h"
 #include "coding.h"
 #include "tree_sitter.h"
@@ -34,6 +35,98 @@ Copyright (C) 2021 Free Software Foundation, Inc.
 /* parser.h defines a macro ADVANCE that conflicts with alloc.c.   */
 #include <tree_sitter/parser.h>
 
+/* Record the byte position of the end of the (to-be) changed text.
+We have to record it now, because by the time we get to after-change
+hook, the _byte_ position of the end is lost.  */
+void
+ts_before_change (ptrdiff_t start_int, ptrdiff_t end_int)
+{
+  /* Iterate through each parser in 'tree-sitter-parser-list' and
+     record the byte position.  There could be better ways to record
+     it than storing the same position in every parser, but this is
+     the most fool-proof way, and I expect a buffer to have only one
+     parser most of the time anyway. */
+  ptrdiff_t beg_byte = CHAR_TO_BYTE (start_int);
+  ptrdiff_t old_end_byte = CHAR_TO_BYTE (end_int);
+  Lisp_Object parser_list = Fsymbol_value (Qtree_sitter_parser_list);
+  while (!NILP (parser_list))
+    {
+      Lisp_Object lisp_parser = Fcar (parser_list);
+      XTS_PARSER (lisp_parser)->edit.start_byte = beg_byte;
+      XTS_PARSER (lisp_parser)->edit.old_end_byte = old_end_byte;
+      parser_list = Fcdr (parser_list);
+    }
+}
+
+/* Update each parser's tree after the user made an edit.  This
+function does not parse the buffer and only updates the tree. (So it
+should be very fast.)  */
+void
+ts_after_change (ptrdiff_t charpos, ptrdiff_t lendel, ptrdiff_t lenins)
+{
+  ptrdiff_t new_end_byte = CHAR_TO_BYTE (charpos + lenins);
+  Lisp_Object parser_list = Fsymbol_value (Qtree_sitter_parser_list);
+  while (!NILP (parser_list))
+    {
+      Lisp_Object lisp_parser = Fcar (parser_list);
+      TSTree *tree = XTS_PARSER (lisp_parser)->tree;
+      XTS_PARSER (lisp_parser)->edit.new_end_byte = new_end_byte;
+      if (tree != NULL)
+	  ts_tree_edit (tree, &XTS_PARSER (lisp_parser)->edit);
+      parser_list = Fcdr (parser_list);
+    }
+}
+
+/* Parse the buffer.  We don't parse until we have to. When we have
+to, we call this function to parse and update the tree.  */
+void
+ts_ensure_parsed (Lisp_Object parser)
+{
+  TSParser *ts_parser = XTS_PARSER (parser)->parser;
+  TSTree *tree = XTS_PARSER(parser)->tree;
+  TSInput input = XTS_PARSER (parser)->input;
+  TSTree *new_tree = ts_parser_parse(ts_parser, tree, input);
+  XTS_PARSER (parser)->tree = new_tree;
+}
+
+/* This is the read function provided to tree-sitter to read from a
+   buffer.  It reads one character at a time and automatically skip
+   the gap.  */
+const char*
+ts_read_buffer (void *buffer, uint32_t byte_index,
+		TSPoint position, uint32_t *bytes_read)
+{
+  if (! BUFFER_LIVE_P ((struct buffer *) buffer))
+    error ("BUFFER is not live");
+
+  ptrdiff_t byte_pos = byte_index + 1;
+
+  // FIXME: Add some boundary checks?
+  /* I believe we can get away with only setting current-buffer
+     and not actually switching to it, like what we did in
+     'make_gap_1'.  */
+  struct buffer *old_buffer = current_buffer;
+  current_buffer = (struct buffer *) buffer;
+
+  /* Read one character.  */
+  char *beg;
+  int len;
+  if (byte_pos >= Z_BYTE)
+    {
+      beg = "";
+      len = 0;
+    }
+  else
+    {
+      beg = (char *) BYTE_POS_ADDR (byte_pos);
+      len = next_char_len(byte_pos);
+    }
+  *bytes_read = (uint32_t) len;
+  current_buffer = old_buffer;
+  return beg;
+}
+
+/* Wrap the parser in a Lisp_Object to be used in the Lisp machine.  */
 Lisp_Object
 make_ts_parser (struct buffer *buffer, TSParser *parser, TSTree *tree)
 {
@@ -42,10 +135,15 @@ make_ts_parser (struct buffer *buffer, TSParser *parser, TSTree *tree)
   lisp_parser->buffer = buffer;
   lisp_parser->parser = parser;
   lisp_parser->tree = tree;
-  // TODO TSInput.
+  TSInput input = {buffer, ts_read_buffer, TSInputEncodingUTF8};
+  lisp_parser->input = input;
+  TSPoint dummy_point = {0, 0};
+  TSInputEdit edit = {0, 0, 0, dummy_point, dummy_point, dummy_point};
+  lisp_parser->edit = edit;
   return make_lisp_ptr (lisp_parser, Lisp_Vectorlike);
 }
 
+/* Wrap the node in a Lisp_Object to be used in the Lisp machine.  */
 Lisp_Object
 make_ts_node (Lisp_Object parser, TSNode node)
 {
@@ -57,19 +155,59 @@ make_ts_node (Lisp_Object parser, TSNode node)
 }
 
 
-/* Tree-sitter parser.  */
+DEFUN ("tree-sitter-create-parser",
+       Ftree_sitter_create_parser, Stree_sitter_create_parser,
+       2, 2, 0,
+       doc: /* Create and return a parser in BUFFER for LANGUAGE.
+The parser is automatically added to BUFFER's
+`tree-sitter-parser-list'.  LANGUAGE should be the language provided
+by a tree-sitter language dynamic module.  */)
+  (Lisp_Object buffer, Lisp_Object language)
+{
+  CHECK_BUFFER(buffer);
+
+  /* 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);
+
+  Lisp_Object lisp_parser
+    = make_ts_parser (XBUFFER(buffer), parser, NULL);
+
+  // FIXME: Is this the correct way to set a buffer-local variable?
+  struct buffer *old_buffer = current_buffer;
+  set_buffer_internal (XBUFFER (buffer));
+
+  Fset (Qtree_sitter_parser_list,
+	Fcons (lisp_parser, Fsymbol_value (Qtree_sitter_parser_list)));
+
+  set_buffer_internal (old_buffer);
+  return lisp_parser;
+}
+
+DEFUN ("tree-sitter-parser-root-node",
+       Ftree_sitter_parser_root_node, Stree_sitter_parser_root_node,
+       1, 1, 0,
+       doc: /* Return the root node of PARSER.  */)
+  (Lisp_Object parser)
+{
+  ts_ensure_parsed(parser);
+  TSNode root_node = ts_tree_root_node (XTS_PARSER (parser)->tree);
+  return make_ts_node (parser, root_node);
+}
 
 DEFUN ("tree-sitter-parse", Ftree_sitter_parse, Stree_sitter_parse,
        2, 2, 0,
-       doc: /* Parse STRING and return a parser object.
+       doc: /* Parse STRING and return the root node.
 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.  */
+  /* 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);
@@ -104,7 +242,7 @@ DEFUN ("tree-sitter-node-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.  */)
+Return nil if we couldn't find any.  */)
   (Lisp_Object node)
 {
   TSNode ts_node = XTS_NODE (node)->node;
@@ -119,7 +257,7 @@ DEFUN ("tree-sitter-node-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.  */)
+Return nil if we couldn't find any.  */)
   (Lisp_Object node, Lisp_Object n)
 {
   CHECK_INTEGER (n);
@@ -138,6 +276,17 @@ DEFUN ("tree-sitter-node-child",
 void
 syms_of_tree_sitter (void)
 {
+  DEFSYM (Qtree_sitter_parser_list, "tree-sitter-parser-list");
+  DEFVAR_LISP ("ts-parser-list", Vtree_sitter_parser_list,
+		     doc: /* A list of tree-sitter parsers.
+// TODO: more doc.
+If you removed a parser from this list, do not put it back in.  */);
+  Vtree_sitter_parser_list = Qnil;
+  Fmake_variable_buffer_local (Qtree_sitter_parser_list);
+
+
+  defsubr (&Stree_sitter_create_parser);
+  defsubr (&Stree_sitter_parser_root_node);
   defsubr (&Stree_sitter_parse);
   defsubr (&Stree_sitter_node_string);
   defsubr (&Stree_sitter_node_parent);
diff --git a/src/tree_sitter.h b/src/tree_sitter.h
index 3c9e03475f..0606f336cc 100644
--- a/src/tree_sitter.h
+++ b/src/tree_sitter.h
@@ -28,6 +28,8 @@ #define EMACS_TREE_SITTER_H
 
 INLINE_HEADER_BEGIN
 
+/* A wrapper for a tree-sitter parser, but also contains a parse tree
+   and other goodies for convenience.  */
 struct Lisp_TS_Parser
 {
   union vectorlike_header header;
@@ -35,8 +37,10 @@ #define EMACS_TREE_SITTER_H
   TSParser *parser;
   TSTree *tree;
   TSInput input;
+  TSInputEdit edit;
 };
 
+/* A wrapper around a tree-sitter node.  */
 struct Lisp_TS_Node
 {
   union vectorlike_header header;
@@ -74,6 +78,12 @@ XTS_NODE (Lisp_Object a)
   return XUNTAG (a, Lisp_Vectorlike, struct Lisp_TS_Node);
 }
 
+void
+ts_before_change (ptrdiff_t charpos, ptrdiff_t lendel);
+
+void
+ts_after_change (ptrdiff_t charpos, ptrdiff_t lendel, ptrdiff_t lenins);
+
 Lisp_Object
 make_ts_parser (struct buffer *buffer, TSParser *parser, TSTree *tree);
 
-- 
2.24.3 (Apple Git-128)

