From afbd56887b77e28f67373e1a3acae36e242fcf50 Mon Sep 17 00:00:00 2001
From: Peter Mikkelsen <peter@pmikkelsen.com>
Date: Wed, 30 Jun 2021 21:17:08 +0000
Subject: Add functor/3

---
 builtins.c | 44 +++++++++++++++++++++++++++++++++++++++++++-
 eval.c     |  1 -
 2 files changed, 43 insertions(+), 2 deletions(-)

diff --git a/builtins.c b/builtins.c
index 6cba6d8..3008513 100644
--- a/builtins.c
+++ b/builtins.c
@@ -20,6 +20,7 @@ BuiltinProto(builtinnonvar);
 BuiltinProto(builtinnumber);
 BuiltinProto(builtinstring);
 BuiltinProto(builtincompare);
+BuiltinProto(builtinfunctor);
 
 int compareterms(Term *, Term *);
 
@@ -69,6 +70,8 @@ findbuiltin(Term *goal)
 		return builtinstring;
 	if(Match(L"compare", 3))
 		return builtincompare;
+	if(Match(L"functor", 3))
+		return builtinfunctor;
 
 	return nil;
 }
@@ -293,4 +296,43 @@ builtincompare(Term *database, Term *goal, Goal **goals, Choicepoint **choicesta
 		resultorder = mkatom(L">");
 
 	return unify(order, resultorder, bindings);
-}
\ No newline at end of file
+}
+
+int
+builtinfunctor(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
+{
+	USED(database);
+	USED(goals);
+	USED(choicestack);
+
+	Term *term = goal->children;
+	Term *name = term->next;
+	Term *arity = name->next;
+
+	if(term->tag == CompoundTerm){
+		Term *realname = mkatom(term->text);
+		Term *realarity = mknumber(NumberInt, term->arity, 0);
+		if(unify(name, realname, bindings) && unify(arity, realarity, bindings))
+			return 1;
+	}else if(arity->tag == NumberTerm && arity->numbertype == NumberInt &&
+			(name->tag == AtomTerm || name->tag == NumberTerm)){
+		if(arity->ival == 0)
+			return unify(term, name, bindings);
+		else{
+			if(name->tag != AtomTerm)
+				return 0;
+
+			/* Make arity maky fresh variables */
+			int i;
+			Term *args = nil;
+			for(i = 0; i < arity->ival; i++){
+				Rune *varname = runesmprint("FunctorVar%d", i);
+				Term *arg = mkvariable(varname);
+				args = appendterm(args, arg);
+			}
+			Term *realterm = mkcompound(name->text, arity->ival, args);
+			return unify(term, realterm, bindings);
+		}
+	}
+	return 0;
+}
diff --git a/eval.c b/eval.c
index 3477141..a3b1e87 100644
--- a/eval.c
+++ b/eval.c
@@ -150,7 +150,6 @@ unify(Term *a, Term *b, Binding **bindings)
 	Term *left;
 	Term *right;
 
-	*bindings = nil;
 	leftstack = copyterm(a, nil);
 	rightstack = copyterm(b, nil);
 
-- 
cgit v1.2.3