ref: 1b73b6d1323c69c0086a41bf85a9b85003377a3b
parent: daadb2b174846cda95e51e0c4c94bcb748da4a69
author: Peter Mikkelsen <peter@pmikkelsen.com>
date: Mon Jul 19 08:44:08 EDT 2021
More work on streams
--- a/builtins.c
+++ b/builtins.c
@@ -63,6 +63,9 @@
BuiltinProto(builtinchoicestacksize);
BuiltinProto(builtincollectgarbage);
BuiltinProto(builtinloadmodulefromfile);
+BuiltinProto(builtinflushoutput);
+BuiltinProto(builtinstreamproperties);
+BuiltinProto(builtinsetstreamposition);
int compareterms(Term *, Term *);
@@ -178,6 +181,12 @@
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 @@
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
--- a/fns.h
+++ b/fns.h
@@ -57,11 +57,15 @@
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);
--- a/stdlib.pl
+++ b/stdlib.pl
@@ -110,6 +110,29 @@
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 :-
--- a/streams.c
+++ b/streams.c
@@ -13,8 +13,11 @@
Biobuf *bio;
int type;
int mode;
+ int reposition;
+ int eofaction;
int nalias;
Rune **aliases;
+ Rune *filename;
Stream *next;
};
@@ -26,9 +29,15 @@
enum {ReadStream,
WriteStream,
- AppendStream
+ AppendStream,
};
+enum {+ EofActionError,
+ EofActionEof,
+ EofActionReset,
+};
+
static Stream *streams;
static Stream *currentinput;
static Stream *currentoutput;
@@ -37,6 +46,8 @@
Stream *getstreambyfd(int);
Stream *getstreambyalias(Rune *);
Stream *getstream(Term *);
+Term *streamproperties(Stream *);
+void addstreamalias(int, Rune *);
void
initstreams(void)
@@ -48,7 +59,10 @@
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 @@
}
Stream *s = openstreamfd(fd, bio, TextStream, smode);
+ s->filename = sourcesink;
*stream = mkinteger(s->fd);
return 0;
}
@@ -192,6 +207,16 @@
}
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 @@
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 @@
{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