Replace the C repl with one written in prolog :)

10 files changed, 145 insertions, 154 deletions

diff --git a/builtins.c b/builtins.c
index 369ac92..bde52fd 100644
--- a/builtins.c
+++ b/builtins.c
@@ -60,6 +60,8 @@ BuiltinProto(builtingetchar);
 BuiltinProto(builtinpeekchar);
 BuiltinProto(builtinputchar);
 BuiltinProto(builtincharcode);
+BuiltinProto(builtinchoicestacksize);
+BuiltinProto(builtincollectgarbage);
 
 int compareterms(Term *, Term *);
 
@@ -169,6 +171,10 @@ findbuiltin(Term *goal)
 		return builtinputchar;
 	if(Match(L"char_code", 2))
 		return builtincharcode;
+	if(Match(L"$choicestack_size", 1))
+		return builtinchoicestacksize;
+	if(Match(L"$collect_garbage", 0))
+		return builtincollectgarbage;
 
 	return nil;
 }
@@ -569,37 +575,30 @@ int
 builtinthrow(Term *goal, Binding **bindings, Module *module)
 {
 	USED(bindings);
+	USED(module);
 
 	Term *ball = goal->children;
 
-	print("Throwing: %S\n", prettyprint(ball, 0, 0, 0, module));
 	Goal *g;
 	for(g = goalstack; g != nil; g = g->next){
 		if(g->catcher == nil)
 			continue;
 
 		if(unify(g->catcher, ball, bindings)){
-			if(g->goal == nil){
-				/* As soon as we have print facilities as builtins, we can avoid this by having the protector frame have a unhandled exception handler*/
-				print("Unhandled exception: %S\n", prettyprint(ball, 0, 0, 0, module));
-				exits("exception");
-				return 0;
-			}else{
-				goalstack = g->next;
-				Goal *newgoal = gmalloc(sizeof(Goal));
-				newgoal->goal = copyterm(g->goal, nil);
-				newgoal->module = module;
-				newgoal->catcher = nil;
-				newgoal->next = goalstack;
-				goalstack = newgoal;
-				applybinding(newgoal->goal, *bindings);
-
-				Choicepoint *cp = choicestack;
-				while(cp != nil && cp->id >= goal->clausenr)
-					cp = cp->next;
-				choicestack = cp;
-				return 1;
-			}
+			goalstack = g->next;
+			Goal *newgoal = gmalloc(sizeof(Goal));
+			newgoal->goal = copyterm(g->goal, nil);
+			newgoal->module = g->module;
+			newgoal->catcher = nil;
+			newgoal->next = goalstack;
+			goalstack = newgoal;
+			applybinding(newgoal->goal, *bindings);
+
+			Choicepoint *cp = choicestack;
+			while(cp != nil && cp->id >= goal->clausenr)
+				cp = cp->next;
+			choicestack = cp;
+			return 1;
 		}
 	}
 	return 0;
@@ -1404,3 +1403,29 @@ builtincharcode(Term *goal, Binding **bindings, Module *module)
 	}
 }
 
+int
+builtinchoicestacksize(Term *goal, Binding **bindings, Module *module)
+{
+	USED(bindings);
+	USED(module);
+	Term *size = goal->children;
+	
+	vlong i = 0;
+	Choicepoint *cp;
+	for(cp = choicestack; cp != nil; cp = cp->next)
+		i++;
+	Term *realsize = mkinteger(i);
+	return unify(size, realsize, bindings);
+}
+
+int
+builtincollectgarbage(Term *goal, Binding **bindings, Module *module)
+{
+	USED(goal);
+	USED(bindings);
+	USED(module);
+	vlong amount = collectgarbage();
+	if(amount != 0 & debug)
+		print("Collected %lld bytes of garbage\n", amount);
+	return 1;
+}
\ No newline at end of file
diff --git a/dat.h b/dat.h
index b5f6f4f..5e1641e 100644
--- a/dat.h
+++ b/dat.h
@@ -123,5 +123,4 @@ Module *modules;
 Module *systemmodule; /* The module for the builtins. Everything has access to those */
 Module *usermodule; /* The default module for user defined predicates */
 uvlong clausenr;
-Binding *replbindings; /* The bindings used by the repl */
-Term *replquery; /* The currently active repl query */
\ No newline at end of file
+
diff --git a/eval.c b/eval.c
index 13718ab..6fec2b6 100644
--- a/eval.c
+++ b/eval.c
@@ -11,33 +11,10 @@ Builtin findbuiltin(Term *);
 void addchoicepoints(Clause *, Term *, Goal *, Module *);
 
 int
