summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--builtins.c99
-rw-r--r--dat.h2
-rw-r--r--error.c8
-rw-r--r--eval.c75
-rw-r--r--fns.h5
-rw-r--r--misc.c24
-rw-r--r--parser.c6
-rw-r--r--streams.c18
-rw-r--r--system.pl5
-rw-r--r--types.c2
10 files changed, 106 insertions, 138 deletions
diff --git a/builtins.c b/builtins.c
index 7d32d98..7ef74df 100644
--- a/builtins.c
+++ b/builtins.c
@@ -20,7 +20,6 @@
BuiltinProto(builtintrue);
BuiltinProto(builtinfail);
BuiltinProto(builtincall);
-BuiltinProto(builtincut);
BuiltinProto(builtinvar);
BuiltinProto(builtinatom);
BuiltinProto(builtininteger);
@@ -36,7 +35,6 @@ BuiltinProto(builtinuniv);
BuiltinProto(builtincopyterm);
BuiltinProto(builtinis);
BuiltinProto(builtincatch);
-BuiltinProto(builtinthrow);
BuiltinProto(builtinsetprologflag);
BuiltinProto(builtincurrentprologflags);
BuiltinProto(builtinopen);
@@ -101,8 +99,6 @@ findbuiltin(Term *goal)
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))
@@ -133,8 +129,6 @@ findbuiltin(Term *goal)
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_flags", 1))
@@ -241,21 +235,6 @@ canbecalled(Term *t)
return 1;
}
-void
-updateclausenr(Term *t, uvlong nr)
-{
- /* Change the clause number on the term and its subterms, unless it is a variable */
- if(t->tag == VariableTerm)
- return;
-
- t->clausenr = nr;
- if(t->tag == CompoundTerm){
- Term *child;
- for(child = t->children; child != nil; child = child->next)
- updateclausenr(child, nr);
- }
-}
-
int
builtincall(Term *goal, Binding **bindings, Module *module)
{
@@ -265,27 +244,7 @@ builtincall(Term *goal, Binding **bindings, Module *module)
if(!canbecalled(callgoal))
Throw(typeerror(L"callable", callgoal));
- updateclausenr(callgoal, clausenr);
- clausenr++;
-
- goalstack = addgoals(goalstack, callgoal, module);
- return 1;
-}
-
-int
-builtincut(Term *goal, Binding **bindings, Module *module)
-{
- USED(bindings);
- USED(module);
-
- 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;
+ goalstack = addgoals(goalstack, callgoal, module, clausenr++);
return 1;
}
@@ -563,7 +522,7 @@ builtinuniv(Term *goal, Binding **bindings, Module *module)
list = list->children->next;
for(i = 1; i < len; i++){
- Term *t = copyterm(list->children, nil);
+ Term *t = copyterm(list->children);
elems = appendterm(elems, t);
list = list->children->next;
}
@@ -575,7 +534,7 @@ builtinuniv(Term *goal, Binding **bindings, Module *module)
Term *reallist = mklist(elems);
return unify(list, reallist, bindings);
}else{
- Term *t = copyterm(term, nil);
+ Term *t = copyterm(term);
t->next = mkatom(L"[]");
Term *reallist = mkcompound(L".", 2, t);
return unify(list, reallist, bindings);
@@ -588,8 +547,8 @@ builtincopyterm(Term *goal, Binding **bindings, Module *module)
USED(module);
Term *term1 = goal->children;
Term *term2 = term1->next;
- Term *t = copyterm(term1, &clausenr);
- clausenr++;
+ Term *t = copyterm(term1);
+ renametermvars(t);
return unify(term2, t, bindings);
}
@@ -623,44 +582,11 @@ builtincatch(Term *goal, Binding **bindings, Module *module)
catchframe->next = goalstack;
goalstack = catchframe;
- goalstack = addgoals(goalstack, catchgoal, module);
+ goalstack = addgoals(goalstack, catchgoal, module, clausenr++);
return 1;
}
int
-builtinthrow(Term *goal, Binding **bindings, Module *module)
-{
- USED(bindings);
- USED(module);
-
- Term *ball = goal->children;
-
- Goal *g;
- for(g = goalstack; g != nil; g = g->next){
- if(g->catcher == nil)
- continue;
-
- if(unify(g->catcher, ball, bindings)){
- goalstack = g->next;
- Goal *newgoal = gmalloc(sizeof(Goal));
- newgoal->goal = copyterm(g->goal, nil);
- newgoal->module = g->module;
- 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
builtincurrentprologflags(Term *goal, Binding **bindings, Module *module)
{
USED(module);
@@ -852,13 +778,13 @@ builtinreadterm(Term *goal, Binding **bindings, Module *module)
if(options->tag == CompoundTerm){
VarName *vn;
for(vn = varnames; vn != nil; vn = vn->next){
- uniquevars = appendterm(uniquevars, copyterm(vn->var, nil));
+ uniquevars = appendterm(uniquevars, copyterm(vn->var));
Term *name = mkatom(vn->name);
- name->next = copyterm(vn->var, nil);
+ name->next = copyterm(vn->var);
Term *vnpair = mkcompound(L"=", 2, name);
varsnames = appendterm(varsnames, vnpair);
if(vn->count == 1)
- singlevars = appendterm(singlevars, copyterm(vnpair, nil));
+ singlevars = appendterm(singlevars, copyterm(vnpair));
}
}
@@ -1053,11 +979,10 @@ assertclause(Term *clause, Module *module, int after, int dynamic)
else
arity = 0;
- uvlong id = 0;
Clause *cl = gmalloc(sizeof(Clause));
- cl->head = copyterm(head, &id);
- cl->body = copyterm(body, &id);
- cl->clausenr = id;
+ cl->head = copyterm(head);
+ cl->body = copyterm(body);
+ cl->clausenr = 0;
cl->next = nil;
Predicate *p;
diff --git a/dat.h b/dat.h
index 2855a3e..1061d47 100644
--- a/dat.h
+++ b/dat.h
@@ -30,7 +30,6 @@ struct Term
{
u8int tag;
u8int inparens;
- uvlong clausenr;
Term *next;
union {
@@ -51,6 +50,7 @@ struct Binding
struct Goal
{
Term *goal;
+ uvlong goalnr; /* What clause caused this goal to be activated? */
Module *module; /* What module is this goal to be evaluated in? */
Term *catcher; /* When this is non-nil, the goal is a catch frame, goal is the recovery. */
Goal *next;
diff --git a/error.c b/error.c
index d5ff0bf..ba2877e 100644
--- a/error.c
+++ b/error.c
@@ -15,7 +15,7 @@ Term *
typeerror(Rune *validtype, Term *culprit)
{
Term *valid = mkatom(validtype);
- valid->next = copyterm(culprit, nil);
+ valid->next = copyterm(culprit);
return mkcompound(L"type_error", 2, valid);
}
@@ -23,7 +23,7 @@ Term *
domainerror(Rune *validdomain, Term *culprit)
{
Term *valid = mkatom(validdomain);
- valid->next = copyterm(culprit, nil);
+ valid->next = copyterm(culprit);
return mkcompound(L"domain_error", 2, valid);
}
@@ -31,7 +31,7 @@ Term *
existenceerror(Rune *objecttype, Term *culprit)
{
Term *obj = mkatom(objecttype);
- obj->next = copyterm(culprit, nil);
+ obj->next = copyterm(culprit);
return mkcompound(L"existence_error", 2, obj);
}
@@ -40,7 +40,7 @@ permissionerror(Rune *operation, Rune *permissiontype, Term *culprit)
{
Term *op = mkatom(operation);
op->next = mkatom(permissiontype);
- op->next->next = copyterm(culprit, nil);
+ op->next->next = copyterm(culprit);
return mkcompound(L"permission_error", 3, op);
}
diff --git a/eval.c b/eval.c
index c8388e6..b5f78bc 100644
--- a/eval.c
+++ b/eval.c
@@ -14,19 +14,20 @@ int
evalquery(Term *query)
{
Binding *replbindings = nil;
- goalstack = addgoals(goalstack, query, getmodule(L"user"));
+ goalstack = addgoals(goalstack, query, getmodule(L"user"), 0);
while(goalstack->goal != nil){
Term *goal = goalstack->goal;
Term *catcher = goalstack->catcher;
Module *module = goalstack->module;
+ uvlong goalnr = goalstack->goalnr;
goalstack = goalstack->next;
if(catcher)
continue;
if(flagdebug)
- print("Working goal: %S:%S\n", module->name, prettyprint(goal, 0, 0, 0, nil));
+ print("Working goal %ulld: %S:%S\n", goalnr, module->name, prettyprint(goal, 0, 1, 0, nil));
if(goal->tag == VariableTerm)
goal = instantiationerror();
@@ -35,7 +36,46 @@ evalquery(Term *query)
Binding *bindings = nil;
Clause *clause = nil;
-
+
+ /* handle special cases which need to cut: !/0, throw/1 */
+ if(goal->tag == AtomTerm && runestrcmp(goal->text, L"!") == 0){
+ 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 >= goalnr)
+ cp = cp->next;
+ choicestack = cp;
+ continue;
+ }else if(goal->tag == CompoundTerm && runestrcmp(goal->text, L"throw") == 0 && goal->arity == 1){
+ Term *ball = goal->children;
+ Goal *g;
+ int caught = 0;
+ for(g = goalstack; g != nil && !caught; g = g->next){
+ if(g->catcher == nil)
+ continue;
+
+ if(unify(g->catcher, ball, &bindings)){
+ goalstack = g->next;
+ Goal *newgoal = gmalloc(sizeof(Goal));
+ newgoal->goal = copyterm(g->goal);
+ newgoal->module = g->module;
+ newgoal->catcher = nil;
+ newgoal->next = goalstack;
+ goalstack = newgoal;
+ applybinding(newgoal->goal, bindings);
+
+ Choicepoint *cp = choicestack;
+ while(cp != nil && cp->id >= goalnr)
+ cp = cp->next;
+ choicestack = cp;
+ caught = 1;
+ }
+ }
+ continue;
+ }
+
/* Try to see if the goal can be solved using a builtin first */
Builtin builtin = findbuiltin(goal);
if(builtin != nil){
@@ -79,7 +119,7 @@ evalquery(Term *query)
case UnknownFail:
replacement = mkatom(L"fail");
}
- goalstack = addgoals(goalstack, replacement, module);
+ goalstack = addgoals(goalstack, replacement, module, goalnr);
continue;
}
@@ -111,9 +151,9 @@ Backtrack:
/* Add clause body as goals, with bindings applied */
if(clause != nil && clause->body != nil){
- Term *subgoal = copyterm(clause->body, nil);
+ Term *subgoal = copyterm(clause->body);
applybinding(subgoal, bindings);
- goalstack = addgoals(goalstack, subgoal, module);
+ goalstack = addgoals(goalstack, subgoal, module, clause->clausenr);
}
}
goalstack = goalstack->next;
@@ -122,11 +162,11 @@ Backtrack:
}
Goal *
-addgoals(Goal *goals, Term *t, Module *module)
+addgoals(Goal *goals, Term *t, Module *module, uvlong goalnr)
{
if(t->tag == CompoundTerm && runestrcmp(t->text, L",") == 0 && t->arity == 2){
- goals = addgoals(goals, t->children->next, module);
- goals = addgoals(goals, t->children, module);
+ goals = addgoals(goals, t->children->next, module, goalnr);
+ goals = addgoals(goals, t->children, module, goalnr);
}else{
if(t->tag == CompoundTerm && runestrcmp(t->text, L":") == 0 && t->arity == 2){
Term *moduleterm = t->children;
@@ -143,6 +183,7 @@ addgoals(Goal *goals, Term *t, Module *module)
}
Goal *g = gmalloc(sizeof(Goal));
g->goal = t;
+ g->goalnr = goalnr;
g->module = module;
g->catcher = nil;
g->next = goals;
@@ -194,8 +235,8 @@ unify(Term *a, Term *b, Binding **bindings)
Term *left;
Term *right;
- leftstack = copyterm(a, nil);
- rightstack = copyterm(b, nil);
+ leftstack = copyterm(a);
+ rightstack = copyterm(b);
while(leftstack != nil && rightstack != nil){
left = leftstack;
@@ -211,7 +252,7 @@ unify(Term *a, Term *b, Binding **bindings)
left = right;
right = tmp;
}
- if(left->tag == VariableTerm && right->tag == VariableTerm && right->clausenr > left->clausenr){
+ if(left->tag == VariableTerm && right->tag == VariableTerm && right->varnr > left->varnr){
Term *tmp = left;
left = right;
right = tmp;
@@ -235,12 +276,12 @@ unify(Term *a, Term *b, Binding **bindings)
Term *leftchild = left->children;
Term *rightchild = right->children;
while(leftchild != nil && rightchild != nil){
- Term *t1 = copyterm(leftchild, nil);
+ Term *t1 = copyterm(leftchild);
t1->next = leftstack;
leftstack = t1;
leftchild = leftchild->next;
- Term *t2 = copyterm(rightchild, nil);
+ Term *t2 = copyterm(rightchild);
t2->next = rightstack;
rightstack = t2;
rightchild = rightchild->next;
@@ -300,12 +341,13 @@ copygoals(Goal *goals)
if(goals != nil){
Goal *g = gmalloc(sizeof(Goal));
g->module = goals->module;
+ g->goalnr = goals->goalnr;
if(goals->goal)
- g->goal = copyterm(goals->goal, nil);
+ g->goal = copyterm(goals->goal);
else
g->goal = nil;
if(goals->catcher)
- g->catcher = copyterm(goals->catcher, nil);
+ g->catcher = copyterm(goals->catcher);
else
g->catcher = nil;
g->next = copygoals(goals->next);
@@ -325,6 +367,7 @@ addchoicepoints(Clause *clause, Term *goal, Goal *goals, Module *mod){
Binding *altbindings = nil;
clause = findclause(alt, goal, &altbindings);
if(clause){
+ print("Created choicepoint for %S with id %ulld\n", prettyprint(goal, 0, 1, 0, nil), clause->clausenr);
/* Add choicepoint here */
Choicepoint *cp = gmalloc(sizeof(Choicepoint));
cp->goalstack = copygoals(goals);
diff --git a/fns.h b/fns.h
index a45af7e..c975ceb 100644
--- a/fns.h
+++ b/fns.h
@@ -5,7 +5,8 @@ Term *parse(Biobuf *, Module *, VarName **);
Rune *prettyprint(Term *, int, int, int, Module *);
/* misc.c */
-Term *copyterm(Term *, uvlong *);
+Term *copyterm(Term *);
+void renametermvars(Term *);
void renameclausevars(Clause *);
Term *appendterm(Term *, Term *);
int termslength(Term *);
@@ -22,7 +23,7 @@ Clause *copyclause(Clause *, uvlong *);
int evalquery(Term *);
int unify(Term *, Term *, Binding **);
void applybinding(Term *, Binding *);
-Goal *addgoals(Goal *, Term *, Module *);
+Goal *addgoals(Goal *, Term *, Module *, uvlong);
Predicate *findpredicate(Predicate *, Term *);
Clause *findclause(Clause *, Term *, Binding **);
diff --git a/misc.c b/misc.c
index bf7010f..91396bd 100644
--- a/misc.c
+++ b/misc.c
@@ -8,22 +8,17 @@
static uvlong varnr = 0;
Term *
-copyterm(Term *orig, uvlong *clausenr)
+copyterm(Term *orig)
{
Term *new = gmalloc(sizeof(Term));
memcpy(new, orig, sizeof(Term));
new->next = nil;
new->children = nil;
- if(clausenr)
- new->clausenr = *clausenr;
- else
- new->clausenr = orig->clausenr;
-
if(orig->tag == CompoundTerm){
Term *child;
for(child = orig->children; child != nil; child = child->next)
- new->children = appendterm(new->children, copyterm(child, clausenr));
+ new->children = appendterm(new->children, copyterm(child));
}
return new;
}
@@ -68,6 +63,14 @@ addvarnr(Term *t, uvlong offset)
}
void
+renametermvars(Term *t)
+{
+ uvlong minvar = smallestvar(t);
+ uvlong offset = varnr - minvar;
+ addvarnr(t, offset);
+}
+
+void
renameclausevars(Clause *c)
{
uvlong minhead = smallestvar(c->head);
@@ -108,7 +111,6 @@ mkterm(int tag)
t->next = nil;
t->children = nil;
t->text = nil;
- t->clausenr = 0;
t->inparens = 0;
t->varnr = 0;
return t;
@@ -191,7 +193,7 @@ mklist(Term *elems)
if(elems == nil)
return mkatom(L"[]");
else{
- Term *t = copyterm(elems, nil);
+ Term *t = copyterm(elems);
t->next = mklist(elems->next);
return mkcompound(L".", 2, t);
}
@@ -201,9 +203,9 @@ Clause *
copyclause(Clause *orig, uvlong *clausenr)
{
Clause *new = gmalloc(sizeof(Clause));
- new->head = copyterm(orig->head, clausenr);
+ new->head = copyterm(orig->head);
if(orig->body)
- new->body = copyterm(orig->body, clausenr);
+ new->body = copyterm(orig->body);
else
new->body = nil;
if(clausenr)
diff --git a/parser.c b/parser.c
index 9ce68f1..5758af8 100644
--- a/parser.c
+++ b/parser.c
@@ -66,10 +66,6 @@ parse(Biobuf *bio, Module *mod, VarName **vns)
Term *result = parseterm();
*vns = varnames;
- if(result){
- result = copyterm(result, &clausenr);
- clausenr++;
- }
return result;
}
@@ -215,7 +211,7 @@ parsevar(void)
for(vn = varnames; vn != nil; vn = vn->next, i++)
if(runestrcmp(vn->name, name) == 0 && !runestrcmp(vn->name, L"_") == 0){
vn->count++;
- return copyterm(vn->var, nil);
+ return copyterm(vn->var);
}
VarName *new = gmalloc(sizeof(VarName));
diff --git a/streams.c b/streams.c
index 29e8746..54d5b2d 100644
--- a/streams.c
+++ b/streams.c
@@ -365,7 +365,7 @@ Term *streamproperties(Stream *s)
/* file_name(F) */
if(s->filename){
arg = mkatom(s->filename);
- data = copyterm(stream, nil);
+ data = copyterm(stream);
data->next = mkcompound(L"file_name", 1, arg);
prop = mkcompound(L"prop", 2, data);
props = appendterm(props, prop);
@@ -377,13 +377,13 @@ Term *streamproperties(Stream *s)
case WriteStream: arg = mkatom(L"write"); break;
case AppendStream: arg = mkatom(L"append"); break;
}
- data = copyterm(stream, nil);
+ data = copyterm(stream);
data->next = mkcompound(L"mode", 1, arg);
prop = mkcompound(L"prop", 2, data);
props = appendterm(props, prop);
/* input or output */
- data = copyterm(stream, nil);
+ data = copyterm(stream);
if(s->mode == ReadStream)
data->next = mkatom(L"input");
else
@@ -395,7 +395,7 @@ Term *streamproperties(Stream *s)
int i;
for(i = 0; i < s->nalias; i++){
arg = mkatom(s->aliases[i]);
- data = copyterm(stream, nil);
+ data = copyterm(stream);
data->next = mkcompound(L"alias", 1, arg);
prop = mkcompound(L"prop", 2, data);
props = appendterm(props, prop);
@@ -404,7 +404,7 @@ Term *streamproperties(Stream *s)
/* position(P) */
if(s->reposition){
arg = mkinteger(Boffset(s->bio));
- data = copyterm(stream, nil);
+ data = copyterm(stream);
data->next = mkcompound(L"position", 1, arg);
prop = mkcompound(L"prop", 2, data);
props = appendterm(props, prop);
@@ -419,7 +419,7 @@ Term *streamproperties(Stream *s)
Bungetrune(s->bio);
arg = mkatom(L"not");
}
- data = copyterm(stream, nil);
+ data = copyterm(stream);
data->next = mkcompound(L"end_of_stream", 1, arg);
prop = mkcompound(L"prop", 2, data);
props = appendterm(props, prop);
@@ -431,7 +431,7 @@ Term *streamproperties(Stream *s)
case EofActionEof: arg = mkatom(L"eof_code"); break;
case EofActionReset: arg = mkatom(L"reset"); break;
}
- data = copyterm(stream, nil);
+ data = copyterm(stream);
data->next = mkcompound(L"eof_action", 1, arg);
prop = mkcompound(L"prop", 2, data);
props = appendterm(props, prop);
@@ -441,7 +441,7 @@ Term *streamproperties(Stream *s)
arg = mkatom(L"true");
else
arg = mkatom(L"false");
- data = copyterm(stream, nil);
+ data = copyterm(stream);
data->next = mkcompound(L"reposition", 1, arg);
prop = mkcompound(L"prop", 2, data);
props = appendterm(props, prop);
@@ -451,7 +451,7 @@ Term *streamproperties(Stream *s)
arg = mkatom(L"text");
else
arg = mkatom(L"binary");
- data = copyterm(stream, nil);
+ data = copyterm(stream);
data->next = mkcompound(L"type", 1, arg);
prop = mkcompound(L"prop", 2, data);
props = appendterm(props, prop);
diff --git a/system.pl b/system.pl
index 5883aee..35db774 100644
--- a/system.pl
+++ b/system.pl
@@ -69,8 +69,6 @@ If ; _ :-
_ ; Else :-
Else.
-A , B :- A , B.
-
% Term unification
A = A.
@@ -696,3 +694,6 @@ halt :-
consult(File) :-
loader:load_module_from_file(File).
+
+twice(!) :- '$write_term'(4, 'C ', []).
+twice(true) :- '$write_term'(4, 'Moss ', []). \ No newline at end of file
diff --git a/types.c b/types.c
index 0e70abf..bb672df 100644
--- a/types.c
+++ b/types.c
@@ -69,4 +69,4 @@ listtail(Term *t)
return t->children->next;
else
return nil;
-} \ No newline at end of file
+}
generated by cgit v1.2.3 (git 2.25.1) at 2025-10-13 12:46:46 +0000