From 329c6975c44fcbe1cf7c9d93ab6164495f432213 Mon Sep 17 00:00:00 2001
From: Peter Mikkelsen <peter@pmikkelsen.com>
Date: Thu, 1 Jul 2021 00:52:41 +0000
Subject: Start implementation of is/2

---
 builtins.c | 51 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 51 insertions(+)

(limited to 'builtins.c')

diff --git a/builtins.c b/builtins.c
index a3a7d8c..4a2161f 100644
--- a/builtins.c
+++ b/builtins.c
@@ -23,6 +23,7 @@ BuiltinProto(builtincompare);
 BuiltinProto(builtinfunctor);
 BuiltinProto(builtinarg);
 BuiltinProto(builtinuniv);
+BuiltinProto(builtinis);
 
 int compareterms(Term *, Term *);
 
@@ -78,6 +79,8 @@ findbuiltin(Term *goal)
 		return builtinarg;
 	if(Match(L"=..", 2))
 		return builtinuniv;
+	if(Match(L"is", 2))
+		return builtinis;
 
 	return nil;
 }
@@ -433,4 +436,52 @@ builtinuniv(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack,
 		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
-- 
cgit v1.2.3