shithub: pprolog

Download patch

ref: d81447526cde6fa98dfa792a65f71acb78ef1398
parent: 8dd4f85c85aa9ab7a5f1219efd694e6707f2718c
author: Peter Mikkelsen <peter@pmikkelsen.com>
date: Fri Jul 2 18:01:59 EDT 2021

Start work on input/output streams

--- a/builtins.c
+++ b/builtins.c
@@ -35,6 +35,12 @@
 BuiltinProto(builtinthrow);
 BuiltinProto(builtinsetprologflag);
 BuiltinProto(builtincurrentprologflag);
+BuiltinProto(builtinopen);
+BuiltinProto(builtinclose);
+BuiltinProto(builtincurrentinput);
+BuiltinProto(builtincurrentoutput);
+BuiltinProto(builtinsetinput);
+BuiltinProto(builtinsetoutput);
 
 int compareterms(Term *, Term *);
 
@@ -98,6 +104,18 @@
 		return builtinsetprologflag;
 	if(Match(L"current_prolog_flag", 2))
 		return builtincurrentprologflag;
+	if(Match(L"open", 4))
+		return builtinopen;
+	if(Match(L"close", 2))
+		return builtinclose;
+	if(Match(L"current_input", 1))
+		return builtincurrentinput;
+	if(Match(L"current_output", 1))
+		return builtincurrentoutput;
+	if(Match(L"set_input", 1))
+		return builtinsetinput;
+	if(Match(L"set_output", 1))
+		return builtinsetoutput;
 
 	return nil;
 }
@@ -582,3 +600,151 @@
 	return 1;
 }
 
+int
+builtinopen(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
+{
+	USED(database);
+	USED(goals);
+	USED(choicestack);
+	USED(bindings);
+
+	Term *sourcesink = goal->children;
+	Term *mode = sourcesink->next;
+	Term *stream = mode->next;
+	Term *options = stream->next;
+
+	if(sourcesink->tag == VariableTerm || mode->tag == VariableTerm || options->tag == VariableTerm)
+		Throw(instantiationerror());
+
+	if(stream->tag != VariableTerm)
+		Throw(typeerror(L"variable", stream));
+
+	if(options->tag != AtomTerm || runestrcmp(options->text, L"[]") != 0)
+		Throw(typeerror(L"empty_list", options));
+
+	if(mode->tag != AtomTerm)
+		Throw(typeerror(L"atom", mode));
+
+	if(sourcesink->tag != AtomTerm)
+		Throw(domainerror(L"source_sink", sourcesink));
+
+	Term *newstream;
+	int error = openstream(sourcesink->text, mode->text, options, &newstream);
+	if(error)
+		Throw(newstream);
+	else
+		return unify(stream, newstream, bindings);
+
+	return 0;
+}
+
+int
+builtinclose(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
+{
+	USED(database);
+	USED(goals);
+	USED(choicestack);
+	USED(bindings);
+	
+	Term *stream = goal->children;
+	Term *options = stream->next;
+
+	if(stream->tag == VariableTerm || options->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));
+
+	closestream(stream);
+
+	return 1;
+}
+
+int
+builtincurrentinput(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
+{
+	USED(database);
+	USED(goals);
+	USED(choicestack);
+	USED(bindings);
+
+	Term *stream = goal->children;
+	if(stream->tag != VariableTerm && (stream->tag != NumberTerm || stream->numbertype != NumberInt))
+		Throw(domainerror(L"stream", stream));
+
+	Term *current = currentinputstream();
+	return unify(stream, current, bindings);
+}
+
+int
+builtincurrentoutput(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
+{
+	USED(database);
+	USED(goals);
+	USED(choicestack);
+	USED(bindings);
+
+	Term *stream = goal->children;
+	if(stream->tag != VariableTerm && (stream->tag != NumberTerm || stream->numbertype != NumberInt))
+		Throw(domainerror(L"stream", stream));
+
+	Term *current = currentoutputstream();
+	return unify(stream, current, bindings);
+}
+
+int
+builtinsetinput(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
+{
+	USED(database);
+	USED(goals);
+	USED(choicestack);
+	USED(bindings);
+
+	Term *stream = goal->children;
+	if(stream->tag == VariableTerm)
+		Throw(instantiationerror());
+
+	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"input", L"stream", stream));
+
+	setcurrentinputstream(stream);
+	return 1;
+}
+
+int
+builtinsetoutput(Term *database, Term *goal, Goal **goals, Choicepoint **choicestack, Binding **bindings)
+{
+	USED(database);
+	USED(goal);
+	USED(goals);
+	USED(choicestack);
+	USED(bindings);
+
+	Term *stream = goal->children;
+	if(stream->tag == VariableTerm)
+		Throw(instantiationerror());
+
+	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"output", L"stream", stream));
+
+	setcurrentoutputstream(stream);
+	return 1;
+}
\ No newline at end of file
--- a/fns.h
+++ b/fns.h
@@ -40,3 +40,15 @@
 Term *evaluationerror(Rune *);
 Term *resourceerror(Rune *);
 Term *syntaxerror(Rune *);
+
+/* streams.c */
+void initstreams(void);
+int openstream(Rune *, Rune *, Term *, Term **);
+void closestream(Term *);
+Term *currentinputstream(void);
+Term *currentoutputstream(void);
+void setcurrentinputstream(Term *);
+void setcurrentoutputstream(Term *);
+int isopenstream(Term *);
+int isinputstream(Term *);
+int isoutputstream(Term *);
\ No newline at end of file
--- a/main.c
+++ b/main.c
@@ -26,6 +26,7 @@
 		usage();
 
 	initflags();