-evalquery(Term *query, Binding **resultbindings)
+evalquery(Term *query)
 {
-	if(choicestack == nil){
-	/*
-		The goal stack has the original query at the very bottom, protected by a catch frame where the ->goal field is nil.
-		This makes it so that we can continue until we hit the protective goal, at which point we have solved everything
-		and to get the result we can unify the original query with the one at the bottom of the stack, to get the bindings
-		applied.
-	*/
-		goalstack = gmalloc(sizeof(Goal));
-		goalstack->goal = copyterm(query, nil);
-		goalstack->module = usermodule;
-		goalstack->catcher = nil;
-		goalstack->next = nil;
-		Goal *protector = gmalloc(sizeof(Goal));
-		protector->goal = nil;
-		protector->module = usermodule;
-		protector->catcher = mkvariable(L"catch-var");
-		protector->next = goalstack;
-		goalstack = protector;
-
-		/* Now add the actual goals */
-		goalstack = addgoals(goalstack, query, usermodule);
-
-	}else{
-		goto Backtrack;
-	}
+	Binding *replbindings = nil;
+	goalstack = addgoals(goalstack, query, usermodule);
 
 	while(goalstack->goal != nil){
 		Term *goal = goalstack->goal;
@@ -101,7 +78,7 @@ Backtrack:
 		}
 	}
 	goalstack = goalstack->next;
-	unify(query, goalstack->goal, resultbindings);
+	unify(query, goalstack->goal, &replbindings);
 	return 1;
 }
 
diff --git a/fns.h b/fns.h
index caf9c2e..18b47b5 100644
--- a/fns.h
+++ b/fns.h
@@ -18,16 +18,13 @@ Term *mklist(Term *);
 Clause *copyclause(Clause *, uvlong *);
 
 /* eval.c */
-int evalquery(Term *, Binding **);
+int evalquery(Term *);
 int unify(Term *, Term *, Binding **);
 void applybinding(Term *, Binding *);
 Goal *addgoals(Goal *, Term *, Module *);
 Predicate *findpredicate(Predicate *, Term *);
 Clause *findclause(Clause *, Term *, Binding **);
 
-/* repl.c */
-void repl(void);
-
 /* builtins.c */
 Builtin findbuiltin(Term *);
 
diff --git a/garbage.c b/garbage.c
index 212c171..4e5d041 100644
--- a/garbage.c
+++ b/garbage.c
@@ -66,14 +66,10 @@ collectgarbage(void)
 		1) The modules
 		2) The goalstack
 		3) The choicestack
-		4) The replbindings
-		5) The replquery
 	*/
 	markmodules();
 	markgoalstack(goalstack);
 	markchoicestack();
-	markbindings(replbindings);
-	markterm(replquery);
 
 	/* Free the allocations that were not marked as reachable */
 	for(i = 0; i < TableSize; i++){
diff --git a/main.c b/main.c
index f97a466..463e881 100644
--- a/main.c
+++ b/main.c
@@ -6,6 +6,7 @@
 #include "fns.h"
 
 void usage(void);
+void repl(int, char **);
 
 void
 main(int argc, char *argv[])
@@ -22,14 +23,8 @@ main(int argc, char *argv[])
 	initflags();
 	initstreams();
 	initmodules();
+	repl(argc, argv);
 
-	while(argc != 0){
-		parsemodule(argv[0]);
-		argc--;
-		argv++;
-	}
-
-	repl();
 	exits(nil);
 }
 
@@ -38,4 +33,16 @@ usage(void)
 {
 	fprint(2, "Usage: pprolog [-d] modulefiles\n");
 	exits("Usage");
+}
+
+void
+repl(int argc, char *argv[])
+{
+	USED(argc);
+	USED(argv);
+	Term *mod = mkatom(L"repl");
+	Term *pred = mkatom(L"repl");
+	mod->next = pred;
+	Term *goal = mkcompound(L":", 2, mod);
+	evalquery(goal);	
 }
\ No newline at end of file
diff --git a/mkfile b/mkfile
index 6878070..8e920c2 100644
--- a/mkfile
+++ b/mkfile
@@ -9,7 +9,6 @@ OFILES=\
 	builtins.$O\
 	prettyprint.$O\
 	misc.$O\
-	repl.$O\
 	flags.$O\
 	error.$O\
 	streams.$O\
diff --git a/module.c b/module.c
index 36effb4..1ac931e 100644
--- a/module.c
+++ b/module.c
@@ -21,6 +21,7 @@ initmodules(void)
 	}
 
 	usermodule = addemptymodule(L"user");
+	parsemodule("./repl.pl");
 }
 
 Module *
