ref: 2a77288e28f2725b5621c239d2393d49f61993e8
parent: d4fc86d5988dacfca455cac55aae71ad4fd3bb95
author: Peter Mikkelsen <peter@pmikkelsen.com>
date: Thu Jul 15 18:04:03 EDT 2021
Make read_term understand the three read options: variables(Vars), variable_names(VarNames), singletons(Singles) as required per the ISO standard
--- a/builtins.c
+++ b/builtins.c
@@ -135,7 +135,7 @@
return builtinsetinput;
if(Match(L"set_output", 1))
return builtinsetoutput;
- if(Match(L"read_term", 3))
+ if(Match(L"$read_term", 3))
return builtinreadterm;
if(Match(L"write_term", 3))
return builtinwriteterm;
@@ -760,6 +760,72 @@
return 1;
}
+Term *
+readtermvars(Term *t)
+{
+ Term *vars;
+ switch(t->tag){
+ case VariableTerm:
+ vars = copyterm(t, nil);
+ break;
+ case CompoundTerm:
+ vars = nil;
+ int n = t->arity;
+ for(t = t->children; n > 0; t = t->next, n--){
+ Term *childvars = readtermvars(t);
+ while(childvars){
+ Term *childvarscopy = copyterm(childvars, nil);
+ vars = appendterm(vars, childvarscopy);
+ childvars = childvars->next;
+ }
+ }
+ break;
+ default:
+ vars = nil;
+ }
+ return vars;
+}
+
+Term *
+varsandnames(Term *vars)
+{
+ Term *varsnames = nil;
+ Term *var;
+ for(var = vars; var != nil; var = var->next){
+ if(runestrcmp(var->text, L"_") == 0)
+ continue;
+ Term *varname = mkatom(var->text);
+ varname->next = copyterm(var, nil);
+ Term *pair = mkcompound(L"=", 2, varname);
+ varsnames = appendterm(varsnames, pair);
+ }
+ return varsnames;
+}
+
+Term *
+singletons(Term *vars)
+{
+ Term *var;
+ Term *varsnames = varsandnames(vars);
+ Term *singles = nil;
+
+ for(var = varsnames; var != nil; var = var->next){
+ Term *tmp;
+ int duplicate = 0;
+ for(tmp = varsnames; tmp != nil ; tmp = tmp->next){
+ if(tmp == var)
+ continue;
+ if(runestrcmp(var->children->text, tmp->children->text) == 0){
+ duplicate = 1;
+ break;
+ }
+ }
+ if(!duplicate)
+ singles = appendterm(singles, copyterm(var, nil));
+ }
+ return singles;
+}
+
int
builtinreadterm(Term *goal, Binding **bindings, Module *module)
{
@@ -772,8 +838,6 @@
if(stream->tag == VariableTerm)
Throw(instantiationerror());
- if(options->tag != AtomTerm || runestrcmp(options->text, L"[]") != 0)
- Throw(typeerror(L"empty_list", options));
if(stream->tag != IntegerTerm && stream->tag != AtomTerm)
Throw(domainerror(L"stream_or_alias", stream));
if(!isopenstream(stream))
@@ -784,9 +848,54 @@
Throw(permissionerror(L"input", L"binary_stream", stream));
Term *realterm;
- int error = readterm(stream, options, &realterm);
+ int error = readterm(stream, &realterm);
if(error)
Throw(realterm);
+
+ Term *singlevars = nil;
+ Term *uniquevars = nil;
+ Term *varsnames = nil;
+ if(options->tag == CompoundTerm){
+ Term *allvars = readtermvars(realterm);
+ Term *tmp1;
+ for(tmp1 = allvars; tmp1 != nil; tmp1 = tmp1->next){
+ Term *tmp2;
+ int duplicate = 0;
+ for(tmp2 = uniquevars; tmp2 != nil; tmp2 = tmp2->next){
+ if(runestrcmp(tmp2->text, tmp1->text) == 0){
+ duplicate = 1;
+ break;
+ }
+ }
+ if(!duplicate){
+ Term *v = copyterm(tmp1, nil);
+ uniquevars = appendterm(uniquevars, v);
+ }
+ }
+
+ varsnames = varsandnames(uniquevars);
+ singlevars = singletons(allvars);
+ }
+
+ Term *op;
+ for(op = options; op->tag == CompoundTerm; op = op->children->next){
+ Term *opkey = op->children->children;
+ Term *opval = opkey->next;
+
+ if(runestrcmp(opkey->text, L"variables") == 0){
+ Term *variablelist = mklist(uniquevars);
+ if(unify(opval, variablelist, bindings) == 0)
+ return 0;
+ }else if(runestrcmp(opkey->text, L"variable_names") == 0){
+ Term *list = mklist(varsnames);
+ if(unify(opval, list, bindings) == 0)
+ return 0;
+ }else if(runestrcmp(opkey->text, L"singletons") == 0){
+ Term *list = mklist(singlevars);
+ if(unify(opval, list, bindings) == 0)
+ return 0;
+ }
+ }
return unify(term, realterm, bindings);
}
--- a/fns.h
+++ b/fns.h
@@ -59,7 +59,7 @@
int isoutputstream(Term *);
int istextstream(Term *);
int isbinarystream(Term *);
-int readterm(Term *, Term *, Term **);
+int readterm(Term *, Term **);
void writeterm(Term *, Term *, Term *);
/* module.c */
--- a/stdlib.pl
+++ b/stdlib.pl
@@ -97,7 +97,25 @@
throw(error(syntax_error(Error), _)).
% Input and output
+parse_read_option(variables(Vs), options(variables, Vs)).
+parse_read_option(variable_names(VNames), option(variable_names, VNames)).
+parse_read_option(singletons(S), options(singletons, S)).
+parse_read_options([], []).
+parse_read_options([Op|Rest], [OpParsed|RestParsed]) :-
+ is_nonvar(Op),
+ parse_read_options(Rest, RestParsed),
+ ( parse_read_option(Op, OpParsed)
+ -> true
+ ; domain_error(read_option, Op)
+ ).
+
+read_term(S, Term, Options) :-
+ is_nonvar(Options),
+ is_list(Options),
+ parse_read_options(Options, ParsedOptions),
+ '$read_term'(S, Term, ParsedOptions).
+
read_term(Term, Options) :-
current_input(S),
read_term(S, Term, Options).
@@ -106,6 +124,9 @@
current_input(S),
read_term(S, Term, []).
+read(S, Term) :-
+ read_term(S, Term, []).
+
write_term(Term, Options) :-
current_output(S),
write_term(S, Term, Options).
@@ -128,6 +149,10 @@
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.
@@ -240,6 +265,8 @@
is_list_or_partial_list(T) :- (list(T) ; partial_list(T)), ! ; type_error(list, T).
+is_list(T) :- list(T), ! ; type_error(list, T).
+
% All solutions
findall(Template, Goal, Instances) :-
@@ -405,4 +432,4 @@
atom_codes(A1, Codes1),
atom_codes(A2, Codes2).
atom_concat(A1, A2, A3) :-
- instantiation_error.
\ No newline at end of file
+ instantiation_error.
--- a/streams.c
+++ b/streams.c
@@ -192,16 +192,13 @@
}
int
-readterm(Term *stream, Term *options, Term **term)
+readterm(Term *stream, Term **term)
{
- USED(options);
-
Stream *s = getstream(stream);
if(s == nil){
*term = existenceerror(L"stream", stream);
return 1;
}
- print(": ");
*term = parse(0, s->bio, 1);
return 0;