shithub: pprolog

Download patch

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;