From ee65a81ee5b0112ba4480619ca672c569fb28b45 Mon Sep 17 00:00:00 2001 From: Peter Mikkelsen Date: Fri, 16 Jul 2021 14:19:24 +0000 Subject: Add character input/output --- builtins.c | 123 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- fns.h | 3 ++ stdlib.pl | 56 ++++++++++++++++++++++++++-- streams.c | 23 ++++++++++++ 4 files changed, 200 insertions(+), 5 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); + } +} + diff --git a/fns.h b/fns.h index e6f454a..caf9c2e 100644 --- a/fns.h +++ b/fns.h @@ -61,6 +61,9 @@ int istextstream(Term *); 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); diff --git a/stdlib.pl b/stdlib.pl index d31e3ab..0986781 100644 --- a/stdlib.pl +++ b/stdlib.pl @@ -217,10 +217,6 @@ write_canonical(Term) :- 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_concat(A1, A2, A3) :- 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 diff --git a/streams.c b/streams.c index e090cdb..63a7099 100644 --- a/streams.c +++ b/streams.c @@ -283,3 +283,26 @@ getstream(Term *t) 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 -- cgit v1.2.3