shithub: pprolog

--- a/builtins.c

+++ b/builtins.c

@@ -6,6 +6,15 @@

 #define BuiltinProto(name) int name(Term *, Term *, Goal **, Choicepoint **, Binding **)

 #define Match(X, Y) (runestrcmp(name, X) == 0 && arity == Y)

+#define Throw(What) do{\

+	Term *t = mkcompound(L"throw", 1, What); \

+	Goal *g = malloc(sizeof(Goal)); \

+	g->goal = t; \

+	g->catcher = nil; \

+	g->next = *goals; \

+	*goals = g; \

+	return 1; \

+}while(0)

 BuiltinProto(builtinfail);

 BuiltinProto(builtincall);

@@ -18,7 +27,6 @@

 BuiltinProto(builtincompound);

 BuiltinProto(builtinnonvar);

 BuiltinProto(builtinnumber);

-BuiltinProto(builtinstring);

 BuiltinProto(builtincompare);

 BuiltinProto(builtinfunctor);

 BuiltinProto(builtinarg);

@@ -28,6 +36,15 @@

 BuiltinProto(builtinthrow);

 int compareterms(Term *, Term *);

+Term *instantiationerror(void);

+Term *typeerror(Rune *, Term *);

+Term *domainerror(Rune *, Term *);

+Term *existenceerror(Rune *, Term *);

+Term *permissionerror(Rune *, Rune *, Term *);

+Term *representationerror(Rune *);

+Term *evaluationerror(Rune *);

+Term *resourceerror(Rune *);

+Term *syntaxerror(Rune *);

 Builtin

 findbuiltin(Term *goal)

@@ -71,8 +88,6 @@

 		return builtinnonvar;

 	if(Match(L"number", 1))

 		return builtinnumber;

-	if(Match(L"string", 1))

-		return builtinstring;

 	if(Match(L"compare", 3))

 		return builtincompare;

 	if(Match(L"functor", 3))

@@ -224,17 +239,6 @@

 	return (arg->tag == NumberTerm);

-int

-builtinstring(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)

-{

-	USED(database);

-	USED(goals);

-	USED(choicestack);

-	USED(bindings);

-	Term *arg = goal->children;

-	return (arg->tag == StringTerm);

-}

 #define Compare(A, B) ((A < B) ? -1 : ((A > B) ? 1 : 0))

int

@@ -262,7 +266,6 @@

 			}else

 				result = Compare(t1->numbertype, t2->numbertype);

 			break;

-		case StringTerm:

 		case AtomTerm:

 			result = runestrcmp(t1->text, t2->text);

 			break;

@@ -364,8 +367,10 @@

 	Term *term = n->next;

 	Term *arg = term->next;

-	if(n->tag != NumberTerm || n->numbertype != NumberInt || n->ival < 0)

+	if(n->tag != NumberTerm || n->numbertype != NumberInt)

 		return 0;

+	if(n->ival < 0)

+		Throw(domainerror(L"not_less_than_zero", n));

 	if(term->tag != CompoundTerm)

 		return 0;

 	if(n->ival >= term->arity)

@@ -377,18 +382,6 @@

 	return unify(arg, t, bindings);

-Term *

-mklist(Term *elems)

-{

-	if(elems == nil)

-		return mkatom(L"[]");

-	else{

-		Term *t = copyterm(elems, nil);

-		t->next = mklist(elems->next);

-		return mkcompound(L".", 2, t);

-	}

-}

int

 listlength(Term *term)

@@ -559,4 +552,35 @@

 	return 0;

-}

\ No newline at end of file

+}

+/* Helpers to create error terms */

+Term *

+instantiationerror(void)

+{

+	return mkatom(L"instantiation_error");

+}

+Term *

+typeerror(Rune *validtype, Term *culprit)

+{

+	Term *valid = mkatom(validtype);

+	valid->next = copyterm(culprit, nil);

+	return mkcompound(L"type_error", 2, valid);

+}

+Term *

+domainerror(Rune *validdomain, Term *culprit)

+{

+	Term *valid = mkatom(validdomain);

+	valid->next = copyterm(culprit, nil);

+	return mkcompound(L"domain_error", 2, valid);

+}

+Term *existenceerror(Rune *, Term *);

+Term *permissionerror(Rune *, Rune *, Term *);

