More work on streams

4 files changed, 262 insertions, 2 deletions

diff --git a/builtins.c b/builtins.c
index b33bc49..9699de1 100644
--- a/builtins.c
+++ b/builtins.c
@@ -63,6 +63,9 @@ BuiltinProto(builtincharcode);
 BuiltinProto(builtinchoicestacksize);
 BuiltinProto(builtincollectgarbage);
 BuiltinProto(builtinloadmodulefromfile);
+BuiltinProto(builtinflushoutput);
+BuiltinProto(builtinstreamproperties);
+BuiltinProto(builtinsetstreamposition);
 
 int compareterms(Term *, Term *);
 
@@ -178,6 +181,12 @@ findbuiltin(Term *goal)
 		return builtincollectgarbage;
 	if(Match(L"$load_module_from_file", 1))
 		return builtinloadmodulefromfile;
+	if(Match(L"flush_output", 1))
+		return builtinflushoutput;
+	if(Match(L"stream_properties", 1))
+		return builtinstreamproperties;
+	if(Match(L"set_stream_position", 2))
+		return builtinsetstreamposition;
 
 	return nil;
 }
@@ -1445,4 +1454,58 @@ builtinloadmodulefromfile(Term *goal, Binding **bindings, Module *module)
 		return 1;
 	else
 		return 0;
+}
+
+int
+builtinflushoutput(Term *goal, Binding **bindings, Module *module)
+{
+	USED(bindings);
+	USED(module);
+	Term *s = goal->children;
+
+	if(s->tag == VariableTerm)
+		Throw(instantiationerror());
+	if(s->tag != IntegerTerm && s->tag != AtomTerm)
+		Throw(domainerror(L"stream_or_alias", s));
+	if(!isopenstream(s))
+		Throw(existenceerror(L"stream", s));
+	if(!isoutputstream(s))
+		Throw(permissionerror(L"output", L"stream", s));
+
+	flushstream(s);
+	return 1;
+}
+
+int
+builtinstreamproperties(Term *goal, Binding **bindings, Module *module)
+{
+	USED(module);
+	USED(bindings);
+	Term *props = goal->children;
+	Term *list = streamsproperties();
+	Term *realprops = mklist(list);
+	return unify(props, realprops, bindings);
+}
+
+int
+builtinsetstreamposition(Term *goal, Binding **bindings, Module *module)
+{
+	USED(module);
+	USED(bindings);
+	Term *s = goal->children;
+	Term *pos = s->next;
+
+	if(s->tag == VariableTerm || pos->tag == VariableTerm)
+		Throw(instantiationerror());
+	if(s->tag != IntegerTerm && s->tag != AtomTerm)
+		Throw(domainerror(L"stream_or_alias", s));
+	if(pos->tag != IntegerTerm || pos->ival < 0)
+		Throw(domainerror(L"stream_position", pos));
+	if(!isopenstream(s))
+		Throw(existenceerror(L"stream", s));
+	if(!canreposition(s))
+		Throw(permissionerror(L"reposition", L"stream", s));
+
+	reposition(s, pos->ival);
+	return 1;
 }
\ No newline at end of file
diff --git a/fns.h b/fns.h
index 6a11174..f3d9ebd 100644
--- a/fns.h
+++ b/fns.h
@@ -57,11 +57,15 @@ int isinputstream(Term *);
 int isoutputstream(Term *);
 int istextstream(Term *);
 int isbinarystream(Term *);
+int canreposition(Term *);
 int readterm(Term *, Term **);
 void writeterm(Term *, Term *, Term *, Module *);
 Rune getchar(Term *);
 Rune peekchar(Term *);
 void putchar(Term *, Rune);
+void flushstream(Term *);
+Term *streamsproperties(void);
+void reposition(Term *, vlong);
 
 /* module.c */
 void initmodules(void);
diff --git a/stdlib.pl b/stdlib.pl
index d093eed..c6b395f 100644
--- a/stdlib.pl
+++ b/stdlib.pl
@@ -110,6 +110,29 @@ open(SourceSink, Mode, Stream) :-
 close(StreamOrAlias) :-
 	close(StreamOrAlias, []).
 
