ref: ee65a81ee5b0112ba4480619ca672c569fb28b45
parent: 1c8789198373a52da9e80dc9b2b1ee2b67af61c4
author: Peter Mikkelsen <[email protected]>
date: Fri Jul 16 10:19:24 EDT 2021
Add character input/output
--- a/builtins.c
+++ b/builtins.c
@@ -56,6 +56,10 @@
BuiltinProto(builtinabolish);
BuiltinProto(builtinatomlength);
BuiltinProto(builtinatomcodes);
+BuiltinProto(builtingetchar);
+BuiltinProto(builtinpeekchar);
+BuiltinProto(builtinputchar);
+BuiltinProto(builtincharcode);
int compareterms(Term *, Term *);
@@ -157,6 +161,14 @@
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 @@
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);
+ }
+}
+
--- a/fns.h
+++ b/fns.h
@@ -61,6 +61,9 @@
int isbinarystream(Term *);
int readterm(Term *, Term **);
void writeterm(Term *, Term *, Term *, Module *);
+Rune getchar(Term *);
+Rune peekchar(Term *);
+void putchar(Term *, Rune);
/* module.c */
void initmodules(void);
--- a/stdlib.pl
+++ b/stdlib.pl
@@ -217,10 +217,6 @@
write_canonical(S, Term) :-
write_term(S, Term, [quoted(true), ignore_ops(true)]).
-nl :-
- write_term('-', []).
-
% Arithmetic comparisons defined in terms of >=. This is not the most effective way,
% but it is fine for now.
@@ -501,3 +497,55 @@
atom_codes(A2, Codes2).
atom_concat(A1, A2, A3) :-
instantiation_error.
+
+% Character input/output
+
+get_char(Char) :-
+ current_input(S),
+ get_char(S, Char).
+
+get_code(Code) :-
+ current_input(S),
+ get_code(S, Code).
+
+get_code(S, Code) :-
+ get_char(S, Char),
+ ( Char = end_of_file
+ -> Code = -1
+ ; char_code(Char, Code)
+ ).
+
+peek_char(Char) :-
+ current_input(S),
+ peek_char(S, Char).
+
+peek_code(Code) :-
+ current_input(S),
+ peek_code(S, Code).
+
+peek_code(S, Code) :-
+ peek_char(S, Char),
+ ( Char = end_of_file
+ -> Code = -1
+ ; char_code(Char, Code)
+ ).
+
+put_char(Char) :-
+ current_output(S),
+ put_char(S, Char).
+
+put_code(Code) :-
+ current_output(S),
+ put_code(S, Code).
+
+put_code(S, Code) :-
+ char_code(Char, Code),
+ put_char(S, Char).
+
+nl :-
+ current_output(S),
+ nl(S).
+
+nl(S) :-
+ put_char(S, '
+'). % This should really be \n
--- a/streams.c
+++ b/streams.c
@@ -283,3 +283,26 @@
return s;
}
+Rune
+getchar(Term *t)
+{+ Stream *s = getstream(t);
+ return Bgetrune(s->bio);
+}
+
+Rune
+peekchar(Term *t)
+{+ Stream *s = getstream(t);
+ Rune r = Bgetrune(s->bio);
+ Bungetrune(s->bio);
+ return r;
+}
+
+void
+putchar(Term *t, Rune r)
+{+ Stream *s = getstream(t);
+ Bprint(s->bio, "%C", r);
+ Bflush(s->bio);
+}
\ No newline at end of file