diff --git a/repl.c b/repl.c
deleted file mode 100644
index 5e619f7..0000000
--- a/repl.c
+++ /dev/null
@@ -1,87 +0,0 @@
-#include <u.h>
-#include <libc.h>
-#include <bio.h>
-
-#include "dat.h"
-#include "fns.h"
-
-Rune parsefindmore(int);
-void dogc(void);
-
-void
-repl(void)
-{
-	int fd = 0; /* Standard input */
-	while(1){
-		print("?- ");
-		replquery = parse(fd, nil, 1);
-		replbindings = nil;
-		choicestack = nil;
-		goalstack = nil;
-		int success;
-		int firsttime = 1;
-FindMore:
-		success = evalquery(replquery, &replbindings);
-		dogc();
-		if(firsttime){
-			print(" ");
-			firsttime = 0;
-		}
-		if(success == 0)
-			print("  false.\n");
-		else{
-			if(replbindings == nil)
-				print("  true");
-			else{
-				while(replbindings){
-					print("  %S = %S%s", 
-						replbindings->name, 
-						prettyprint(replbindings->value, 0, 0, 0, nil), 
-						replbindings->next ? ",\n " : "");
-					replbindings = replbindings->next;
-				}
-			}
-			if(choicestack != nil){
-				print("\n");
-				if(parsefindmore(fd) == L';'){
-					print(";");
-					goto FindMore;
-				}else
-					print(".\n");
-			}else{
-				print(".\n");
-			}
-		}
-	}
-}
-
-Rune
-parsefindmore(int fd)
-{
-	int consctl = open("/dev/consctl", OWRITE);
-	if(consctl > 0)
-		write(consctl, "rawon", 5);
-	else{
-		print("Could not open /dev/consctl\n");
-		exits("open");
-	}
-
-	fd = dup(fd, -1);
-	Biobuf *input = Bfdopen(fd, OREAD);
-	Rune peek = Bgetrune(input);
-	Bterm(input);
-
-	if(consctl > 0){
-		write(consctl, "rawoff", 6);
-		close(consctl);
-	}
-	return peek;
-}
-
-void
-dogc(void)
-{
-	vlong amount = collectgarbage();
-	if(amount != 0 && debug)
-		print("Collected %lld bytes of garbage\n", amount);
-}
\ No newline at end of file
diff --git a/repl.pl b/repl.pl
new file mode 100644
index 0000000..eb272a9
--- /dev/null
+++ b/repl.pl
@@ -0,0 +1,77 @@
+:- module(repl, []).
+
+repl :-
+	catch(read_eval_print, E, print_exception(E)),
+	'$collect_garbage',
+	repl.
+
+read_eval_print :-
+	write('?- '),
+	asserta(found_a_solution :- (!, fail)),
+	read_term(Term, [variable_names(Vars)]),
+	'$choicestack_size'(Choicecount),
+	eval_and_print(Term, Vars, Choicecount),
+	!,
+	abolish(found_a_solution/0).
+
+eval_and_print(Goal, Vars, Choicecount) :-
+	user:call(Goal),
+	abolish(found_a_solution/0),
+	asserta(found_a_solution :- !),
+	'$choicestack_size'(ChoicecountNew),
+	( ChoicecountNew > Choicecount + 1
+	-> write_result(Vars, more),
+	   get_raw_char(Char),
+	   ( Char = ';'
+	   -> put_char(Char),
+	      nl,
+	      '$collect_garbage',
+	      asserta(found_a_solution :- (!, fail)),
+              fail % backtrack and call G again
+	   ; put_char('.'), nl
+	   )
+	; write_result(Vars, end)
+	).
+eval_and_print(Goal, _, _) :-
+	\+ found_a_solution,
+	write('false.'),
+	nl.
+
+write_state(end) :- write('.'), nl.
+write_state(more).
+
+write_result([], State) :- write('true'), write_state(State).
+write_result([B|Bs], State) :- write_bindings([B|Bs]), write_state(State).
+
+write_bindings([]).
+write_bindings([B|Bs]) :-
+	write(B),
+	( Bs = []
+	-> true
+	; put_char(','), nl
+	),
+	write_bindings(Bs).
+
+print_exception(E) :-
+	write('Unhandled exception: '),
+	write(E),
+	nl.
+
+whitespace(' ').
+whitespace('	').
+whitespace('
+').
+
+get_raw_char(Char) :-
+	open('/dev/consctl', write, S),
+	write(S, rawon),
+	get_one_char(Char),
+	write(S, rawoff),
+	close(S).
+
+get_one_char(Char) :-
+	get_char(C),
+	( whitespace(C)
+	-> get_one_char(Char)
+	; Char = C
+	).