shithub: pprolog

--- a/builtins.c

+++ b/builtins.c

@@ -1,5 +1,6 @@

 #include <u.h>

 #include <libc.h>

+#include <bio.h>

 #include "dat.h"

 #include "fns.h"

@@ -41,6 +42,8 @@

 BuiltinProto(builtincurrentoutput);

 BuiltinProto(builtinsetinput);

 BuiltinProto(builtinsetoutput);

+BuiltinProto(builtinreadterm);

+BuiltinProto(builtinwriteterm);

 int compareterms(Term *, Term *);

@@ -116,6 +119,10 @@

 		return builtinsetinput;

 	if(Match(L"set_output", 1))

 		return builtinsetoutput;

+	if(Match(L"read_term", 3))

+		return builtinreadterm;

+	if(Match(L"write_term", 3))

+		return builtinwriteterm;

 	return nil;

@@ -536,7 +543,7 @@

 	Term *ball = goal->children;

-	print("Throwing: %S\n", prettyprint(ball));

+	print("Throwing: %S\n", prettyprint(ball, 0, 0, 0));

 	Goal *g;

 	for(g = *goals; g != nil; g = g->next){

 		if(g->catcher == nil)

@@ -545,7 +552,7 @@

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

+				print("Unhandled exception: %S\n", prettyprint(ball, 0, 0, 0));

 				exits("exception");

 				return 0;

 			}else{

@@ -727,7 +734,6 @@

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

 	USED(database);

-	USED(goal);

 	USED(goals);

 	USED(choicestack);

 	USED(bindings);

@@ -747,4 +753,66 @@

 	setcurrentoutputstream(stream);

 	return 1;

-}

\ No newline at end of file

+}

+int

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

+{

+	USED(database);

+	USED(goals);

+	USED(choicestack);

+	USED(bindings);

+	Term *stream = goal->children;

+	Term *term = stream->next;

+	Term *options = term->next;

+	if(stream->tag == VariableTerm)

+		Throw(instantiationerror());

+	if(options->tag != AtomTerm || runestrcmp(options->text, L"[]") != 0)

+		Throw(typeerror(L"empty_list", options));

+	if((stream->tag != NumberTerm || stream->numbertype != NumberInt) && stream->tag != AtomTerm)

+		Throw(domainerror(L"stream_or_alias", stream));

+	if(!isopenstream(stream))

+		Throw(existenceerror(L"stream", stream));

+	if(isoutputstream(stream))

+		Throw(permissionerror(L"input", L"stream", stream));

+	if(isbinarystream(stream))

+		Throw(permissionerror(L"input", L"binary_stream", stream));

+	Term *realterm;

+	int error = readterm(stream, options, &realterm);

+	if(error)

+		Throw(realterm);

+	return unify(term, realterm, bindings);

+}

+int

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

+{

+	USED(database);

+	USED(goals);

+	USED(choicestack);

+	USED(bindings);

+	Term *stream = goal->children;

+	Term *term = stream->next;

+	Term *options = term->next;

+	if(stream->tag == VariableTerm)

+		Throw(instantiationerror());

+	if(options->tag != AtomTerm || runestrcmp(options->text, L"[]") != 0)

+		Throw(typeerror(L"empty_list", options));

+	if((stream->tag != NumberTerm || stream->numbertype != NumberInt) && stream->tag != AtomTerm)

+		Throw(domainerror(L"stream_or_alias", stream));

+	if(!isopenstream(stream))

+		Throw(existenceerror(L"stream", stream));

+	if(isinputstream(stream))

+		Throw(permissionerror(L"output", L"stream", stream));

+	if(isbinarystream(stream))

+		Throw(permissionerror(L"output", L"binary_stream", stream));

+	writeterm(stream, options, term);

+	return 1;

+}

--- a/error.c

+++ b/error.c

@@ -1,5 +1,6 @@

 #include <u.h>

 #include <libc.h>

+#include <bio.h>

 #include "dat.h"

 #include "fns.h"

--- a/eval.c

+++ b/eval.c

@@ -1,5 +1,6 @@

 #include <u.h>

 #include <libc.h>

+#include <bio.h>

 #include "dat.h"

 #include "fns.h"

@@ -57,7 +58,7 @@

 		if(debug)

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

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

 		Binding *bindings = nil;

 		Term *clause = nil;

