shithub: pprolog

--- a/builtins.c

+++ b/builtins.c

@@ -60,6 +60,8 @@

 BuiltinProto(builtinpeekchar);

 BuiltinProto(builtinputchar);

 BuiltinProto(builtincharcode);

+BuiltinProto(builtinchoicestacksize);

+BuiltinProto(builtincollectgarbage);

 int compareterms(Term *, Term *);

@@ -169,6 +171,10 @@

 		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,10 +575,10 @@

 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)

@@ -579,27 +585,20 @@

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

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

-			}

+			Choicepoint *cp = choicestack;

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

+				cp = cp->next;

+			choicestack = cp;

+			return 1;

 	return 0;

@@ -1404,3 +1403,29 @@

+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

--- a/dat.h

+++ b/dat.h

@@ -123,5 +123,4 @@

 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

--- a/eval.c

+++ b/eval.c

@@ -11,34 +11,11 @@

 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;

+	Binding *replbindings = nil;

+	goalstack = addgoals(goalstack, query, usermodule);

-		/* Now add the actual goals */

-		goalstack = addgoals(goalstack, query, usermodule);

-	}else{

-		goto Backtrack;

-	}

 	while(goalstack->goal != nil){

 		Term *goal = goalstack->goal;

 		Term *catcher = goalstack->catcher;

@@ -101,7 +78,7 @@

 	goalstack = goalstack->next;

-	unify(query, goalstack->goal, resultbindings);

+	unify(query, goalstack->goal, &replbindings);

 	return 1;

--- a/fns.h

+++ b/fns.h

@@ -18,15 +18,12 @@

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

--- a/garbage.c

+++ b/garbage.c

@@ -66,14 +66,10 @@

 		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++){

--- 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 @@

 	initflags();

 	initstreams();

 	initmodules();

+	repl(argc, argv);

-	while(argc != 0){

-		parsemodule(argv[0]);

-		argc--;

-		argv++;

-	}

-	repl();

 	exits(nil);

@@ -38,4 +33,16 @@

 	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

--- a/mkfile

+++ b/mkfile

@@ -9,7 +9,6 @@

 	builtins.$O\

 	prettyprint.$O\

 	misc.$O\

-	repl.$O\

 	flags.$O\

 	error.$O\

 	streams.$O\

--- a/module.c

+++ b/module.c

@@ -21,6 +21,7 @@

 	usermodule = addemptymodule(L"user");

+	parsemodule("./repl.pl");

 Module *

--- a/repl.c

+++ /dev/null

@@ -1,87 +1,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

--- /dev/null

+++ b/repl.pl

@@ -1,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

+	).