shithub: pprolog

Info  •  Files  •  Log

Add comparison predicates

--- a/builtins.c

+++ b/builtins.c

@@ -19,7 +19,10 @@

 BuiltinProto(builtinnonvar);

 BuiltinProto(builtinnumber);

 BuiltinProto(builtinstring);

+BuiltinProto(builtincompare);

+int compareterms(Term *, Term *);

+

 Builtin

 findbuiltin(Term *goal)

 {

@@ -64,6 +67,8 @@

 		return builtinnumber;

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

 		return builtinstring;

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

+		return builtincompare;

 	return nil;

 }

@@ -209,4 +214,83 @@

 	USED(bindings);

 	Term *arg = goal->children;

 	return (arg->tag == StringTerm);

+}

+

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

+

+int

+compareterms(Term *t1, Term *t2)

+{

+	int result = 0;

+

+	if(t1->tag != t2->tag)

+		result = Compare(t1->tag, t2->tag);

+	else{

+		/* Same type term */

+		switch(t1->tag){

+		case VariableTerm:

+			if(t1->clausenr == t2->clausenr)

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

+			else

+				result = Compare(t1->clausenr, t2->clausenr);

+			break;

+		case NumberTerm:

+			if(t1->numbertype == t2->numbertype){

+				if(t1->numbertype == NumberInt)

+					result = Compare(t1->ival, t2->ival);

+				else

+					result = Compare(t1->dval, t2->dval);

+			}else

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

+			break;

+		case StringTerm:

+		case AtomTerm:

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

+			break;

+		case CompoundTerm:

+			result = Compare(t1->arity, t2->arity);

+			if(result != 0)

+				break;

+

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

+			if(result != 0)

+				break;

+

+			t1 = t1->children;

+			t2 = t2->children;

+			while(t1 != nil && t2 != nil){

+				result = compareterms(t1, t2);

+				if(result != 0)

+					break;

+				else

+					t1 = t1->next;

+					t2 = t2->next;

+			}

+			break;

+		}

+	}

+	return result;

+}

+

+int

+builtincompare(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)

+{

+	USED(database);

+	USED(goals);

+	USED(choicestack);

+	Term *order = goal->children;

+	Term *t1 = order->next;

+	Term *t2 = t1->next;

+

+	int result = compareterms(t1, t2);

+

+	Term *resultorder;

+	if(result == -1)

+		resultorder = mkatom(L"<");

+	else if(result == 0)

+		resultorder = mkatom(L"=");

+	else

+		resultorder = mkatom(L">");

+

+	return unify(order, resultorder, bindings);

 }

\ No newline at end of file

--- a/dat.h

+++ b/dat.h

@@ -40,17 +40,18 @@

 	Choicepoint *next;

 };

+/* Sorted so that a lower value means it comes earlier in the standard ordering */

 enum {

-	CompoundTerm,

-	AtomTerm,

 	VariableTerm,

 	NumberTerm,

 	StringTerm,

+	AtomTerm,

+	CompoundTerm,

 };

 enum {

-	NumberInt,

 	NumberFloat,

+	NumberInt,

 };

 int debug;

--- a/eval.c

+++ b/eval.c

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

 Goal *addgoals(Goal *, Term *);

 Term *findclause(Term *, Term *, Binding **);

-int unify(Term *, Term *, Binding **);

 int equalterms(Term *, Term *);

 void applybinding(Term *, Binding *);

 Goal *copygoals(Goal *);

@@ -77,6 +76,7 @@

 Backtrack:

 				if(choicestack == nil)

 					return 0;

+				print("Backtracking..\n");

 				Choicepoint *cp = choicestack;

 				choicestack = cp->next;

 				/* freegoals(goals) */

--- a/fns.h

+++ b/fns.h

@@ -16,6 +16,7 @@

 /* eval.c */

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

+int unify(Term *, Term *, Binding **);

 /* repl.c */

 void repl(Term *);

--- a/parser.c

+++ b/parser.c

@@ -264,7 +264,7 @@

 	for(i = 0, t = list; i < length; i++){

 		Operator *op = getoperator(t->text);

-		if(op && t->tag == AtomTok){

+		if(op && t->tag == AtomTerm){

 			infos[i].type = op->type;

 			infos[i].level = op->level;

 		}else{

@@ -292,7 +292,10 @@

 		}

 		if(index == -1){

-			print("Can't parse, list contains no operators");

+			print("Can't parse, list of length %d contains no operators: ", length);

+			for(i = 0; i < length; i++)

+				print("%S(%d) ", prettyprint(terms[i]), infos[i].level);

+			print("\n");

 			syntaxerror("parseoperators");

 		}

@@ -439,6 +442,7 @@

 		replaypeek = -1;

 	}

+SkipWhite:

 	/* Skip whitespace */

 	while(isspacerune(peek))

 		peek = Bgetrune(parsein);

@@ -447,7 +451,7 @@

 	if(peek == L'%'){

 		while(peek != L'\n')

 			peek = Bgetrune(parsein);

-		peek = Bgetrune(parsein);

+		goto SkipWhite;

 	}

 	/* Variables */

--- a/stdlib.pl

+++ b/stdlib.pl

@@ -28,3 +28,27 @@

 A \= B :- 

 	\+ A = B.

+

+% Comparison of terms using the standard order

+

+A == B :-

+	compare(=, A, B).

+

+A \== B :-

+	\+ A == B.

+

+A @< B :-

+	compare(<, A, B).

+

+A @=< B :-

+	A == B.

+A @=< B :-

+	A @< B.

+

+A @> B :-

+	compare(>, A, B).

+

+A @>= B :-

+	A == B.

+A @>= B :-

+	A @> B.