Add character input/output

1 files changed, 122 insertions, 1 deletions

diff --git a/builtins.c b/builtins.c
index 7230ba4..369ac92 100644
--- a/builtins.c
+++ b/builtins.c
@@ -56,6 +56,10 @@ BuiltinProto(builtinretractone);
 BuiltinProto(builtinabolish);
 BuiltinProto(builtinatomlength);
 BuiltinProto(builtinatomcodes);
+BuiltinProto(builtingetchar);
+BuiltinProto(builtinpeekchar);
+BuiltinProto(builtinputchar);
+BuiltinProto(builtincharcode);
 
 int compareterms(Term *, Term *);
 
@@ -157,6 +161,14 @@ findbuiltin(Term *goal)
 		return builtinatomlength;
 	if(Match(L"atom_codes", 2))
 		return builtinatomcodes;
+	if(Match(L"get_char", 2))
+		return builtingetchar;
+	if(Match(L"peek_char", 2))
+		return builtinpeekchar;
+	if(Match(L"put_char", 2))
+		return builtinputchar;
+	if(Match(L"char_code", 2))
+		return builtincharcode;
 
 	return nil;
 }
@@ -1282,4 +1294,113 @@ builtinatomcodes(Term *goal, Binding **bindings, Module *module)
 		Term *realatom = mkatom(buf);
 		return unify(atom, realatom, bindings);
 	}
-}
\ No newline at end of file
+}
+
+int
+builtingetchar(Term *goal, Binding **bindings, Module *module)
+{
+	USED(module);
+	Term *s = goal->children;
+	Term *ch = s->next;
+
+	if(s->tag == VariableTerm)
+		Throw(instantiationerror());
+	if(ch->tag != VariableTerm && !(ch->tag == AtomTerm && runestrlen(ch->text) == 1))
+		Throw(typeerror(L"in_character", ch));
+	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"input", L"stream", s));
+	if(isbinarystream(s))
+		Throw(permissionerror(L"input", L"binary_stream", s));
+
+	Rune r = getchar(s);
+	Term *realch;
+	if(r == Beof)
+		realch = mkatom(L"end_of_file");
+	else
+		realch = mkatom(runesmprint("%C", r));
+	return unify(ch, realch, bindings);
+}
+
+int
+builtinpeekchar(Term *goal, Binding **bindings, Module *module)
+{
+	USED(module);
+	Term *s = goal->children;
+	Term *ch = s->next;
+
+	if(s->tag == VariableTerm)
+		Throw(instantiationerror());
+	if(ch->tag != VariableTerm && !(ch->tag == AtomTerm && runestrlen(ch->text) == 1))
+		Throw(typeerror(L"in_character", ch));
+	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"input", L"stream", s));
+	if(isbinarystream(s))
+		Throw(permissionerror(L"input", L"binary_stream", s));
+
+	Rune r = peekchar(s);
+	Term *realch;
+	if(r == Beof)
+		realch = mkatom(L"end_of_file");
+	else
+		realch = mkatom(runesmprint("%C", r));
+	return unify(ch, realch, bindings);
+}
+
+int
+builtinputchar(Term *goal, Binding **bindings, Module *module)
+{
+	USED(module);
+	USED(bindings);
+	Term *s = goal->children;
+	Term *ch = s->next;
+
+	if(s->tag == VariableTerm || ch->tag == VariableTerm)
+		Throw(instantiationerror());
+	if(ch->tag != AtomTerm || runestrlen(ch->text) != 1)
+		Throw(typeerror(L"character", ch));
+	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));
+	if(isbinarystream(s))
+		Throw(permissionerror(L"output", L"binary_stream", s));
+
+	putchar(s, ch->text[0]);
+	return 1;
+}
+
+int
+builtincharcode(Term *goal, Binding **bindings, Module *module)
+{
+	USED(module);
+	Term *ch = goal->children;
+	Term *code = ch->next;
+
+	if(ch->tag == VariableTerm && code->tag == VariableTerm)
+		Throw(instantiationerror());
+	if(ch->tag != VariableTerm && !(ch->tag == AtomTerm && runestrlen(ch->text) == 1))
+		Throw(typeerror(L"character", ch));
+	if(code->tag != VariableTerm && code->tag != IntegerTerm)
+		Throw(typeerror(L"integer", code));
+	if(code->ival < 0)
+		Throw(representationerror(L"character_code"));
+
+	if(ch->tag == VariableTerm){
+		Term *realch = mkatom(runesmprint("%C", (Rune)code->ival));
+		return unify(ch, realch, bindings);
+	}else{
+		Term *realcode = mkinteger(ch->text[0]);
+		return unify(code, realcode, bindings);
+	}
+}
+