Finished the Emacs binding.

Now the binding part is finished.

What remains is a bug encountered when planting a fragment to the
forest which intersects a packed node, which would lead to invalid
forests.  This will also cause problem when planting a packed
fragment, but until now my testing grammars do not produce packed
fragments, so this problem is not encountered yet.

I am still figuring out efficient ways to solve this problem.

1 files changed, 286 insertions, 0 deletions

diff --git a/src/binding.c b/src/binding.c
new file mode 100644
index 0000000..43f73ba
--- /dev/null
+++ b/src/binding.c
@@ -0,0 +1,286 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <limits.h>
+#include <string.h>
+#include <emacs-module.h>
+#include "helper.h"
+
+int plugin_is_GPL_compatible = 3;
+
+emacs_value
+rep_new_parser(emacs_env *env, ptrdiff_t narg, emacs_value *args, void *data)
+{
+  char *buffer = NULL;
+  ptrdiff_t len = 0;
+  emacs_value error_data[1];
+
+  unsigned char error_vec_len[8] = { 0 };
+  unsigned char error_vec_cap[8] = { 0 };
+
+  struct SignedVec error_vec = { 0 };
+
+  error_vec.len = error_vec_len;
+  error_vec.capacity = error_vec_cap;
+
+  env->copy_string_contents(env, *args, NULL, &len);
+  len++;
+  buffer = malloc(sizeof(char) * len);
+
+  if (buffer == NULL) return env->intern(env, "nil");
+
+  env->copy_string_contents(env, *args, buffer, &len);
+
+  struct parser *new_parser_result = new_parser(buffer, &error_vec);
+
+  free(buffer);
+
+  uint64_t error_length = from_big_endian(error_vec.len);
+
+  if (error_length) {
+    error_data[0] = env->make_string(env, error_vec.data, (ptrdiff_t) error_length);
+
+    clean_signed(&error_vec, 4);
+
+    env->non_local_exit_signal(env, env->intern(env, "error"),
+                               env->funcall(env, env->intern(env, "list"),
+                                            1, error_data));
+
+    return env->intern(env, "nil");
+  }
+
+  return env->make_user_ptr(env, clean_parser, new_parser_result);
+}
+
+emacs_value
+rep_parser_recognize(emacs_env *env, ptrdiff_t narg, emacs_value *args, void *data)
+{
+  struct parser *parser = env->get_user_ptr(env, *args);
+
+  if (env->non_local_exit_check(env) != emacs_funcall_exit_return)
+    return env->intern(env, "nil");
+
+  unsigned char *buffer = NULL;
+  ptrdiff_t len = 0;
+
+  emacs_value error_data[1];
+
+  if (!env->eq(env,
+               env->type_of(env, *(args+1)),
+               env->intern(env, "vector"))) {
+    error_data[0] = env->make_string
+      (env, "INPUT should be a vector of integers", 36);
+
+    env->non_local_exit_signal(env, env->intern(env, "wrong-type-argument"),
+                               env->funcall(env, env->intern(env, "list"),
+                                            1, error_data));
+
+    return env->intern(env, "nil");
+  }
+
+  len = env->vec_size(env, *(args+1));
+
+  buffer = malloc(sizeof(unsigned char) * len * 8);
+
+  if (buffer == NULL) {
+    error_data[0] = env->make_string(env, "out of memory", 13);
+
+    env->non_local_exit_signal(env, env->intern(env, "error"),
+                               env->funcall(env, env->intern(env, "list"),
+                                            1, error_data));
+
+    return env->intern(env, "nil");
+  }
+
+  for (ptrdiff_t i = 0; i < len; i++) {
+    emacs_value element = env->vec_get(env, *(args+1), i);
+
+    to_big_endian((uint64_t) env->extract_integer(env, element),
+                  buffer + 8 * i);
+  }
+
+  if (env->non_local_exit_check(env) != emacs_funcall_exit_return) {
+    free(buffer);
+    return env->intern(env, "nil");
+  }
+
+  unsigned char error_vec_len[8] = { 0 };
+  unsigned char error_vec_cap[8] = { 0 };
+
+  struct SignedVec error_vec = { 0 };
+
+  error_vec.len = error_vec_len;
+  error_vec.capacity = error_vec_cap;
+
+  unsigned char input_len[8] = { 0 };
+
+  to_big_endian((uint64_t) len * 8, input_len);
+
+  struct UnsignedVec input_vec = (struct UnsignedVec)
+    { input_len, NULL, buffer };
+
+  int result = parser_recognize(parser, &input_vec, &error_vec, (unsigned char) 1);
+
+  free(buffer);
+
+  uint64_t error_length = from_big_endian(error_vec.len);
+
+  if (error_length) {
+    error_data[0] = env->make_string(env, error_vec.data, (ptrdiff_t) error_length);
+
+    clean_signed(&error_vec, 4);
+
+    env->non_local_exit_signal(env, env->intern(env, "error"),
+                               env->funcall(env, env->intern(env, "list"),
+                                            1, error_data));
+
+    return env->intern(env, "nil");
+  }
+
+  return (result) ? env->intern(env, "t") : env->intern(env, "nil");
+}
+
+void
+clean_forest(void *ptr)
+{
+  clean_unsigned((struct UnsignedVec *) ptr, 15);
+}
+
+emacs_value
+rep_parser_parse(emacs_env *env, ptrdiff_t narg, emacs_value *args, void *data)
+{
+  struct parser *parser = env->get_user_ptr(env, *args);
+
+  if (env->non_local_exit_check(env) != emacs_funcall_exit_return)
+    return env->intern(env, "nil");
+
+  unsigned char *buffer = NULL;
+  ptrdiff_t len = 0;
+
+  emacs_value error_data[1];
+
+  if (!env->eq(env,
+               env->type_of(env, *(args+1)),
+               env->intern(env, "vector"))) {
+    error_data[0] = env->make_string
+      (env, "INPUT should be a vector of integers", 36);
+
+    env->non_local_exit_signal(env, env->intern(env, "wrong-type-argument"),
+                               env->funcall(env, env->intern(env, "list"),
+                                            1, error_data));
+
+    return env->intern(env, "nil");
+  }
+
+  len = env->vec_size(env, *(args+1));
+
+  buffer = malloc(sizeof(char) * len * 8);
+
+  if (buffer == NULL) {
+    error_data[0] = env->make_string(env, "out of memory", 13);
+
+    env->non_local_exit_signal(env, env->intern(env, "error"),
+                               env->funcall(env, env->intern(env, "list"),
+                                            1, error_data));
+
+    return env->intern(env, "nil");
+  }
+
+  for (ptrdiff_t i = 0; i < len; i++) {
+    emacs_value element = env->vec_get(env, *(args+1), i);
+
+    to_big_endian((uint64_t) env->extract_integer(env, element),
+                  buffer + 8 * i);
+  }
+
+  if (env->non_local_exit_check(env) != emacs_funcall_exit_return) {
+    free(buffer);
+    return env->intern(env, "nil");
+  }
+
+  unsigned char error_vec_len[8] = { 0 };
+  unsigned char error_vec_cap[8] = { 0 };
+
+  struct SignedVec error_vec = { 0 };
+
+  error_vec.len = error_vec_len;
+  error_vec.capacity = error_vec_cap;
+
+  unsigned char input_len[8] = { 0 };
+
+  to_big_endian((uint64_t) len * 8, input_len);
+
+struct UnsignedVec input_vec = (struct UnsignedVec)
+    { input_len, NULL, buffer };
+
+  struct UnsignedVec *result = parser_parse(parser, &input_vec, &error_vec, (unsigned char) 1);
+
+  free(buffer);
+
+  uint64_t error_length = from_big_endian(error_vec.len);
+
+  if (error_length) {
+    error_data[0] = env->make_string(env, error_vec.data, (ptrdiff_t) error_length);
+
+    clean_signed(&error_vec, 4);
+
+    env->non_local_exit_signal(env, env->intern(env, "error"),
+                               env->funcall(env, env->intern(env, "list"),
+                                            1, error_data));
+
+    return env->intern(env, "nil");
+  }
+
+  if (result) {
+    return env->make_user_ptr(env, clean_forest, result);
+  }
+
+  return env->intern(env, "nil");
+}
+
+int
+emacs_module_init(struct emacs_runtime *ert)
+{
+  emacs_env *env = ert->get_environment(ert);
+
+  unsigned char emacs_version = 0;
+
+  if ((unsigned long) env->size >= sizeof(struct emacs_env_27))
+    emacs_version = 27;
+  else if ((unsigned long) env->size >= sizeof(struct emacs_env_26))
+    emacs_version = 26;
+  else if ((unsigned long) env->size >= sizeof(struct emacs_env_25))
+    emacs_version = 25;
+  else return 2;
+
+  emacs_value newfunc = env->make_function
+    (env, 1, 1, rep_new_parser,
+     "Create a new parser from the grammar string GRAMMAR_STRING."
+     "\n\n\(fn grammar_string)",
+     NULL);
+
+  env->funcall(env, env->intern(env, "defalias"),
+               2, (emacs_value[]){ env->intern(env, "rep-new-parser"), newfunc });
+
+  emacs_value recognizefunc = env->make_function
+    (env, 2, 2, rep_parser_recognize,
+     "Recognize an INPUT using PARSER."
+     "\n\n\(fn parser INPUT)",
+     NULL);
+
+  env->funcall(env, env->intern(env, "defalias"),
+               2, (emacs_value[]){ env->intern(env, "rep-recognize"), recognizefunc });
+
+  emacs_value parsefunc = env->make_function
+    (env, 2, 2, rep_parser_parse,
+     "Parse an INPUT using PARSER."
+     "\n\n\(fn parser input)",
+     NULL);
+
+  env->funcall(env, env->intern(env, "defalias"),
+               2, (emacs_value[]){ env->intern(env, "rep-parse"), parsefunc });
+
+  env->funcall(env, env->intern(env, "provide"),
+               1, (emacs_value[]){ env->intern(env, "rep") });
+
+  return 0;
+}