+flush_output :-
+	current_output(S),
+	flush_output(S).
+
+stream_property(S, P) :-
+	stream_properties(Props),
+	member(prop(S,P), Props).
+
+at_end_of_stream :-
+	current_input(S),
+	stream_property(S, end_of_stream(E)),
+	!,
+	(E = at ; E = past).
+
+at_end_of_stream(S_or_a) :-
+	( atom(S_or_a)
+	-> stream_property(S, alias(S_or_a))
+	; S = S_or_a
+	),
+	stream_property(S, end_of_stream(E)),
+	!,
+	(E = at; E = past).
+
 % Standard exceptions
 
 instantiation_error :-
diff --git a/streams.c b/streams.c
index 63a7099..beed5b1 100644
--- a/streams.c
+++ b/streams.c
@@ -13,8 +13,11 @@ struct Stream
 	Biobuf *bio;
 	int type;
 	int mode;
+	int reposition;
+	int eofaction;
 	int nalias;
 	Rune **aliases;
+	Rune *filename;
 	Stream *next;
 };
 
@@ -26,7 +29,13 @@ enum {
 enum {
 	ReadStream,
 	WriteStream,
-	AppendStream
+	AppendStream,
+};
+
+enum {
+	EofActionError,
+	EofActionEof,
+	EofActionReset,
 };
 
 static Stream *streams;
@@ -37,6 +46,8 @@ Stream *openstreamfd(int, Biobuf *, int, int);
 Stream *getstreambyfd(int);
 Stream *getstreambyalias(Rune *);
 Stream *getstream(Term *);
+Term *streamproperties(Stream *);
+void addstreamalias(int, Rune *);
 
 void
 initstreams(void)
@@ -48,7 +59,10 @@ initstreams(void)
 	Biobuf *bioout = Bfdopen(outfd, OWRITE);
 	
 	currentinput = openstreamfd(infd, bioin, TextStream, ReadStream);
-	currentoutput = openstreamfd(outfd, bioout, TextStream, WriteStream);
+	currentoutput = openstreamfd(outfd, bioout, TextStream, AppendStream);
+
+	addstreamalias(infd, L"user_input");
+	addstreamalias(outfd, L"user_output");
 }
 
 int
@@ -84,6 +98,7 @@ openstream(Rune *sourcesink, Rune *mode, Term *options, Term **stream)
 	}
 
 	Stream *s = openstreamfd(fd, bio, TextStream, smode);
+	s->filename = sourcesink;
 	*stream = mkinteger(s->fd);
 	return 0;
 }
@@ -192,6 +207,16 @@ isbinarystream(Term *t)
 }
 
 int
