shithub: pprolog

Download patch

ref: 329c6975c44fcbe1cf7c9d93ab6164495f432213
parent: 2c166a1496c5638924d29df9dcf6c125a31ce18c
author: Peter Mikkelsen <[email protected]>
date: Wed Jun 30 20:52:41 EDT 2021 

Start implementation of is/2


--- a/TODO
+++ b/TODO
@@ -2,4 +2,7 @@
 * Stop copying the entire goal stack into every choicepoint
 * Stop creating choicepoints when it is not needed
 * How to implement builtins nicely?
-* Right now we copy and allocate a lot, but almost never free stuff.
\ No newline at end of file
+* Right now we copy and allocate a lot, but almost never free stuff.
+* Many builtins should really throw an error, but they just fail for now.
+* Exceptions (throw, catch)
+* Modules
--- a/builtins.c
+++ b/builtins.c
@@ -23,6 +23,7 @@
 BuiltinProto(builtinfunctor);
 BuiltinProto(builtinarg);
 BuiltinProto(builtinuniv);
+BuiltinProto(builtinis);
 
 int compareterms(Term *, Term *);
 
@@ -78,6 +79,8 @@
 		return builtinarg;
 	if(Match(L"=..", 2))
 		return builtinuniv;
+	if(Match(L"is", 2))
+		return builtinis;
 
 	return nil;
 }
@@ -433,4 +436,52 @@
 		Term *reallist = mkcompound(L".", 2, t);
 		return unify(list, reallist, bindings);
 	}
+}
+
+#define ToFloat(t) (t->numbertype == NumberInt ? (double)t->ival : t->dval)
+
+Term *
+aritheval(Term *expr)
+{
+	/* Not every arithmetic operation is defined right now. */
+
+	if(expr->tag == NumberTerm)
+		return expr;
+	else if(expr->tag == CompoundTerm && expr->arity == 2){
+		Term *A = aritheval(expr->children);
+		Term *B = aritheval(expr->children->next);
+		Term *result = mknumber(NumberInt, 0, 0);
+
+		if(A == nil || B == nil)
+			return nil;
+		if(runestrcmp(expr->text, L"+") == 0){
+			if(A->numbertype == NumberInt && B->numbertype == NumberInt){
+				result->numbertype = NumberInt;
+				result->ival = A->ival + B->ival;
+			}else{
+				result->numbertype = NumberFloat;
+				result->dval = ToFloat(A) + ToFloat(B);
+			}
+		}else
+			return nil;
+		return result;
+	}else
+		return nil;
+}
+
+int
+builtinis(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
+{
+	USED(database);
+	USED(goals);
+	USED(choicestack);
+	Term *result = goal->children;
+	Term *expr = result->next;
+
+	
+	Term *realresult = aritheval(expr);
+	if(realresult)
+		return unify(result, realresult, bindings);
+	else
+		return 0;
 }
\ No newline at end of file
--- a/stdlib.pl
+++ b/stdlib.pl
@@ -61,7 +61,7 @@
 length([], 0).
 length([_|Tail], Length) :-
 	length(Tail, Length0),
-	Length is Length + 1.
+	Length is Length0 + 1.
 
 member(X, [X|_]).
 member(X, [_|Tail]) :-