From ff418c798b580204f6fea5512adc36835f8b7efa Mon Sep 17 00:00:00 2001
From: Peter Mikkelsen <peter@pmikkelsen.com>
Date: Wed, 30 Jun 2021 20:51:02 +0000
Subject: Add comparison predicates

---
 builtins.c | 84 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 dat.h      |  7 +++---
 eval.c     |  2 +-
 fns.h      |  1 +
 parser.c   | 10 +++++---
 stdlib.pl  | 24 ++++++++++++++++++
 6 files changed, 121 insertions(+), 7 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
diff --git a/dat.h b/dat.h
index a090afb..2cf28b7 100644
--- a/dat.h
+++ b/dat.h
@@ -40,17 +40,18 @@ struct Choicepoint
 	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;
diff --git a/eval.c b/eval.c
index 3a6ab38..3477141 100644
--- 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 @@ Retry:
 Backtrack:
 				if(choicestack == nil)
 					return 0;
+				print("Backtracking..\n");
 				Choicepoint *cp = choicestack;
 				choicestack = cp->next;
 				/* freegoals(goals) */
diff --git a/fns.h b/fns.h
index 54db8dc..6d545e9 100644
--- a/fns.h
+++ b/fns.h
@@ -16,6 +16,7 @@ Term *mkstring(Rune *);
 
 /* eval.c */
 int evalquery(Term *, Term *, Binding **);
+int unify(Term *, Term *, Binding **);
 
 /* repl.c */
 void repl(Term *);
diff --git a/parser.c b/parser.c
index 577c338..d7f750a 100644
--- a/parser.c
+++ b/parser.c
@@ -264,7 +264,7 @@ parseoperators(Term *list)
 
 	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 @@ parseoperators(Term *list)
 		}
 
 		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 @@ nexttoken(void)
 		replaypeek = -1;
 	}
 
+SkipWhite:
 	/* Skip whitespace */
 	while(isspacerune(peek))
 		peek = Bgetrune(parsein);
@@ -447,7 +451,7 @@ nexttoken(void)
 	if(peek == L'%'){
 		while(peek != L'\n')
 			peek = Bgetrune(parsein);
-		peek = Bgetrune(parsein);
+		goto SkipWhite;
 	}
 
 	/* Variables */
diff --git a/stdlib.pl b/stdlib.pl
index c53cf78..b0f2160 100644
--- a/stdlib.pl
+++ b/stdlib.pl
@@ -28,3 +28,27 @@ A = A.
 
 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.
-- 
cgit v1.2.3