1 files changed, 141 insertions, 0 deletions
diff --git a/c/pl.cpp b/c/pl.cpp
new file mode 100644
index 0000000..dd69517
--- /dev/null
+++ b/c/pl.cpp
@@ -0,0 +1,141 @@
+#include <stdarg.h>
+#include <string.h>
+#include <SWI-Prolog.h>
+#include "defs.h"
+
+static int Plpv(term_t, const char *, va_list);
+static int Plgv(term_t, const char *, va_list);
+
+/* Call Prolog predicate once. */
+int
+Pl(const char *szMod, const char *szPred, const char *szFmt, ...)
+{
+	int iArity;
+	term_t t;
+	va_list vl, vl2;
+
+	iArity = strlen(szFmt);
+	t = PL_new_term_refs(iArity);
+
+	va_start(vl, szFmt);
+	va_copy(vl2, vl);
+
+	if (!Plpv(t, szFmt, vl)) goto f;
+	if (!PL_call_predicate(NULL, PL_Q_NORMAL,
+		PL_predicate(szPred, iArity, szMod), t))
+		goto f;
+	if (!Plgv(t, szFmt, vl2)) goto f;
+
+	va_end(vl);
+	va_end(vl2);
+	return 1;
+f:	va_end(vl);
+	va_end(vl2);
+	return 0;
+}
+
+/* Put known values in term. */
+int
+Plp(term_t t, const char *szFmt, ...)
+{
+	int r;
+	va_list vl;
+	va_start(vl, szFmt);
+	r = Plpv(t, szFmt, vl);
+	va_end(vl);
+	return r;
+}
+int
+Plpv(term_t t, const char *szFmt, va_list vl)
+{
+	int i;
+	for (i = 0; szFmt[i]; i++) {
+		switch (szFmt[i]) {
+		case 'I':
+		    {
+			int x;
+			x = va_arg(vl, int);
+			if (!PL_put_integer(t+i, x)) return 0;
+			break;
+		    }
+		case 'A':
+		    {
+			atom_t x;
+			x = va_arg(vl, atom_t);
+			if (!PL_put_atom(t+i, x)) return 0;
+			break;
+		    }
+		case 'S':
+		    {
+			atom_t a;
+			char *x;
+			x = va_arg(vl, char *);
+			a = PL_new_atom(x);
+			if (!PL_put_atom(t+i, a)) return 0;
+			break;
+		    }
+		case 'i':
+			va_arg(vl, int *);
+			break;
+		case 'a':
+			va_arg(vl, atom_t *);
+			break;
+		case 's':
+			va_arg(vl, char **);
+			break;
+		}
+	}
+	return 1;
+}
+
+/* Get unknown values from term. */
+int
+Plg(term_t t, const char *szFmt, ...)
+{
+	int r;
+	va_list vl;
+	va_start(vl, szFmt);
+	r = Plgv(t, szFmt, vl);
+	va_end(vl);
+	return r;
+}
+int
+Plgv(term_t t, const char *szFmt, va_list vl)
+{
+	int i;
+	for (i = 0; szFmt[i]; i++) {
+		switch (szFmt[i]) {
+		case 'i':
+		    {
+			int *lp;
+			lp = va_arg(vl, int *);
+			if (!PL_get_integer(t+i, lp)) return 0;
+			break;
+		    }
+		case 'a':
+		    {
+			atom_t *lp;
+			lp = va_arg(vl, atom_t *);
+			if (!PL_get_atom(t+i, lp)) return 0;
+			break;
+		    }
+		case 's':
+		    {
+			char **lp;
+			lp = va_arg(vl, char **);
+			if (!PL_get_atom_chars(t+i, lp)) return 0;
+			break;
+		    }
+		case 'I':
+			va_arg(vl, int);
+			break;
+		case 'A':
+			va_arg(vl, atom_t);
+			break;
+		case 'S':
+			va_arg(vl, char *);
+			break;
+		}
+	}
+	return 1;
+}