shithub: pprolog

Download patch

ref: 3e1e9621d1f19b221d59191ed55e78b171a5fe93
parent: 91f737e4effa109cb22bc1b2000f457fa1ad88db
author: Peter Mikkelsen <peter@pmikkelsen.com>
date: Wed Jul 7 11:42:52 EDT 2021 

Make functor/3 work according to spec


--- a/builtins.c
+++ b/builtins.c
@@ -317,30 +317,49 @@
 	Term *name = term->next;
 	Term *arity = name->next;
 
-	if(term->tag == CompoundTerm){
-		Term *realname = mkatom(term->text);
-		Term *realarity = mkinteger(term->arity);
-		if(unify(name, realname, bindings) && unify(arity, realarity, bindings))
-			return 1;
-	}else if(arity->tag == IntegerTerm &&
-			(name->tag == AtomTerm || name->tag == IntegerTerm || name->tag == FloatTerm)){
+	if(term->tag == VariableTerm && name->tag == VariableTerm)
+		Throw(instantiationerror());
+	if(term->tag == VariableTerm && arity->tag == VariableTerm)
+		Throw(instantiationerror());
+	if(term->tag == VariableTerm && !(name->tag == VariableTerm || name->tag == AtomTerm || name->tag == IntegerTerm || name->tag == FloatTerm))
+		Throw(typeerror(L"atomic", name));
+	if(term->tag == VariableTerm && !(arity->tag == VariableTerm || arity->tag == IntegerTerm))
+		Throw(typeerror(L"integer", arity));
+	if(term->tag == VariableTerm && name->tag != VariableTerm && name->tag != AtomTerm && arity->tag == IntegerTerm && arity->ival > 0)
+		Throw(typeerror(L"atom", name));
+	if(term->tag == VariableTerm && arity->tag == IntegerTerm && arity->ival < 0)
+		Throw(domainerror(L"not_less_than_zero", arity));
+
+
+	if(term->tag == VariableTerm){
 		if(arity->ival == 0)
 			return unify(term, name, bindings);
 		else{
-			if(name->tag != AtomTerm)
-				return 0;
-
-			/* Make arity maky fresh variables */
+			/* Make arity many fresh variables */
 			int i;
 			Term *args = nil;
 			for(i = 0; i < arity->ival; i++){
-				Rune *varname = runesmprint("FunctorVar%d", i);
-				Term *arg = mkvariable(varname);
+				Term *arg = mkvariable(L"_");
 				args = appendterm(args, arg);
 			}
 			Term *realterm = mkcompound(name->text, arity->ival, args);
 			return unify(term, realterm, bindings);
 		}
+	}else{
+		Rune *namestr;
+		int arityint;
+
+		if(term->tag == CompoundTerm){
+			namestr = term->text;
+			arityint = term->arity;
+		}else{
+			namestr = prettyprint(term, 0, 0, 0);
+			arityint = 0;
+		}
+		Term *realname = mkatom(namestr);
+		Term *realarity = mkinteger(arityint);
+		if(unify(name, realname, bindings) && unify(arity, realarity, bindings))
+			return 1;
 	}
 	return 0;
 }
--- a/parser.c
+++ b/parser.c
@@ -536,7 +536,7 @@
 				goto Integer;
 			}
 			while(isdigitrune(peek)){
-				numD += (peek - L'0') / (10 * place);
+				numD += (peek - L'0') / (double)(10 * place);
 				peek = Bgetrune(parsein);
 			}
 			Bungetrune(parsein);