+Term *representationerror(Rune *);

+Term *evaluationerror(Rune *);

+Term *resourceerror(Rune *);

+Term *syntaxerror(Rune *);

\ No newline at end of file

--- a/dat.h

+++ b/dat.h

@@ -45,7 +45,6 @@

 enum {

 	VariableTerm,

 	NumberTerm,

-	StringTerm,

 	AtomTerm,

 	CompoundTerm,

};

@@ -56,4 +55,14 @@

};

 int debug;

-Term *initgoals;

\ No newline at end of file

+Term *initgoals;

+/* Flags */

+enum {

+	DoubleQuotesChars,

+	DoubleQuotesCodes,

+	DoubleQuotesAtom,

+};

+int flagdoublequotes;

--- a/eval.c

+++ b/eval.c

@@ -226,8 +226,6 @@

 	switch(a->tag){

 	case AtomTerm:

-	case StringTerm:

-		return !runestrcmp(a->text, b->text);

 	case VariableTerm:

 		return (runestrcmp(a->text, b->text) == 0 && a->clausenr == b->clausenr);

 	case NumberTerm:

--- /dev/null

+++ b/flags.c

@@ -1,0 +1,11 @@

+#include <u.h>

+#include <libc.h>

+#include "dat.h"

+#include "fns.h"

+void

+initflags(void)

+{

+	flagdoublequotes = DoubleQuotesChars;

+}

\ No newline at end of file

--- a/fns.h

+++ b/fns.h

@@ -13,6 +13,7 @@

 Term *mkcompound(Rune *, int, Term *);

 Term *mknumber(int, vlong, double);

 Term *mkstring(Rune *);

+Term *mklist(Term *);

 /* eval.c */

 int evalquery(Term *, Term *, Binding **, Choicepoint **);

@@ -24,3 +25,6 @@

 /* builtins.c */

 Builtin findbuiltin(Term *);

+/* flags.c */

+void initflags(void);

--- a/main.c

+++ b/main.c

@@ -25,11 +25,14 @@

 	if(argc != 0)

 		usage();

+	initflags();

 	int fd = open("./stdlib.pl", OREAD);

 	if(fd < 0){

 		print("Can't open ./stdlib.pl\n");

 		exits("open");

 	Term *database = parse(fd, 0);

 	close(fd);

--- a/misc.c

+++ b/misc.c

@@ -94,7 +94,40 @@

 Term *

 mkstring(Rune *text)

-	Term *t = mkterm(StringTerm);

-	t->text = text;

+	Term *t = nil;

+	Rune *r;

+	switch(flagdoublequotes){

+	case DoubleQuotesChars:

+		for(r = text; *r != '\0'; r++){

+			Rune *chtext = runesmprint("%C", *r);

+			Term *ch = mkatom(chtext);

+			t = appendterm(t, ch);

+		}

+		t = mklist(t);

+		break;

+	case DoubleQuotesCodes:

+		for(r = text; *r != '\0'; r++){

+			Term *code = mknumber(NumberInt, *r, 0);

+			t = appendterm(t, code);

+		}

+		t = mklist(t);

+		break;

+		break;

+	case DoubleQuotesAtom:

+		t = mkatom(text);

+	}

 	return t;

+}

+Term *

+mklist(Term *elems)

+{

+	if(elems == nil)

+		return mkatom(L"[]");

+	else{

+		Term *t = copyterm(elems, nil);

+		t->next = mklist(elems->next);

+		return mkcompound(L".", 2, t);

+	}

--- a/mkfile

+++ b/mkfile

@@ -2,7 +2,15 @@

 TARG=pprolog

-OFILES=main.$O parser.$O eval.$O builtins.$O prettyprint.$O misc.$O repl.$O

+OFILES=\

+	main.$O\

+	parser.$O\

+	eval.$O\

+	builtins.$O\

+	prettyprint.$O\

+	misc.$O\

+	repl.$O\

+	flags.$O

 HFILES=dat.h fns.h

--- a/prettyprint.c

+++ b/prettyprint.c

@@ -36,9 +36,6 @@

 		else

 			result = runesmprint("%f", t->dval);

 		break;

-	case StringTerm:

-		result = runesmprint("\"%S\"", t->text);

-		break;

 	default:

 		result = runesmprint("cant print term with tag %d", t->tag);

 		break;