[nongnu] elpa/sweeprolog 89733a1b7f 001/166: Initial commit

[ELPA Syncer]

branch: elpa/sweeprolog
commit 89733a1b7fa8a445caee8633ee7fe8e5d23ce498
Author: Eshel Yaron <me@eshelyaron.com>
Commit: Eshel Yaron <me@eshelyaron.com>

    Initial commit
---
 .gitignore |   2 +
 Makefile   |  24 +++
 sweep.c    | 594 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 sweep.el   | 120 +++++++++++++
 sweep.h    |  15 ++
 sweep.pl   | 197 ++++++++++++++++++++
 6 files changed, 952 insertions(+)

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000000..42073c2d27
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+/.iprolog_history
+/sweep-module.dylib
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000000..59a4c355ec
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,24 @@
+BASENAME = sweep
+SOEXT    = dylib
+
+TARGET   = $(BASENAME)-module.$(SOEXT)
+SOURCE   = $(BASENAME).c
+
+LDFLAGS += -shared
+LDFLAGS += -lswipl
+
+CFLAGS  += -fPIC
+CFLAGS  += -fdiagnostics-absolute-paths
+CFLAGS  += -Wall
+CFLAGS  += -Wextra
+CFLAGS  += -O2
+
+.PHONY: clean all
+
+all: $(TARGET)
+
+$(TARGET): $(SOURCE)
+       $(CC) $(CFLAGS) -o $@ $^ $(LDFLAGS)
+
+clean:
+       rm -f $(TARGET)
diff --git a/sweep.c b/sweep.c
new file mode 100644
index 0000000000..2b5612fb1f
--- /dev/null
+++ b/sweep.c
@@ -0,0 +1,594 @@
+#include "sweep.h"
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+
+int plugin_is_GPL_compatible;
+
+term_t o = 0;
+
+char*
+estring_to_cstring(emacs_env *eenv, emacs_value estring, ptrdiff_t *len_p) {
+  char * buf = NULL;
+  ptrdiff_t len = 0;
+
+  if (len_p == NULL) len_p = &len;
+
+  if (!eenv->copy_string_contents(eenv, estring, NULL, len_p)) {
+    ethrow(eenv, "Failed to get string length");
+    return NULL;
+  }
+  if ((buf = (char*)malloc((*len_p))) == NULL) {
+    ethrow(eenv, "malloc failed");
+    return NULL;
+  }
+  memset(buf, 0, (*len_p));
+  if (!eenv->copy_string_contents(eenv, estring, buf, len_p)) {
+    ethrow(eenv, "Failed to copy string contents");
+    free(buf);
+    buf = NULL;
+  }
+
+  return buf;
+}
+
+int
+estring_to_atom(emacs_env *eenv, emacs_value estring, term_t t) {
+  ptrdiff_t len = 0;
+  char *buf = NULL;
+  int i = 0;
+
+  if ((buf = estring_to_cstring(eenv, estring, &len)) == NULL) return -1;
+
+  i = PL_put_atom_nchars(t, len - 1, buf);
+  free(buf);
+  return i;
+}
+
+int
+estring_to_pstring(emacs_env *eenv, emacs_value estring, term_t t) {
+  ptrdiff_t len = 0;
+  char *buf = NULL;
+  int i = 0;
+
+  if ((buf = estring_to_cstring(eenv, estring, &len)) == NULL) return -1;
+
+  i = PL_put_string_nchars(t, len - 1, buf);
+  free(buf);
+  return i;
+}
+
+static IOSTREAM *
+estring_to_stream(emacs_env *eenv, emacs_value estring) {
+  ptrdiff_t len = 0;
+  size_t slen = 0;
+  char *buf = NULL;
+
+  if ((buf = estring_to_cstring(eenv, estring, &len)) == NULL) return NULL;
+
+  slen = len - 1;
+  return Sopenmem(&buf, &slen, "r");
+}
+
+static emacs_value
+econs(emacs_env *env, emacs_value car, emacs_value cdr) {
+  emacs_value args[2] = {car, cdr};
+  return env->funcall (env, env->intern (env, "cons"), 2, args);
+}
+
+static emacs_value
+ecar(emacs_env *env, emacs_value cons) {
+  return env->funcall (env, env->intern (env, "car"), 1, &cons);
+}
+
+static emacs_value
+ecdr(emacs_env *env, emacs_value cons) {
+  return env->funcall (env, env->intern (env, "cdr"), 1, &cons);
+}
+
+void
+ethrow(emacs_env *env, const char * message) {
+  ptrdiff_t  len = strlen(message);
+
+  emacs_value str = env->make_string(env, message, len);
+  emacs_value arg = env->funcall (env, env->intern (env, "list"), 1, &str);
+  env->non_local_exit_signal(env, env->intern(env, "error"), arg);
+}
+
+emacs_value
+enil(emacs_env *env) { return env->intern(env, "nil"); }
+
+emacs_value
+et(emacs_env *env) { return env->intern(env, "t"); }
+
+static emacs_value
+term_to_value_list(emacs_env *eenv, term_t l) {
+  term_t      ph = PL_new_term_ref();
+  term_t      pt = PL_new_term_ref();
+
+  if (PL_get_list(l, ph, pt)) {
+    return econs(eenv, term_to_value(eenv, ph), term_to_value(eenv, pt));
+  } else return NULL;
+}
+
+static emacs_value
+term_to_value_integer(emacs_env *eenv, term_t t) {
+  emacs_value v = NULL;
+  int64_t     l = -1;
+  if (PL_get_int64(t, &l)) {
+
+    v = eenv->make_integer(eenv, l);
+  }
+  return v;
+}
+
+emacs_value
+term_to_value_string(emacs_env *eenv, term_t t) {
+  char * string = NULL;
+  emacs_value v = NULL;
+  size_t      l = -1;
+  if (PL_get_string_chars(t, &string, &l)) {
+    v = eenv->make_string(eenv, string, l);
+  }
+  return v;
+}
+
+emacs_value
+term_to_value_atom(emacs_env *eenv, term_t t) {
+  char * string = NULL;
+  emacs_value v = NULL;
+  emacs_value s = NULL;
+  size_t      l = -1;
+
+  if (PL_get_nchars(t, &l, &string, CVT_ATOM|REP_UTF8)) {
+    s = eenv->make_string(eenv, string, l);
+    v = econs(eenv, eenv->intern(eenv, "atom"), s);
+  }
+  return v;
+}
+
+emacs_value
+term_to_value_variable(emacs_env *env, term_t t) {
+  (void)t;
+  return env->intern(env, "variable");
+}
+
+emacs_value
+term_to_value_dict(emacs_env *env, term_t t) {
+  (void)t;
+  return env->intern(env, "dict");
+}
+
+emacs_value
+term_to_value_blob(emacs_env *env, term_t t) {
+  (void)t;
+  return env->intern(env, "blob");
+}
+
+emacs_value
+term_to_value_float(emacs_env *env, term_t t) {
+  (void)t;
+  return env->intern(env, "float");
+}
+
+emacs_value
+term_to_value_compound(emacs_env *env, term_t t) {
+  atom_t name = 0;
+  size_t arity = 0;
+  term_t arg = PL_new_term_ref();
+  const char * chars = NULL;
+  size_t len = 0;
+  emacs_value * vals = NULL;
+  size_t n = 0;
+  PL_get_compound_name_arity(t, &name, &arity);
+  chars = PL_atom_nchars(name, &len);
+  vals = (emacs_value*)malloc(sizeof(emacs_value)*arity + 1);
+  if (vals == NULL) {
+    ethrow(env, "malloc failed");
+    return NULL;
+  }
+  memset(vals, 0, sizeof(emacs_value)*arity + 1);
+
+  vals[0] = env->make_string(env, chars, len);
+
+  for(n=1; n<=arity; n++) {
+
+    PL_get_arg(n, t, arg);
+    vals[n] = term_to_value(env, arg);
+  }
+
+  return econs(env, env->intern(env, "compound"), env->funcall(env, 
env->intern(env, "list"), arity + 1, vals));
+}
+
+emacs_value
+term_to_value(emacs_env *env, term_t t) {
+  switch (PL_term_type(t)) {
+  case PL_VARIABLE:
+    return term_to_value_variable(env, t);
+  case PL_ATOM:
+    return term_to_value_atom(env, t);
+  case PL_STRING:
+    return term_to_value_string(env, t);
+  case PL_NIL:
+    return enil(env);
+  case PL_LIST_PAIR:
+    return term_to_value_list(env, t);
+  case PL_INTEGER:
+    return term_to_value_integer(env, t);
+  case PL_TERM:
+    return term_to_value_compound(env, t);
+  case PL_DICT:
+    return term_to_value_dict(env, t);
+  case PL_BLOB:
+    return term_to_value_blob(env, t);
+  case PL_FLOAT:
+    return term_to_value_blob(env, t);
+  default:
+    /* ethrow(env, "Prolog to Elisp conversion failed"); */
+    /* return NULL; */
+    return env->intern(env, "unconvertable");
+  }
+}
+
+int
+value_to_term_string(emacs_env *env, emacs_value v, term_t t) {
+  return estring_to_pstring(env, v, t);
+}
+
+int
+value_to_term_integer(emacs_env *env, emacs_value v, term_t t) {
+  intmax_t l = env->extract_integer(env, v);
+  return PL_put_int64(t, l);
+}
+
+int
+value_to_term_list(emacs_env *env, emacs_value v, term_t t) {
+  int r = -1;
+  term_t head = PL_new_term_ref();
+  term_t tail = PL_new_term_ref();
+  emacs_value car = ecar(env, v);
+  emacs_value cdr = ecdr(env, v);
+  if ((r = value_to_term(env, car, head)) < 0) {
+    return r;
+  }
+  if ((r = value_to_term(env, cdr, tail)) < 0) {
+    return r;
+  }
+  return PL_cons_list(t, head, tail);
+}
+
+int
+value_to_term(emacs_env *env, emacs_value v, term_t t) {
+  int r = -1;
+  emacs_value vt = env->type_of(env, v);
+
+  if (env->is_not_nil(env, v)) {
+    if (env->eq(env, vt, env->intern(env, "string"))) {
+      r = value_to_term_string(env, v, t);
+    } else if (env->eq(env, vt, env->intern(env, "integer"))) {
+      r = value_to_term_integer(env, v, t);
+    } else if (env->eq(env, vt, env->intern(env, "cons"))) {
+      r = value_to_term_list(env, v, t);
+    } else r = -1;
+  } else r = PL_put_nil(t);
+
+  return r;
+}
+
+emacs_value
+sweep_close_query(emacs_env *env, ptrdiff_t nargs, emacs_value *args, void 
*data)
+{
+  qid_t d = PL_current_query();
+
+  (void)data;
+  (void)nargs;
+  (void)args;
+
+  if (d == 0) {
+    ethrow(env, "No current query");
+    return NULL;
+  }
+
+  switch (PL_close_query(d)) {
+  case FALSE:
+    return term_to_value(env, PL_exception(d));
+  default:
+    return et(env);
+  }
+}
+
+emacs_value
+sweep_cut_query(emacs_env *env, ptrdiff_t nargs, emacs_value *args, void *data)
+{
+  qid_t d = PL_current_query();
+
+  (void)data;
+  (void)nargs;
+  (void)args;
+
+  if (d == 0) {
+    ethrow(env, "No current query");
+    return NULL;
+  }
+
+  switch (PL_cut_query(d)) {
+  case FALSE:
+    return term_to_value(env, PL_exception(d));
+  default:
+    return et(env);
+  }
+}
+
+emacs_value
+sweep_next_solution(emacs_env *env, ptrdiff_t nargs, emacs_value *args, void 
*data)
+{
+  qid_t d = PL_current_query();
+
+  (void)data;
+  (void)nargs;
+  (void)args;
+
+  if (d == 0) {
+    ethrow(env, "No current query");
+    return NULL;
+  }
+
+  switch (PL_next_solution(d)) {
+  case PL_S_EXCEPTION:
+    return econs(env, env->intern(env, "exception"), term_to_value(env, 
PL_exception(d)));
+  case PL_S_FALSE:
+    return enil(env);
+  case PL_S_TRUE:
+    return econs(env, et(env), term_to_value(env, o));
+  case PL_S_LAST:
+    return econs(env, env->intern(env, "!"), term_to_value(env, o));
+  default:
+    return NULL;
+  }
+}
+
+emacs_value
+sweep_open_query(emacs_env *env, ptrdiff_t nargs, emacs_value *args, void 
*data)
+{
+  predicate_t p = NULL;
+  IOSTREAM *  s = NULL;
+  char *      m = NULL;
+  module_t    n = NULL;
+  char *      c = NULL;
+  char *      f = NULL;
+  term_t      a = PL_new_term_refs(2);
+
+  (void)data;
+  (void)nargs;
+
+  if (PL_current_query() != 0) {
+    ethrow(env, "Prolog is already executing a query");
+    goto cleanup;
+  }
+
+  if ((c = estring_to_cstring(env, args[0], NULL)) == NULL) {
+    goto cleanup;
+  }
+
+  n = PL_new_module(PL_new_atom(c));
+
+  if ((m = estring_to_cstring(env, args[1], NULL)) == NULL) {
+    goto cleanup;
+  }
+
+  if ((f = estring_to_cstring(env, args[2], NULL)) == NULL) {
+    goto cleanup;
+  }
+
+  p = PL_predicate(f, 2, m);
+
+  if (value_to_term(env, args[3], a+0) < 0) {
+    goto cleanup;
+  }
+  PL_open_query(n, PL_Q_NODEBUG | PL_Q_EXT_STATUS | PL_Q_CATCH_EXCEPTION, p, 
a);
+
+  o = a+1;
+
+ cleanup:
+  if (c != NULL) free(c);
+  if (m != NULL) free(m);
+  if (f != NULL) free(f);
+  //  if (s != NULL) Sclose(s);
+
+  return et(env);
+}
+
+/* emacs_value */
+/* sweep_open_query(emacs_env *env, ptrdiff_t nargs, emacs_value *args, void 
*data) */
+/* { */
+/*   predicate_t p = NULL; */
+/*   IOSTREAM *  s = NULL; */
+/*   char *      m = NULL; */
+/*   module_t    n = NULL; */
+/*   char *      c = NULL; */
+/*   char *      f = NULL; */
+/*   term_t      a = PL_new_term_refs(3); */
+
+/*   (void)data; */
+/*   (void)nargs; */
+
+/*   if (PL_current_query() != 0) { */
+/*     ethrow(env, "Prolog is already executing a query"); */
+/*     goto cleanup; */
+/*   } */
+
+/*   if ((c = estring_to_cstring(env, args[0], NULL)) == NULL) { */
+/*     goto cleanup; */
+/*   } */
+
+/*   n = PL_new_module(PL_new_atom(c)); */
+
+/*   if ((m = estring_to_cstring(env, args[1], NULL)) == NULL) { */
+/*     goto cleanup; */
+/*   } */
+
+/*   if ((f = estring_to_cstring(env, args[2], NULL)) == NULL) { */
+/*     goto cleanup; */
+/*   } */
+
+/*   p = PL_predicate(f, 3, m); */
+
+/*   if (estring_to_atom(env, args[3], a+0) < 0) { */
+/*     goto cleanup; */
+/*   } */
+
+/*   if ((s = estring_to_stream(env, args[4])) == NULL) { */
+/*     goto cleanup; */
+/*   } */
+
+/*   PL_unify_stream(a+1, s); */
+
+/*   PL_open_query(n, PL_Q_NODEBUG | PL_Q_EXT_STATUS | PL_Q_CATCH_EXCEPTION, 
p, a); */
+/*   o = a+2; */
+
+/*  cleanup: */
+/*   if (c != NULL) free(c); */
+/*   if (m != NULL) free(m); */
+/*   if (f != NULL) free(f); */
+/*   //  if (s != NULL) Sclose(s); */
+
+/*   return et(env); */
+/* } */
+
+static emacs_value
+sweep_initialize(emacs_env *env, ptrdiff_t nargs, emacs_value *args, void 
*data)
+{
+  (void)data;
+  int i = 0, r = 0;
+  char **argv = (char**)malloc(sizeof(char*)*nargs);
+  if (argv == NULL) {
+    ethrow(env, "malloc failed");
+    return NULL;
+  }
+  for (i = 0; i < nargs; i++) {
+    if ((argv[i] = estring_to_cstring(env, args[i], NULL)) == NULL) {
+      free(argv);
+      return NULL;
+    }
+  }
+  r = PL_initialise(nargs, argv);
+  for (i = 0; i < nargs; i++) {
+    free(argv[i]);
+  }
+  free(argv);
+  return env->intern(env, r ? "t" : "nil");
+}
+
+
+static emacs_value
+sweep_is_initialized(emacs_env *env, ptrdiff_t nargs, emacs_value *args, void 
*data)
+{
+  (void)nargs;
+  (void)args;
+  (void)data;
+  if (PL_is_initialised(NULL, NULL) == FALSE) {
+    return enil(env);
+  } else return et(env);
+}
+
+static emacs_value
+sweep_cleanup(emacs_env *env, ptrdiff_t nargs, emacs_value *args, void *data)
+{
+  (void)nargs;
+  (void)data;
+  (void)args;
+  return env->intern(env, (PL_cleanup(PL_CLEANUP_SUCCESS) ? "t" : "nil"));
+}
+
+static void provide(emacs_env *env, const char *feature) {
+  emacs_value Qfeat = env->intern(env, feature);
+  emacs_value Qprovide = env->intern(env, "provide");
+
+  env->funcall(env, Qprovide, 1, (emacs_value[]){Qfeat});
+}
+
+int
+emacs_module_init (struct emacs_runtime *runtime)
+{
+  emacs_env *env = runtime->get_environment (runtime);
+
+  emacs_value symbol_initialize = env->intern (env, "sweep-initialize");
+  emacs_value func_initialize =
+    env->make_function(env,
+                       1, emacs_variadic_function,
+                       sweep_initialize,
+                       "Initialize Prolog.\
+ARG1 is passed as argv[0] to `PL_initialise()', which see.\
+REST is passed as the rest of the command line arguments to Prolog.",
+                       NULL);
+  emacs_value args_initialize[] = {symbol_initialize, func_initialize};
+  env->funcall (env, env->intern (env, "defalias"), 2, args_initialize);
+
+  emacs_value symbol_is_initialized = env->intern (env, "sweep-initialized-p");
+  emacs_value func_is_initialized =
+    env->make_function(env,
+                       0, 0,
+                       sweep_is_initialized,
+                       "Return t if Prolog is initialized, else return nil.",
+                       NULL);
+  emacs_value args_is_initialized[] = {symbol_is_initialized, 
func_is_initialized};
+  env->funcall (env, env->intern (env, "defalias"), 2, args_is_initialized);
+
+  emacs_value symbol_open_query = env->intern (env, "sweep-open-query");
+  emacs_value func_open_query =
+    env->make_function(env,
+                       4, 4,
+                       sweep_open_query,
+                       "Query Prolog.\
+ARG1 is a string denoting the context module for the query.\
+ARG2 and ARG3 are strings designating the module and predicate name of the 
Prolog predicate to invoke, which must be of arity 3.\
+ARG4 is a string that is converted to an atom and passed as the first argument 
of the invoked predicate.\
+ARG5 is a string that is converted to a Prolog stream and passed as the second 
argument of the invoked predicate.\
+The third and final argument of the predicate is left unbound and is assumed 
to be an output variable, whose further instantiations can be examined via 
`sweep-next-solution'.",
+                       NULL);
+  emacs_value args_open_query[] = {symbol_open_query, func_open_query};
+  env->funcall (env, env->intern (env, "defalias"), 2, args_open_query);
+
+  emacs_value symbol_next_solution = env->intern (env, "sweep-next-solution");
+  emacs_value func_next_solution =
+    env->make_function(env,
+                       0, 0,
+                       sweep_next_solution,
+                       "Return the next solution from Prolog, or nil if there 
are none.\
+See also `sweep-open-query'.",
+                       NULL);
+  emacs_value args_next_solution[] = {symbol_next_solution, 
func_next_solution};
+  env->funcall (env, env->intern (env, "defalias"), 2, args_next_solution);
+
+  emacs_value symbol_cut_query = env->intern (env, "sweep-cut-query");
+  emacs_value func_cut_query =
+    env->make_function(env,
+                       0, 0,
+                       sweep_cut_query,
+                       "Finalize the current Prolog query.\
+This function retains the current instantiation of the query variables.",
+                       NULL);
+  emacs_value args_cut_query[] = {symbol_cut_query, func_cut_query};
+  env->funcall (env, env->intern (env, "defalias"), 2, args_cut_query);
+
+  emacs_value symbol_close_query = env->intern (env, "sweep-close-query");
+  emacs_value func_close_query =
+    env->make_function(env,
+                       0, 0,
+                       sweep_close_query,
+                       "Finalize the current Prolog query.\
+This function drops the current instantiation of the query variables.",
+                       NULL);
+  emacs_value args_close_query[] = {symbol_close_query, func_close_query};
+  env->funcall (env, env->intern (env, "defalias"), 2, args_close_query);
+
+
+  emacs_value symbol_cleanup = env->intern (env, "sweep-cleanup");
+  emacs_value func_cleanup = env->make_function (env, 0, 0, sweep_cleanup, 
"Cleanup Prolog.", NULL);
+  emacs_value args_cleanup[] = {symbol_cleanup, func_cleanup};
+  env->funcall (env, env->intern (env, "defalias"), 2, args_cleanup);
+
+  provide(env, "sweep-module");
+
+  return 0;
+}
diff --git a/sweep.el b/sweep.el
new file mode 100644
index 0000000000..961eac9128
--- /dev/null
+++ b/sweep.el
@@ -0,0 +1,120 @@
+;;; sweep.el --- SWI-Prolog Embedded in Emacs -*- lexical-binding:t -*-
+
+;; Copyright (C) 2022 Eshel Yaron
+
+;; Authors: Eshel Yaron <me(at)eshelyaron(dot)com>
+;; Maintainer: Eshel Yaron <me(at)eshelyaron(dot)com>
+;; Keywords: prolog programming
+
+;; This file is NOT part of GNU Emacs.
+
+;;; Package-Version: 0.1.0
+;;; Package-Requires: ((emacs "28"))
+
+;;; Commentary:
+
+;;; Code:
+
+(defvar sweep-install-buffer-name "*Install sweep*"
+  "Name of the buffer used for compiling sweep-module.")
+
+;;;###autoload
+(defun sweep-module-compile ()
+  "Compile sweep-module."
+  (interactive)
+  (let* ((sweep-directory
+          (shell-quote-argument
+           (file-name-directory (locate-library "sweep.el" t))))
+         (make-commands
+          (concat
+           "cd " sweep-directory "; make; cd -"))
+         (buffer (get-buffer-create sweep-install-buffer-name)))
+    (pop-to-buffer buffer)
+    (compilation-mode)
+    (if (zerop (let ((inhibit-read-only t))
+                 (call-process "sh" nil buffer t "-c" make-commands)))
+        (message "Compilation of `sweep' module succeeded")
+      (error "Compilation of `sweep' module failed!"))))
+
+(unless (require 'sweep-module nil t)
+  (if (y-or-n-p "Sweep needs `sweep-module' to work.  Compile it now? ")
+      (progn
+        (sweep-module-compile)
+        (require 'sweep-module))
+    (error "Sweep will not work until `sweep-module' is compiled!")))
+
+(declare-function sweep-initialize "sweep-module")
+(declare-function sweep-initialized-p "sweep-module")
+(declare-function sweep-open-query "sweep-module")
+(declare-function sweep-cut-query "sweep-module")
+(declare-function sweep-close-query "sweep-module")
+(declare-function sweep-cleanup "sweep-module")
+
+(defun sweep-predicates-collection ()
+  (sweep-open-query "user" "sweep" "sweep_predicates_collection" nil)
+  (let ((sol (sweep-next-solution)))
+    (sweep-close-query)
+    (when (eq '! (car sol))
+      (cdr sol))))
+
+(defun sweep-predicate-location (mfn)
+  (sweep-open-query "user" "sweep" "sweep_predicate_location" mfn)
+  (let ((sol (sweep-next-solution)))
+    (sweep-close-query)
+    (let ((car (car sol)))
+      (when (or (eq car '!)
+                (eq car t))
+        (cdr sol)))))
+
+(defun sweep-read-predicate ()
+  "Read a Prolog predicate (M:F/N) from the minibuffer, with completion."
+  (let* ((col (sweep-predicates-collection)))
+    (completing-read "Predicate: " col)))
+
+(defun sweep-find-predicate (mfn)
+  (interactive (list (sweep-read-predicate)))
+  (let* ((loc (sweep-predicate-location mfn))
+         (path (car loc))
+         (line (cdr loc)))
+    (find-file path)
+    (goto-char (point-min))
+    (forward-line (1- line))))
+
+(defun sweep-modules-collection ()
+  (sweep-open-query "user" "sweep" "sweep_modules_collection" nil)
+  (let ((sol (sweep-next-solution)))
+    (sweep-close-query)
+    (when (eq '! (car sol))
+      (cdr sol))))
+
+(defun sweep-module-path (mod)
+  (sweep-open-query "user" "sweep" "sweep_module_path" mod)
+  (let ((sol (sweep-next-solution)))
+    (sweep-close-query)
+    (when (eq '! (car sol))
+      (cdr sol))))
+
+(defun sweep-read-module-name ()
+  "Read a Prolog module name from the minibuffer, with completion."
+  (let* ((col (sweep-modules-collection))
+         (completion-extra-properties
+          (list :annotation-function
+                (lambda (key)
+                  (concat (make-string (- 32 (length key)) ? )
+                          (cdr (assoc-string key col)))))))
+    (completing-read "Module: " col)))
+
+(defun sweep-find-module (mod)
+  (interactive (list (sweep-read-module-name)))
+  (find-file (sweep-module-path mod)))
+
+;; (add-to-list 'load-path (expand-file-name  "~/checkouts/sweep/"))
+
+;; (require 'sweep)
+
+;; (sweep-initialized-p)
+;; (sweep-initialize (executable-find "swipl") "-q" (expand-file-name 
"sweep.pl" (file-name-directory (locate-library "sweep.el" t))))
+
+
+(provide 'sweep)
+;;; sweep.el ends here
diff --git a/sweep.h b/sweep.h
new file mode 100644
index 0000000000..4566ad2439
--- /dev/null
+++ b/sweep.h
@@ -0,0 +1,15 @@
+#ifndef _SWEEP_H
+#define _SWEEP_H
+
+#include <emacs-module.h>
+#include <SWI-Prolog.h>
+#include <SWI-Stream.h>
+
+static int value_to_term(emacs_env*, emacs_value, term_t);
+static emacs_value term_to_value(emacs_env*, term_t);
+static char *      estring_to_cstring(emacs_env*, emacs_value, ptrdiff_t*);
+static int         estring_to_atom(emacs_env*, emacs_value, term_t);
+static IOSTREAM *  estring_to_stream(emacs_env*, emacs_value);
+static void        ethrow(emacs_env*, const char*);
+
+#endif /*_SWEEP_H*/
diff --git a/sweep.pl b/sweep.pl
new file mode 100644
index 0000000000..3ecbd0fdaf
--- /dev/null
+++ b/sweep.pl
@@ -0,0 +1,197 @@
+:- module(sweep, [ sweep_colors/2,
+                   sweep_documentation/2,
+                   sweep_predicate_location/2,
+                   sweep_predicates_collection/2,
+                   sweep_modules_collection/2,
+                   sweep_module_path/2]).
+
+:- use_module(library(pldoc)).
+:- use_module(library(listing)).
+:- use_module(library(prolog_source)).
+:- use_module(library(prolog_colour)).
+:- use_module(library(pldoc/doc_process)).
+:- use_module(library(pldoc/doc_wiki)).
+:- use_module(library(pldoc/doc_modes)).
+:- use_module(library(pldoc/doc_man)).
+:- use_module(library(lynx/html_text)).
+
+:- dynamic sweep_current_color/3,
+           sweep_open/2,
+           sweep_source_time/2,
+           sweep_current_comment/3.
+
+:- multifile prolog:xref_source_time/2,
+             prolog:xref_open_source/2,
+             prolog:xref_open_source/2,
+             prolog:quasi_quotation_syntax/2.
+
+prolog:quasi_quotation_syntax(graphql, library(http/graphql)).
+
+prolog:xref_source_time(Source, Time) :-
+    sweep_source_time(Source, Time).
+
+prolog:xref_open_source(Source, Stream) :-
+    sweep_open(Source, Stream).
+
+prolog:xref_close_source(Source, Stream) :-
+    sweep_open(Source, Stream).
+
+sweep_colors([Path, String], Colors) :-
+    setup_call_cleanup(( new_memory_file(H),
+                         insert_memory_file(H, 0, String),
+                         open_memory_file(H, read, Contents)
+                       ),
+                       sweep_colors(Path, Contents, Colors),
+                       ( close(Contents),
+                         free_memory_file(H)
+                       )).
+sweep_colors(Path, Contents, Colors) :-
+    set_stream(Contents, encoding(utf8)),
+    set_stream(Contents, file_name(Path)),
+    get_time(Time),
+    asserta(sweep_open(Path, Contents), Ref0),
+    asserta(sweep_source_time(Path, Time), Ref1),
+    xref_source(Path, []),
+    retractall(sweep_current_color(_, _, _)),
+    retractall(sweep_current_comment(_, _, _)),
+    seek(Contents, 0, bof, _),
+    prolog_colourise_stream(Contents,
+                            Path,
+                            sweep_server_handle_color),
+    erase(Ref0),
+    erase(Ref1),
+    findall([B,L,T],
+            sweep_current_color(B, L, T),
+            Colors,
+            Comments),
+    findall([B,L,T],
+            sweep_current_comment(B, L, T),
+            Comments).
+
+sweep_server_handle_color(comment(C), B0, L) =>
+    B is B0 + 1,
+    assertz(sweep_current_comment(B, L, C)).
+sweep_server_handle_color(syntax_error(D, EB-EE), _B, _L) =>
+    EL is EE-EB,
+    assertz(sweep_current_color(EB,
+                                  EL,
+                                  syntax_error(D, EB-EE))).
+sweep_server_handle_color(head_term(meta, Head), B0, L) =>
+    B is B0 + 1,
+    assertz(sweep_current_color(B, L, head_term(meta, Head))).
+sweep_server_handle_color(head_term(Kind, Head), B0, L) =>
+    B is B0+1,
+    pi_head(PI, Head),
+    assertz(sweep_current_color(B,
+                                L,
+                                head_term(Kind, PI))).
+sweep_server_handle_color(head(Kind, Head), B0, L) =>
+    B is B0+1,
+    pi_head(PI, Head),
+    assertz(sweep_current_color(B, L, head(Kind, PI))).
+sweep_server_handle_color(goal(Kind, Head), B0, L) =>
+    B is B0+1,
+    pi_head(PI, Head),
+    assertz(sweep_current_color(B, L, goal(Kind, PI))).
+sweep_server_handle_color(goal_term(meta, Goal), B0, L) =>
+    B is B0 + 1,
+    assertz(sweep_current_color(B, L, goal_term(meta, Goal))).
+sweep_server_handle_color(goal_term(Kind, Goal), B0, L) =>
+    B is B0 + 1,
+    pi_head(PI, Goal),
+    assertz(sweep_current_color(B, L, goal_term(Kind, PI))).
+sweep_server_handle_color(T, B0, L) =>
+    B is B0 + 1,
+    assertz(sweep_current_color(B, L, T)).
+
+sweep_documentation([Path, Functor, Arity], Docs) :-
+    atom_string(P, Path),
+    atom_string(F, Functor),
+    PI = F/Arity,
+    pi_head(PI, Head),
+    (   module_property(M, file(P)),
+        \+ predicate_property(M:Head, imported_from(_))
+    ->  true
+    ;   module_property(M0, file(P)),
+        predicate_property(M0:Head, imported_from(M))
+    ->  true
+    ;   M=user
+    ),
+    findall(Doc, sweep_documentation_(M, PI, Doc), Docs).
+
+sweep_documentation_(M, PI, Docs) :-
+   doc_comment(M:PI, Pos, OneLiner, Comment),
+   is_structured_comment(Comment, Prefixes),
+   string_codes(Comment, Codes),
+   indented_lines(Codes, Prefixes, Lines),
+   pldoc_modes:mode_lines(Lines, ModeText, [], _),
+   pldoc_modes:modes(ModeText, M, Pos, Modes),
+   sweep_documentation_modes(Modes, OneLiner, Docs).
+sweep_documentation_(_, PI, Docs) :-
+    pldoc_man:load_man_object(PI, _, _, Dom),
+    with_output_to(string(DomS), html_text(Dom, [])),
+    sub_string(DomS, EOL, _, _, '\n'),
+    sub_string(DomS, 0, EOL, _, FLine),
+    sub_string(DomS, EOL, _, 0, Rest),
+    (   sub_string(Rest, EOS, _, _, '. ')
+    ->  sub_string(Rest, 0, EOS, _, OneLiner2)
+    ;   OneLiner2=Rest
+    ),
+    format(string(Docs), '~w.    ~w.~n', [FLine, OneLiner2]),
+    !.
+
+sweep_documentation_modes([mode(Mode0, Args)|_], OneLiner, Docs) :-
+    maplist([Name=Var]>>(Var='$VAR'(Name)), Args),
+    (   Mode0=(Mode1 is Det)
+    ->  true
+    ;   Mode1=Mode0,
+        Det=unspec
+    ),
+    format(string(Docs),
+           '~W is ~w.~n    ~w~n',
+           [ Mode1,
+             [module(pldoc_modes), numbervars(true)],
+             Det,
+             OneLiner
+           ]).
+sweep_documentation_modes([_|T], OneLiner, Docs) :-
+    sweep_documentation_modes(T, OneLiner, Docs).
+
+
+sweep_module_path(ModuleName, Path) :-
+    atom_string(Module, ModuleName),
+    sweep_module_path_(Module, Path0),
+    atom_string(Path0, Path).
+
+sweep_module_path_(Module, Path) :-
+    module_property(Module, file(Path)), !.
+sweep_module_path_(Module, Path) :-
+    '$autoload':library_index(_, Module, Path), !.
+
+sweep_modules_collection([], Modules) :-
+    findall([M|P], ( module_property(M0, file(P0)), atom_string(M0, M), 
atom_string(P0, P) ), Modules0, Tail),
+    setof([M|P], M0^P0^N^('$autoload':library_index(N, M0, P0), 
atom_string(M0, M), atom_string(P0, P) ), Tail),
+    list_to_set(Modules0, Modules).
+
+sweep_predicate_location(MFN, [Path|Line]) :-
+    term_string(M:F/N, MFN),
+    pi_head(F/N, H),
+    predicate_property(M:H, line_count(Line)),
+    predicate_property(M:H, file(Path0)), atom_string(Path0, Path).
+
+sweep_predicates_collection([], Preds) :-
+    findall(Pred,
+            ( current_predicate(M0:P0/N),
+              pi_head(P0/N, H),
+              \+ (predicate_property(M0:H, imported_from(M)), M \= M0),
+              format(string(Pred), '~w:~w/~w', [M0, P0, N])
+            ),
+            Preds0,
+            Tail),
+    findall(Pred,
+            ( '$autoload':library_index(F, M0, _),
+              pi_head(P0/N, F),
+              format(string(Pred), '~w:~w/~w', [M0, P0, N])
+            ),
+            Tail),
+    list_to_set(Preds0, Preds).