shithub: pprolog

Download patch

ref: 2dce50fbd5ef72bbcd51533cf04f8722f8139d6a
parent: 3844776a21b3f2a1f028f76bdf06b3ff05b8fc0f
author: Peter Mikkelsen <peter@pmikkelsen.com>
date: Wed Jul 7 20:49:34 EDT 2021 

Add arithmetic comparison predicates


--- a/builtins.c
+++ b/builtins.c
@@ -46,6 +46,7 @@
 BuiltinProto(builtinsetoutput);
 BuiltinProto(builtinreadterm);
 BuiltinProto(builtinwriteterm);
+BuiltinProto(builtingeq);
 
 int compareterms(Term *, Term *);
 
@@ -127,6 +128,8 @@
 		return builtinreadterm;
 	if(Match(L"write_term", 3))
 		return builtinwriteterm;
+	if(Match(L">=", 2))
+		return builtingeq;
 
 	return nil;
 }
@@ -777,3 +780,32 @@
 	writeterm(stream, options, term);
 	return 1;
 }
+
+int
+builtingeq(Term *goal, Binding **bindings, Module *module)
+{
+	USED(bindings);
+	USED(module);
+	Term *a = goal->children;
+	Term *b = a->next;
+
+	int waserror;
+	Term *aval = aritheval(a, &waserror);
+	if(waserror)
+		Throw(aval);
+	
+	Term *bval = aritheval(b, &waserror);
+	if(waserror)
+		Throw(bval);
+
+	if(aval->tag == IntegerTerm && bval->tag == IntegerTerm)
+		return aval->ival >= bval->ival;
+	else if(aval->tag == FloatTerm && bval->tag == FloatTerm)
+		return aval->dval >= bval->dval;
+	else if(aval->tag == IntegerTerm && bval->tag == FloatTerm)
+		return aval->ival >= bval->dval;
+	else if(aval->tag == FloatTerm && bval->tag == IntegerTerm)
+		return aval->dval >= bval->ival;
+	else
+		return 0;
+}
\ No newline at end of file
--- a/parser.c
+++ b/parser.c
@@ -382,7 +382,7 @@
 	addoperator(700,  Xfx, L"@>=");
 	addoperator(700,  Xfx, L"is");
 	addoperator(700,  Xfx, L"=:=");
-	addoperator(700,  Xfx, L"=\=");
+	addoperator(700,  Xfx, L"=\\=");
 	addoperator(700,  Xfx, L"<");
 	addoperator(700,  Xfx, L"=<");
 	addoperator(700,  Xfx, L">");
--- a/stdlib.pl
+++ b/stdlib.pl
@@ -129,3 +129,24 @@
 write_canonical(S, Term) :-
 	write_term(S, Term, [quoted(true), ignore_ops(true)]).
 
+% Arithmetic comparisons defined in terms of >=. This is not the most effective way,
+% but it is fine for now.
+
+E1 =:= E2 :-
+	E1 >= E2,
+	E2 >= E1.
+
+E1 =\= E2 :-
+	\+ E1 =:= E2.
+
+E1 < E2 :-
+	E2 >= E1,
+	E1 =\= E2.
+
+E1 =< E2 :-
+	E2 >= E1.
+
+E1 > E2 :-
+	E2 < E1.
+
+