diff options
| -rw-r--r-- | builtins.c | 117 | ||||
| -rw-r--r-- | fns.h | 2 | ||||
| -rw-r--r-- | stdlib.pl | 29 | ||||
| -rw-r--r-- | streams.c | 5 |
4 files changed, 143 insertions, 10 deletions
@@ -135,7 +135,7 @@ findbuiltin(Term *goal) 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 @@ builtinsetoutput(Term *goal, Binding **bindings, Module *module) 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 @@ builtinreadterm(Term *goal, Binding **bindings, Module *module) 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,10 +848,55 @@ builtinreadterm(Term *goal, Binding **bindings, Module *module) 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); } @@ -59,7 +59,7 @@ int isinputstream(Term *); 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 */ @@ -97,6 +97,24 @@ syntax_error(Error) :- 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), @@ -106,6 +124,9 @@ read(Term) :- 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(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. @@ -240,6 +265,8 @@ is_nonvar(T) :- nonvar(T), ! ; instantiation_error. 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_concat(A1, A2, A3) :- atom_codes(A1, Codes1), atom_codes(A2, Codes2). atom_concat(A1, A2, A3) :- - instantiation_error.
\ No newline at end of file + instantiation_error. @@ -192,16 +192,13 @@ isbinarystream(Term *t) } 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; |