From baea4aa939861fd4efbc71b96f93ba890f01ac40 Mon Sep 17 00:00:00 2001
From: Peter Mikkelsen <peter@pmikkelsen.com>
Date: Wed, 30 Jun 2021 17:48:49 +0000
Subject: Add a standard library with the "builtins" that doesn't really need
 to be actual builtins

---
 builtins.c | 20 +++++---------------
 eval.c     |  3 +++
 main.c     | 17 +++++++++++++----
 parser.c   | 13 +++++++------
 stdlib.pl  | 30 ++++++++++++++++++++++++++++++
 5 files changed, 58 insertions(+), 25 deletions(-)
 create mode 100644 stdlib.pl

diff --git a/builtins.c b/builtins.c
index 5db5e62..b6031fe 100644
--- 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 @@ findbuiltin(Term *goal)
 		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)
@@ -40,17 +37,6 @@ findbuiltin(Term *goal)
 	return nil;
 }
 
-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)
 {
@@ -85,7 +71,11 @@ builtincut(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack,
 	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;
diff --git a/eval.c b/eval.c
index cf26fdf..3a6ab38 100644
--- a/eval.c
+++ b/eval.c
@@ -48,6 +48,9 @@ evalquery(Term *database, Term *query, Binding **resultbindings)
 Retry:
 		goal = goals->goal;
 
+		if(debug)
+			print("Working goal: %S\n", prettyprint(goal));
+
 		Binding *bindings = nil;
 		Term *clause = nil;
 
diff --git a/main.c b/main.c
index 416e832..c30e5f7 100644
--- a/main.c
+++ b/main.c
@@ -25,21 +25,30 @@ main(int argc, char *argv[])
 	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);
 }
 
diff --git a/parser.c b/parser.c
index 1e4dc41..e1a7de8 100644
--- a/parser.c
+++ b/parser.c
@@ -292,9 +292,9 @@ parseoperators(Term *list)
 			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 @@ parseoperators(Term *list)
 				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 @@ getoperator(Rune *spelling)
 			}
 		}
 	}
+
 	return op;
 }
 
@@ -442,7 +443,6 @@ nexttoken(void)
 	if(peek == L'%'){
 		while(peek != L'\n')
 			peek = Bgetrune(parsein);
-		Bgetrune(parsein);
 		peek = Bgetrune(parsein);
 	}
 
@@ -595,7 +595,7 @@ Integer:
 	}
 
 	/* 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 @@ Integer:
 		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;
 	}
diff --git a/stdlib.pl b/stdlib.pl
new file mode 100644
index 0000000..c53cf78
--- /dev/null
+++ b/stdlib.pl
@@ -0,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.
-- 
cgit v1.2.3