From d110df7a1fed3f1d3ed85fc76b4490cc0958ebff Mon Sep 17 00:00:00 2001
From: "kr.angelov" <kr.angelov@gmail.com>
Date: Wed, 2 Apr 2014 10:03:19 +0000
Subject: [PATCH] initial binding to Prolog for the C runtime

---
 src/runtime/swipl/Makefile |  2 +
 src/runtime/swipl/pgf.pl   |  2 +
 src/runtime/swipl/swipgf.c | 82 ++++++++++++++++++++++++++++++++++++++
 3 files changed, 86 insertions(+)
 create mode 100644 src/runtime/swipl/Makefile
 create mode 100644 src/runtime/swipl/pgf.pl
 create mode 100644 src/runtime/swipl/swipgf.c

diff --git a/src/runtime/swipl/Makefile b/src/runtime/swipl/Makefile
new file mode 100644
index 000000000..929af540d
--- /dev/null
+++ b/src/runtime/swipl/Makefile
@@ -0,0 +1,2 @@
+all:
+	swipl-ld -cc-options,-std=c99 -lgu -lpgf -shared swipgf.c -o swipgf.so
diff --git a/src/runtime/swipl/pgf.pl b/src/runtime/swipl/pgf.pl
new file mode 100644
index 000000000..94b508365
--- /dev/null
+++ b/src/runtime/swipl/pgf.pl
@@ -0,0 +1,2 @@
+:- module(pgf, [ readPGF/2, language/3 ]).
+:- use_foreign_library(foreign('./swipgf.so')).
diff --git a/src/runtime/swipl/swipgf.c b/src/runtime/swipl/swipgf.c
new file mode 100644
index 000000000..39b683217
--- /dev/null
+++ b/src/runtime/swipl/swipgf.c
@@ -0,0 +1,82 @@
+#include <SWI-Prolog.h>
+#include <pgf/pgf.h>
+
+typedef struct {
+	GuPool* pool;
+	PgfPGF* pgf;
+} PlPGF;
+
+static PL_blob_t pgf_blob = {
+	PL_BLOB_MAGIC,
+	PL_BLOB_UNIQUE,
+	"PGF",
+	NULL,
+	NULL,
+	NULL,
+	NULL
+};
+
+static foreign_t
+pl_readPGF(term_t a1, term_t a2)
+{
+	char *fpath;
+
+	if (!PL_get_atom_chars(a1, &fpath) )
+		PL_fail;
+		
+	PlPGF pl_pgf;
+	pl_pgf.pool = gu_new_pool();
+
+	GuPool* tmp_pool = gu_local_pool();
+
+	// Create an exception frame that catches all errors.
+	GuExn* err = gu_new_exn(NULL, gu_kind(type), tmp_pool);
+
+	// Read the PGF grammar.
+	pl_pgf.pgf = pgf_read(fpath, pl_pgf.pool, err);
+	if (!gu_ok(err)) {
+		int res;
+		if (gu_exn_caught(err) == gu_type(GuErrno)) {
+			errno = *((GuErrno*) gu_exn_caught_data(err));
+			res = PL_existence_error("source_sink", a1);
+		} else {
+			res = PL_raise_exception(a1);
+		}
+		gu_pool_free(pl_pgf.pool);
+		gu_pool_free(tmp_pool);
+		return res;
+	}
+
+	gu_pool_free(tmp_pool);
+
+	if (!PL_unify_blob(a2, &pl_pgf, sizeof(pl_pgf), &pgf_blob)) {
+		gu_pool_free(pl_pgf.pool);
+		PL_fail;
+	}
+
+	PL_succeed;
+}
+
+static foreign_t
+pl_language(term_t a1, term_t a2, term_t a3, control_t handle)
+{
+	switch (PL_foreign_control(handle)) {
+	case PL_FIRST_CALL:
+        //ctxt = malloc(sizeof(struct context));
+        PL_retry_address(NULL/*ctxt*/);
+    case PL_REDO:
+        //ctxt = PL_foreign_context_address(handle);
+        PL_retry_address(NULL/*ctxt*/);
+    case PL_PRUNED:
+        //ctxt = PL_foreign_context_address(handle);
+        //free(ctxt);
+        PL_succeed;
+	}
+	PL_succeed;
+}
+
+install_t
+install_swipgf()
+{ PL_register_foreign("readPGF", 2, pl_readPGF, 0);
+  PL_register_foreign("language", 3, pl_language, PL_FA_NONDETERMINISTIC);
+}