ref: 13efe91101a11f41caf6321a8b2fbdd96ef9927a
parent: 4fba3e66dce0d167d2031a0d1f1f6f4571cbd981
author: Peter Mikkelsen <peter@pmikkelsen.com>
date: Tue Jul 27 12:41:12 EDT 2021
remove clausenr from terms, and put it into goals instead. Next up is implementing the control constructs in C, since they misbehave right now due to the new changes
--- 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(builtincopyterm);
BuiltinProto(builtinis);
BuiltinProto(builtincatch);
-BuiltinProto(builtinthrow);
BuiltinProto(builtinsetprologflag);
BuiltinProto(builtincurrentprologflags);
BuiltinProto(builtinopen);
@@ -101,8 +99,6 @@
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 @@
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 @@
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,31 +244,11 @@
if(!canbecalled(callgoal))
Throw(typeerror(L"callable", callgoal));
- updateclausenr(callgoal, clausenr);
- clausenr++;
-
- goalstack = addgoals(goalstack, callgoal, module);
+ goalstack = addgoals(goalstack, callgoal, module, clausenr++);
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;
- return 1;
-}
-
-int
builtinvar(Term *goal, Binding **bindings, Module *module)
{USED(bindings);
@@ -563,7 +522,7 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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;
--- a/dat.h
+++ b/dat.h
@@ -30,7 +30,6 @@
{u8int tag;
u8int inparens;
- uvlong clausenr;
Term *next;
union {@@ -51,6 +50,7 @@
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;
--- a/error.c
+++ b/error.c
@@ -15,7 +15,7 @@
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 @@
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 @@
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 @@
{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);
}
--- a/eval.c
+++ b/eval.c
@@ -14,12 +14,13 @@
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)
@@ -26,7 +27,7 @@
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 @@
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 @@
case UnknownFail:
replacement = mkatom(L"fail");
}
- goalstack = addgoals(goalstack, replacement, module);
+ goalstack = addgoals(goalstack, replacement, module, goalnr);
continue;
}
@@ -111,9 +151,9 @@
/* 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 @@
}
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 @@
}
Goal *g = gmalloc(sizeof(Goal));
g->goal = t;
+ g->goalnr = goalnr;
g->module = module;
g->catcher = nil;
g->next = goals;
@@ -194,8 +235,8 @@
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 @@
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 @@
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 @@
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 @@
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);
--- a/fns.h
+++ b/fns.h
@@ -5,7 +5,8 @@
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 @@
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 **);
--- a/misc.c
+++ b/misc.c
@@ -8,7 +8,7 @@
static uvlong varnr = 0;
Term *
-copyterm(Term *orig, uvlong *clausenr)
+copyterm(Term *orig)
{Term *new = gmalloc(sizeof(Term));
memcpy(new, orig, sizeof(Term));
@@ -15,15 +15,10 @@
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 @@
}
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 @@
t->next = nil;
t->children = nil;
t->text = nil;
- t->clausenr = 0;
t->inparens = 0;
t->varnr = 0;
return t;
@@ -191,7 +193,7 @@
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 @@
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)
--- a/parser.c
+++ b/parser.c
@@ -66,10 +66,6 @@
Term *result = parseterm();
*vns = varnames;
- if(result){- result = copyterm(result, &clausenr);
- clausenr++;
- }
return result;
}
@@ -215,7 +211,7 @@
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));
--- a/streams.c
+++ b/streams.c
@@ -365,7 +365,7 @@
/* 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 @@
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 @@
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 @@
/* 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 @@
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 @@
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 @@
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 @@
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);
--- a/system.pl
+++ b/system.pl
@@ -69,8 +69,6 @@
_ ; Else :-
Else.
-A , B :- A , B.
-
% Term unification
A = A.
@@ -696,3 +694,6 @@
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
--- a/types.c
+++ b/types.c
@@ -69,4 +69,4 @@
return t->children->next;
else
return nil;
-}
\ No newline at end of file
+}