diff options
Diffstat (limited to 'builtins.c')
| -rw-r--r-- | builtins.c | 117 |
1 files changed, 113 insertions, 4 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); } |