@@ -226,6 +227,7 @@

 	switch(a->tag){

 	case AtomTerm:

+		return runestrcmp(a->text, b->text) == 0;

 	case VariableTerm:

 		return (runestrcmp(a->text, b->text) == 0 && a->clausenr == b->clausenr);

 	case NumberTerm:

--- a/flags.c

+++ b/flags.c

@@ -1,5 +1,6 @@

 #include <u.h>

 #include <libc.h>

+#include <bio.h>

 #include "dat.h"

 #include "fns.h"

--- a/fns.h

+++ b/fns.h

@@ -1,8 +1,8 @@

 /* parser.c */

-Term *parse(int, int);

+Term *parse(int, Biobuf *, int);

 /* prettyprint.c */

-Rune *prettyprint(Term *);

+Rune *prettyprint(Term *, int, int, int);

 /* misc.c */

 Term *copyterm(Term *, uvlong *);

@@ -51,4 +51,8 @@

 void setcurrentoutputstream(Term *);

 int isopenstream(Term *);

 int isinputstream(Term *);

-int isoutputstream(Term *);

\ No newline at end of file

+int isoutputstream(Term *);

+int istextstream(Term *);

+int isbinarystream(Term *);

+int readterm(Term *, Term *, Term **);

+void writeterm(Term *, Term *, Term *);

\ No newline at end of file

--- a/main.c

+++ b/main.c

@@ -1,5 +1,6 @@

 #include <u.h>

 #include <libc.h>

+#include <bio.h>

 #include "dat.h"

 #include "fns.h"

@@ -34,7 +35,7 @@

 		exits("open");

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

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

 	close(fd);

 	if(parsetestfile){

@@ -41,7 +42,7 @@

 		int fd = open(parsetestfile, OREAD);

 		if(fd < 0)

 			exits("open");

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

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

 		database = appendterm(database, clauses);

 		Term *goal;

--- a/misc.c

+++ b/misc.c

@@ -1,5 +1,6 @@

 #include <u.h>

 #include <libc.h>

+#include <bio.h>

 #include "dat.h"

 #include "fns.h"

--- a/parser.c

+++ b/parser.c

@@ -79,14 +79,18 @@

 Term *prologtext(int);

 Term *

-parse(int fd, int querymode)

+parse(int fd, Biobuf *bio, int querymode)

-	fd = dup(fd, -1);

-	parsein = Bfdopen(fd, OREAD);

-	if(parsein == nil){

-		print("Could not open file\n");

-		return nil;

-	}

+	if(bio == nil){

+		fd = dup(fd, -1);

+		parsein = Bfdopen(fd, OREAD);

+		if(parsein == nil){

+			print("Could not open file\n");

+			return nil;

+		}

+	}else

+		parsein = bio;

 	initgoals = nil;

 	initoperators();

 	nexttoken();

@@ -96,7 +100,9 @@

 		uvlong id = 1;

 		result = copyterm(result, &id);

-	Bterm(parsein);

+	if(!bio)

+		Bterm(parsein);

 	return result;

@@ -118,7 +124,7 @@

 	if(t->tag == CompoundTerm && runestrcmp(t->text, L":-") == 0 && t->arity == 1){

 		Term *body = t->children;

-		print("Got directive: %S\n", prettyprint(body));

+		print("Got directive: %S\n", prettyprint(body, 0, 0, 0));

 		if(body->tag == CompoundTerm && body->arity == 1 && runestrcmp(body->text, L"initialization") == 0){

 			Term *tmp = initgoals;

 			initgoals = body->children;

@@ -296,7 +302,7 @@

 		if(index == -1){

 			print("Can't parse, list of length %d contains no operators: ", length);

 			for(i = 0; i < length; i++)

-				print("%S(%d) ", prettyprint(terms[i]), infos[i].level);

+				print("%S(%d) ", prettyprint(terms[i], 0, 0, 0), infos[i].level);

 			print("\n");

 			syntaxerror_parser("parseoperators");

@@ -337,7 +343,7 @@

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

 		}else{

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

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

 			syntaxerror_parser("parseoperators");

--- a/prettyprint.c

+++ b/prettyprint.c

@@ -1,15 +1,16 @@

 #include <u.h>

 #include <libc.h>

+#include <bio.h>

 #include "dat.h"

 #include "fns.h"

-Rune *prettyprintlist(Term *, Rune *, int);

-Rune *printlist(Term *);

+Rune *prettyprintlist(Term *, Rune *, int, int, int, int);

+Rune *printlist(Term *, int, int, int);

 int islist(Term *);

 Rune *

-prettyprint(Term *t)

+prettyprint(Term *t, int quoted, int ignoreops, int numbervars)

 	Rune *result;

 	Rune *args;

@@ -16,9 +17,9 @@

 	switch(t->tag){

 	case CompoundTerm:

-		args = printlist(t);

+		args = printlist(t, quoted, ignoreops, numbervars);

 		if(args == nil){

-			args = prettyprintlist(t->children, L", ", 0);

+			args = prettyprintlist(t->children, L", ", 0, quoted, ignoreops, numbervars);

 			result = runesmprint("%S(%S)", t->text, args);

 			free(args);

 		}else

@@ -45,7 +46,7 @@

 Rune *

-prettyprintlist(Term *t, Rune *sep, int end)

+prettyprintlist(Term *t, Rune *sep, int end, int quoted, int ignoreops, int numbervars)

 	if(t == nil){

 		if(end)

@@ -54,8 +55,8 @@

 			return runesmprint("");

-	Rune *str = prettyprint(t);

-	Rune *rest = prettyprintlist(t->next, sep, end);

+	Rune *str = prettyprint(t, quoted, ignoreops, numbervars);

+	Rune *rest = prettyprintlist(t->next, sep, end, quoted, ignoreops, numbervars);

 	Rune *result;

 	if(t->next != nil)

@@ -70,7 +71,7 @@

 /* printlist prints a list's elements but not the surrounding [ and ] */

 Rune *

-printlist(Term *list)

+printlist(Term *list, int quoted, int ignoreops, int numbervars)

 	if(list->tag != CompoundTerm || list->arity != 2 || runestrcmp(L".", list->text) != 0)

 		return nil;

@@ -78,20 +79,20 @@

 	Term *head = list->children;

 	Term *tail = head->next;

-	Rune *headstr = prettyprint(head);

+	Rune *headstr = prettyprint(head, quoted, ignoreops, numbervars);

 	Rune *tailstr = nil;

 	Rune *result;

 	if(tail->tag == CompoundTerm && tail->arity == 2 && runestrcmp(L".", tail->text) == 0){

-		tailstr = printlist(tail);

+		tailstr = printlist(tail, quoted, ignoreops, numbervars);

 		result = runesmprint("%S, %S", headstr, tailstr);

 	}else if(tail->tag == AtomTerm && runestrcmp(L"[]", tail->text) == 0){

 		result = runesmprint("%S", headstr);

 	}else{

-		tailstr = prettyprint(tail);

+		tailstr = prettyprint(tail, quoted, ignoreops, numbervars);

 		result = runesmprint("%S | %S", headstr, tailstr);

 	free(headstr);

 	free(tailstr);

 	return result;

-}

\ No newline at end of file

+}

--- a/repl.c

+++ b/repl.c

@@ -13,7 +13,7 @@

 	int fd = 0; /* Standard input */

 	while(1){

 		print("?- ");

-		Term *query = parse(fd, 1);

+		Term *query = parse(fd, nil, 1);

 		Binding *bindings = nil;

 		Choicepoint *choicestack = nil;

 		int success;

@@ -28,7 +28,7 @@

 				while(bindings){

 					print("  %S = %S%s",

 						bindings->name,

-						prettyprint(bindings->value),

+						prettyprint(bindings->value, 0, 0, 0),

 						bindings->next ? " ,\n" : "");

 					bindings = bindings->next;

--- a/stdlib.pl

+++ b/stdlib.pl

@@ -105,3 +105,35 @@

 syntax_error(Error) :-

 	throw(error(syntax_error(Error), _)).

+% Input and output

+read_term(Term, Options) :-

+	current_input(S),

+	read_term(S, Term, Options).

+read(Term) :-

+	current_input(S),

+	read_term(S, Term, []).

+write_term(Term, Options) :-

+	current_output(S),

+	write_term(S, Term, Options).

+write(Term) :-

+	current_output(S),

+	write_term(S, Term, [numbervars(true)]).

+writeq(Term) :-

+	current_output(S),

+	write_term(S, Term, [quoted(true), numbervars(true)]).

+writeq(S, Term) :-

+	write_term(S, Term, [quoted(true), numbervars(true)]).

+write_canonical(Term) :-

+	current_output(S),

+	write_term(S, Term, [quoted(true), ignore_ops(true)]).

+write_canonical(S, Term) :-

+	write_term(S, Term, [quoted(true), ignore_ops(true)]).

--- a/streams.c

+++ b/streams.c

@@ -1,5 +1,6 @@

 #include <u.h>

 #include <libc.h>

+#include <bio.h>

 #include "dat.h"

 #include "fns.h"

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

 struct Stream

 	ulong fd;

+	Biobuf *bio;

 	int type;

 	int mode;

 	int nalias;

@@ -31,7 +33,7 @@

 static Stream *currentinput;

 static Stream *currentoutput;

-Stream *openstreamfd(int, int, int);

+Stream *openstreamfd(int, Biobuf *, int, int);

 Stream *getstreambyfd(int);

 Stream *getstreambyalias(Rune *);

 Stream *getstream(Term *);

@@ -39,8 +41,14 @@

 void

 initstreams(void)

-	currentinput = openstreamfd(0, TextStream, ReadStream);

-	currentoutput = openstreamfd(1, TextStream, WriteStream);

+	int infd = dup(0, -1);

+	int outfd = dup(1, -1);

+	Biobuf *bioin = Bfdopen(infd, OREAD);

+	Biobuf *bioout = Bfdopen(outfd, OWRITE);

+	currentinput = openstreamfd(infd, bioin, TextStream, ReadStream);

+	currentoutput = openstreamfd(outfd, bioout, TextStream, WriteStream);

int

@@ -69,7 +77,13 @@

 		*stream = permissionerror(L"open", L"source_sink", mkatom(sourcesink));

 		return 1;

-	Stream *s = openstreamfd(fd, TextStream, smode);

+	Biobuf *bio = Bfdopen(fd, omode);

+	if(bio == nil){

+		*stream = permissionerror(L"open", L"source_sink", mkatom(sourcesink));

+		return 1;

+	}

+	Stream *s = openstreamfd(fd, bio, TextStream, smode);

 	*stream = mknumber(NumberInt, s->fd, 0);

 	return 0;

@@ -81,6 +95,9 @@

 	if(s == nil)

 		return;

+	Bterm(s->bio);

+	close(s->fd);

 	Stream *tmp;

 	Stream *prev = nil;

 	for(tmp = streams; tmp != nil; tmp = tmp->next){

@@ -154,11 +171,66 @@

 		return 0;

+int

+istextstream(Term *t)

+{

+	Stream *s = getstream(t);

+	if(s && s->type == TextStream)

+		return 1;

+	else

+		return 0;

+}

+int

+isbinarystream(Term *t)

+{

+	Stream *s = getstream(t);

+	if(s && s->type == BinaryStream)

+		return 1;

+	else

+		return 0;

+}

+int

+readterm(Term *stream, Term *options, Term **term)

+{

+	USED(options);

+	Stream *s = getstream(stream);

+	if(s == nil){

+		*term = existenceerror(L"stream", stream);

+		return 1;

+	}

+	print(": ");

+	*term = parse(0, s->bio, 1);

+	return 0;

+}

+void

+writeterm(Term *stream, Term *options, Term *term)

+{

+	USED(options);

+	Stream *s = getstream(stream);

+	if(s == nil)

+		return;

+	int quoted = 0;

+	int ignoreops = 0;

+	int numbervars = 0;

+	Rune *output = prettyprint(term, quoted, ignoreops, numbervars);

+	Bprint(s->bio, "%S", output);

+	Bflush(s->bio);

+}

 Stream *

-openstreamfd(int fd, int type, int mode)

+openstreamfd(int fd, Biobuf *bio, int type, int mode)

 	Stream *s = malloc(sizeof(Stream));

 	s->fd = fd;

+	s->bio = bio;

 	s->type = type;

 	s->mode = mode;

 	s->nalias = 0;

@@ -201,4 +273,5 @@

 	else if(t->tag == AtomTerm)

 		s = getstreambyalias(t->text);

 	return s;

-}

\ No newline at end of file

+}