Start work on input/output streams

1 files changed, 166 insertions, 0 deletions

diff --git a/builtins.c b/builtins.c
index ac2ef75..46b761b 100644
--- a/builtins.c
+++ b/builtins.c
@@ -35,6 +35,12 @@ BuiltinProto(builtincatch);
 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 @@ findbuiltin(Term *goal)
 		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 @@ builtinsetprologflag(Term *database, Term *goal, Goal **goals, Choicepoint **cho
 	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