+canreposition(Term *t)
+{
+	Stream *s = getstream(t);
+	if(s && s->reposition)
+		return 1;
+	else
+		return 0;
+}
+
+int
 readterm(Term *stream, Term **term)
 {
 	Stream *s = getstream(stream);
@@ -241,8 +266,11 @@ openstreamfd(int fd, Biobuf *bio, int type, int mode)
 	s->bio = bio;
 	s->type = type;
 	s->mode = mode;
+	s->reposition = 0;
+	s->eofaction = EofActionEof;
 	s->nalias = 0;
 	s->aliases = nil;
+	s->filename = nil;
 	s->next = streams;
 	streams = s;
 	return s;
@@ -304,5 +332,147 @@ putchar(Term *t, Rune r)
 {
 	Stream *s = getstream(t);
 	Bprint(s->bio, "%C", r);
+}
+
+void
+flushstream(Term *t)
+{
+	Stream *s = getstream(t);
 	Bflush(s->bio);
+}
+
+Term *
+streamsproperties(void)
+{
+	Term *list = nil;
+	Stream *s;
+	for(s = streams; s != nil; s = s->next){
+		Term *props = streamproperties(s);
+		list = appendterm(list, props);
+	}
+	return list;
+}
+
+Term *streamproperties(Stream *s)
+{
+	Term *props = nil;
+	Term *stream = mkinteger(s->fd);
+	Term *arg = nil;
+	Term *data;
+	Term *prop;
+
+	/* file_name(F) */
+	if(s->filename){
+		arg = mkatom(s->filename);
+		data = copyterm(stream, nil);
+		data->next = mkcompound(L"file_name", 1, arg);
+		prop = mkcompound(L"prop", 2, data);
+		props = appendterm(props, prop);
+	}
+
+	/* mode(M) */
+	switch(s->mode){
+	case ReadStream: arg = mkatom(L"read"); break;
+	case WriteStream: arg = mkatom(L"write"); break;
+	case AppendStream: arg = mkatom(L"append"); break;
+	}
+	data = copyterm(stream, nil);
+	data->next = mkcompound(L"mode", 1, arg);
+	prop = mkcompound(L"prop", 2, data);
+	props = appendterm(props, prop);
+
+	/* input or output */
+	data = copyterm(stream, nil);
+	if(s->mode == ReadStream)
+		data->next = mkatom(L"input");
+	else
+		data->next = mkatom(L"output");
+	prop = mkcompound(L"prop", 2, data);
+	props = appendterm(props, prop);
+
+	/* alias(A) */
+	int i;
+	for(i = 0; i < s->nalias; i++){
+		arg = mkatom(s->aliases[i]);
+		data = copyterm(stream, nil);
+		data->next = mkcompound(L"alias", 1, arg);
+		prop = mkcompound(L"prop", 2, data);
+		props = appendterm(props, prop);
+	}
+
+	/* position(P) */
+	if(s->reposition){
+		arg = mkinteger(Boffset(s->bio));
+		data = copyterm(stream, nil);
+		data->next = mkcompound(L"position", 1, arg);
+		prop = mkcompound(L"prop", 2, data);
+		props = appendterm(props, prop);
+	}
+
+	/* end_of_stream(E) */
+	if(s->mode == ReadStream){
+		Rune r = Bgetrune(s->bio);
+		Bungetrune(s->bio);
+		if(r == Beof)
+			arg = mkatom(L"at");
+		else
+			arg = mkatom(L"not");
+		data = copyterm(stream, nil);
+		data->next = mkcompound(L"end_of_stream", 1, arg);
+		prop = mkcompound(L"prop", 2, data);
+		props = appendterm(props, prop);
+	}
+	
+	/* eof_action(A) */
+	switch(s->eofaction){
+	case EofActionError: arg = mkatom(L"error"); break;
+	case EofActionEof: arg = mkatom(L"eof_code"); break;
+	case EofActionReset: arg = mkatom(L"reset"); break;
+	}
+	data = copyterm(stream, nil);
+	data->next = mkcompound(L"eof_action", 1, arg);
+	prop = mkcompound(L"prop", 2, data);
+	props = appendterm(props, prop);
+
+	/* reposition(Bool) */
+	if(s->reposition)
+		arg = mkatom(L"true");
+	else
+		arg = mkatom(L"false");
+	data = copyterm(stream, nil);
+	data->next = mkcompound(L"reposition", 1, arg);
+	prop = mkcompound(L"prop", 2, data);
+	props = appendterm(props, prop);
+
+	/* type(T) */
+	if(s->type == TextStream)
+		arg = mkatom(L"text");
+	else
+		arg = mkatom(L"binary");
+	data = copyterm(stream, nil);
+	data->next = mkcompound(L"type", 1, arg);
+	prop = mkcompound(L"prop", 2, data);
+	props = appendterm(props, prop);
+
+	return props;
+}
+
+void
+reposition(Term *t, vlong pos)
+{
+	Stream *s = getstream(t);
+	Bseek(s->bio, pos, 0);
+}
+
+void
+addstreamalias(int fd, Rune *alias)
+{
+	Stream *s;
+	for(s = streams; s != nil; s = s->next){
+		if(s->fd == fd){
+			s->nalias++;
+			s->aliases = realloc(s->aliases, sizeof(Rune *) * s->nalias);
+			s->aliases[s->nalias-1] = alias;
+		}
+	}
 }
\ No newline at end of file