shithub: pprolog

Download patch

ref: afbd56887b77e28f67373e1a3acae36e242fcf50
parent: ff418c798b580204f6fea5512adc36835f8b7efa
author: Peter Mikkelsen <peter@pmikkelsen.com>
date: Wed Jun 30 17:17:08 EDT 2021

Add functor/3

--- a/builtins.c
+++ b/builtins.c
@@ -20,6 +20,7 @@
 BuiltinProto(builtinnumber);
 BuiltinProto(builtinstring);
 BuiltinProto(builtincompare);
+BuiltinProto(builtinfunctor);
 
 int compareterms(Term *, Term *);
 
@@ -69,6 +70,8 @@
 		return builtinstring;
 	if(Match(L"compare", 3))
 		return builtincompare;
+	if(Match(L"functor", 3))
+		return builtinfunctor;
 
 	return nil;
 }
@@ -293,4 +296,43 @@
 		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;
+}
--- a/eval.c
+++ b/eval.c
@@ -150,7 +150,6 @@
 	Term *left;
 	Term *right;
 
-	*bindings = nil;
 	leftstack = copyterm(a, nil);
 	rightstack = copyterm(b, nil);