shithub: pprolog

Info  •  Files  •  Log

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);