+	initstreams();
 
 	int fd = open("./stdlib.pl", OREAD);
 	if(fd < 0){
--- a/mkfile
+++ b/mkfile
@@ -11,7 +11,8 @@
 	misc.$O\
 	repl.$O\
 	flags.$O\
-	error.$O
+	error.$O\
+	streams.$O
 
 HFILES=dat.h fns.h
 
--- a/stdlib.pl
+++ b/stdlib.pl
@@ -69,6 +69,14 @@
 member(X, [_|Tail]) :-
 	member(X, Tail).
 
+% Input output
+
+open(SourceSink, Mode, Stream) :-
+	open(SourceSink, Mode, Stream, []).
+
+close(StreamOrAlias) :-
+	close(StreamOrAlias, []).
+
 % Standard exceptions
 
 instantiation_error :-
--- /dev/null
+++ b/streams.c
@@ -1,0 +1,204 @@
+#include <u.h>
+#include <libc.h>
+
+#include "dat.h"
+#include "fns.h"
+
+typedef struct Stream Stream;
+
+struct Stream
+{
+	ulong fd;
+	int type;
+	int mode;
+	int nalias;
+	Rune **aliases;
+	Stream *next;
+};
+
+enum {
+	TextStream,
+	BinaryStream,
+};
+
+enum {
+	ReadStream,
+	WriteStream,
+	AppendStream
+};
+
+static Stream *streams;
+static Stream *currentinput;
+static Stream *currentoutput;
+
+Stream *openstreamfd(int, int, int);
+Stream *getstreambyfd(int);
+Stream *getstreambyalias(Rune *);
+Stream *getstream(Term *);
+
+void
+initstreams(void)
+{
+	currentinput = openstreamfd(0, TextStream, ReadStream);
+	currentoutput = openstreamfd(1, TextStream, WriteStream);
+}
+
+int
+openstream(Rune *sourcesink, Rune *mode, Term *options, Term **stream)
+{
+	USED(options);
+	int omode;
+	int smode;
+	if(runestrcmp(mode, L"read") == 0){
+		omode = OREAD;
+		smode = ReadStream;
+	}else if(runestrcmp(mode, L"write") == 0){
+		omode = OWRITE;
+		smode = WriteStream;
+	}else if(runestrcmp(mode, L"append") == 0){
+		omode = OWRITE; /* Is this correct? */
+		smode = AppendStream;
+	}else{
+		*stream = existenceerror(L"source_sink", mkatom(sourcesink));
+		return 1;
+	}
+
+	char *filename = smprint("%S", sourcesink);
+	int fd = open(filename, omode);
+	if(fd < 0){
+		*stream = permissionerror(L"open", L"source_sink", mkatom(sourcesink));
+		return 1;
+	}
+	Stream *s = openstreamfd(fd, TextStream, smode);
+	*stream = mknumber(NumberInt, s->fd, 0);
+	return 0;
+}
+
+void
+closestream(Term *t)
+{
+	Stream *s = getstream(t);
+	if(s == nil)
+		return;
+
+	Stream *tmp;
+	Stream *prev = nil;
+	for(tmp = streams; tmp != nil; tmp = tmp->next){
+		if(tmp == s){
+			if(prev == nil)
+				streams = tmp->next;
+			else
+				prev->next = tmp->next;
+			break;
+		}
+		if(prev == nil)
+			prev = tmp;
+	}
+}
+
+Term *
+currentinputstream(void)
+{
+	return mknumber(NumberInt, currentinput->fd, 0);
+}
+
+Term *
+currentoutputstream(void)
+{
+	return mknumber(NumberInt, currentoutput->fd, 0);
+}
+
+void
+setcurrentinputstream(Term *t)
+{
+	Stream *s = getstream(t);
+	if(s)
+		currentinput = s;
+}
+
+void
+setcurrentoutputstream(Term *t)
+{
+	Stream *s = getstream(t);
+	if(s)
+		currentoutput = s;
+}
+
+int
+isopenstream(Term *t)
+{
+	Stream *s = getstream(t);
+	if(s)
+		return 1;
+	else
+		return 0;
+}
+
+int
+isinputstream(Term *t)
+{
+	Stream *s = getstream(t);
+	if(s && s->mode == ReadStream)
+		return 1;
+	else
+		return 0;
+}
+
+int
+isoutputstream(Term *t)
+{
+	Stream *s = getstream(t);
+	if(s && (s->mode == WriteStream || s->mode == AppendStream))
+		return 1;
+	else
+		return 0;
+}
+
+Stream *
+openstreamfd(int fd, int type, int mode)
+{
+	Stream *s = malloc(sizeof(Stream));
+	s->fd = fd;
+	s->type = type;
+	s->mode = mode;
+	s->nalias = 0;
+	s->aliases = nil;
+	s->next = streams;
+	streams = s;
+	return s;
+}
+
+Stream *
+getstreambyfd(int fd)
+{
+	Stream *s;
+	for(s = streams; s != nil; s = s->next)
+		if(s->fd == fd)
+			return s;
+	return nil;
+}
+
+Stream *
+getstreambyalias(Rune *alias)
+{
+	Stream *s;
+	for(s = streams; s != nil; s = s->next){
+		int i;
+		for(i = 0; i < s->nalias; i++){
+			if(runestrcmp(alias, s->aliases[i]) == 0)
+				return s;
+		}
+	}
+	return nil;
+}
+
+Stream *
+getstream(Term *t)
+{
+	Stream *s = nil;
+	if(t->tag == NumberTerm && t->numbertype == NumberInt)
+		s = getstreambyfd(t->ival);
+	else if(t->tag == AtomTerm)
+		s = getstreambyalias(t->text);
+	return s;
+}
\ No newline at end of file