ref: 0c45e33c1b8d094353a5585c44179d1818ff6e1e
dir: /builtins.c/
#include <u.h>
#include <libc.h>
#include <bio.h>
#include "dat.h"
#include "fns.h"
#define BuiltinProto(name) int name(Term *, Binding **)
#define Match(X, Y) (runestrcmp(name, X) == 0 && arity == Y)
#define Throw(What) do{\
Goal *g = malloc(sizeof(Goal)); \
g->goal = What; \
g->catcher = nil; \
g->next = goalstack; \
goalstack = g; \
return 1; \
}while(0)
BuiltinProto(builtinfail);
BuiltinProto(builtincall);
BuiltinProto(builtincut);
BuiltinProto(builtinvar);
BuiltinProto(builtinatom);
BuiltinProto(builtininteger);
BuiltinProto(builtinfloat);
BuiltinProto(builtinatomic);
BuiltinProto(builtincompound);
BuiltinProto(builtinnonvar);
BuiltinProto(builtinnumber);
BuiltinProto(builtincompare);
BuiltinProto(builtinfunctor);
BuiltinProto(builtinarg);
BuiltinProto(builtinuniv);
BuiltinProto(builtinis);
BuiltinProto(builtincatch);
BuiltinProto(builtinthrow);
BuiltinProto(builtinsetprologflag);
BuiltinProto(builtincurrentprologflag);
BuiltinProto(builtinopen);
BuiltinProto(builtinclose);
BuiltinProto(builtincurrentinput);
BuiltinProto(builtincurrentoutput);
BuiltinProto(builtinsetinput);
BuiltinProto(builtinsetoutput);
BuiltinProto(builtinreadterm);
BuiltinProto(builtinwriteterm);
int compareterms(Term *, Term *);
Builtin
findbuiltin(Term *goal)
{
int arity;
Rune *name;
switch(goal->tag){
case AtomTerm:
arity = 0;
name = goal->text;
break;
case CompoundTerm:
arity = goal->arity;
name = goal->text;
break;
default:
return nil;
}
/* Rewrite this so its not just a long if chain */
if(Match(L"fail", 0))
return builtinfail;
if(Match(L"call", 1))
return builtincall;
if(Match(L"!", 0))
return builtincut;
if(Match(L"var", 1))
return builtinvar;
if(Match(L"atom", 1))
return builtinatom;
if(Match(L"integer", 1))
return builtininteger;
if(Match(L"float", 1))
return builtinfloat;
if(Match(L"atomic", 1))
return builtinatomic;
if(Match(L"compound", 1))
return builtincompound;
if(Match(L"nonvar", 1))
return builtinnonvar;
if(Match(L"number", 1))
return builtinnumber;
if(Match(L"compare", 3))
return builtincompare;
if(Match(L"functor", 3))
return builtinfunctor;
if(Match(L"arg", 3))
return builtinarg;
if(Match(L"=..", 2))
return builtinuniv;
if(Match(L"is", 2))
return builtinis;
if(Match(L"catch", 3))
return builtincatch;
if(Match(L"throw", 1))
return builtinthrow;
if(Match(L"set_prolog_flag", 2))
return builtinsetprologflag;
if(Match(L"current_prolog_flag", 2))
return builtincurrentprologflag;
if(Match(L"open", 4))
return builtinopen;
if(Match(L"close", 2))
return builtinclose;
if(Match(L"current_input", 1))
return builtincurrentinput;
if(Match(L"current_output", 1))
return builtincurrentoutput;
if(Match(L"set_input", 1))
return builtinsetinput;
if(Match(L"set_output", 1))
return builtinsetoutput;
if(Match(L"read_term", 3))
return builtinreadterm;
if(Match(L"write_term", 3))
return builtinwriteterm;
return nil;
}
int
builtinfail(Term *goal, Binding **bindings)
{
USED(goal);
USED(bindings);
return 0;
}
int
builtincall(Term *goal, Binding **bindings)
{
USED(bindings);
Goal *g = malloc(sizeof(Goal));
g->goal = goal->children;
g->catcher = nil;
g->next = goalstack;
goalstack = g;
return 1;
}
int
builtincut(Term *goal, Binding **bindings)
{
USED(bindings);
Choicepoint *cp = choicestack;
/* Cut all choicepoints with an id larger or equal to the goal clause number, since they must have been introduced
after this goal's parent.
*/
while(cp != nil && cp->id >= goal->clausenr)
cp = cp->next;
choicestack = cp;
return 1;
}
int
builtinvar(Term *goal, Binding **bindings)
{
USED(bindings);
Term *arg = goal->children;
return (arg->tag == VariableTerm);
}
int
builtinatom(Term *goal, Binding **bindings)
{
USED(bindings);
Term *arg = goal->children;
return (arg->tag == AtomTerm);
}
int
builtininteger(Term *goal, Binding **bindings)
{
USED(bindings);
Term *arg = goal->children;
return (arg->tag == IntegerTerm);
}
int
builtinfloat(Term *goal, Binding **bindings)
{
USED(bindings);
Term *arg = goal->children;
return (arg->tag == FloatTerm);
}
int
builtinatomic(Term *goal, Binding **bindings)
{
USED(bindings);
Term *arg = goal->children;
return (arg->tag == AtomTerm || arg->tag == FloatTerm || arg->tag == IntegerTerm);
}
int
builtincompound(Term *goal, Binding **bindings)
{
USED(bindings);
Term *arg = goal->children;
return (arg->tag == CompoundTerm);
}
int
builtinnonvar(Term *goal, Binding **bindings)
{
USED(bindings);
Term *arg = goal->children;
return (arg->tag != VariableTerm);
}
int
builtinnumber(Term *goal, Binding **bindings)
{
USED(bindings);
Term *arg = goal->children;
return (arg->tag == FloatTerm || arg->tag == IntegerTerm);
}
#define Compare(A, B) ((A < B) ? -1 : ((A > B) ? 1 : 0))
int
compareterms(Term *t1, Term *t2)
{
int result = 0;
if(t1->tag != t2->tag)
result = Compare(t1->tag, t2->tag);
else{
/* Same type term */
switch(t1->tag){
case VariableTerm:
if(t1->clausenr == t2->clausenr)
result = runestrcmp(t1->text, t2->text);
else
result = Compare(t1->clausenr, t2->clausenr);
break;
case FloatTerm:
result = Compare(t1->dval, t2->dval);
break;
case IntegerTerm:
result = Compare(t1->ival, t2->ival);
break;
case AtomTerm:
result = runestrcmp(t1->text, t2->text);
break;
case CompoundTerm:
result = Compare(t1->arity, t2->arity);
if(result != 0)
break;
result = runestrcmp(t1->text, t2->text);
if(result != 0)
break;
t1 = t1->children;
t2 = t2->children;
while(t1 != nil && t2 != nil){
result = compareterms(t1, t2);
if(result != 0)
break;
else
t1 = t1->next;
t2 = t2->next;
}
break;
}
}
return result;
}
int
builtincompare(Term *goal, Binding **bindings)
{
Term *order = goal->children;
Term *t1 = order->next;
Term *t2 = t1->next;
int result = compareterms(t1, t2);
Term *resultorder;
if(result == -1)
resultorder = mkatom(L"<");
else if(result == 0)
resultorder = mkatom(L"=");
else
resultorder = mkatom(L">");
return unify(order, resultorder, bindings);
}
int
builtinfunctor(Term *goal, Binding **bindings)
{
Term *term = goal->children;
Term *name = term->next;
Term *arity = name->next;
if(term->tag == CompoundTerm){
Term *realname = mkatom(term->text);
Term *realarity = mkinteger(term->arity);
if(unify(name, realname, bindings) && unify(arity, realarity, bindings))
return 1;
}else if(arity->tag == IntegerTerm &&
(name->tag == AtomTerm || name->tag == IntegerTerm || name->tag == FloatTerm)){
if(arity->ival == 0)
return unify(term, name, bindings);
else{
if(name->tag != AtomTerm)
return 0;
/* Make arity maky fresh variables */
int i;
Term *args = nil;
for(i = 0; i < arity->ival; i++){
Rune *varname = runesmprint("FunctorVar%d", i);
Term *arg = mkvariable(varname);
args = appendterm(args, arg);
}
Term *realterm = mkcompound(name->text, arity->ival, args);
return unify(term, realterm, bindings);
}
}
return 0;
}
int
builtinarg(Term *goal, Binding **bindings)
{
Term *n = goal->children;
Term *term = n->next;
Term *arg = term->next;
if(n->tag != IntegerTerm)
return 0;
if(n->ival < 0)
Throw(domainerror(L"not_less_than_zero", n));
if(term->tag != CompoundTerm)
return 0;
if(n->ival >= term->arity)
return 0;
int i;
Term *t;
for(i = 0, t = term->children; i < n->ival; i++, t = t->next);
return unify(arg, t, bindings);
}
int
listlength(Term *term)
{
if(term->tag == AtomTerm && runestrcmp(term->text, L"[]") == 0)
return 0;
else if(term->tag == CompoundTerm && term->arity == 2 && runestrcmp(term->text, L".") == 0){
int taillength = listlength(term->children->next);
return (taillength == -1) ? -1 : 1 + taillength;
}else
return -1;
}
int
builtinuniv(Term *goal, Binding **bindings)
{
Term *term = goal->children;
Term *list = term->next;
int len;
if(term->tag == VariableTerm){
Rune *name;
Term *elems = nil;
Term *realterm;
int i;
len = listlength(list);
if(len < 1)
return 0;
if(list->children->tag != AtomTerm)
return 0;
name = list->children->text;
list = list->children->next;
for(i = 1; i < len; i++){
Term *t = copyterm(list->children, nil);
elems = appendterm(elems, t);
list = list->children->next;
}
realterm = mkcompound(name, len-1, elems);
return unify(term, realterm, bindings);
}else if(term->tag == CompoundTerm){
Term *elems = mkatom(term->text);
elems->next = term->children;
Term *reallist = mklist(elems);
return unify(list, reallist, bindings);
}else{
Term *t = copyterm(term, nil);
t->next = mkatom(L"[]");
Term *reallist = mkcompound(L".", 2, t);
return unify(list, reallist, bindings);
}
}
#define ToFloat(t) (t->tag == IntegerTerm ? (double)t->ival : t->dval)
Term *
aritheval(Term *expr)
{
/* Not every arithmetic operation is defined right now. */
if(expr->tag == FloatTerm || expr->tag == IntegerTerm)
return expr;
else if(expr->tag == CompoundTerm && expr->arity == 2){
Term *A = aritheval(expr->children);
Term *B = aritheval(expr->children->next);
Term *result = mkinteger(0);
if(A == nil || B == nil)
return nil;
if(runestrcmp(expr->text, L"+") == 0){
if(A->tag == IntegerTerm && B->tag == IntegerTerm){
result->tag = IntegerTerm;
result->ival = A->ival + B->ival;
}else{
result->tag = FloatTerm;
result->dval = ToFloat(A) + ToFloat(B);
}
}else
return nil;
return result;
}else
return nil;
}
int
builtinis(Term *goal, Binding **bindings)
{
Term *result = goal->children;
Term *expr = result->next;
Term *realresult = aritheval(expr);
if(realresult)
return unify(result, realresult, bindings);
else
return 0;
}
int
builtincatch(Term *goal, Binding **bindings)
{
USED(bindings);
Term *catchgoal = goal->children;
Term *catcher = catchgoal->next;
Term *recover = catcher->next;
Goal *catchframe = malloc(sizeof(Goal));
catchframe->goal = recover;
catchframe->catcher = catcher;
catchframe->next = goalstack;
goalstack = catchframe;
Goal *g = malloc(sizeof(Goal));
g->goal = catchgoal;
g->catcher = nil;
g->next = goalstack;
goalstack = g;
return 1;
}
int
builtinthrow(Term *goal, Binding **bindings)
{
USED(bindings);
Term *ball = goal->children;
print("Throwing: %S\n", prettyprint(ball, 0, 0, 0));
Goal *g;
for(g = goalstack; g != nil; g = g->next){
if(g->catcher == nil)
continue;
if(unify(g->catcher, ball, bindings)){
if(g->goal == nil){
/* As soon as we have print facilities as builtins, we can avoid this by having the protector frame have a unhandled exception handler*/
print("Unhandled exception: %S\n", prettyprint(ball, 0, 0, 0));
exits("exception");
return 0;
}else{
goalstack = g->next;
Goal *newgoal = malloc(sizeof(Goal));
newgoal->goal = copyterm(g->goal, nil);
newgoal->catcher = nil;
newgoal->next = goalstack;
goalstack = newgoal;
applybinding(newgoal->goal, *bindings);
Choicepoint *cp = choicestack;
while(cp != nil && cp->id >= goal->clausenr)
cp = cp->next;
choicestack = cp;
return 1;
}
}
}
return 0;
}
int
builtincurrentprologflag(Term *goal, Binding **bindings)
{
USED(goal);
USED(bindings);
return 0;
}
int
builtinsetprologflag(Term *goal, Binding **bindings)
{
USED(bindings);
Term *key = goal->children;
Term *value = key->next;
if(key->tag == VariableTerm || value->tag == VariableTerm)
Throw(instantiationerror());
if(key->tag != AtomTerm)
Throw(typeerror(L"atom", key));
Term *error = setflag(key->text, value);
if(error)
Throw(error);
return 1;
}
int
builtinopen(Term *goal, Binding **bindings)
{
USED(bindings);
Term *sourcesink = goal->children;
Term *mode = sourcesink->next;
Term *stream = mode->next;
Term *options = stream->next;
if(sourcesink->tag == VariableTerm || mode->tag == VariableTerm || options->tag == VariableTerm)
Throw(instantiationerror());
if(stream->tag != VariableTerm)
Throw(typeerror(L"variable", stream));
if(options->tag != AtomTerm || runestrcmp(options->text, L"[]") != 0)
Throw(typeerror(L"empty_list", options));
if(mode->tag != AtomTerm)
Throw(typeerror(L"atom", mode));
if(sourcesink->tag != AtomTerm)
Throw(domainerror(L"source_sink", sourcesink));
Term *newstream;
int error = openstream(sourcesink->text, mode->text, options, &newstream);
if(error)
Throw(newstream);
else
return unify(stream, newstream, bindings);
return 0;
}
int
builtinclose(Term *goal, Binding **bindings)
{
USED(bindings);
Term *stream = goal->children;
Term *options = stream->next;
if(stream->tag == VariableTerm || options->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))
Throw(existenceerror(L"stream", stream));
closestream(stream);
return 1;
}
int
builtincurrentinput(Term *goal, Binding **bindings)
{
USED(bindings);
Term *stream = goal->children;
if(stream->tag != VariableTerm && stream->tag != IntegerTerm)
Throw(domainerror(L"stream", stream));
Term *current = currentinputstream();
return unify(stream, current, bindings);
}
int
builtincurrentoutput(Term *goal, Binding **bindings)
{
USED(bindings);
Term *stream = goal->children;
if(stream->tag != VariableTerm && stream->tag != IntegerTerm)
Throw(domainerror(L"stream", stream));
Term *current = currentoutputstream();
return unify(stream, current, bindings);
}
int
builtinsetinput(Term *goal, Binding **bindings)
{
USED(bindings);
Term *stream = goal->children;
if(stream->tag == VariableTerm)
Throw(instantiationerror());
if(stream->tag != IntegerTerm && stream->tag != AtomTerm)
Throw(domainerror(L"stream_or_alias", stream));
if(!isopenstream(stream))
Throw(existenceerror(L"stream", stream));
if(!isinputstream(stream))
Throw(permissionerror(L"input", L"stream", stream));
setcurrentinputstream(stream);
return 1;
}
int
builtinsetoutput(Term *goal, Binding **bindings)
{
USED(bindings);
Term *stream = goal->children;
if(stream->tag == VariableTerm)
Throw(instantiationerror());
if(stream->tag != IntegerTerm && stream->tag != AtomTerm)
Throw(domainerror(L"stream_or_alias", stream));
if(!isopenstream(stream))
Throw(existenceerror(L"stream", stream));
if(!isoutputstream(stream))
Throw(permissionerror(L"output", L"stream", stream));
setcurrentoutputstream(stream);
return 1;
}
int
builtinreadterm(Term *goal, Binding **bindings)
{
USED(bindings);
Term *stream = goal->children;
Term *term = stream->next;
Term *options = term->next;
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))
Throw(existenceerror(L"stream", stream));
if(isoutputstream(stream))
Throw(permissionerror(L"input", L"stream", stream));
if(isbinarystream(stream))
Throw(permissionerror(L"input", L"binary_stream", stream));
Term *realterm;
int error = readterm(stream, options, &realterm);
if(error)
Throw(realterm);
return unify(term, realterm, bindings);
}
int
builtinwriteterm(Term *goal, Binding **bindings)
{
USED(bindings);
Term *stream = goal->children;
Term *term = stream->next;
Term *options = term->next;
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))
Throw(existenceerror(L"stream", stream));
if(isinputstream(stream))
Throw(permissionerror(L"output", L"stream", stream));
if(isbinarystream(stream))
Throw(permissionerror(L"output", L"binary_stream", stream));
writeterm(stream, options, term);
return 1;
}