shithub: pprolog

Info  •  Files  •  Log  •  Branches

Add a standard library with the "builtins" that doesn't really need to be actual builtins

--- a/builtins.c

+++ b/builtins.c

@@ -4,7 +4,6 @@

 #include "dat.h"

 #include "fns.h"

-int builtintrue(Term *, Term *, Goal **, Choicepoint **, Binding **);

 int builtinfail(Term *, Term *, Goal **, Choicepoint **, Binding **);

 int builtincall(Term *, Term *, Goal **, Choicepoint **, Binding **);

 int builtincut(Term *, Term *, Goal **, Choicepoint **, Binding **);

@@ -28,8 +27,6 @@

 		return nil;

 	}

-	if(!runestrcmp(name, L"true") && arity == 0)

-		return builtintrue;

 	if(!runestrcmp(name, L"fail") && arity == 0)

 		return builtinfail;

 	if(!runestrcmp(name, L"call") && arity == 1)

@@ -41,17 +38,6 @@

 }

 int

-builtintrue(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)

-{

-	USED(database);

-	USED(goal);

-	USED(goals);

-	USED(choicestack);

-	USED(bindings);

-	return 1;

-}

-

-int

 builtinfail(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)

 {

 	USED(database);

@@ -85,7 +71,11 @@

 	USED(bindings);

 	Choicepoint *cp = *choicestack;

-	while(cp != nil && cp->id == goal->clausenr)

+

+	/* Cut all choicepoints with an id larger or equal to the goal clause number, since they must have been introduced

+	   after this goal's parent.

+	*/

+	while(cp != nil && cp->id >= goal->clausenr)

 		cp = cp->next;

 	*choicestack = cp;

 	return 1;

--- a/eval.c

+++ b/eval.c

@@ -48,6 +48,9 @@

 Retry:

 		goal = goals->goal;

+		if(debug)

+			print("Working goal: %S\n", prettyprint(goal));

+

 		Binding *bindings = nil;

 		Term *clause = nil;

--- a/main.c

+++ b/main.c

@@ -25,20 +25,29 @@

 	if(argc != 0)

 		usage();

+	int fd = open("./stdlib.pl", OREAD);

+	if(fd < 0){

+		print("Can't open ./stdlib.pl\n");

+		exits("open");

+	}

+	Term *database = parse(fd, 0);

+	close(fd);

+

 	if(parsetestfile){

 		int fd = open(parsetestfile, OREAD);

 		if(fd < 0)

 			exits("open");

-		Term *database = parse(fd, 0);

-	

+		Term *clauses = parse(fd, 0);

+		database = appendterm(database, clauses);

+

 		Term *goal;

 		for(goal = initgoals; goal != nil; goal = goal->next){

 			Binding *bindings = nil;

 			evalquery(database, goal, &bindings);

 		}

-

-		repl(database);

 	}

+

+	repl(database);

 	exits(nil);

 }

--- a/parser.c

+++ b/parser.c

@@ -292,9 +292,9 @@

 			syntaxerror("parseoperators");

 		}

-		int infixlevel = infos[index].level & (Xfx|Xfy|Yfx);

-		int prefixlevel = infos[index].level & (Fx|Fy);

-		int postfixlevel = infos[index].level & (Xf|Yf);

+		int infixlevel = infos[index].type & (Xfx|Xfy|Yfx);

+		int prefixlevel = infos[index].type & (Fx|Fy);

+		int postfixlevel = infos[index].type & (Xf|Yf);

 		if(infixlevel && index != 0 && index != length-1 && infos[index-1].type == 0 && infos[index-1].type == 0){

 			infos[index-1].type = 0;

@@ -328,7 +328,7 @@

 				terms[i] = terms[i+1];

 			}

 		}else{

-			print("Parse error when parsing operators\n");

+			print("Parse error when parsing operator %S (prefix=%d, postfix=%d, infix=%d level=%d)\n", prettyprint(terms[index]), prefixlevel, postfixlevel, infixlevel, infos[index].level);

 			syntaxerror("parseoperators");

 		}

 	}

@@ -413,6 +413,7 @@

 			}

 		}

 	}

+

 	return op;

 }

@@ -442,7 +443,6 @@

 	if(peek == L'%'){

 		while(peek != L'\n')

 			peek = Bgetrune(parsein);

-		Bgetrune(parsein);

 		peek = Bgetrune(parsein);

 	}

@@ -595,7 +595,7 @@

 	}

 	/* Other */

-	if(runestrchr(L",.()]}|!", peek)){

+	if(runestrchr(L",.()]}|!;", peek)){

 		switch(peek){

 		case L',': lookahead.tag = CommaTok; break;

 		case L'(': lookahead.tag = ParenLeftTok; break;

@@ -604,6 +604,7 @@

 		case L'}': lookahead.tag = CurlyBracketRightTok; break;

 		case L'|': lookahead.tag = PipeTok; break;

 		case L'!': lookahead.tag = AtomTok; lookahead.text = runestrdup(L"!"); break;

+		case L';': lookahead.tag = AtomTok; lookahead.text = runestrdup(L";"); break;

 		}

 		return;

 	}

--- /dev/null

+++ b/stdlib.pl

@@ -1,0 +1,30 @@

+% Logic and control predicates

+\+ Goal :- call(Goal), !, fail.

+\+ Goal.

+

+once(Goal) :-

+	call(Goal),

+	!.

+

+repeat :- true ; repeat.

+

+% Control structures. 

+true.

+

+If -> Then :-

+	If, !, Then.

+

+If -> Then ; _ :- 

+	If, !, Then.

+_ -> _ ; Else :-

+	!, Else.

+If ; _ :-

+	If.

+_ ; Else :-

+	Else.

+

+% Term unification

+A = A.

+

+A \= B :- 

+	\+ A = B.