Add comparison predicates

1 files changed, 84 insertions, 0 deletions

diff --git a/builtins.c b/builtins.c
index f66cd5e..6cba6d8 100644
--- a/builtins.c
+++ b/builtins.c
@@ -19,6 +19,9 @@ BuiltinProto(builtincompound);
 BuiltinProto(builtinnonvar);
 BuiltinProto(builtinnumber);
 BuiltinProto(builtinstring);
+BuiltinProto(builtincompare);
+
+int compareterms(Term *, Term *);
 
 Builtin
 findbuiltin(Term *goal)
@@ -64,6 +67,8 @@ findbuiltin(Term *goal)
 		return builtinnumber;
 	if(Match(L"string", 1))
 		return builtinstring;
+	if(Match(L"compare", 3))
+		return builtincompare;
 
 	return nil;
 }
@@ -209,4 +214,83 @@ builtinstring(Term *database, Term *goal, Goal **goals, Choicepoint **choicestac
 	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