Sindbad~EG File Manager
./Makefile 0000644 0002044 0001012 00000000641 11120534727 010756 0 ustar beeson DEFINES= -D'__STRICT_ANSI__' -D'__declspec(x)=' -D'_export=' -D'NOMATHXPERT'
all: otter2 otter $(OBJS)
gcc *.o -lm -o otter-lambda
otter2: otter2/*.c otter2/*.h Makefile
gcc -c -g $(DEFINES) -I otter -I otter2 otter2/*.c
otter: otter/*.c otter/*.h Makefile
gcc -c -g $(DEFINES) -I otter -I otter2 otter/*.c
exe: Makefile
gcc *.o -lm -o otter-lambda
clean:
-rm *.o
-rm otter-lambda
./otter/ 0000777 0002044 0001012 00000000000 11120534312 010444 5 ustar beeson ./otter/attrib.c 0000744 0002044 0001012 00000013155 11026756616 012121 0 ustar beeson /*
* attrib.c - attributes of clauses
*
*/
#include "header.h"
struct {
char *name;
int type;
} Attributes[MAX_ATTRIBUTES];
/*************
*
* init_attributes()
*
*************/
void init_attributes(void)
{
int i;
for (i = 0; i < MAX_ATTRIBUTES; i++)
Attributes[i].name = "";
Attributes[BSUB_HINT_WT_ATTR].name = "bsub_hint_wt";
Attributes[BSUB_HINT_WT_ATTR].type = INT_ATTR;
Attributes[FSUB_HINT_WT_ATTR].name = "fsub_hint_wt";
Attributes[FSUB_HINT_WT_ATTR].type = INT_ATTR;
Attributes[EQUIV_HINT_WT_ATTR].name = "equiv_hint_wt";
Attributes[EQUIV_HINT_WT_ATTR].type = INT_ATTR;
Attributes[BSUB_HINT_ADD_WT_ATTR].name = "bsub_hint_add_wt";
Attributes[BSUB_HINT_ADD_WT_ATTR].type = INT_ATTR;
Attributes[FSUB_HINT_ADD_WT_ATTR].name = "fsub_hint_add_wt";
Attributes[FSUB_HINT_ADD_WT_ATTR].type = INT_ATTR;
Attributes[EQUIV_HINT_ADD_WT_ATTR].name = "equiv_hint_add_wt";
Attributes[EQUIV_HINT_ADD_WT_ATTR].type = INT_ATTR;
Attributes[LABEL_ATTR].name = "label";
Attributes[LABEL_ATTR].type = STRING_ATTR;
} /* init_attributes */
/*************
*
* get_attribute_index()
*
* Return -1 if s is not any known attribute.
*
*************/
int get_attribute_index(char *s)
{
int i, found;
if (str_ident(s, ""))
return(-1);
else {
for (i = 0, found = 0; i < MAX_ATTRIBUTES && !found; i++)
found = str_ident(s, Attributes[i].name);
return(found ? i-1 : -1);
}
} /* get_attribute_index */
/*************
*
* attribute_type()
*
*************/
int attribute_type(int name)
{
switch (name) {
case BSUB_HINT_WT_ATTR: return(INT_ATTR);
case FSUB_HINT_WT_ATTR: return(INT_ATTR);
case EQUIV_HINT_WT_ATTR: return(INT_ATTR);
case BSUB_HINT_ADD_WT_ATTR: return(INT_ATTR);
case FSUB_HINT_ADD_WT_ATTR: return(INT_ATTR);
case EQUIV_HINT_ADD_WT_ATTR: return(INT_ATTR);
case LABEL_ATTR: return(STRING_ATTR);
default:
printf("%d ", name);
abend("attribute_type: unknown attribute name");
return(-1);
}
} /* attribute_type */
/*************
*
* get_attribute()
*
* Return the attribute (the whole node) associated with an
* attribute name. If it does not exist, return NULL.
*
*************/
struct cl_attribute *get_attribute(struct clause *c,
int name)
{
struct cl_attribute *a;
for (a = c->attributes; a && a->name != name; a = a->next);
return(a);
} /* get_attribute */
/*************
*
* set_attribute()
*
*************/
void set_attribute(struct clause *c,
int name,
void *val_ptr)
{
struct cl_attribute *a1;
a1 = get_cl_attribute();
a1->next = c->attributes;
c->attributes = a1;
a1->name = name;
switch (attribute_type(name)) {
case INT_ATTR:
case BOOL_ATTR:
a1->u.i = *((int *) val_ptr);
break;
case DOUBLE_ATTR:
a1->u.d = *((double *) val_ptr);
break;
case STRING_ATTR:
a1->u.s = (char *) val_ptr;
break;
case TERM_ATTR:
a1->u.t = (struct term *) val_ptr;
break;
}
} /* set_attribute */
/*************
*
* delete_attributes()
*
*************/
void delete_attributes(struct clause *c)
{
struct cl_attribute *a1, *a2;
a1 = c->attributes;
while (a1) {
if (attribute_type(a1->name) == TERM_ATTR)
zap_term(a1->u.t);
a2 = a1;
a1 = a1->next;
free_cl_attribute(a2);
}
} /* delete_attributes */
/*************
*
* term_to_attributes()
*
* If error, print message to stdout and return NULL;
*
*************/
struct cl_attribute *term_to_attributes(struct term *t)
{
if (!is_symbol(t, "#", 2)) {
struct cl_attribute *a = get_cl_attribute();
struct term *attr_val;
int i;
if (sn_to_arity(t->sym_num) != 1) {
printf("attributes must have arity 1: ");
p_term(t);
return(NULL);
}
a->name = get_attribute_index(sn_to_str(t->sym_num));
attr_val = t->farg->argval;
switch(attribute_type(a->name)) {
case INT_ATTR:
if (str_int(sn_to_str(attr_val->sym_num), &i)) {
a->u.i = i;
return(a);
}
else {
printf("attribute value should be integer: ");
p_term(t);
return(NULL);
}
case BOOL_ATTR:
a->u.i = 0; /* FIX THIS! */
return(a);
case DOUBLE_ATTR:
a->u.d = 123.4567E89; /* FIX THIS! */
return(a);
case STRING_ATTR:
a->u.s = sn_to_str(attr_val->sym_num);
return(a);
case TERM_ATTR:
a->u.t = copy_term(attr_val);
return(a);
default:
return(NULL);
}
}
else {
struct cl_attribute *a1, *a2, *a3;
a1 = term_to_attributes(t->farg->argval);
a2 = term_to_attributes(t->farg->narg->argval);
if (!a1 || !a2)
return(NULL);
else {
/* Append attribute lists. */
for (a3 = a1; a3->next; a3 = a3->next);
a3->next = a2;
return(a1);
}
}
} /* term_to_attributes */
/*************
*
* print_attributes()
*
*************/
void print_attributes(FILE *fp,
struct cl_attribute *a)
{
for ( ; a; a = a->next) {
fprintf(fp, " # %s(", Attributes[a->name].name);
switch (attribute_type(a->name)) {
case INT_ATTR:
fprintf(fp, "%d", a->u.i); break;
case BOOL_ATTR:
fprintf(fp, "%s", (a->u.i ? "true" : "false")); break;
case DOUBLE_ATTR:
fprintf(fp, "%f", a->u.d); break;
case STRING_ATTR:
fprintf(fp, "%s", a->u.s); break;
case TERM_ATTR:
print_term(fp, a->u.t); break;
}
fprintf(fp, ")");
}
} /* print_attributes */
./otter/av.c 0000744 0002044 0001012 00000111406 11120534420 011216 0 ustar beeson /*
* av.c -- This file has routines for memory management.
*
*/
#include "header.h"
#include "beta.h" // Beeson
#ifdef SCOTT
#include "called_by_otter.h"
#endif
/* Size of chunk allocated by malloc */
#define TP_ALLOC_SIZE 32700
#define ALLOC_ARG_T unsigned
#ifdef THINK_C
#define TP_ALLOC_SIZE 8180
#define ALLOC_ARG_T size_t
#endif
static char *Alloc_block; /* location returned by most recent malloc */
static char *Alloc_pos; /* current position in block */
/* a list of available nodes for each type of structure */
static struct term *term_avail;
static struct rel *rel_avail;
static struct sym_ent *sym_ent_avail;
static struct term_ptr *term_ptr_avail;
static struct formula_ptr_2 *formula_ptr_2_avail;
static struct fpa_tree *fpa_tree_avail;
static struct fpa_head *fpa_head_avail;
static struct context *context_avail;
static struct trail *trail_avail;
static struct imd_tree *imd_tree_avail;
static struct imd_pos *imd_pos_avail;
static struct is_tree *is_tree_avail;
static struct is_pos *is_pos_avail;
static struct fsub_pos *fsub_pos_avail;
static struct literal *literal_avail;
static struct clause *clause_avail;
static struct list *list_avail;
static struct clash_nd *clash_nd_avail;
static struct clause_ptr *clause_ptr_avail;
static struct ci_ptr *ci_ptr_avail;
static struct int_ptr *int_ptr_avail;
static struct link_node *link_node_avail;
static struct ans_lit_node *ans_lit_node_avail;
static struct formula_box *formula_box_avail;
static struct formula *formula_avail;
static struct formula_ptr *formula_ptr_avail;
static struct cl_attribute *cl_attribute_avail;
static int Malloc_calls; /* number of calls to malloc */
/* # of gets, frees, and size of avail list for each type of structure */
static unsigned long term_gets, term_frees, term_avails;
static unsigned long rel_gets, rel_frees, rel_avails;
static unsigned long sym_ent_gets, sym_ent_frees, sym_ent_avails;
static unsigned long term_ptr_gets, term_ptr_frees, term_ptr_avails;
static unsigned long formula_ptr_2_gets, formula_ptr_2_frees, formula_ptr_2_avails;
static unsigned long fpa_tree_gets, fpa_tree_frees, fpa_tree_avails;
static unsigned long fpa_head_gets, fpa_head_frees, fpa_head_avails;
static unsigned long context_gets, context_frees, context_avails;
static unsigned long trail_gets, trail_frees, trail_avails;
static unsigned long imd_tree_gets, imd_tree_frees, imd_tree_avails;
static unsigned long imd_pos_gets, imd_pos_frees, imd_pos_avails;
static unsigned long is_tree_gets, is_tree_frees, is_tree_avails;
static unsigned long is_pos_gets, is_pos_frees, is_pos_avails;
static unsigned long fsub_pos_gets, fsub_pos_frees, fsub_pos_avails;
static unsigned long literal_gets, literal_frees, literal_avails;
static unsigned long clause_gets, clause_frees, clause_avails;
static unsigned long list_gets, list_frees, list_avails;
static unsigned long clash_nd_gets, clash_nd_frees, clash_nd_avails;
static unsigned long clause_ptr_gets, clause_ptr_frees, clause_ptr_avails;
static unsigned long ci_ptr_gets, ci_ptr_frees, ci_ptr_avails;
static unsigned long int_ptr_gets, int_ptr_frees, int_ptr_avails;
static unsigned long link_node_gets, link_node_frees, link_node_avails;
static unsigned long ans_lit_node_gets, ans_lit_node_frees, ans_lit_node_avails;
static unsigned long formula_box_gets, formula_box_frees, formula_box_avails;
static unsigned long formula_gets, formula_frees, formula_avails;
static unsigned long formula_ptr_gets, formula_ptr_frees, formula_ptr_avails;
static unsigned long cl_attribute_gets, cl_attribute_frees, cl_attribute_avails;
/*************
*
* int **tp_alloc(n)
*
* Allocate n contiguous bytes, aligned on pointer boundry.
*
*************/
int **tp_alloc(int n)
{
char *return_block;
int scale;
/* if n is not a multiple of sizeof(int *), then round up so that it is */
scale = sizeof(int *);
if (n % scale != 0)
n = n + (scale - (n % scale));
if (Alloc_block == NULL || Alloc_block + TP_ALLOC_SIZE - Alloc_pos < n) {
/* try to malloc a new block */
if (n > TP_ALLOC_SIZE) {
char s[100];
sprintf(s, "tp_alloc, request too big: %d", n);
abend(s);
}
else if (Parms[MAX_MEM].val != -1 &&
((Malloc_calls+1)*TP_ALLOC_SIZE)/1024 > Parms[MAX_MEM].val) {
fprintf(stdout, "\nSearch stopped in tp_alloc by max_mem option.\n");
fprintf(stderr, "\n%cSearch stopped in tp_alloc by max_mem option.\n", Bell);
if (Flags[FREE_ALL_MEM].val) {
/* freeing memory can require additional memory */
fprintf(stdout, " (free_all_mem cleared).\n");
Flags[FREE_ALL_MEM].val = 0;
}
if (Flags[PRINT_LISTS_AT_END].val) { /* 2/5/92 WWM */
/* printing can require additional memory */
fprintf(stdout, " (print_lists_at_end cleared).\n");
Flags[PRINT_LISTS_AT_END].val = 0;
}
cleanup();
exit(MAX_MEM_EXIT);
}
else {
Alloc_pos = Alloc_block = (char *) malloc((ALLOC_ARG_T) TP_ALLOC_SIZE);
Malloc_calls++;
Stats[K_MALLOCED] = (long) (Malloc_calls * (TP_ALLOC_SIZE / 1024.)); // (long) added by Beeson, 7.23.02
if (Alloc_pos == NULL) {
/* Don't call abend() so that we can exit with a value. */
output_stats(stdout, 3);
fprintf(stdout, "\nABEND, malloc returns NULL (out of memory).\n");
fprintf(stderr, "%cABEND, malloc returns NULL (out of memory).\n", Bell);
exit(MALLOC_NULL_EXIT);
}
}
}
return_block = Alloc_pos;
Alloc_pos += n;
return((int **) return_block);
} /* tp_alloc */
/*************
*
* struct term *get_term()
*
*************/
struct term *get_term(void)
{
struct term *p;
term_gets++;
if (term_avail == NULL)
p = (struct term *) tp_alloc((int) sizeof(struct term));
else {
term_avails--;
p = term_avail;
term_avail = (struct term *) term_avail->farg;
}
p->sym_num = 0;
p->farg = NULL;
p->occ.rel = NULL;
p->varnum = 0;
p->bits = 0;
p->fpa_id = 0;
return(p);
} /* get_term */
/*************
*
* free_term()
*
*************/
void free_term(struct term *p)
{
term_frees++;
term_avails++;
p->farg = (struct rel *) term_avail;
term_avail = p;
} /* free_term */
/*************
*
* struct rel *get_rel()
*
*************/
struct rel *get_rel(void)
{
struct rel *p;
rel_gets++;
if (rel_avail == NULL)
p = (struct rel *) tp_alloc((int) sizeof(struct rel));
else {
rel_avails--;
p = rel_avail;
rel_avail = rel_avail->narg;
}
p->argval = NULL;
p->argof = NULL;
p->narg = NULL;
p->nocc = NULL;
p->path = 0;
p->clashable = 0;
return(p);
} /* get_rel */
/*************
*
* free_rel()
*
*************/
void free_rel(struct rel *p)
{
rel_frees++;
rel_avails++;
p->narg = rel_avail;
rel_avail = p;
} /* free_rel */
/*************
*
* struct sym_ent *get_sym_ent()
*
*************/
struct sym_ent *get_sym_ent(void)
{
struct sym_ent *p;
sym_ent_gets++;
if (sym_ent_avail == NULL)
p = (struct sym_ent *) tp_alloc((int) sizeof(struct sym_ent));
else {
sym_ent_avails--;
p = sym_ent_avail;
sym_ent_avail = sym_ent_avail->next;
}
p->eval_code = 0;
p->lex_val = MAX_INT;
p->skolem = 0;
p->special_unary = 0;
p->lex_rpo_status = LRPO_LR_STATUS;
p->special_op = 0;
p->op_type = 0;
p->op_prec = 0;
p->next = NULL;
return(p);
} /* get_sym_ent */
/*************
*
* free_sym_ent()
*
*************/
void free_sym_ent(struct sym_ent *p)
{
sym_ent_frees++;
sym_ent_avails++;
p->next = sym_ent_avail;
sym_ent_avail = p;
} /* free_sym_ent */
/*************
*
* struct term_ptr *get_term_ptr()
*
*************/
struct term_ptr *get_term_ptr(void)
{
struct term_ptr *p;
term_ptr_gets++;
if (term_ptr_avail == NULL)
p = (struct term_ptr *) tp_alloc((int) sizeof(struct term_ptr));
else {
term_ptr_avails--;
p = term_ptr_avail;
term_ptr_avail = term_ptr_avail->next;
}
p->term = NULL;
p->next = NULL;
return(p);
} /* get_term_ptr */
/*************
*
* free_term_ptr()
*
*************/
void free_term_ptr(struct term_ptr *p)
{
term_ptr_frees++;
term_ptr_avails++;
p->next = term_ptr_avail;
term_ptr_avail = p;
} /* free_term_ptr */
/*************
*
* struct formula_ptr_2 *get_formula_ptr_2()
*
*************/
struct formula_ptr_2 *get_formula_ptr_2(void)
{
struct formula_ptr_2 *p;
formula_ptr_2_gets++;
if (formula_ptr_2_avail == NULL)
p = (struct formula_ptr_2 *) tp_alloc((int) sizeof(struct formula_ptr_2));
else {
formula_ptr_2_avails--;
p = formula_ptr_2_avail;
formula_ptr_2_avail = formula_ptr_2_avail->next;
}
p->f = NULL;
p->next = NULL;
p->prev = NULL;
p->left = NULL;
p->right = NULL;
p->up = NULL;
p->down = NULL;
return(p);
} /* get_formula_ptr_2 */
/*************
*
* free_formula_ptr_2()
*
*************/
void free_formula_ptr_2(struct formula_ptr_2 *p)
{
formula_ptr_2_frees++;
formula_ptr_2_avails++;
p->next = formula_ptr_2_avail;
formula_ptr_2_avail = p;
} /* free_formula_ptr_2 */
/*************
*
* struct fpa_tree *get_fpa_tree()
*
*************/
struct fpa_tree *get_fpa_tree(void)
{
struct fpa_tree *p;
fpa_tree_gets++;
if (fpa_tree_avail == NULL)
p = (struct fpa_tree *) tp_alloc((int) sizeof(struct fpa_tree));
else {
fpa_tree_avails--;
p = fpa_tree_avail;
fpa_tree_avail = fpa_tree_avail->left;
}
p->terms = NULL;
p->left = NULL;
p->right = NULL;
p->left_term = NULL;
p->right_term = NULL;
p->path = NULL;
return(p);
} /* get_fpa_tree */
/*************
*
* free_fpa_tree()
*
*************/
void free_fpa_tree(struct fpa_tree *p)
{
fpa_tree_frees++;
fpa_tree_avails++;
p->left = fpa_tree_avail;
fpa_tree_avail = p;
} /* free_fpa_tree */
/*************
*
* struct fpa_head *get_fpa_head()
*
*************/
struct fpa_head *get_fpa_head(void)
{
struct fpa_head *p;
fpa_head_gets++;
if (fpa_head_avail == NULL)
p = (struct fpa_head *) tp_alloc((int) sizeof(struct fpa_head));
else {
fpa_head_avails--;
p = fpa_head_avail;
fpa_head_avail = fpa_head_avail->next;
}
p->terms = NULL;
p->next = NULL;
p->path = NULL;
return(p);
} /* get_fpa_head */
/*************
*
* free_fpa_head()
*
*************/
void free_fpa_head(struct fpa_head *p)
{
fpa_head_frees++;
fpa_head_avails++;
p->next = fpa_head_avail;
fpa_head_avail = p;
} /* free_head */
/*************
*
* struct context *get_context()
*
*************/
struct context *get_context(void)
{
struct context *p;
static int count=0;
context_gets++;
if (context_avail == NULL) {
p = (struct context *) tp_alloc((int) sizeof(struct context));
}
else {
context_avails--;
p = context_avail;
context_avail = context_avail->contexts[0];
}
memset(p->terms,0,MAX_VARS * sizeof(int*)); // Beeson 2.8.03
memset(p->forbidden,0,MAX_VARS * sizeof(restrictdata)); // Beeson 2.8.03
p->built_in_multiplier = count++; /* never change */
p->multiplier = -1;
p->next_var =-2; // Beeson 6.24.03
memset(p->bound,0,MAX_VARS * sizeof(char)); // Beeson 7.16.03
p->next = NULL; // Beeson 12.3.05
return(p);
} /* get_context */
/*************
*
* free_context()
*
*************/
void free_context(struct context *p)
{
#if 1 // DEBUG
int i;
for (i=0; i<MAX_VARS; i++) {
if (p->terms[i] != NULL) {
printf("ERROR, context %x, var %d not null.\n", (unsigned) p->contexts[i], i);
print_term_nl(stdout, p->terms[i]);
p->terms[i] = NULL;
}
}
#endif
for(i=0;i<MAX_VARS;i++){ // Beeson 8.10.02
if(p->forbidden[i]) // Beeson 8.10.02
{ free_int_ptr(p->forbidden[i]); // Beeson 8.10.02
} // Beeson 8.10.02
}
context_frees++;
context_avails++;
p->contexts[0] = context_avail;
context_avail = p;
} /* free_context */
/*************
*
* struct trail *get_trail()
*
*************/
struct trail *get_trail(void)
{
struct trail *p;
trail_gets++;
if (trail_avail == NULL)
p = (struct trail *) tp_alloc((int) sizeof(struct trail));
else {
trail_avails--;
p = trail_avail;
trail_avail = trail_avail->next;
}
p->next = NULL;
return(p);
} /* get_trail */
/*************
*
* free_trail()
*
*************/
void free_trail(struct trail *p)
{
trail_frees++;
trail_avails++;
p->next = trail_avail;
trail_avail = p;
} /* free_trail */
/*************
*
* struct imd_tree *get_imd_tree()
*
*************/
struct imd_tree *get_imd_tree(void)
{
struct imd_tree *p;
imd_tree_gets++;
if (imd_tree_avail == NULL)
p = (struct imd_tree *) tp_alloc((int) sizeof(struct imd_tree));
else {
imd_tree_avails--;
p = imd_tree_avail;
imd_tree_avail = imd_tree_avail->next;
}
p->next = NULL;
p->kids = NULL;
p->type = 0;
p->lab = 0;
p->atoms = NULL;
return(p);
} /* get_imd_tree */
/*************
*
* free_imd_tree()
*
*************/
void free_imd_tree(struct imd_tree *p)
{
imd_tree_frees++;
imd_tree_avails++;
p->next = imd_tree_avail;
imd_tree_avail = p;
} /* free_imd_tree */
/*************
*
* struct imd_pos *get_imd_pos()
*
*************/
struct imd_pos *get_imd_pos(void)
{
struct imd_pos *p;
imd_pos_gets++;
if (imd_pos_avail == NULL)
p = (struct imd_pos *) tp_alloc((int) sizeof(struct imd_pos));
else {
imd_pos_avails--;
p = imd_pos_avail;
imd_pos_avail = imd_pos_avail->next;
}
p->next = NULL;
return(p);
} /* get_imd_pos */
/*************
*
* free_imd_pos()
*
*************/
void free_imd_pos(struct imd_pos *p)
{
imd_pos_frees++;
imd_pos_avails++;
p->next = imd_pos_avail;
imd_pos_avail = p;
} /* free_imd_pos */
/*************
*
* struct is_tree *get_is_tree()
*
*************/
struct is_tree *get_is_tree(void)
{
struct is_tree *p;
is_tree_gets++;
if (is_tree_avail == NULL)
p = (struct is_tree *) tp_alloc((int) sizeof(struct is_tree));
else {
is_tree_avails--;
p = is_tree_avail;
is_tree_avail = is_tree_avail->next;
}
p->next = NULL;
p->type = 0;
p->lab = 0;
p->u.kids = NULL;
return(p);
} /* get_is_tree */
/*************
*
* free_is_tree()
*
*************/
void free_is_tree(struct is_tree *p)
{
is_tree_frees++;
is_tree_avails++;
p->next = is_tree_avail;
is_tree_avail = p;
} /* free_is_tree */
/*************
*
* struct is_pos *get_is_pos()
*
*************/
struct is_pos *get_is_pos(void)
{
struct is_pos *p;
is_pos_gets++;
if (is_pos_avail == NULL)
p = (struct is_pos *) tp_alloc((int) sizeof(struct is_pos));
else {
is_pos_avails--;
p = is_pos_avail;
is_pos_avail = is_pos_avail->next;
}
p->next = NULL;
return(p);
} /* get_is_pos */
/*************
*
* free_is_pos()
*
*************/
void free_is_pos(struct is_pos *p)
{
is_pos_frees++;
is_pos_avails++;
p->next = is_pos_avail;
is_pos_avail = p;
} /* free_is_pos */
/*************
*
* struct fsub_pos *get_fsub_pos()
*
*************/
struct fsub_pos *get_fsub_pos(void)
{
struct fsub_pos *p;
fsub_pos_gets++;
if (fsub_pos_avail == NULL)
p = (struct fsub_pos *) tp_alloc((int) sizeof(struct fsub_pos));
else {
fsub_pos_avails--;
p = fsub_pos_avail;
fsub_pos_avail = (struct fsub_pos *) fsub_pos_avail->terms;
}
return(p);
} /* get_fsub_pos */
/*************
*
* free_fsub_pos()
*
*************/
void free_fsub_pos(struct fsub_pos *p)
{
fsub_pos_frees++;
fsub_pos_avails++;
p->terms = (struct term_ptr *) fsub_pos_avail;
fsub_pos_avail = p;
} /* free_fsub_pos */
/*************
*
* struct literal *get_literal()
*
*************/
struct literal *get_literal(void)
{
struct literal *p;
literal_gets++;
if (literal_avail == NULL)
p = (struct literal *) tp_alloc((int) sizeof(struct literal));
else {
literal_avails--;
p = literal_avail;
literal_avail = literal_avail->next_lit;
}
p->container = NULL;
p->next_lit = NULL;
p->sign = 0;
p->atom = NULL;
return(p);
} /* get_literal */
/*************
*
* free_literal()
*
*************/
void free_literal(struct literal *p)
{
literal_frees++;
literal_avails++;
p->next_lit = literal_avail;
literal_avail = p;
} /* free_literal */
/*************
*
* struct clause *get_clause()
*
*************/
struct clause *get_clause(void)
{
struct clause *p;
clause_gets++;
if (clause_avail == NULL)
p = (struct clause *) tp_alloc((int) sizeof(struct clause));
else {
clause_avails--;
p = clause_avail;
clause_avail = clause_avail->next_cl;
}
p->id = 0;
p->parents = NULL;
p->container = NULL;
p->next_cl = NULL;
p->prev_cl = NULL;
p->first_lit = NULL;
p->pick_weight = 0;
p->type = NOT_SPECIFIED;
p->bits = 0;
p->heat_level = 0;
p->attributes = NULL;
p->next_var = 0; // Beeson 2.13.03
#ifdef SCOTT
set_scott_clause(p);
#endif
return(p);
} /* get_clause */
/*************
*
* free_clause()
*
*************/
void free_clause(struct clause *p)
{
clause_frees++;
clause_avails++;
p->next_cl = clause_avail;
clause_avail = p;
} /* free_clause */
/*************
*
* struct list *get_list()
*
*************/
struct list *get_list(void)
{
struct list *p;
list_gets++;
if (list_avail == NULL)
p = (struct list *) tp_alloc((int) sizeof(struct list));
else {
list_avails--;
p = list_avail;
list_avail = (struct list *) list_avail->first_cl;
}
p->first_cl = NULL;
p->last_cl = NULL;
p->name[0] = '\0';
return(p);
} /* get_list */
/*************
*
* free_list()
*
*************/
void free_list(struct list *p)
{
list_frees++;
list_avails++;
p->first_cl = (struct clause *) list_avail;
list_avail = p;
} /* free_list */
/*************
*
* struct clash_nd *get_clash_nd()
*
*************/
struct clash_nd *get_clash_nd(void)
{
struct clash_nd *p;
clash_nd_gets++;
if (clash_nd_avail == NULL)
p = (struct clash_nd *) tp_alloc((int) sizeof(struct clash_nd));
else {
clash_nd_avails--;
p = clash_nd_avail;
clash_nd_avail = clash_nd_avail->next;
}
p->next = NULL;
p->prev = NULL;
p->evaluable = 0;
return(p);
} /* get_clash_nd */
/*************
*
* free_clash_nd()
*
*************/
void free_clash_nd(struct clash_nd *p)
{
clash_nd_frees++;
clash_nd_avails++;
p->next = clash_nd_avail;
clash_nd_avail = p;
} /* free_clash_nd */
/*************
*
* struct clause_ptr *get_clause_ptr()
*
*************/
struct clause_ptr *get_clause_ptr(void)
{
struct clause_ptr *p;
clause_ptr_gets++;
if (clause_ptr_avail == NULL)
p = (struct clause_ptr *) tp_alloc((int) sizeof(struct clause_ptr));
else {
clause_ptr_avails--;
p = clause_ptr_avail;
clause_ptr_avail = clause_ptr_avail->next;
}
p->next = NULL;
p->c = NULL;
return(p);
} /* get_clause_ptr */
/*************
*
* free_clause_ptr()
*
*************/
void free_clause_ptr(struct clause_ptr *p)
{
clause_ptr_frees++;
clause_ptr_avails++;
p->next = clause_ptr_avail;
clause_ptr_avail = p;
} /* free_clause_ptr */
/*************
*
* struct ci_ptr *get_ci_ptr()
*
*************/
struct ci_ptr *get_ci_ptr(void)
{
struct ci_ptr *p;
ci_ptr_gets++;
if (ci_ptr_avail == NULL)
p = (struct ci_ptr *) tp_alloc((int) sizeof(struct ci_ptr));
else {
ci_ptr_avails--;
p = ci_ptr_avail;
ci_ptr_avail = ci_ptr_avail->next;
}
p->next = NULL;
p->c = NULL;
p->v = NULL;
return(p);
} /* get_ci_ptr */
/*************
*
* free_ci_ptr()
*
*************/
void free_ci_ptr(struct ci_ptr *p)
{
ci_ptr_frees++;
ci_ptr_avails++;
p->next = ci_ptr_avail;
ci_ptr_avail = p;
} /* free_ci_ptr */
/*************
*
* struct int_ptr *get_int_ptr()
*
*************/
struct int_ptr *get_int_ptr(void)
{
struct int_ptr *p;
int_ptr_gets++;
if (int_ptr_avail == NULL)
p = (struct int_ptr *) tp_alloc((int) sizeof(struct int_ptr));
else {
int_ptr_avails--;
p = int_ptr_avail;
int_ptr_avail = int_ptr_avail->next;
}
p->next = NULL;
p->i = 0;
return(p);
} /* get_int_ptr */
/*************
*
* free_int_ptr()
*
*************/
void free_int_ptr(struct int_ptr *p)
{
int_ptr_frees++;
int_ptr_avails++;
p->next = int_ptr_avail;
int_ptr_avail = p;
} /* free_int_ptr */
/*************
*
* struct ans_lit_node *get_ans_lit_node()
*
*************/
struct ans_lit_node *get_ans_lit_node(void)
{
struct ans_lit_node *p;
ans_lit_node_gets++;
if (ans_lit_node_avail == NULL)
p = (struct ans_lit_node *) tp_alloc((int) sizeof(struct ans_lit_node));
else {
ans_lit_node_avails--;
p = ans_lit_node_avail;
ans_lit_node_avail = ans_lit_node_avail->next;
}
p->next = NULL;
p->parent = NULL;
p->lit = NULL;
return(p);
} /* get_ans_lit_node */
/*************
*
* void free_ans_lit_node()
*
*************/
void free_ans_lit_node(struct ans_lit_node *p)
{
ans_lit_node_frees++;
ans_lit_node_avails++;
p->next = ans_lit_node_avail;
ans_lit_node_avail = p;
} /* free_ans_lit_node */
/*************
*
* struct formula_box *get_formula_box()
*
*************/
struct formula_box *get_formula_box(void)
{
struct formula_box *p;
formula_box_gets++;
if (formula_box_avail == NULL)
p = (struct formula_box *) tp_alloc((int) sizeof(struct formula_box));
else {
formula_box_avails--;
p = formula_box_avail;
formula_box_avail = formula_box_avail->next;
}
p->first_child = p->next = p->parent = NULL;
p->f = NULL;
p->str[0] = '\0';
p->type = p->subtype = p->length = p->height = p->x_off = p->y_off = 0;
p->abs_x_loc = p->abs_y_loc = 0;
return(p);
} /* get_formula_box */
/*************
*
* void free_formula_box()
*
*************/
void free_formula_box(struct formula_box *p)
{
formula_box_frees++;
formula_box_avails++;
p->next = formula_box_avail;
formula_box_avail = p;
} /* free_formula_box */
/*************
*
* struct formula *get_formula()
*
*************/
struct formula *get_formula(void)
{
struct formula *p;
formula_gets++;
if (formula_avail == NULL)
p = (struct formula *) tp_alloc((int) sizeof(struct formula));
else {
formula_avails--;
p = formula_avail;
formula_avail = formula_avail->next;
}
p->type = 0;
p->quant_type = 0;
p->parent = p->first_child = p->next = NULL;
p->t = NULL;
return(p);
} /* get_formula */
/*************
*
* void free_formula()
*
*************/
void free_formula(struct formula *p)
{
formula_frees++;
formula_avails++;
p->next = formula_avail;
formula_avail = p;
} /* free_formula */
/*************
*
* struct formula_ptr *get_formula_ptr()
*
*************/
struct formula_ptr *get_formula_ptr(void)
{
struct formula_ptr *p;
formula_ptr_gets++;
if (formula_ptr_avail == NULL)
p = (struct formula_ptr *) tp_alloc((int) sizeof(struct formula_ptr));
else {
formula_ptr_avails--;
p = formula_ptr_avail;
formula_ptr_avail = formula_ptr_avail->next;
}
p->f = NULL;
p->next = NULL;
return(p);
} /* get_formula_ptr */
/*************
*
* void free_formula_ptr()
*
*************/
void free_formula_ptr(struct formula_ptr *p)
{
formula_ptr_frees++;
formula_ptr_avails++;
p->next = formula_ptr_avail;
formula_ptr_avail = p;
} /* free_formula_ptr */
/*************
*
* struct cl_attribute *get_cl_attribute()
*
*************/
struct cl_attribute *get_cl_attribute(void)
{
struct cl_attribute *p;
cl_attribute_gets++;
if (cl_attribute_avail == NULL)
p = (struct cl_attribute *) tp_alloc((int) sizeof(struct cl_attribute));
else {
cl_attribute_avails--;
p = cl_attribute_avail;
cl_attribute_avail = cl_attribute_avail->next;
}
p->name = -1;
p->next = NULL;
return(p);
} /* get_cl_attribute */
/*************
*
* void free_cl_attribute()
*
*************/
void free_cl_attribute(struct cl_attribute *p)
{
cl_attribute_frees++;
cl_attribute_avails++;
p->next = cl_attribute_avail;
cl_attribute_avail = p;
} /* free_cl_attribute */
/*************
*
* struct link_node *get_link_node()
*
*************/
struct link_node *get_link_node(void)
{
struct link_node *p;
link_node_gets++;
if (link_node_avail == NULL)
p = (struct link_node *) tp_alloc((int) sizeof(struct link_node));
else {
link_node_avails--;
p = link_node_avail;
link_node_avail = link_node_avail->next_sibling;
}
p->parent = NULL;
p->first_child = NULL;
p->child_first_ans = NULL;
p->child_last_ans = NULL;
p->next_sibling = NULL;
p->prev_sibling = NULL;
p->first = TRUE;
p->unit_deleted = FALSE; /* Initially literal has not been unit deleted */
p->goal = NULL;
p->goal_to_resolve = NULL;
p->current_clause = NULL;
p->subst = NULL;
p->unif_position = NULL;
p->tr = NULL;
p->near_poss_nuc = UNDEFINED;
p->farthest_sat = 0;
p->target_dist = 0;
p->back_up = UNDEFINED;
return(p);
} /* get_link_node */
/*************
*
* void free_link_node()
*
*************/
void free_link_node(struct link_node *p)
{
link_node_frees++;
link_node_avails++;
p->next_sibling = link_node_avail;
link_node_avail = p;
} /* free_link_node */
/*************
*
* free_imd_pos_list(imd_pos) -- free a list of imd_pos nodes.
*
*************/
void free_imd_pos_list(struct imd_pos *p)
{
struct imd_pos *q;
if (p != NULL) {
q = p;
imd_pos_frees++;
imd_pos_avails++;
while (q->next != NULL) {
imd_pos_frees++;
imd_pos_avails++;
q = q->next;
}
q->next = imd_pos_avail;
imd_pos_avail = p;
}
} /* free_imd_pos_list */
/*************
*
* free_is_pos_list(is_pos) -- free a list of is_pos nodes.
*
*************/
void free_is_pos_list(struct is_pos *p)
{
struct is_pos *q;
if (p != NULL) {
q = p;
is_pos_frees++;
is_pos_avails++;
while (q->next != NULL) {
is_pos_frees++;
is_pos_avails++;
q = q->next;
}
q->next = is_pos_avail;
is_pos_avail = p;
}
} /* free_is_pos_list */
/*************
*
* print_mem()
*
*************/
void print_mem(FILE *fp)
{
fprintf(fp, "\n------------- memory usage ------------\n");
fprintf(fp, "%d mallocs of %d bytes each, %.1f K.\n",
Malloc_calls, TP_ALLOC_SIZE, (Malloc_calls * (TP_ALLOC_SIZE / 1024.)));
fprintf(fp, " type (bytes each) gets frees in use avail bytes\n");
fprintf(fp, "sym_ent (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct sym_ent), sym_ent_gets, sym_ent_frees, sym_ent_gets - sym_ent_frees, sym_ent_avails, (((sym_ent_gets - sym_ent_frees) + sym_ent_avails) * sizeof(struct sym_ent)) / 1024.);
fprintf(fp, "term (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct term), term_gets, term_frees, term_gets - term_frees, term_avails, (((term_gets - term_frees) + term_avails) * sizeof(struct term)) / 1024.);
fprintf(fp, "rel (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct rel), rel_gets, rel_frees, rel_gets - rel_frees, rel_avails, (((rel_gets - rel_frees) + rel_avails) * sizeof(struct rel)) / 1024.);
fprintf(fp, "term_ptr (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct term_ptr), term_ptr_gets, term_ptr_frees, term_ptr_gets - term_ptr_frees, term_ptr_avails, (((term_ptr_gets - term_ptr_frees) + term_ptr_avails) * sizeof(struct term_ptr)) / 1024.);
fprintf(fp, "formula_ptr_2 (%4d)%11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct formula_ptr_2), formula_ptr_2_gets, formula_ptr_2_frees, formula_ptr_2_gets - formula_ptr_2_frees, formula_ptr_2_avails, (((formula_ptr_2_gets - formula_ptr_2_frees) + formula_ptr_2_avails) * sizeof(struct formula_ptr_2)) / 1024.);
fprintf(fp, "fpa_head (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct fpa_head), fpa_head_gets, fpa_head_frees, fpa_head_gets - fpa_head_frees, fpa_head_avails, (((fpa_head_gets - fpa_head_frees) + fpa_head_avails) * sizeof(struct fpa_head)) / 1024.);
fprintf(fp, "fpa_tree (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct fpa_tree), fpa_tree_gets, fpa_tree_frees, fpa_tree_gets - fpa_tree_frees, fpa_tree_avails, (((fpa_tree_gets - fpa_tree_frees) + fpa_tree_avails) * sizeof(struct fpa_tree)) / 1024.);
fprintf(fp, "context (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct context), context_gets, context_frees, context_gets - context_frees, context_avails, (((context_gets - context_frees) + context_avails) * sizeof(struct context)) / 1024.);
fprintf(fp, "trail (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct trail), trail_gets, trail_frees, trail_gets - trail_frees, trail_avails, (((trail_gets - trail_frees) + trail_avails) * sizeof(struct trail)) / 1024.);
fprintf(fp, "imd_tree (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct imd_tree), imd_tree_gets, imd_tree_frees, imd_tree_gets - imd_tree_frees, imd_tree_avails, (((imd_tree_gets - imd_tree_frees) + imd_tree_avails) * sizeof(struct imd_tree)) / 1024.);
fprintf(fp, "imd_pos (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct imd_pos), imd_pos_gets, imd_pos_frees, imd_pos_gets - imd_pos_frees, imd_pos_avails, (((imd_pos_gets - imd_pos_frees) + imd_pos_avails) * sizeof(struct imd_pos)) / 1024.);
fprintf(fp, "is_tree (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct is_tree), is_tree_gets, is_tree_frees, is_tree_gets - is_tree_frees, is_tree_avails, (((is_tree_gets - is_tree_frees) + is_tree_avails) * sizeof(struct is_tree)) / 1024.);
fprintf(fp, "is_pos (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct is_pos), is_pos_gets, is_pos_frees, is_pos_gets - is_pos_frees, is_pos_avails, (((is_pos_gets - is_pos_frees) + is_pos_avails) * sizeof(struct is_pos)) / 1024.);
fprintf(fp, "fsub_pos (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct fsub_pos), fsub_pos_gets, fsub_pos_frees, fsub_pos_gets - fsub_pos_frees, fsub_pos_avails, (((fsub_pos_gets - fsub_pos_frees) + fsub_pos_avails) * sizeof(struct fsub_pos)) / 1024.);
fprintf(fp, "literal (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct literal), literal_gets, literal_frees, literal_gets - literal_frees, literal_avails, (((literal_gets - literal_frees) + literal_avails) * sizeof(struct literal)) / 1024.);
fprintf(fp, "clause (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct clause), clause_gets, clause_frees, clause_gets - clause_frees, clause_avails, (((clause_gets - clause_frees) + clause_avails) * sizeof(struct clause)) / 1024.);
fprintf(fp, "list (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct list), list_gets, list_frees, list_gets - list_frees, list_avails, (((list_gets - list_frees) + list_avails) * sizeof(struct list)) / 1024.);
fprintf(fp, "clash_nd (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct clash_nd), clash_nd_gets, clash_nd_frees, clash_nd_gets - clash_nd_frees, clash_nd_avails, (((clash_nd_gets - clash_nd_frees) + clash_nd_avails) * sizeof(struct clash_nd)) / 1024.);
fprintf(fp, "clause_ptr (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct clause_ptr), clause_ptr_gets, clause_ptr_frees, clause_ptr_gets - clause_ptr_frees, clause_ptr_avails, (((clause_ptr_gets - clause_ptr_frees) + clause_ptr_avails) * sizeof(struct clause_ptr)) / 1024.);
fprintf(fp, "int_ptr (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct int_ptr), int_ptr_gets, int_ptr_frees, int_ptr_gets - int_ptr_frees, int_ptr_avails, (((int_ptr_gets - int_ptr_frees) + int_ptr_avails) * sizeof(struct int_ptr)) / 1024.);
fprintf(fp, "ci_ptr (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct ci_ptr), ci_ptr_gets, ci_ptr_frees, ci_ptr_gets - ci_ptr_frees, ci_ptr_avails, (((ci_ptr_gets - ci_ptr_frees) + ci_ptr_avails) * sizeof(struct ci_ptr)) / 1024.);
fprintf(fp, "link_node (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct link_node), link_node_gets, link_node_frees, link_node_gets - link_node_frees, link_node_avails, (((link_node_gets - link_node_frees) + link_node_avails) * sizeof(struct link_node)) / 1024.);
fprintf(fp, "ans_lit_node(%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct ans_lit_node), ans_lit_node_gets, ans_lit_node_frees, ans_lit_node_gets - ans_lit_node_frees, ans_lit_node_avails, (((ans_lit_node_gets - ans_lit_node_frees) + ans_lit_node_avails) * sizeof(struct ans_lit_node)) / 1024.);
fprintf(fp, "formula_box(%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct formula_box), formula_box_gets, formula_box_frees, formula_box_gets - formula_box_frees, formula_box_avails, (((formula_box_gets - formula_box_frees) + formula_box_avails) * sizeof(struct formula_box)) / 1024.);
fprintf(fp, "formula(%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct formula), formula_gets, formula_frees, formula_gets - formula_frees, formula_avails, (((formula_gets - formula_frees) + formula_avails) * sizeof(struct formula)) / 1024.);
fprintf(fp, "formula_ptr(%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct formula_ptr), formula_ptr_gets, formula_ptr_frees, formula_ptr_gets - formula_ptr_frees, formula_ptr_avails, (((formula_ptr_gets - formula_ptr_frees) + formula_ptr_avails) * sizeof(struct formula_ptr)) / 1024.);
fprintf(fp, "cl_attribute(%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct cl_attribute), cl_attribute_gets, cl_attribute_frees, cl_attribute_gets - cl_attribute_frees, cl_attribute_avails, (((cl_attribute_gets - cl_attribute_frees) + cl_attribute_avails) * sizeof(struct cl_attribute)) / 1024.);
} /* print_mem */
/*************
*
* print_mem_brief()
*
*************/
void print_mem_brief(FILE *fp)
{
fprintf(fp, "\n------------- memory usage ------------\n");
fprintf(fp, "%d mallocs of %d bytes each, %.1f K.\n",
Malloc_calls, TP_ALLOC_SIZE, (Malloc_calls * (TP_ALLOC_SIZE / 1024.)));
fprintf(fp, " type (bytes each) gets frees in use avail bytes\n");
fprintf(fp, "term (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct term), term_gets, term_frees, term_gets - term_frees, term_avails, (((term_gets - term_frees) + term_avails) * sizeof(struct term)) / 1024.);
fprintf(fp, "rel (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct rel), rel_gets, rel_frees, rel_gets - rel_frees, rel_avails, (((rel_gets - rel_frees) + rel_avails) * sizeof(struct rel)) / 1024.);
fprintf(fp, "term_ptr (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct term_ptr), term_ptr_gets, term_ptr_frees, term_ptr_gets - term_ptr_frees, term_ptr_avails, (((term_ptr_gets - term_ptr_frees) + term_ptr_avails) * sizeof(struct term_ptr)) / 1024.);
fprintf(fp, "is_tree (%4d) %11lu%11lu%11lu%11lu%9.1f K\n", (int) sizeof(struct is_tree), is_tree_gets, is_tree_frees, is_tree_gets - is_tree_frees, is_tree_avails, (((is_tree_gets - is_tree_frees) + is_tree_avails) * sizeof(struct is_tree)) / 1024.);
} /* print_mem_brief */
/*************
*
* int total_mem() -- How many K have been dynamically allocated?
*
*************/
int total_mem(void)
{
return( (int) (Malloc_calls * (TP_ALLOC_SIZE / 1024.)));
} /* total_mem */
/*************
*
* total_mem_calls()
*
*************/
int total_mem_calls(void)
{
return((int) (Malloc_calls));
} /* total_mem_calls */
/*************
*
* void print_linked_ur_mem_stats()
*
*************/
void print_linked_ur_mem_stats(void)
{
printf("context gets=%lu frees=%lu inuse=%lu\n",context_gets, context_frees, context_gets-context_frees);
printf("trail gets=%lu frees=%lu inuse=%lu\n",trail_gets, trail_frees, trail_gets-trail_frees);
printf("fpa_tree gets=%lu frees=%lu inuse=%lu\n",fpa_tree_gets, fpa_tree_frees, fpa_tree_gets-fpa_tree_frees);
printf("term gets=%lu frees=%lu inuse=%lu\n",term_gets, term_frees, term_gets-term_frees);
printf("link_node gets=%lu frees=%lu inuse=%lu\n",link_node_gets,link_node_frees, link_node_gets-link_node_frees);
} /* end print_linked_ur_mem_stats */
./otter/awk.prototypes 0000744 0002044 0001012 00000000210 11120534427 013375 0 ustar beeson /^long .*\(/,/^{/
/^int .*\(/,/^{/
/^double .*\(/,/^{/
/^char .*\(/,/^{/
/^struct .*\(/,/^{/
/^void .*\(/,/^{/
/^FILE .*\(/,/^{/
./otter/case.c 0000744 0002044 0001012 00000105421 11120534440 011525 0 ustar beeson /*
* case.c - case splitting
*
*/
#include "header.h"
#ifdef TP_FORK /* for calls to fork() and wait() */
# include <sys/types.h>
# include <sys/wait.h>
# include <unistd.h>
#endif
#define MAX_SPLIT_DEPTH 255 /* see SPLIT_DEPTH in options.c */
#define POS_CLAUSE 1
#define NEG_CLAUSE 2
#define MIX_CLAUSE 3
#define FORK_FAIL 0
#define PARENT 1
#define CHILD 2
#define CHILD_FAIL 3
extern int write(int, const void *, unsigned int); // added by Beeson 8.1.02 to silence a warning
/* Current_case is a sequence of integers, e.g., Case [2.1.3.2]. */
struct int_ptr *Current_case = NULL;
/* The literal_data structure is used for atom splitting. When
* deciding which atom to split, all ground literal occurrences
* are considered, and for each, the data in the structure is
* collected. See routines get_literal_data(), compare_literal_data(),
* find_atom_to_split().
*/
struct literal_data {
struct term *atom;
int sign;
int equality;
int atom_weight;
int clause_id;
int clause_weight;
int clause_type;
int clause_variables;
int pos_occurrences;
int neg_occurrences;
int pos_binary_occurrences;
int neg_binary_occurrences;
};
/* These are file descriptors (from pipe()), which are used to
* communicate with child and parent processes. The main use is
* for a child to tell its parent what case assumptions were
* used for a refutation, which allows ancestors to sometimes
* skip further cases. See assumps_to_parent(), prover_forks().
*/
int To_parent, From_parent; /* pipe for communicating with parent */
int To_children, From_children; /* pipe for communicating with children */
/*************
*
* splitting() -- Is slitting enabled?
*
*************/
int splitting(void)
{
return(Flags[SPLIT_CLAUSE].val ||
Flags[SPLIT_ATOM].val ||
Flags[SPLIT_WHEN_GIVEN].val);
} /* splitting */
/*************
*
* max_split_depth() -- Return the maximum depth allowed for splitting.
*
*************/
int max_split_depth(void)
{
return(MAX_SPLIT_DEPTH);
} /* max_split_depth */
/*************
*
* splitable_literal(clause, lit) -- Is the atom splittable?
*
* The test is done on an occurrence of a literal.
*
*************/
int splitable_literal(struct clause *c,
struct literal *l)
{
if (num_literals(c) < 2 || !ground(l->atom))
return 0;
else {
int ok = 1;
if (ok && Flags[SPLIT_POS].val)
ok = pos_clause(c);
if (ok && Flags[SPLIT_NEG].val)
ok = neg_clause(c);
if (ok && Flags[SPLIT_NONHORN].val)
ok = l->sign && !horn_clause(c);
return ok;
}
} /* splitable_literal */
/*************
*
* compare_literal_data(d1, d2) -- Compare two splittable literal occurrences.
*
* Return the better literal_data. If neither is better, return d1.
*
*************/
static struct literal_data compare_literal_data(struct literal_data d1,
struct literal_data d2)
{
if (d1.atom == NULL)
return d2;
else if (d2.atom == NULL)
return d1;
else if (Flags[SPLIT_POPULAR].val) {
if (d2.pos_occurrences + d2.neg_occurrences >
d1.pos_occurrences + d1.neg_occurrences)
return d2;
else
return d1;
}
else {
if (d2.clause_weight < d1.clause_weight)
return d2;
else if (d1.clause_weight < d2.clause_weight)
return d1;
else if (d2.atom_weight < d1.atom_weight)
return d2;
else
return d1;
}
} /* compare_literal_data */
/*************
*
* splitable_clause(c) -- Is this clause splittable?
*
*************/
int splitable_clause(struct clause *c)
{
if (!ground_clause(c))
return 0;
else if (num_literals(c) < 2)
return 0;
else {
int ok = 1;
if (ok && Flags[SPLIT_POS].val)
ok = pos_clause(c);
if (ok && Flags[SPLIT_NEG].val)
ok = neg_clause(c);
if (ok && Flags[SPLIT_NONHORN].val)
ok = !horn_clause(c);
return ok;
}
} /* splitable_clause */
/*************
*
* compare_splitable_clauses(c, d) -- Compare two splittable clauses.
*
* Return the better clause. If neither is better, return c.
*
*************/
struct clause *compare_splitable_clauses(struct clause *c,
struct clause *d)
{
if (c == NULL)
return d;
else if (d == NULL)
return c;
else if (Flags[SPLIT_MIN_MAX].val) {
/* Return the clause with the smaller maximum literal.
* If maxes are the same, return the smaller clause
* if clauses are the same weight, return c.
*/
int cm = max_literal_weight(c, Weight_pick_given_index);
int dm = max_literal_weight(c, Weight_pick_given_index);
/* printf("maxes: %4d=%4d, %4d=%4d\n", c->id, cm, d->id, dm); */
if (cm < dm) {
return c;
}
else if (dm < cm) {
return d;
}
else
return (d->pick_weight < c->pick_weight ? d : c);
}
else {
/* Return smaller clause; if clauses are the same weight, return c. */
return (d->pick_weight < c->pick_weight ? d : c);
}
} /* compare_splitable_clauses */
/*************
*
* init_literal_data(p) -- Initialize a literal_data structure.
*
*************/
static void init_literal_data(struct literal_data *p)
{
p->atom = NULL;
} /* init_literal_data */
/*************
*
* p_literal_data(data) -- Print a literal_data structure to stdout.
*
*************/
static void p_literal_data(struct literal_data data)
{
printf("Atom: "); print_term(stdout, data.atom);
printf(" sign=%d, equality=%d, atom_wt=%d, cl_id=%d, cl_wt=%d, cl_type=%d, variables=%d, pos=%d, neg=%d, pos_binary=%d, neg_binary=%d\n",
data.sign,data.equality,data.atom_weight,data.clause_id,
data.clause_weight,
data.clause_type,data.clause_variables,
data.pos_occurrences,data.neg_occurrences,
data.pos_binary_occurrences,data.neg_binary_occurrences);
} /* p_literal_data */
/*************
*
* get_literal_data(lit, p)
*
* Given a ground literal occurrence, fill in the data.
*
*************/
static void get_literal_data(struct literal *lit,
struct literal_data *p)
{
struct clause *c = lit->container;
struct term *a;
struct fpa_tree *ut;
int n, m;
p->atom = lit->atom;
p->sign = lit->sign;
p->equality = is_eq(lit->atom->sym_num);
p->atom_weight = weight(lit->atom, Weight_pick_given_index);
p->clause_id = c->id;
p->clause_weight = weight_cl(c, Weight_pick_given_index);
p->clause_variables = distinct_vars(c);
if (pos_clause(c))
p->clause_type = POS_CLAUSE;
else if (neg_clause(c))
p->clause_type = NEG_CLAUSE;
else
p->clause_type = MIX_CLAUSE;
if (!Flags[SPLIT_POPULAR].val) {
p->pos_occurrences = 0;
p->neg_occurrences = 0;
p->pos_binary_occurrences = 0;
p->neg_binary_occurrences = 0;
}
else {
ut = build_tree(lit->atom, INSTANCE, Parms[FPA_LITERALS].val, Fpa_pos_lits);
n = 0; m = 0;
a = next_term(ut, 0);
while (a != NULL) {
n++;
if (num_literals(a->occ.lit->container) == 2)
m++;
a = next_term(ut, 0);
}
p->pos_occurrences = n;
p->pos_binary_occurrences = m;
ut = build_tree(lit->atom, INSTANCE, Parms[FPA_LITERALS].val, Fpa_neg_lits);
n = 0; m = 0;
a = next_term(ut, 0);
while (a != NULL) {
n++;
if (num_literals(a->occ.lit->container) == 2)
m++;
a = next_term(ut, 0);
}
p->neg_occurrences = n;
p->neg_binary_occurrences = m;
}
} /* get_literal_data */
/*************
*
* print_case() -- print the current case, e.g., [2.1.3], to a file
*
*************/
void print_case(FILE *fp)
{
struct int_ptr *ip;
fprintf(fp, "[");
for (ip = Current_case; ip; ip = ip->next)
fprintf(fp, "%d%s", ip->i, ip->next == NULL ? "" : ".");
fprintf(fp, "]");
} /* print_case */
/*************
*
* p_case()
*
*************/
void p_case(void)
{
print_case(stdout);
} /* p_case */
/*************
*
* print_case_n() -- Like print_case, but add the argument.
*
*************/
void print_case_n(FILE *fp,
int n)
{
struct int_ptr *ip;
fprintf(fp, "[");
for (ip = Current_case; ip; ip = ip->next)
fprintf(fp, "%d.", ip->i);
fprintf(fp, "%d]", n);
} /* print_case_n */
/*************
*
* p_case_n()
*
*************/
void p_case_n(int n)
{
print_case_n(stdout, n);
} /* p_case_n */
/*************
*
* p_assumption_depths()
*
*************/
void p_assumption_depths(char assumptions[])
{
#if 0
int i;
printf("Assumptions at the following depths were used to refute this branch:");
for (i = 0; i <= MAX_SPLIT_DEPTH; i++) {
if (assumptions[i])
printf(" %d", i);
}
printf(".\n");
#endif
} /* p_assumption_depths */
/*************
*
* current_case() -- Return Current_case.
*
*************/
struct int_ptr *current_case(void)
{
return(Current_case);
} /* current_case */
/*************
*
* add_subcase(i) -- Append an integer to Current_case.
*
*************/
void add_subcase(int i)
{
struct int_ptr *p1, *p2;
p1 = get_int_ptr();
p1->i = i;
if (Current_case == NULL)
Current_case = p1;
else {
for (p2 = Current_case; p2->next != NULL; p2 = p2->next);
p2->next = p1;
}
} /* add_subcase */
/*************
*
* case_depth() -- What is the depth of the current case?
*
*************/
int case_depth(void)
{
return int_list_length(Current_case);
} /* case_depth */
/*************
*
* find_clause_to_split()
*
* Go through Usable, then Sos, and find the best splittable clause.
*
*************/
struct clause *find_clause_to_split(void)
{
struct clause *c;
struct clause *best_so_far = NULL;
for (c = Usable->first_cl; c != NULL; c = c->next_cl) {
if (splitable_clause(c)) {
best_so_far = compare_splitable_clauses(best_so_far, c);
}
}
for (c = Sos->first_cl; c != NULL; c = c->next_cl) {
if (splitable_clause(c)) {
best_so_far = compare_splitable_clauses(best_so_far, c);
}
}
return(best_so_far); /* may be NULL */
} /* find_clause_to_split */
/*************
*
* find_atom_to_split()
*
* Go through all literal occurrences in Usable+Sos, and return
* the atom of the best splittable literal occurrence.
*
*************/
struct term *find_atom_to_split(void)
{
if (Split_atoms != NULL) {
int i;
struct term *t;
/* Split_atoms is a proper list. If the case_depth is n,
* return the n-th member of split_atoms.
*/
for (t = Split_atoms, i = 0;
t->sym_num != Nil_sym_num && i < case_depth();
t = t->farg->narg->argval, i++);
return (t->sym_num == Nil_sym_num ? NULL : t->farg->argval);
}
else {
struct clause *c;
struct literal *lit;
struct literal_data min, curr;
init_literal_data(&min);
for (c = Usable->first_cl; c != NULL; c = c->next_cl) {
for (lit = c->first_lit; lit != NULL; lit = lit->next_lit) {
if (splitable_literal(c, lit)) {
get_literal_data(lit, &curr);
min = compare_literal_data(min, curr);
}
}
}
for (c = Sos->first_cl; c != NULL; c = c->next_cl) {
for (lit = c->first_lit; lit != NULL; lit = lit->next_lit) {
if (splitable_literal(c, lit)) {
get_literal_data(lit, &curr);
min = compare_literal_data(min, curr);
}
}
}
return min.atom; /* NULL if no ground lits found */
}
} /* find_atom_to_split */
/*************
*
* prover_forks(int n, int *ip, char assumptions[])
*
* This is the guts of the splitting. It is used for both clause
* splitting and atom splitting. Parameter n tells how many cases
* to do. This routine also takes care of skipping redundant cases
* when assumptions are not used. For example, if we split on
* clause p|q, and the p case is refuted without using p, then we
* skip the q case.
*
* This routine does not return when a child returns without
* a proof. When this happens, we just exit,
* sending the same exit code to the parent.
*
* When this routine does return to its caller, the return value is:
*
* CHILD Return as child process ready to do its case.
* Also, integer *ip is set to the case number.
* PARENT Return as parent process---all children succeeded.
* Also, fill in the Boolean array assumptions, which
* tells which ancestor case assumptions were used to
* refute the child cases.
* FORK_FAIL Operating system would not allow process to fork.
* CHILD_FAIL A child did not exit normally (WIFEXITED(status) nonzero).
*
*************/
int prover_forks(int n,
int *ip,
char assumptions[])
{
#ifndef TP_FORK
return FORK_FAIL;
#else
int child_status, rc;
int parent = 1;
int i = 1;
int fd[2];
char assumptions_descendents[MAX_SPLIT_DEPTH+1];
int j;
for (j = 0; j <= MAX_SPLIT_DEPTH; j++)
assumptions[j] = 0;
/* Set up pipe for communicating with children. The child processes
* will inherit these values and immediately use them to set up a
* pipe to the parent (that is, copy them to To_parent and From_parent).
*/
rc = pipe(fd); From_children = fd[0]; To_children = fd[1];
if (rc != 0) {
return FORK_FAIL;
}
while (i <= n && parent) {
fflush(stdout); fflush(stderr);
rc = fork();
if (rc < 0) {
return FORK_FAIL;
}
else if (rc > 0) {
/* This is the parent process */
int depth = case_depth();
wait(&child_status);
if (WIFEXITED(child_status)) {
int child_exit_code = WEXITSTATUS(child_status);
if (child_exit_code==PROOF_EXIT) {
/* all is well---the child proved its case */
printf("Refuted case ");
p_case_n(i);
printf(".\n");
fflush(stdout);
if (Flags[REALLY_DELETE_CLAUSES].val) {
/* Really_delete_clauses is incompatable with the assumption
redundancy check. We'll just go on to the next case
in stead of checking if the assumption for the previous
case was used for the refutation.
*/
i++;
}
else {
rc = read(From_children, assumptions_descendents,MAX_SPLIT_DEPTH+1);
if (assumptions_descendents[depth+1])
i++;
else if (i == n)
i++; /* assumption for last case was not used */
else {
printf("\nThe Assumption for case ");
p_case_n(i);
printf(" was not used;\n");
printf("therefore we skip case%s", (i == n-1 ? ": " : "s:"));
for (j = i+1; j <= n; j++) {
printf(" ");
p_case_n(j);
}
printf(".\n");
i = n+1;
}
/* "or" in the assumptions used. */
for (j = 0; j <= depth; j++)
assumptions[j] = (assumptions[j] | assumptions_descendents[j]);
}
} /* child found proof */
else {
/* Child exited without a proof. Exit with same code to parent. */
output_stats(stdout, Parms[STATS_LEVEL].val);
printf("\nProcess %d finished %s", my_process_id(), get_time());
exit(child_exit_code);
}
} /* WIFEXITED */
else {
/* Child fails for some other reason. */
return CHILD_FAIL;
}
} /* if parent */
else {
/* This is the child process. */
/* Set up pipe to parent. */
To_parent = To_children; From_parent = From_children;
/* Exit loop and do the case. */
parent = 0;
}
} /* while */
*ip = i;
return (parent ? PARENT : CHILD);
#endif
} /* prover_forks */
/*************
*
* split_clause(c)
*
* If (c == NULL), look for a clause to split.
* If (c != NULL), split on c.
*
* If success (i.e., split, and each child refutes its case), exit process.
*
* Return value:
* 0: no split
* 1: split, child returns
* 2: split, parent returns failure (this might not be used)
*
*************/
int split_clause(struct clause *giv_cl)
{
#ifndef TP_FORK
return 0;
#else
struct clause *c;
char assumptions[MAX_SPLIT_DEPTH+1];
if (giv_cl == NULL)
c = find_clause_to_split();
else
c = giv_cl;
if (c == NULL) {
printf("\nI tried to split, but I could not find a suitable clause.\n");
return 0;
}
else {
int rc, n, case_number;
printf("\nSplitting on clause "); p_clause(c);
n = num_literals(c);
rc = prover_forks(n, &case_number, assumptions);
if (rc == FORK_FAIL) {
printf("Case splitting (fork) failed. Returning to search.\n");
return 0;
}
else if (rc == PARENT) {
if (Current_case == NULL) {
printf("\nThat finishes the proof of the theorem.\n");
fprintf(stderr, "%c\nThat finishes the proof of the theorem.\n", Bell);
}
else {
/* Tell the parent the assumptions used to refute this
* branch. We don't send the actual assumptions; instead,
* we send a set of integers giving the depths of the
* assumptions. This is implemented as a Boolean array
* indexed by depth.
*/
rc = write(To_parent, assumptions, MAX_SPLIT_DEPTH+1);
p_assumption_depths(assumptions);
}
output_stats(stdout, Parms[STATS_LEVEL].val);
printf("\nProcess %d finished %s", my_process_id(), get_time());
exit(PROOF_EXIT);
}
else if (rc == CHILD) {
/* We are the child. Assert units for this case, then continue search. */
int j;
struct literal *c_lit, *d_lit;
struct clause *d, *sos_pos;
clock_init(); /* reset all clocks to 0 */
add_subcase(case_number); /* Update the case vector. */
printf("\nCase "); p_case();
printf(" (process %d):\n", my_process_id());
/* Disable the clause being split. */
un_index_lits_all(c);
if (c->container == Usable)
un_index_lits_clash(c);
rem_from_list(c);
hide_clause(c);
/* Add negated units for cases already done. */
/* Then add the unit for this case. */
sos_pos = Sos->last_cl; /* save position for post processing */
for (j = 1; j <= case_number; j++) {
c_lit = ith_literal(c, j);
d = get_clause();
d_lit = get_literal();
d->first_lit = d_lit;
d_lit->container = d;
d_lit->atom = copy_term(c_lit->atom);
d_lit->atom->occ.lit = d_lit;
d_lit->sign = c_lit->sign;
d_lit->atom->varnum = c_lit->atom->varnum; /* copy type of atom */
if (j != case_number) {
/* negate literal */
d_lit->sign = !d_lit->sign;
if (d_lit->atom->varnum == POS_EQ)
d_lit->atom->varnum = NEG_EQ;
else if (d_lit->atom->varnum == NEG_EQ)
d_lit->atom->varnum = POS_EQ;
}
d->parents = get_int_ptr();
d->parents->i = c->id;
d->parents->next = get_int_ptr();
d->parents->next->i = (j == case_number ? SPLIT_RULE : SPLIT_NEG_RULE);
d->parents->next->next = get_int_ptr();
d->parents->next->next->i = LIST_RULE - int_list_length(Current_case);;
d->parents->next->next->next = copy_int_ptr_list(Current_case);
pre_process(d, 0, Sos);
if (j == case_number && d->container == Sos) {
printf("Assumption: ");
p_clause(d);
}
}
post_proc_all(sos_pos, 0, Sos);
return 1;
}
else { /* rc == CHILD_FAIL */
abend("case failure");
return -1;
}
}
#endif
} /* split_clause */
/*************
*
* split_atom()
*
* If success (i.e., split, and each child refutes its case), exit process.
*
* Return value:
* 0: no split
* 1: split, child returns
* 2: split, parent returns failure (this might not be used)
*
*************/
int split_atom(void)
{
#ifndef TP_FORK
return 0;
#else
struct term *atom;
char assumptions[MAX_SPLIT_DEPTH+1];
atom = find_atom_to_split();
if (atom == NULL) {
printf("\nI tried to split, but I could not find a suitable atom.\n");
return 0;
}
else {
int rc, case_number;
printf("\nSplitting on atom "); p_term(atom);
rc = prover_forks(2, &case_number, assumptions);
if (rc == FORK_FAIL) {
printf("Case splitting (fork) failed. Returning to search.\n");
return 0;
}
else if (rc == PARENT) {
if (Current_case == NULL) {
printf("\nThat finishes the proof of the theorem.\n");
fprintf(stderr, "%c\nThat finishes the proof of the theorem.\n", Bell);
}
else {
rc = write(To_parent, assumptions, MAX_SPLIT_DEPTH+1);
p_assumption_depths(assumptions);
}
output_stats(stdout, Parms[STATS_LEVEL].val);
printf("\nProcess %d finished %s", my_process_id(), get_time());
exit(PROOF_EXIT);
} /* parent */
else if (rc == CHILD) {
/* We are the child. Assert units for this case, then continue search. */
struct literal *d_lit;
struct clause *d, *sos_pos;
clock_init(); /* reset all clocks to 0 */
add_subcase(case_number); /* Update the case vector. */
printf("\nCase "); p_case();
printf(" (process %d):\n", my_process_id());
sos_pos = Sos->last_cl; /* save position for post processing */
d = get_clause();
d_lit = get_literal();
d->first_lit = d_lit;
d_lit->container = d;
d_lit->atom = copy_term(atom);
d_lit->atom->occ.lit = d_lit;
d_lit->sign = (case_number == 1 ? 1 : 0);
if (is_eq(atom->sym_num))
d_lit->atom->varnum = d_lit->sign ? POS_EQ : NEG_EQ;
else
d_lit->atom->varnum = NORM_ATOM;
d->parents = get_int_ptr();
d->parents->i = SPLIT_RULE;
d->parents->next = get_int_ptr();
d->parents->next->i = LIST_RULE - int_list_length(Current_case);
d->parents->next->next = copy_int_ptr_list(Current_case);
pre_process(d, 0, Sos);
if (d->container == Sos) {
printf("Assumption: ");
p_clause(d);
}
post_proc_all(sos_pos, 0, Sos);
return 1;
} /* child */
else { /* rc == CHILD_FAIL */
abend("case failure");
return -1;
}
}
#endif
} /* split_atom */
/*************
*
* possible_split()
*
* Check if it is time to split, and if so, try to split.
*
* If a split occurs, children return to continue searching.
* If all children find proofs, parent calls exit(PROOF_EXIT).
* If any child fails, parent abends. (This may change.)
*
*************/
void possible_split(void)
{
static int next_attempt = 0;
int ok = 0;
#ifndef TP_FORK
abend("case splitting is not compiled into this Otter");
#endif
if (Flags[SPLIT_CLAUSE].val || Flags[SPLIT_ATOM].val) {
if (Parms[SPLIT_SECONDS].val != -1) {
int runtime = run_time() / 1000;
if (next_attempt == 0)
next_attempt = Parms[SPLIT_SECONDS].val;
if (runtime >= next_attempt) {
ok = 1;
next_attempt += Parms[SPLIT_SECONDS].val;
}
}
else if (Parms[SPLIT_GIVEN].val != -1) {
int n = Parms[SPLIT_GIVEN].val;
if (n == 0 || Stats[CL_GIVEN] % n == 0) {
ok = 1;
}
}
if (ok) {
int rc;
if (case_depth() < Parms[SPLIT_DEPTH].val) {
if (Flags[SPLIT_ATOM].val)
rc = split_atom();
else
rc = split_clause((struct clause *) NULL);
}
}
}
} /* possible_split */
/*************
*
* always_split()
*
* Unconditional splitting, and keep splitting as long as possible.
*
*************/
void always_split(void)
{
int rc;
#ifndef TP_FORK
abend("case splitting is not compiled into this Otter");
#endif
if (Flags[SPLIT_ATOM].val)
rc = split_atom();
else
rc = split_clause((struct clause *) NULL);
if (rc == 1)
always_split(); /* We are the child; all is well; split again. */
else {
printf("\nalways_split: returning because no splitting is possible at this time.\n");
return;
}
} /* always_split */
/*************
*
* possible_given_split(c)
*
* c has just been selected as the given clause.
*
*************/
void possible_given_split(struct clause *c)
{
#ifndef TP_FORK
abend("case splitting is not compiled into this Otter");
#endif
if (Flags[SPLIT_WHEN_GIVEN].val && ground_clause(c) && num_literals(c) > 1) {
int ok = 1;
if (ok && Flags[SPLIT_POS].val)
ok = pos_clause(c);
if (ok && Flags[SPLIT_NEG].val)
ok = neg_clause(c);
if (ok && Flags[SPLIT_NONHORN].val)
ok = !horn_clause(c);
if (ok) {
int rc;
if (case_depth() < Parms[SPLIT_DEPTH].val) {
if (Flags[SPLIT_ATOM].val) {
/* This is a little strange. We're allowing splitting on an
atom. We'll first move the clause back to Sos.
*/
un_index_lits_clash(c);
rem_from_list(c);
append_cl(Sos, c);
rc = split_atom();
}
else
rc = split_clause(c);
}
}
}
} /* possible_given_split */
/*************
*
* assumps_to_parent()
*
* This routine is called when a proof is found during case splitting.
*
* Tell the parent the assumptions used to refute this
* leaf. We don't send the actual assumptions; instead,
* we send a set of integers giving the depths of the
* assumptions. This is implemented as a Boolean array
* indexed by depth.
*
*************/
void assumps_to_parent(struct clause *e)
{
struct clause_ptr *p, *q;
struct int_ptr *r;
int i;
char assumptions[MAX_SPLIT_DEPTH+1];
p = NULL;
i = get_ancestors(e, &p, &r); /* i (level), r (level list) won't be used */
for (i = 0; i <= MAX_SPLIT_DEPTH; i++)
assumptions[i] = 0;
for (q = p; q != NULL; q = q->next) {
r = q->c->parents;
/* SPLIT_RULE code is either first (atom split) or second (clause split) */
if (r != NULL && r->i == SPLIT_RULE) {
i = LIST_RULE - r->next->i;
}
else if (r!= NULL && r->next != NULL && r->next->i == SPLIT_RULE) {
i = LIST_RULE - r->next->next->i;
}
else
i = 0;
if (i != 0) {
/* The current clause is a split assumption, and i is the
* depth. This does not include SPLIT_NEG assumptions from
* previous sibling cases.
*/
assumptions[i] = 1;
}
}
i = write(To_parent, assumptions, MAX_SPLIT_DEPTH+1);
printf("\n\n"); p_assumption_depths(assumptions);
} /* assumps_to_parent */
/*************
*
* exit_with_possible_model()
*
*************/
void exit_with_possible_model(void)
{
printf("\nPossible model detected on branch ");
p_case(); printf(".\n");
fprintf(stderr, "\n%cPossible model detected on branch ", Bell);
print_case(stderr); fprintf(stderr, ".\n");
printf("\nHere are the clauses in Usable and SoS. It seems that no more\n");
printf("inferences or splitting can be done. If the search strategy is\n");
printf("complete, these clauses should lead to a model of the input.\n");
printf("\nlist(usable).\n");
print_cl_list(stdout, Usable);
printf("\nlist(sos).\n");
print_cl_list(stdout, Sos);
output_stats(stdout, Parms[STATS_LEVEL].val);
printf("\nProcess %d finished %s", my_process_id(), get_time());
exit(POSSIBLE_MODEL_EXIT);
} /* exit_with_possible_model */
/*************************************************************************/
/* The rest of this file is some documentation on the code in this file. */
/*************************************************************************/
/*
CASE SPLITTING IN OTTER
William McCune, Dale Myers, Rusty Lusk, Mohammed Alumlla
December 1997
This implementation uses the UNIX fork() command to make copies of the
current state of the process for the cases. This avoids having to
explicitly save the state and restore it for the next case. (That is,
it was easy to implement.)
When enabled, splitting occurs periodically during the search. The
default is to split after every 5 given clauses. This can be changed
to some other number of given clauses, say 10, with the command
assign(split_given, 10). % default 5
Instead, one can split after a specified number of seconds, with
a command such as
assign(split_seconds, 10). % default infinity
which asks Otter to attempt a split every (approximately) 10 seconds.
(Jobs that use split_seconds are usually not repeatable.)
A third method is to split when a nonunit ground clause is selected
as the given clause. This option is specified with the command
set(split_when_given).
which causes splitting on the given clause if (1) it is ground, (2) it
is within the split_depth bound (see below), and (3) it satisfies the
split_pos and split_neg flags (see below).
If you wish to limit the depth of splitting, use a command such as
assign(split_depth, 3). % default 256 (which is also the maximum)
which will not allow a case such as "Case [1.1.1.1]".
There are two kinds of splitting: on ground clauses and on ground
atoms. Clause splitting constructs one case for each literal, and
atom splitting, say on p, constructs two cases: p is true; p is false
(or, as Larry Wos says, splitting on a tautology).
Sequence of Splitting Processes
Say Otter decides to split the search into n cases. For each case,
the fork() command creates a child process for the case, then the
parent process waits for the child to exit. If any child fails to
refute its case, the parent exits in failure (causing all
ancestor processes to fail as well). If each child refutes its case,
the parent exits with success.
The Output File
Various messages about the splitting events are sent to the output file.
To get an overview of the search from an output file, say problem.out,
one can use the following command.
egrep "Splitting|Assumption|Refuted|skip|That" problem.out
Splitting Clauses
The following commands enables splitting on clauses after some number
of given clauses have been used (see split_given), or after some
number of seconds (see split_seconds).
set(split_clause). % default clear
The following command simply asks Otter to split on ground given clauses.
set(split_when_given). % default clear
(I suppose one could use both of the preceding commands at the same
time---I haven't tried it.)
If Otter finds a suitable (see flags below) nonunit ground clause
for splitting, say "p | q | r", the assumptions for three cases
are
Case 1: p.
Case 2: -p & q.
Case 3: -p & -q & r.
Eligible Clauses for Splitting
Otter splits on ground nonunit clauses only. They can
occur in Usable or in Sos. The following commands can be used
to specify the type of clause to split.
set(split_pos). % split on positive clauses only (default clear)
set(split_neg). % split on negative clauses only (default clear)
set(split_nonhorn). % split on nonhorn clauses only (default clear)
If none of the preceding flags are set, all ground clauses are eligible.
Selecting the Best Eligible Clause
The default method for selecting the best eligible clause for
splitting is simply to take the first, lowest weight (using the
pick_given scale) clause from Usable+Sos.
Instead, one can use The command
set(split_min_max). % default clear
which says to use the following method to compare two eligible clauses
C and D. Prefer the clause with the lighter heaviest literal
(pick_given scale); if the heaviest literals have the same
weight, use the lighter clause; if the clauses have the same
weight, use the first in Usable+Sos.
Splitting Atoms
The following commands enables splitting on atoms after some number
of given clauses have been used (see split_given), or after some
number of seconds (see split_seconds).
set(split_atom).
(For propositional problems with assign(split_given, 0), this will
cause Otter to perform a (not very speedy) Davis-Putnam search.)
To select an atom for splitting, we consider OCCURRENCES of
atoms within clauses.
Eligible Atoms
Otter splits on atoms that occur in nonunit ground clauses.
The command
set(split_pos). % default clear
says to split on atoms the occur only in positive clauses,
set(split_neg). % default clear
says to split on atoms the occur only in negative clauses, and
set(split_nonhorn). % default clear
says to split on atoms that occur positively in nonHorn clauses.
Selecting the Best Eligible Atom
Default method for comparing two eligible atom-occurrences:
Prefer the atom that occurs in the lower weight clause.
If the clauses have the same weight, prefer the atom
with the lower weight.
An optional method for selecting an atom considers the number
of occurrences of the atom. The command
set(split_popular). % default clear
says to prefer the atom that occurs in the greatest number
of clauses. All clauses in Usable+Sos containing the atom
are counted.
Another Way to Split Atoms
If the user has an idea of how atom splitting should occur, he/she
can give a sequence of atoms in the input file, and Otter will
split accordingly. (As above, the TIME of splitting is determined
as above with the split_given and split_seconds parameters.)
For example, with the commands
set(split_atom).
split_atoms([P, a=b, R]).
assign(split_given, 0).
Otter will immediately (because of split_given) split the
search into 8 cases (because there are 3 atoms), then do no
more splitting.
Problems With This Implementation
Splitting is permanent. That is, if a case fails, the whole
search fails (no backing up to try a different split).
If Otter fails to find a proof for a particular case (e.g., the Sos
empties or some limit is reached), the whole attempt fails. If
the search strategy is complete, then an empty Sos indicates
satisfiability, and the set of assumptions introduced by splitting
give you a partial model; however, it is up to the user to figure this
out.
When splitting is enabled, max_seconds (for the initial process and
all descendent processes) is checked against the wall clock (from the
start of the initial process) instead of against the process clock.
This is problematic if the computer is busy with other processes.
Getting the Total Process Time
The process clock ("user CPU" statistic) is initialized at the
start of the process, and each process prints statistics once at the
end of its life. Therefore, one can get the total process by
summing all of the "user CPU" times in the output file. The command
grep "user CPU" problem.out | awk '{sum += $4}END{print sum}'
can be used to get the approximate total process time from an
output file problem.out.
Advice on Using Otter's Splitting (from McCune)
At this time, we don't have much data. A general strategy
for nonground problems is the following.
set(split_when_given).
set(split_pos). % Also try it without this command.
assign(split_depth, 10).
For ground (propositional) problems, try the following, which
is essentially a Davis-Putnam procedure.
set(split_atom).
set(split_pos).
assign(split_given, 0).
*/
./otter/check.c 0000744 0002044 0001012 00000211330 11120534441 011665 0 ustar beeson /*
* check.c -- code related to proof objects and proof checking
*
*/
#include "header.h"
#include "check.h"
#include "beta.h" // Beeson
/* #define DEBUG */
/* Gen_tab is a general hash table method. You can insert (id,pointer)
* pairs and retrieve the pointer associated with a particular id.
*/
#define GEN_TAB_SIZE 100
struct gen_node {
int id;
void *v;
struct gen_node *next;
};
struct gen_tab {
struct gen_node *a[GEN_TAB_SIZE];
};
/* Global variables */
static struct gen_tab *Old_proof_tab;
static struct gen_tab *New_proof_old_id_tab;
static struct gen_tab *New_proof_tab;
/*************
*
* get_gen_node()
*
*************/
struct gen_node *get_gen_node(void)
{
struct gen_node *p;
p = (struct gen_node *) tp_alloc((int) sizeof(struct gen_node));
p->id = 0;
p->v = NULL;
return(p);
} /* get_gen_node */
/*************
*
* get_proof_object()
*
*************/
struct proof_object *get_proof_object(void)
{
struct proof_object *p;
p = (struct proof_object *) tp_alloc((int) sizeof(struct proof_object));
p->steps = 0;
p->first = NULL;
p->last = NULL;
return(p);
} /* get_proof_object */
/*************
*
* get_proof_object_node()
*
*************/
struct proof_object_node *get_proof_object_node(void)
{
struct proof_object_node *p;
int i;
p = (struct proof_object_node *) tp_alloc((int) sizeof(struct proof_object_node));
p->id = 0;
p->old_id = 0;
p->parent1 = 0;
p->parent2 = 0;
p->position1 = NULL;
p->position2 = NULL;
p->map = NULL;
p->rule = P_RULE_UNDEFINED;
p->backward_subst = FALSE;
for (i = 0; i < 2*MAX_VARS; i++)
p->subst[i] = NULL;
p->next = NULL;
return(p);
} /* get_proof_object_node */
/*************
*
* init_gen_tab()
*
*************/
static struct gen_tab *init_gen_tab(void)
{
int i;
struct gen_tab *p;
p = (struct gen_tab *) tp_alloc(GEN_TAB_SIZE * (int) sizeof(void *));
for (i = 0; i < GEN_TAB_SIZE; i++)
p->a[i] = NULL;
return(p);
} /* init_gen_tab */
/*************
*
* insert_into_gen_tab()
*
* If ok, return 1; if already there, return 0.
*
*************/
static int insert_into_gen_tab(struct gen_tab *tab,
int id,
void *v)
{
struct gen_node *p1, *p2, *p3;
p1 = tab->a[id%GEN_TAB_SIZE];
p2 = NULL;
while (p1 && p1->id < id) {
p2 = p1;
p1 = p1->next;
}
if (p1 && p1->id == id)
abend("insert_into_gen_tab, key already there");
else {
p3 = get_gen_node();
p3->id = id;
p3->v = v;
p3->next = p1;
if (p2)
p2->next = p3;
else
tab->a[id%GEN_TAB_SIZE] = p3;
}
return(1);
} /* insert_into_gen_tab */
/*************
*
* retrieve_from_gen_tab()
*
* Return NULL if it is not there.
*
*************/
static void * retrieve_from_gen_tab(struct gen_tab *tab,
int id)
{
struct gen_node *p;
p = tab->a[id%GEN_TAB_SIZE];
while (p && p->id < id)
p = p->next;
if (p && p->id == id)
return(p->v);
else
return((void *) NULL);
} /* retrieve_from_gen_tab */
static void p_gen_tab(struct gen_tab *tab)
{
struct gen_node *p;
int i;
for (i = 0; i < GEN_TAB_SIZE; i++) {
for (p = tab->a[i]; p; p = p->next) {
printf("%d: ", i);
p_proof_object_node(p->v);
}
}
} /* p_gen_tab */
/*************
*
* copy_ip_segment()
*
*************/
struct int_ptr *copy_ip_segment(struct int_ptr *ip,
int n)
{
struct int_ptr *first, *prev, *curr;
int i;
prev = NULL;
for (i = 0; i < n; i++, ip = ip->next) {
curr = get_int_ptr();
curr->i = ip->i;
if (prev)
prev->next = curr;
else
first = curr;
prev = curr;
}
return(first);
} /* copy_ip_segment */
/*************
*
* print_int_list(fp, ip)
*
*************/
void print_int_list(FILE *fp,
struct int_ptr *ip)
{
struct int_ptr *p;
fprintf(fp, "(");
for (p = ip; p; p = p->next)
fprintf(fp, "%d%s", p->i, (p->next ? " " : ""));
fprintf(fp, ")");
} /* print_int_list */
/*************
*
* p_int_list(ip)
*
*************/
void p_int_list(struct int_ptr *ip)
{
print_int_list(stdout, ip);
printf("\n");
} /* p_int_list */
/*************
*
* int check_eq_lit(lit)
*
*************/
static int check_eq_lit(struct literal *lit)
{
return(lit->atom->varnum == POS_EQ ||
lit->atom->varnum == NEG_EQ ||
lit->atom->varnum == LEX_DEP_DEMOD);
} /* check_eq_lit */
/*************
*
* trivial_subst()
*
* A substitution is trivial if every (nonempty) entry is
* "vi -> vi (NULL context)"
*
*************/
int trivial_subst(struct context *c)
{
int i, ok;
if (c->multiplier != 0)
ok = 0;
else for (i = 0, ok = 1; i < MAX_VARS && ok; i++) {
if (c->terms[i]) {
if (c->terms[i]->type != VARIABLE)
ok = 0;
else if (c->terms[i]->varnum != i)
ok = 0;
else
ok = (c->contexts[i] == NULL);
}
}
return(ok);
} /* trivial_subst */
/*************
*
* connect_new_node()
*
* Add a new node to the end of the proof object; return the node.
*
*************/
struct proof_object_node *connect_new_node(struct proof_object *new_proof)
{
struct proof_object_node *pn;
int rc;
pn = get_proof_object_node();
if (new_proof->steps == 0) {
new_proof->first = pn;
new_proof->last = pn;
}
else {
new_proof->last->next = pn;
new_proof->last = pn;
}
new_proof->steps++;
pn->id = new_proof->steps;
rc = insert_into_gen_tab(New_proof_tab, pn->id, pn);
return(pn);
} /* connect_new_node */
/*************
*
* po_rule()
*
* Return a poitner to the char string corresponding to the integer
* code for a proof object rule.
*
*************/
static char *po_rule(int rule)
{
switch (rule) {
case P_RULE_UNDEFINED: return("undefined");
case P_RULE_INPUT: return("input");
case P_RULE_EQ_AXIOM: return("eq-axiom");
case P_RULE_INSTANTIATE: return("instantiate");
case P_RULE_PROPOSITIONAL: return("propositional");
case P_RULE_RESOLVE: return("resolve");
case P_RULE_PARAMOD: return("paramod");
case P_RULE_FLIP: return("flip");
default: return("unknown");
}
} /* po_rule */
/*************
*
* print_term_s()
*
* Print a term, S-expression style.
*
*************/
void print_term_s(FILE *fp,
struct term *t)
{
if (t->type == VARIABLE) {
if (t->sym_num != 0)
fprintf(fp, "%s", sn_to_str(t->sym_num));
else
fprintf(fp, "v%d", t->varnum);
}
else {
struct rel *r;
fprintf(fp, "(%s", sn_to_str(t->sym_num));
for (r = t->farg; r; r = r->narg) {
fprintf(fp, " ");
print_term_s(fp, r->argval);
}
fprintf(fp, ")");
}
} /* print_term_s */
/*************
*
* p_term_s()
*
*************/
void p_term_s(struct term *t)
{
print_term_s(stdout, t);
} /* print_term_s */
/*************
*
* print_clause_s()
*
* Print a clause, S-expression style (without a newline).
*
*************/
void print_clause_s(FILE *fp,
struct clause *c)
{
struct literal *lit;
fprintf(fp, "(");
for (lit = c->first_lit; lit; lit = lit->next_lit) {
if (!lit->sign)
fprintf(fp, "(not ");
print_term_s(fp, lit->atom);
if (!lit->sign)
fprintf(fp, ")");
if (lit->next_lit)
fprintf(fp, " ");
}
fprintf(fp, ")");
fflush(fp);
} /* print_clause_s */
/*************
*
* p_clause_s()
*
*************/
void p_clause_s(struct clause *c)
{
print_clause_s(stdout, c);
} /* print_clause_s */
/*************
*
* print_clause_s2()
*
* Print a clause, S-expression style (without a newline).
*
*************/
void print_clause_s2(FILE *fp,
struct clause *c)
{
if (c->first_lit == NULL)
fprintf(fp, "false");
else {
struct literal *lit;
for (lit = c->first_lit; lit; lit = lit->next_lit) {
if (lit->next_lit)
fprintf(fp, "(or ");
if (!lit->sign)
fprintf(fp, "(not ");
if (is_symbol(lit->atom, "$T", 0))
fprintf(fp, "true");
else if (is_symbol(lit->atom, "$F", 0))
fprintf(fp, "false");
else
print_term_s(fp, lit->atom);
if (!lit->sign)
fprintf(fp, ")");
if (lit->next_lit)
fprintf(fp, " ");
}
for (lit = c->first_lit->next_lit; lit; lit = lit->next_lit)
fprintf(fp, ")");
}
fflush(fp);
} /* print_clause_s2 */
/*************
*
* p_clause_s2()
*
*************/
void p_clause_s2(struct clause *c)
{
print_clause_s2(stdout, c);
} /* print_clause_s2 */
/*************
*
* print_proof_object_node()
*
*************/
void print_proof_object_node(FILE *fp,
struct proof_object_node *pn)
{
int i;
fprintf(fp, "(%d ", pn->id);
fprintf(fp, "(%s", po_rule(pn->rule));
switch (pn->rule) {
case P_RULE_INPUT:
case P_RULE_EQ_AXIOM:
fprintf(fp, ") ");
break;
case P_RULE_INSTANTIATE:
fprintf(fp, " %d (", pn->parent1);
for (i = 0; i < 2*MAX_VARS; i++) {
if (pn->subst[i]) {
if (pn->backward_subst) {
fprintf(fp, "(");
print_term_s(fp, pn->subst[i]);
fprintf(fp, " . v%d)", i);
}
else {
fprintf(fp, "(v%d . ", i);
print_term_s(fp, pn->subst[i]);
fprintf(fp, ")");
}
}
}
fprintf(fp, ")) ");
break;
case P_RULE_RESOLVE:
case P_RULE_PARAMOD:
fprintf(fp, " %d ", pn->parent1);
print_int_list(fp, pn->position1);
fprintf(fp, " %d ", pn->parent2);
print_int_list(fp, pn->position2);
fprintf(fp, ") ");
break;
case P_RULE_PROPOSITIONAL:
fprintf(fp, " %d) ", pn->parent1);
break;
case P_RULE_FLIP:
fprintf(fp, " %d ", pn->parent1);
print_int_list(fp, pn->position1);
fprintf(fp, ") ");
break;
default:
abend("print_proof_object_node, bad rule");
break;
}
if (Flags[BUILD_PROOF_OBJECT_2].val)
print_clause_s2(fp, pn->c);
else
print_clause_s(fp, pn->c);
if (pn->old_id != 0)
fprintf(fp, " (%d)", pn->old_id); /* Otter ID */
else
fprintf(fp, " NIL"); /* Otter ID */
fprintf(fp, ")\n");
fflush(fp);
} /* print_proof_object_node */
/*************
*
* p_proof_object_node()
*
*************/
void p_proof_object_node(struct proof_object_node *pn)
{
print_proof_object_node(stdout, pn);
} /* print_proof_object_node */
/*************
*
* print_proof_object()
*
*************/
void print_proof_object(FILE *fp,
struct proof_object *po)
{
struct proof_object_node *pn;
fprintf(fp, "(\n");
for (pn = po->first; pn; pn = pn->next)
print_proof_object_node(fp, pn);
fprintf(fp, ")\n");
} /* print_proof_object */
/*************
*
* p_proof_object()
*
*************/
void p_proof_object(struct proof_object *po)
{
print_proof_object(stdout, po);
} /* print_proof_object */
/*************
*
* new_literal_index()
*
* Given a list of integers and a value v, return the position of v.
*
*************/
static int new_literal_index(struct int_ptr *ip,
int v)
{
int i;
for (i = 1; ip && abs(ip->i) != v; ip = ip->next, i++);
if (!ip)
abend("new_literal_index, bad map");
return(i);
} /* new_literal_index */
/*************
*
* copy_subst_to_proof_object()
*
*************/
static void copy_subst_to_proof_object(struct context *subst,
struct proof_object_node *p)
{
struct term *t;
int i;
t = get_term();
t->type = VARIABLE;
/* If multiplier=0, only need to copy nonNULL entries, because the
* variables won't change.
*/
if (subst->multiplier == 0) {
for (i = 0; i < MAX_VARS; i++) {
if (subst->terms[i]) {
t->varnum = i;
p->subst[i] = apply(t, subst);
}
}
}
else {
int max;
struct proof_object_node *parent;
parent = retrieve_from_gen_tab(New_proof_tab, p->parent1);
max = biggest_var_clause(parent->c);
for (i = 0; i <= max; i++) {
t->varnum = i;
p->subst[i] = apply(t, subst);
}
}
free_term(t);
} /* copy_subst_to_proof_object */
/*************
*
* cl_copy_delete_literal()
*
*************/
struct clause *cl_copy_delete_literal(struct clause *c,
int n)
{
struct clause *d;
struct literal *l1, *l2;
int i;
d = cl_copy(c);
for (l1 = d->first_lit, l2 = NULL, i = 1;
i < n;
l2 = l1, l1 = l1->next_lit, i++);
if (l2)
l2->next_lit = l1->next_lit;
else
d->first_lit = l1->next_lit;
return(d);
} /* cl_copy_delete_literal */
/*************
*
* int variant(t1, c1, t2, c2, trail_address, flip) -- alphabetic variant
*
* I take a shortcut and just call `match' twice. If speed is a
* concern, this routine should be rewritten.
*
* if (flip), t1 has arity 2 and should be flipped before test.
*
* WARNING!! if you use the substitutions for anything, use either one,
* but don't use both. This is because, for example, when given
* p(x), p(y), x is bound to y and y is bound to x!
*
* The use of the trail is the same as in `unify'.
*
*************/
int variant(struct term *t1,
struct context *c1,
struct term *t2,
struct context *c2,
struct trail **trp,
int flip)
{
struct trail *tpos;
struct term *tt;
int rc;
if (flip) {
t1 = copy_term(t1);
tt = t1->farg->argval;
t1->farg->argval = t1->farg->narg->argval;
t1->farg->narg->argval = tt;
}
tpos = *trp;
if (otter_match(t1, c1, t2, trp)) {
if (otter_match(t2, c2, t1, trp))
rc = 1;
else {
clear_subst_2(*trp, tpos);
*trp = tpos;
rc = 0;
}
}
else
rc = 0;
if (flip)
zap_term(t1);
return(rc);
} /* variant */
/*************
*
* match_literals()
*
* Note that literals are indexed starting with 1, not 0.
*
*************/
static int match_literals(struct clause *c1,
struct context *s1,
int *m1,
struct clause *c2,
struct context *s2,
int *m2,
struct trail **trp)
{
struct literal *l1, *l2;
int i1, i2, matched, flip;
struct trail *t_pos;
/* Find the first unmatched literal of c2. */
for (l2 = c2->first_lit, i2=1; l2 && m2[i2]!=0; l2 = l2->next_lit, i2++);
if (!l2)
return(1); /* Success. All literals matched. */
else {
matched = 0;
flip = 0;
i1 = 1;
l1 = c1->first_lit;
while (l1 && !matched) {
t_pos = *trp; /* save position in trail in case of failure */
if (m1[i1]==0 && l1->sign == l2->sign &&
variant(l1->atom, s1, l2->atom, s2, trp, flip)) {
m1[i1] = (flip ? -i2: i2);
m2[i2] = (flip ? -i1: i1);
if (match_literals(c1, s1, m1, c2, s2, m2, trp))
matched = 1;
else {
m1[i1] = 0;
m2[i2] = 0;
clear_subst_2(*trp, t_pos);
*trp = t_pos;
}
}
/* increment */
if (check_eq_lit(l1) && check_eq_lit(l2) && !flip) {
flip = 1;
}
else {
l1 = l1->next_lit;
i1++;
flip = 0;
}
}
return(matched);
}
} /* match_literals */
/*************
*
* match_clauses(c1, c2)
*
* This routine takes 2 clauses that are supposed to be
* alphabetic variants (if not, return NULL). The literals
* may be in different orders, and equality literals may
* be flipped. We find the correspondence and
* return it as a list of integers: the i-th integer is the
* index in c1 of the i-th literal in c2. If an equality
* literal is flipped, the index is negated.
*
*************/
struct int_ptr *match_clauses(struct clause *c1,
struct clause *c2)
{
int m1[MAX_LITS+1], m2[MAX_LITS+1];
struct context *s1, *s2;
struct trail *tr;
int i, rc, n1, n2;
struct int_ptr *ip1, *ip2;
n1 = num_literals(c1);
n2 = num_literals(c2);
if (n1 != n2)
abend("match_clauses, different numbers of literals");
if(Flags[LAMBDA_FLAG].val)
{ s1 = get_context2(c1,0);
s2 = get_context2(c2,1);
}
else
{ s1 = get_context();
s2 = get_context();
}
for (i = 1; i <= MAX_LITS; i++) {
m1[i] = 0;
m2[i] = 0;
}
tr = NULL;
rc = match_literals(c1, s1, m1, c2, s2, m2, &tr);
if (!rc)
abend("match_clauses, literals don't match");
clear_subst_1(tr);
free_context(s1);
free_context(s2);
#ifdef DEBUG
printf("\nmatch_clauses rc=%d\n", rc);
for (i = 1; i <= MAX_LITS; i++)
printf("%3d", m1[i]);
p_clause(c1);
for (i = 1; i <= MAX_LITS; i++)
printf("%3d", m2[i]);
p_clause(c2);
#endif
ip1 = NULL;
for (i = n1; i > 0; i--) {
ip2 = get_int_ptr();
ip2->i = m2[i];
ip2->next = ip1;
ip1 = ip2;
}
return(ip1);
} /* match_clauses */
/*************
*
* cl_append()
*
*************/
struct clause *cl_append(struct clause *c1,
struct clause *c2)
{
struct literal *curr, *prev;
for (curr = c1->first_lit, prev = NULL;
curr;
prev = curr, curr = curr->next_lit);
if (prev)
prev->next_lit = c2->first_lit;
else
c1->first_lit = c2->first_lit;
for (curr = c2->first_lit; curr; curr = curr->next_lit)
curr->container = c1;
free_clause(c2);
return(c1);
} /* cl_append */
/*************
*
* identity_resolve()
*
*************/
struct clause *identity_resolve(struct clause *c1,
int i1,
struct clause *c2,
int i2)
{
struct clause *d1, *d2, *res;
d1 = cl_copy_delete_literal(c1, i1);
d2 = cl_copy_delete_literal(c2, i2);
res = cl_append(d1, d2);
return(res);
} /* identity_resolve */
/*************
*
* identity_paramod()
*
*************/
static struct clause *identity_paramod(struct clause *from_cl,
struct int_ptr *from_pos,
struct clause *into_cl,
struct int_ptr *into_pos)
{
struct clause *into_prime, *from_prime, *para;
struct literal *from_lit, *into_lit;
struct term *beta, *t;
struct int_ptr *ip;
struct rel *r;
int i;
from_lit = ith_literal(from_cl, from_pos->i);
if (from_pos->next->i == 1)
beta = from_lit->atom->farg->narg->argval;
else
beta = from_lit->atom->farg->argval;
into_prime = cl_copy(into_cl);
into_lit = ith_literal(into_prime, into_pos->i);
/* Get the into term. */
for (ip = into_pos->next, t = into_lit->atom; ip; ip = ip->next) {
for (i = 1, r = t->farg; i < ip->i; i++, r = r->narg);
t = r->argval;
}
/* Now r points at into term t. */
r->argval = copy_term(beta);
from_prime = cl_copy_delete_literal(from_cl, from_pos->i);
para = cl_append(from_prime, into_prime);
return(para);
} /* identity_paramod */
/*************
*
* void renumber_vars_subst()
*
*************/
void renumber_vars_subst(struct clause *c,
struct term **terms)
{
struct literal *lit;
int varnums[MAX_VARS];
int i, ok;
struct term *t;
ok = 1;
for (i = 0; i < MAX_VARS; i++)
varnums[i] = -1;
lit = c->first_lit;
while (lit) {
if (renum_vars_term(lit->atom, varnums) == 0)
ok = 0;
lit = lit->next_lit;
}
for (i = 0; i < MAX_VARS; i++) {
if (varnums[i] != -1 && varnums[i] != i) {
t = get_term();
t->type = VARIABLE;
t->varnum = i;
terms[varnums[i]] = t;
}
}
} /* renumber_vars_subst */
/*************
*
* translate_unit_deletion()
*
*************/
static int translate_unit_deletion(struct proof_object_node *current,
struct proof_object_node *unit,
struct proof_object *new_proof)
{
struct literal *l1, *l2;
struct proof_object_node *instance, *resolvent;
struct context *subst;
struct trail *tr;
int found, index;
struct int_ptr *ip1, *ip2;
/* First, find the literal that is deleted. */
subst = get_context();
subst->multiplier = 0;
l2 = unit->c->first_lit;
for (l1 = current->c->first_lit, found = 0, index = 0;
l1 && !found;
l1 = l1->next_lit, index++) {
tr = NULL;
if (l2->sign != l1->sign && otter_match(l2->atom,subst,l1->atom,&tr)) {
found = 1;
}
}
if (!found)
abend("translate_unit_deletion, unit deletion not found");
/* Set up a new proof object node for the instantiation. */
if (trivial_subst(subst))
instance = unit;
else {
instance = connect_new_node(new_proof);
instance->rule = P_RULE_INSTANTIATE;
instance->parent1 = unit->id;
instance->c = apply_clause(unit->c, subst);
copy_subst_to_proof_object(subst, instance);
}
clear_subst_1(tr);
free_context(subst);
/* Set up a node for the resolution (negative lit. always first parent). */
resolvent = connect_new_node(new_proof);
resolvent->rule = P_RULE_RESOLVE;
ip1 = get_int_ptr(); resolvent->position1 = ip1;
ip2 = get_int_ptr(); resolvent->position2 = ip2;
if (l2->sign) { /* unit positive */
resolvent->parent1 = current->id;
resolvent->parent2 = instance->id;
ip1->i = index;
ip2->i = 1;
}
else {
resolvent->parent1 = instance->id;
resolvent->parent2 = current->id;
ip1->i = 1;
ip2->i = index;
}
/* Copy the clause then delete the correct literal. */
resolvent->c = cl_copy_delete_literal(current->c, index);
return(1);
} /* translate_unit_deletion */
/*************
*
* translate_factor_simp()
*
* Apply the first factor_simp operation. Note that a sequence of
* factor_simps may be applied in a different order in the new proof,
* because the order of literals can be different. This should be OK.
*
*************/
static int translate_factor_simp(struct proof_object_node *current,
struct proof_object *new_proof)
{
struct literal *lit1, *lit2;
struct clause *factor;
struct context *subst;
struct trail *tr;
struct proof_object_node *previous, *instance, *merge;
int rc;
/* May have to renumber the variables. */
if (biggest_var_clause(current->c) >= MAX_VARS) {
previous = current;
current = connect_new_node(new_proof);
current->rule = P_RULE_INSTANTIATE;
current->parent1 = previous->id;
current->c = cl_copy(previous->c);
renumber_vars_subst(current->c, current->subst);
}
lit1 = NULL; lit2 = NULL;
factor = first_or_next_factor(current->c, &lit1, &lit2);
while (factor && ! subsume(factor, current->c)) {
cl_del_non(factor);
factor = first_or_next_factor(current->c, &lit1, &lit2);
}
if (!factor)
abend("translate_factor_simp, factor not found");
cl_del_non(factor);
subst = get_context( );
subst->multiplier = 0;
tr = NULL;
rc = unify(lit1->atom, subst, lit2->atom, subst, &tr);
if (!rc)
abend("translate_factor_simp, literals don't unify");
if (trivial_subst(subst))
instance = current;
else {
instance = connect_new_node(new_proof);
instance->rule = P_RULE_INSTANTIATE;
instance->parent1 = current->id;
instance->c = apply_clause(current->c, subst);
copy_subst_to_proof_object(subst, instance);
}
clear_subst_1(tr);
free_context(subst);
/* Build the merge node. */
merge = connect_new_node(new_proof);
merge->rule = P_RULE_PROPOSITIONAL;
merge->parent1 = instance->id;
merge->position1 = get_int_ptr();
merge->position1->i = literal_number(lit2);
merge->c = cl_copy_delete_literal(instance->c, literal_number(lit2));
if (num_literals(instance->c)-1 != num_literals(merge->c))
abend("translate_factor_simp: merge failed");
return(1);
} /* translate_factor_simp */
/*************
*
* first_rewrite()
*
*************/
static struct int_ptr *first_rewrite(struct term *t,
struct int_ptr *pos,
struct clause *c,
struct clause_ptr *demods,
struct context *subst,
struct trail **trp,
int *demod_id)
{
struct int_ptr *prev, *last, *pos_ok;
struct rel *r;
struct clause_ptr *cp;
int ok;
struct term *atom;
if (t->type == COMPLEX) {
for (prev = pos; prev->next; prev = prev->next);
last = get_int_ptr();
last->i = 1;
prev->next = last;
for (r = t->farg; r; r = r->narg, last->i++) {
pos_ok = first_rewrite(r->argval,pos,c,demods,subst,trp,demod_id);
if (pos_ok)
return(pos_ok);
}
prev->next = NULL;
free_int_ptr(last);
}
if (t->type != VARIABLE) {
for (cp = demods, ok = 0; cp && !ok; cp = cp->next) {
atom = cp->c->first_lit->atom;
ok = otter_match(atom->farg->argval, subst, t, trp);
if (ok && atom->varnum == LEX_DEP_DEMOD) {
int mult_flag = 0;
struct term *replacement;
replacement = apply_demod(atom->farg->narg->argval, subst, &mult_flag);
if (Flags[LRPO].val)
ok = lrpo_greater(t, replacement);
else
ok = lex_check(replacement, t) == LESS_THAN;
zap_term_special(replacement);
if (!ok) {
clear_subst_1(*trp);
*trp = NULL;
}
}
if (ok) {
*demod_id = cp->c->id;
return(pos);
}
}
}
return(NULL);
} /* first_rewrite */
/*************
*
* first_rewrite_clause()
*
*************/
static struct int_ptr *first_rewrite_clause(struct clause *c,
struct clause_ptr *demods,
struct context *subst,
struct trail **trp,
int *demod_id)
{
struct int_ptr *ip1, *ip2;
struct literal *lit;
ip1 = get_int_ptr();
ip1->i = 1;
for (lit = c->first_lit; lit; lit = lit->next_lit, ip1->i++) {
ip2 = first_rewrite(lit->atom, ip1, c, demods, subst, trp, demod_id);
if (ip2)
return(ip2);
}
free_int_ptr(ip1);
return(NULL);
} /* first_rewrite_clause */
/*************
*
* translate_demod_nonunit()
*
* The sequence of demodulators that apply to the original clause
* might not apply to the new clause in the same order, because
* the literals might be rearranged. So we collect all of the
* demodulators and keep applying the set. This method is still
* not perfect, because at a given term, the set of demodulators
* might be tried in a different order; an abend is possible.
*
*************/
static int translate_demod_nonunit(struct proof_object_node *current,
struct int_ptr *ip,
struct proof_object *new_proof)
{
int count1, count2, demod_id;
struct int_ptr *ip0, *ip1, *ip2, *ip3;
struct clause_ptr *demods;
struct clause *c;
struct context *subst;
struct trail *tr;
struct proof_object_node *instance, *paramod, *pn;
#if 0
printf("\ncurrent="); p_clause(current->c);
#endif
demods = NULL;
for (ip1 = ip, count1 = 0; ip1 && ip1->i > 0; ip1 = ip1->next, count1++) {
c = cl_find(ip1->i);
/* The new versions of the demodulators have to be used, because
the variables might be numbered differently. We have to copy
the ID and the lex-dep flag into the new version. Sorry this
is so messy.
*/
pn = retrieve_from_gen_tab(New_proof_old_id_tab, c->id);
pn->c->id = pn->id;
pn->c->first_lit->atom->varnum = c->first_lit->atom->varnum;
#if 0
printf("old demod:"); p_clause(c);
printf("new demod:"); p_clause(pn->c);
#endif
insert_clause(pn->c, &demods); /* If not already there. */
}
subst = get_context( );
subst->multiplier = 0;
tr = NULL;
count2 = 0;
ip0 = first_rewrite_clause(current->c,demods,subst,&tr,&demod_id);
while (ip0 && count2 < count1) {
count2++;
pn = retrieve_from_gen_tab(New_proof_tab, demod_id);
if (trivial_subst(subst))
instance = pn;
else {
instance = connect_new_node(new_proof);
instance->parent1 = pn->id;
instance->rule = P_RULE_INSTANTIATE;
instance->c = apply_clause(pn->c, subst);
copy_subst_to_proof_object(subst, instance);
}
paramod = connect_new_node(new_proof);
paramod->rule = P_RULE_PARAMOD;
paramod->parent1 = instance->id;
ip2 = get_int_ptr(); ip2->i = 1; paramod->position1 = ip2;
ip3 = get_int_ptr(); ip3->i = 1; ip2->next = ip3;
paramod->parent2 = current->id;
paramod->position2 = ip0;
paramod->c = identity_paramod(instance->c, paramod->position1,
current->c, paramod->position2);
/* If into literal is negated, must add element to position.
* The position vector will no longer be valid for Otter terms.
*/
if (ith_literal(current->c, ip0->i)->sign == 0) {
ip1 = get_int_ptr();
ip1->i = 1;
ip1->next = ip0->next;
ip0->next = ip1;
}
current = paramod;
#if 0
printf("after rewrite with %d: ", demod_id); p_clause(current->c);
#endif
clear_subst_1(tr);
tr = NULL;
ip0 = first_rewrite_clause(current->c, demods, subst, &tr, &demod_id);
}
if (ip0 || count1 != count2) {
#if 0
fprintf(stdout, "%d rewrites in proof, %d trans.\n", count1, count2);
fprintf(stdout, "clause is "); print_clause(stdout, current->c);
#endif
abend("translate_demod_nonunit, wrong number of rewrites");
}
return(1);
} /* translate_demod_nonunit */
/*************
*
* translate_demod_unit()
*
* With units, we can apply the demodulators in the same order.
*
*************/
static int translate_demod_unit(struct proof_object_node *current,
struct int_ptr *ip,
struct proof_object *new_proof)
{
int count1, demod_id;
struct int_ptr *ip0, *ip1, *ip2, *ip3;
struct clause_ptr *demods;
struct clause *c;
struct context *subst;
struct trail *tr;
struct proof_object_node *instance, *paramod, *pn;
#if 0
printf("\ncurrent="); p_clause(current->c);
#endif
subst = get_context( );
subst->multiplier = 0;
tr = NULL;
for (ip1 = ip, count1 = 0; ip1 && ip1->i > 0; ip1 = ip1->next, count1++) {
c = cl_find(ip1->i);
/* The new versions of the demodulators have to be used, because
the variables might be numbered differently. We have to copy
the ID and the lex-dep flag into the new version. Sorry this
is so messy.
*/
pn = retrieve_from_gen_tab(New_proof_old_id_tab, c->id);
pn->c->id = pn->id;
pn->c->first_lit->atom->varnum = c->first_lit->atom->varnum;
#if 0
printf("old demod:"); p_clause(c);
printf("new demod:"); p_clause(pn->c);
#endif
demods = NULL;
insert_clause(pn->c, &demods);
ip0 = first_rewrite_clause(current->c,demods,subst,&tr,&demod_id);
free_clause_ptr(demods);
if (!ip0)
abend("translate_demod_unit: cannot rewrite");
pn = retrieve_from_gen_tab(New_proof_tab, demod_id);
if (trivial_subst(subst))
instance = pn;
else {
instance = connect_new_node(new_proof);
instance->parent1 = pn->id;
instance->rule = P_RULE_INSTANTIATE;
instance->c = apply_clause(pn->c, subst);
copy_subst_to_proof_object(subst, instance);
}
paramod = connect_new_node(new_proof);
paramod->rule = P_RULE_PARAMOD;
paramod->parent1 = instance->id;
ip2 = get_int_ptr(); ip2->i = 1; paramod->position1 = ip2;
ip3 = get_int_ptr(); ip3->i = 1; ip2->next = ip3;
paramod->parent2 = current->id;
paramod->position2 = ip0;
paramod->c = identity_paramod(instance->c, paramod->position1,
current->c, paramod->position2);
/* If into literal is negated, must add element to position.
* The position vector will no longer be valid for Otter terms.
*/
if (ith_literal(current->c, ip0->i)->sign == 0) {
ip2 = get_int_ptr();
ip2->i = 1;
ip2->next = ip0->next;
ip0->next = ip2;
}
current = paramod;
#if 0
printf("after rewrite with %d: ", demod_id); p_clause(current->c);
#endif
clear_subst_1(tr);
tr = NULL;
}
return(1);
} /* translate_demod_unit */
/*************
*
* finish_translating()
*
* c: the clause from the original proof; The result of this routine
* should be equivalent to c.
*
*************/
int finish_translating(struct clause *c,
struct int_ptr *rest_of_history,
struct proof_object_node *current,
struct proof_object *new_proof)
{
int i, j, rc, ok;
struct proof_object_node *previous, *pn;
struct literal *l1, *l2, *prev_lit;
struct int_ptr *ip1;
struct term *t;
/* Process rest of history here. This code depends on the order in
* which Otter processes generated clauses.
* If there is any demodulation, it is first.
*/
if (rest_of_history && rest_of_history->i == DEMOD_RULE) {
rest_of_history = rest_of_history->next;
if (num_literals(c) == 1)
rc = translate_demod_unit(current, rest_of_history, new_proof);
else
rc = translate_demod_nonunit(current, rest_of_history, new_proof);
while (rest_of_history && rest_of_history->i > 0)
rest_of_history = rest_of_history->next;
current = new_proof->last;
}
/* Equality reordering. */
if (Flags[ORDER_EQ].val) {
struct clause *copy;
copy = cl_copy(current->c);
if (Flags[LRPO].val)
order_equalities_lrpo(copy);
else
order_equalities(copy);
for(l1 = copy->first_lit, i = 1; l1; l1 = l1->next_lit, i++) {
if (TP_BIT(l1->atom->bits, SCRATCH_BIT)) {
previous = current;
current = connect_new_node(new_proof);
current->parent1 = previous->id;
current->position1 = get_int_ptr();
current->position1->i = i;
current->rule = P_RULE_FLIP;
current->c = cl_copy(previous->c);
for (l2=current->c->first_lit, j=1; j<i; l2=l2->next_lit, j++);
t = l2->atom->farg->argval;
l2->atom->farg->argval = l2->atom->farg->narg->argval;
l2->atom->farg->narg->argval = t;
}
}
cl_del_non(copy);
}
while (rest_of_history) {
switch (rest_of_history->i) {
case UNIT_DEL_RULE:
rest_of_history = rest_of_history->next;
while (rest_of_history && rest_of_history->i > 0) {
pn = retrieve_from_gen_tab(New_proof_old_id_tab,
rest_of_history->i);
rc = translate_unit_deletion(current, pn, new_proof);
current = new_proof->last;
rest_of_history = rest_of_history->next;
}
break;
case FACTOR_SIMP_RULE:
rc = translate_factor_simp(current, new_proof);
current = new_proof->last;
rest_of_history = rest_of_history->next;
break;
case FLIP_EQ_RULE:
/* Handled elsewhere (ORDER_EQ above, EQ_UNITS_BOTH_WAYS below). */
/* Move past flip,LIST_RULE-1,n. */
rest_of_history = rest_of_history->next->next->next;
break;
case DEMOD_RULE:
/* There are cases like this:
* [...,demod,...,flip,1,demod,...]
* that arise when equality units are flipped.
* Demodulation is handled at the beginning of this routine,
* so the following should handle things.
*/
rc = finish_translating(c, rest_of_history, current, new_proof);
return(rc);
default:
abend("finish_translating, bad rule");
}
}
/* If not ground, renumber variables. */
if (!ground_clause(current->c)) {
struct clause *d;
d = cl_copy(current->c);
rc = renumber_vars(d);
if (!clause_ident(current->c, d)) {
previous = current;
current = connect_new_node(new_proof);
current->rule = P_RULE_INSTANTIATE;
current->parent1 = previous->id;
current->c = cl_copy(previous->c);
renumber_vars_subst(current->c, current->subst);
}
cl_del_non(d);
}
/* Merge identical literals (keep leftmost occurrence). */
while (num_literals(c) < num_literals(current->c)) {
previous = current;
current = connect_new_node(new_proof);
current->parent1 = previous->id;
current->rule = P_RULE_PROPOSITIONAL;
current->c = cl_copy(previous->c);
ok = 0; i = 1;
for (l1 = current->c->first_lit; l1 && !ok; l1 = l1->next_lit, i++) {
prev_lit = l1; j = i+1;
for (l2 = l1->next_lit; l2 && !ok; prev_lit = l2, l2 = l2->next_lit, j++) {
if (l1->sign == l2->sign && term_ident(l1->atom, l2->atom)) {
ok = 1;
prev_lit->next_lit = l2->next_lit;
current->position1 = get_int_ptr();
current->position1->i = j; /* position of deleted literal */
}
}
}
if (!ok)
abend("finish_translating, merge not found.\n");
}
/* Now we have to match up the original clause and the new one.
* If it's an eq unit, it may be flipped; nonunits should be ok.
*/
ip1 = match_clauses(c, current->c);
if (num_literals(current->c) == 1 && check_eq_lit(current->c->first_lit) &&
ip1->i == -1) {
ip1->i = 1;
previous = current;
current = connect_new_node(new_proof);
current->parent1 = previous->id;
current->position1 = get_int_ptr();
current->position1->i = 1;
current->rule = P_RULE_FLIP;
current->c = cl_copy(previous->c);
l2 = current->c->first_lit;
t = l2->atom->farg->argval;
l2->atom->farg->argval = l2->atom->farg->narg->argval;
l2->atom->farg->narg->argval = t;
}
/* OK, finally we have the final clause corresponding to old clause c. */
current->map = ip1;
current->old_id = c->id;
/* rc = insert_into_gen_tab(New_proof_tab, current->id, current); */
rc = insert_into_gen_tab(New_proof_old_id_tab, c->id, current);
#if 1
/* Sanity check: no other literals flipped, and each subsumes the other.
*/
for (ip1 = current->map; ip1; ip1 = ip1->next)
if (ip1->i < 0)
abend("finish_translating, literal flipped");
if (!subsume(c, current->c) || !subsume(current->c, c))
abend("finish_translating, subsumption failure");
#endif
return(1);
} /* finish_translating */
/*************
*
* translate_resolution()
*
*************/
static int translate_resolution(struct clause *c,
struct proof_object *new_proof)
{
struct int_ptr *ip, *ip_save;
struct proof_object_node *par1_node, *par2_node;
int old_index1, old_index2, new_index1, new_index2;
struct literal *new_lit1, *new_lit2;
int i, rc;
struct context *s1, *s2;
struct trail *tr;
struct proof_object_node *par1_instance_node, *par2_instance_node;
struct proof_object_node *resolvent_node;
/* First get info from parent list of clause: */
/* [binary, par1, list-1, lit1, par2, list-1, lit2, ...] */
ip = c->parents->next;
par1_node = retrieve_from_gen_tab(New_proof_old_id_tab, ip->i);
ip = ip->next;
if (ip->i != LIST_RULE-1)
abend("translate_resolution, can't find first list");
ip = ip->next;
old_index1 = ip->i;
ip = ip->next;
par2_node = retrieve_from_gen_tab(New_proof_old_id_tab, ip->i);
ip = ip->next;
if (ip->i != LIST_RULE-1)
abend("translate_resolution, can't find second list");
ip = ip->next;
old_index2 = ip->i;
ip_save = ip->next; /* save place for processing rest of parent list. */
/* Now find the corresp. indexes in the new_parents. */
new_index1 = new_literal_index(par1_node->map, old_index1);
new_index2 = new_literal_index(par2_node->map, old_index2);
/* Get the resolving literals from the new_parents. */
new_lit1 = ith_literal(par1_node->c, new_index1);
new_lit2 = ith_literal(par2_node->c, new_index2);
#ifdef DEBUG
printf("\nBinary resolution: "); p_clause(c);
printf("old_par1=%d, old_index1=%d, par1_node->c=%d, new_index1=%d\n",
par1_node->old_id, old_index1, par1_node->id, new_index1);
printf("old_par2=%d, old_index2=%d, par2_node->c=%d, new_index2=%d\n",
par2_node->old_id, old_index2, par2_node->id, new_index2);
#endif
/* If negative literal is par2, swap par1, par2. */
if (!new_lit2->sign) {
struct literal *temp_lit;
struct proof_object_node *temp_node;
temp_lit = new_lit1; new_lit1 = new_lit2; new_lit2 = temp_lit;
temp_node = par1_node; par1_node = par2_node; par2_node = temp_node;
i = new_index1; new_index1 = new_index2; new_index2 = i;
/* We shouldn't refer to old again, so don't bother to swap them. */
}
if (new_lit1->sign || !new_lit2->sign)
abend("translate_resolution: signs wrong.\n");
/* Unify the atoms. */
s1 = get_context(); s1->multiplier = 0;
s2 = get_context(); s2->multiplier = 1;
tr = NULL;
rc = unify(new_lit1->atom, s1, new_lit2->atom, s2, &tr);
if (!rc) {
p_term(new_lit1->atom);
p_term(new_lit2->atom);
abend("translate_resolution: unify fails on the preceding.\n");
}
/* Buid the instance nodes. */
if (trivial_subst(s1))
par1_instance_node = par1_node;
else {
par1_instance_node = connect_new_node(new_proof);
par1_instance_node->parent1 = par1_node->id;
par1_instance_node->rule = P_RULE_INSTANTIATE;
par1_instance_node->c = apply_clause(par1_node->c, s1);
copy_subst_to_proof_object(s1, par1_instance_node);
}
if (ground_clause(par2_node->c))
par2_instance_node = par2_node;
else {
par2_instance_node = connect_new_node(new_proof);
par2_instance_node->parent1 = par2_node->id;
par2_instance_node->rule = P_RULE_INSTANTIATE;
par2_instance_node->c = apply_clause(par2_node->c, s2);
copy_subst_to_proof_object(s2, par2_instance_node);
}
clear_subst_1(tr); /* clears both substitution tables */
free_context(s1);
free_context(s2);
/* Build the resolvent node. */
resolvent_node = connect_new_node(new_proof);
resolvent_node->rule = P_RULE_RESOLVE;
resolvent_node->parent1 = par1_instance_node->id;
resolvent_node->parent2 = par2_instance_node->id;
ip = get_int_ptr(); ip->i = new_index1; resolvent_node->position1 = ip;
ip = get_int_ptr(); ip->i = new_index2; resolvent_node->position2 = ip;
resolvent_node->c = identity_resolve(par1_instance_node->c, new_index1,
par2_instance_node->c, new_index2);
#ifdef DEBUG
p_proof_object_node(par1_instance_node);
p_proof_object_node(par2_instance_node);
p_proof_object_node(resolvent_node);
#endif
rc = finish_translating(c, ip_save, resolvent_node, new_proof);
return(1);
} /* translate_resolution */
/*************
*
* order_new_lits_for_hyper()
*
* Return a permutation of 1--n, where n is the number of negative literals.
* The permutation gives the relative order of negative literals in the
* old clause to those in the new. Example:
*
* new: -q2 -q1 -q3 p1 p2 p3 p4.
* map: 4 2 6 1 3 5 7
*
* return: 2 1 3.
*
*************/
static struct int_ptr *order_new_lits_for_hyper(struct proof_object_node *pn)
{
struct int_ptr *ip1, *ip2, *ip3, *ip4, *ip_min;
struct literal *lit;
int n, i;
ip4 = NULL;
for (lit = pn->c->first_lit, ip3 = pn->map, n = 0;
lit && ip3;
lit = lit->next_lit, ip3 = ip3->next) {
if (!lit->sign) {
n++;
ip2 = get_int_ptr();
ip2->i = -ip3->i;
if (!ip4)
ip1 = ip2;
else
ip4->next = ip2;
ip4 = ip2;
}
}
for (i = 0; i < n; i++) {
ip_min = NULL;
for (ip2 = ip1; ip2; ip2 = ip2->next)
if (!ip_min || ip2->i < ip_min->i)
ip_min = ip2;
ip_min->i = n-i;
}
#if 0
printf("\nCheck_order: "); p_clause(pn->c);
for (ip2 = ip1; ip2; ip2 = ip2->next)
printf("%d ", ip2->i);
printf("\n\n");
#endif
return(ip1);
} /* order_new_lits_for_hyper */
/*************
*
* translate_hyper()
*
*************/
static int translate_hyper(struct clause *c,
struct proof_object *new_proof)
{
struct int_ptr *ip, *ip1, *ip2, *ip_save;
struct proof_object_node *nuc_node, *sat_node, *result_node;
struct proof_object_node *nuc_i_node, *sat_i_node, *result_i_node; /* instances */
int i, sat_index, nuc_index, rc;
struct literal *nuc_lit, *sat_lit;
struct context *s1, *s2;
struct trail *tr;
s1 = get_context(); s1->multiplier = 0;
s2 = get_context(); s2->multiplier = 1;
/* [hyper, nuc, sat1, -1001, sat1_index, sat2, -1001, sat2_index, ... */
ip = c->parents->next;
nuc_node = retrieve_from_gen_tab(New_proof_old_id_tab, ip->i);
ip_save = ip->next;
for (ip1 = order_new_lits_for_hyper(nuc_node); ip1; ip1 = ip1->next) {
for (ip2 = ip_save, i = 1; i < ip1->i; ip2 = ip2->next->next->next, i++);
sat_node = retrieve_from_gen_tab(New_proof_old_id_tab, ip2->i);
sat_index = new_literal_index(sat_node->map, ip2->next->next->i);
sat_lit = ith_literal(sat_node->c, sat_index);
/* Get index of first negative literal in nuc clause. */
for (nuc_lit = nuc_node->c->first_lit, nuc_index = 1;
nuc_lit->sign;
nuc_lit = nuc_lit->next_lit, nuc_index++);
tr = NULL;
rc = unify(nuc_lit->atom, s1, sat_lit->atom, s2, &tr);
if (nuc_lit->sign == sat_lit->sign || !rc) {
p_term(nuc_lit->atom);
p_term(sat_lit->atom);
abend("translate_hyper: unify fails on the preceding.\n");
}
if (trivial_subst(s1))
nuc_i_node = nuc_node;
else {
nuc_i_node = connect_new_node(new_proof);
nuc_i_node->parent1 = nuc_node->id;
nuc_i_node->rule = P_RULE_INSTANTIATE;
nuc_i_node->c = apply_clause(nuc_node->c, s1);
copy_subst_to_proof_object(s1, nuc_i_node);
}
if (ground_clause(sat_node->c))
sat_i_node = sat_node;
else {
sat_i_node = connect_new_node(new_proof);
sat_i_node->parent1 = sat_node->id;
sat_i_node->rule = P_RULE_INSTANTIATE;
sat_i_node->c = apply_clause(sat_node->c, s2);
copy_subst_to_proof_object(s2, sat_i_node);
}
clear_subst_1(tr); /* clears both substitution tables */
/* Build the resolvent node. */
result_node = connect_new_node(new_proof);
result_node->rule = P_RULE_RESOLVE;
result_node->parent1 = nuc_i_node->id;
result_node->parent2 = sat_i_node->id;
ip = get_int_ptr(); ip->i = nuc_index; result_node->position1 = ip;
ip = get_int_ptr(); ip->i = sat_index; result_node->position2 = ip;
result_node->c = identity_resolve(nuc_i_node->c, nuc_index,
sat_i_node->c, sat_index);
if (ground_clause(result_node->c))
result_i_node = result_node;
else {
struct clause *d;
d = cl_copy(result_node->c);
rc = renumber_vars(d);
if (clause_ident(result_node->c, d))
result_i_node = result_node;
else {
result_i_node = connect_new_node(new_proof);
result_i_node->rule = P_RULE_INSTANTIATE;
result_i_node->parent1 = result_node->id;
result_i_node->c = cl_copy(result_node->c);
renumber_vars_subst(result_i_node->c, result_i_node->subst);
}
cl_del_non(d);
}
nuc_node = result_i_node;
}
free_context(s1);
free_context(s2);
while (ip_save && ip_save->i > 0)
ip_save = ip_save->next->next->next;
rc = finish_translating(c, ip_save, nuc_node, new_proof);
return(1);
} /* translate_hyper */
/*************
*
* ipx()
*
*************/
int ipx(struct int_ptr *ip,
int n)
{
int i;
for (i=1; ip && i < n; ip = ip->next, i++);
if (ip)
return(ip->i);
else
return(MAX_INT);
} /* ipx */
/*************
*
* translate_ur()
*
*************/
static int translate_ur(struct clause *c,
struct proof_object *new_proof)
{
struct int_ptr *ip, *ip1, *ip2, *ip3, *sat_ids, *sat_map;
struct proof_object_node *nuc_node, *sat_node, *result_node;
struct proof_object_node *nuc_i_node, *sat_i_node, *result_i_node; /* instances */
int box_pos, rc, i, skip_first, nuc_index;
struct literal *nuc_lit, *sat_lit;
struct context *s1, *s2;
struct trail *tr;
s1 = get_context(); s1->multiplier = 0;
s2 = get_context(); s2->multiplier = 1;
/* [ur, nuc, -1001, box_pos, sat1, sat2, sat3, ... */
ip = c->parents->next;
nuc_node = retrieve_from_gen_tab(New_proof_old_id_tab, ip->i);
ip = ip->next->next;
box_pos = ip->i;
/* Get satellite ids from history list. */
ip2 = NULL; i = 0;
for (ip = ip->next; ip && ip->i > 0; ip = ip->next) { /* for each sat. ID */
i++;
if (i == box_pos) { /* insert empty slot */
ip1 = get_int_ptr();
ip1->i = 0;
if (ip2)
ip2->next = ip1;
else
sat_ids = ip1;
ip2 = ip1;
}
ip1 = get_int_ptr();
ip1->i = ip->i;
if (ip2)
ip2->next = ip1;
else
sat_ids = ip1;
ip2 = ip1;
}
i++;
if (i == box_pos) { /* insert empty slot */
ip1 = get_int_ptr();
ip1->i = 0;
if (ip2)
ip2->next = ip1;
else
sat_ids = ip1;
ip2 = ip1;
}
/* Use the map to permute sat_ids so that it matches the new nucleus. */
ip2 = NULL;
for (ip3 = nuc_node->map; ip3; ip3 = ip3->next) {
ip1 = get_int_ptr();
ip1->i = ipx(sat_ids, ip3->i);
if (ip2)
ip2->next = ip1;
else
sat_map = ip1;
ip2 = ip1;
}
#if 1
printf("\ntranslate_ur: sat_map for box=%d, orig= ", box_pos);
p_clause(c);
for (ip1 = sat_map; ip1; ip1 = ip1->next) printf("%d ", ip1->i);
p_clause(nuc_node->c);
#endif
skip_first = 0;
for (ip1 = sat_map; ip1; ip1 = ip1->next) {
if (ip1->i == 0)
skip_first = 1;
else {
sat_node = retrieve_from_gen_tab(New_proof_old_id_tab, ip1->i);
sat_lit = ith_literal(sat_node->c, 1);
/* Get index of clash literal in nuc clause. */
nuc_index = (skip_first ? 2 : 1);
nuc_lit = ith_literal(nuc_node->c, nuc_index);
tr = NULL;
rc = unify(nuc_lit->atom, s1, sat_lit->atom, s2, &tr);
if (nuc_lit->sign == sat_lit->sign || !rc) {
p_term(nuc_lit->atom);
p_term(sat_lit->atom);
abend("translate_ur: unify fails on the preceding.\n");
}
if (trivial_subst(s1))
nuc_i_node = nuc_node;
else {
nuc_i_node = connect_new_node(new_proof);
nuc_i_node->parent1 = nuc_node->id;
nuc_i_node->rule = P_RULE_INSTANTIATE;
nuc_i_node->c = apply_clause(nuc_node->c, s1);
copy_subst_to_proof_object(s1, nuc_i_node);
}
if (ground_clause(sat_node->c))
sat_i_node = sat_node;
else {
sat_i_node = connect_new_node(new_proof);
sat_i_node->parent1 = sat_node->id;
sat_i_node->rule = P_RULE_INSTANTIATE;
sat_i_node->c = apply_clause(sat_node->c, s2);
copy_subst_to_proof_object(s2, sat_i_node);
}
clear_subst_1(tr); /* clears both substitution tables */
/* Build the resolvent node. */
result_node = connect_new_node(new_proof);
result_node->rule = P_RULE_RESOLVE;
result_node->parent1 = nuc_i_node->id;
result_node->parent2 = sat_i_node->id;
ip2 =get_int_ptr(); ip2->i =nuc_index; result_node->position1 =ip2;
ip2 =get_int_ptr(); ip2->i =1; result_node->position2 =ip2;
result_node->c = identity_resolve(nuc_i_node->c, nuc_index,
sat_i_node->c, 1);
if (ground_clause(result_node->c))
result_i_node = result_node;
else {
struct clause *d;
d = cl_copy(result_node->c);
rc = renumber_vars(d);
if (clause_ident(result_node->c, d))
result_i_node = result_node;
else {
result_i_node = connect_new_node(new_proof);
result_i_node->rule = P_RULE_INSTANTIATE;
result_i_node->parent1 = result_node->id;
result_i_node->c = cl_copy(result_node->c);
renumber_vars_subst(result_i_node->c, result_i_node->subst);
}
cl_del_non(d);
}
nuc_node = result_i_node;
}
}
free_context(s1);
free_context(s2);
rc = finish_translating(c, ip, nuc_node, new_proof);
return(1);
} /* translate_ur */
/*************
*
* translate_factor()
*
*************/
static int translate_factor(struct clause *c,
struct proof_object *new_proof)
{
int i1, i2, j, k1, k2;
struct literal *lit1, *lit2;
struct context *subst;
struct trail *tr;
struct proof_object_node *parent, *instance, *factor;
/* Retrieve the proof object of the parent. */
parent = retrieve_from_gen_tab(New_proof_old_id_tab, c->parents->next->i);
/* Get the literal indexes in the old_parent. */
i1 = c->parents->next->next->next->i;
i2 = c->parents->next->next->next->next->i;
/* Get corresponding indexes in new parent. */
k1 = new_literal_index(parent->map, i1);
k2 = new_literal_index(parent->map, i2);
/* Get new literals. */
lit1 = ith_literal(parent->c, k1);
lit2 = ith_literal(parent->c, k2);
/* Unify the literals. */
subst = get_context(); subst->multiplier = 0;
tr = NULL;
j = unify(lit1->atom, subst, lit2->atom, subst, &tr);
if (!j)
abend("translate_factor, literals don't unify");
/* Build the instance node. */
instance = connect_new_node(new_proof);
instance->rule = P_RULE_INSTANTIATE;
instance->parent1 = parent->id;
instance->c = apply_clause(parent->c, subst);
copy_subst_to_proof_object(subst, instance);
clear_subst_1(tr);
free_context(subst);
/* Build the merge node. */
factor = connect_new_node(new_proof);
factor->rule = P_RULE_PROPOSITIONAL;
factor->parent1 = instance->id;
factor->position1 = get_int_ptr(); factor->position1->i = k2;
factor->c = cl_copy_delete_literal(instance->c, k2);
j = finish_translating(c, c->parents->next->next->next->next->next,
factor, new_proof);
return(1);
} /* translate_factor */
/*************
*
* para_position()
*
*************/
static struct term *para_position(struct clause *c,
struct int_ptr *ip)
{
struct literal *l;
struct term *t;
struct rel *r;
int i;
l = ith_literal(c, ip->i);
t = l->atom;
for (ip = ip->next; ip; ip = ip->next) {
for (i = 1, r = t->farg; i < ip->i; i++, r = r->narg);
t = r->argval;
}
return(t);
} /* para_position */
/*************
*
* translate_paramod()
*
*************/
static int translate_paramod(struct clause *c,
struct proof_object *new_proof)
{
struct int_ptr *ip, *ip_save, *from_pos, *into_pos;
struct proof_object_node *from_node, *into_node;
int i, rc, n, para_from;
struct context *s1, *s2;
struct trail *tr;
struct proof_object_node *from_instance_node, *into_instance_node;
struct proof_object_node *para_node;
struct term *from_term, *into_term;
/* First get info from parent list of clause: */
/* [rule, par1, list-1, pos1,..., par2, list-1, pos2,..., rest */
para_from = (c->parents->i == PARA_FROM_RULE);
ip = c->parents->next;
if (para_from)
from_node = retrieve_from_gen_tab(New_proof_old_id_tab, ip->i);
else
into_node = retrieve_from_gen_tab(New_proof_old_id_tab, ip->i);
ip = ip->next;
if (ip->i >= LIST_RULE)
abend("translate_paramod, can't find first list");
n = LIST_RULE - ip->i; /* length of position vector */
ip = ip->next;
if (para_from)
from_pos = copy_ip_segment(ip, n);
else
into_pos = copy_ip_segment(ip, n);
for (i = 0; i < n; i++, ip = ip->next);
if (para_from)
into_node = retrieve_from_gen_tab(New_proof_old_id_tab, ip->i);
else
from_node = retrieve_from_gen_tab(New_proof_old_id_tab, ip->i);
ip = ip->next;
if (ip->i >= LIST_RULE)
abend("translate_paramod, can't find second list");
n = LIST_RULE - ip->i; /* length of position vector */
ip = ip->next;
if (para_from)
into_pos = copy_ip_segment(ip, n);
else
from_pos = copy_ip_segment(ip, n);
for (i = 0; i < n; i++, ip = ip->next);
ip_save = ip; /* save place for processing rest of parent list. */
/* Now modify the positions so that they corresp. to the new clauses.
* Must translate literal index. (Eq literals should be in same direction.)
* Same for both from and into.
*/
from_pos->i = new_literal_index(from_node->map, from_pos->i);
into_pos->i = new_literal_index(into_node->map, into_pos->i);
/* Get the unifying terms from the new_parents. */
from_term = para_position(from_node->c, from_pos);
into_term = para_position(into_node->c, into_pos);
#ifdef DEBUG
printf("\nParamodulation: "); p_clause(c);
#endif
/* Unify the terms. */
s1 = get_context(); s1->multiplier = 0;
s2 = get_context(); s2->multiplier = 1;
tr = NULL;
rc = unify(from_term, s1, into_term, s2, &tr);
if (!rc) {
p_term(from_term);
p_term(into_term);
abend("translate_paramod: unify fails on the preceding.\n");
}
/* Buid the instance nodes. */
if (trivial_subst(s1))
from_instance_node = from_node;
else {
from_instance_node = connect_new_node(new_proof);
from_instance_node->parent1 = from_node->id;
from_instance_node->rule = P_RULE_INSTANTIATE;
from_instance_node->c = apply_clause(from_node->c, s1);
copy_subst_to_proof_object(s1, from_instance_node);
}
if (ground_clause(into_node->c))
into_instance_node = into_node;
else {
into_instance_node = connect_new_node(new_proof);
into_instance_node->parent1 = into_node->id;
into_instance_node->rule = P_RULE_INSTANTIATE;
into_instance_node->c = apply_clause(into_node->c, s2);
copy_subst_to_proof_object(s2, into_instance_node);
}
clear_subst_1(tr); /* clears both substitution tables */
free_context(s1);
free_context(s2);
/* Build the para node. */
para_node = connect_new_node(new_proof);
para_node->rule = P_RULE_PARAMOD;
para_node->parent1 = from_instance_node->id;
para_node->parent2 = into_instance_node->id;
para_node->position1 = from_pos;
para_node->position2 = into_pos;
para_node->c = identity_paramod(from_instance_node->c, from_pos,
into_instance_node->c, into_pos);
/* If into literal is negated, must add element to position.
* Note that the position vector will no longer be valid for Otter terms.
*/
if (ith_literal(into_node->c, into_pos->i)->sign == 0) {
ip = get_int_ptr();
ip->i = 1;
ip->next = into_pos->next;
into_pos->next = ip;
}
#ifdef DEBUG
p_proof_object_node(from_instance_node);
p_proof_object_node(into_instance_node);
p_proof_object_node(para_node);
#endif
rc = finish_translating(c, ip_save, para_node, new_proof);
return(1);
} /* translate_paramod */
/************************************************************/
static void varmap(struct term *t,
struct term **vars)
{
if (t->type == VARIABLE)
vars[t->varnum] = t;
else if (t->type == COMPLEX) {
struct rel *r;
for (r = t->farg; r; r = r->narg)
varmap(r->argval, vars);
}
} /* varmap */
/************************************************************/
static BOOLEAN match2(struct clause *c1,
struct clause *c2,
struct term **vars)
{
int ok;
struct literal *l1, *l2;
/* For variables, term_ident does not check sym_num field.
So, we first check if the clauses are identical, then,
get the "substitution".
*/
for (l1 = c1->first_lit, l2 = c2->first_lit, ok = 1;
l1 && l2 && ok;
l1 = l1->next_lit, l2 = l2->next_lit) {
if (l1->sign != l2->sign)
ok = 0;
else
ok = term_ident(l1->atom, l2->atom);
}
if (!ok || l1 || l2)
return 0;
else {
int i;
for (i = 0; i < MAX_VARS; i++)
vars[i] = NULL;
for (l1 = c1->first_lit; l1; l1 = l1->next_lit)
varmap(l1->atom, vars);
return 1;
}
} /* match2 */
/************************************************************/
struct proof_object_node *find_match2(struct clause *c,
struct proof_object *obj,
struct term **vars)
{
struct proof_object_node *pn = obj->first;
while (pn && pn->rule == P_RULE_INPUT && !match2(pn->c, c, vars))
pn = pn->next;
return (pn && pn->rule == P_RULE_INPUT ? pn : NULL);
} /* find_match2 */
/************************************************************/
/*************
*
* translate_step()
*
* Translate one step in an Otter proof into a sequence of detailed steps
* and add them to New_proof.
*
* return (ok ? 1 : 0)
*
*************/
static int translate_step(struct clause *c,
struct proof_object *new_proof)
{
int rc, rule, id;
struct proof_object_node *pn;
if (!c->parents) {
pn = connect_new_node(new_proof);
pn->c = cl_copy(c);
pn->old_id = c->id;
pn->map = match_clauses(c, pn->c); /* wasteful, but convenient */
rc = insert_into_gen_tab(New_proof_old_id_tab, c->id, pn);
if (!retrieve_initial_proof_object()) {
pn->rule = P_RULE_INPUT;
rc = 1;
}
else {
struct term *vars[MAX_VARS];
struct proof_object_node *initial_step;
initial_step = find_match2(c, new_proof, vars);
if (!initial_step)
abend("translate_step, clauses don't match");
else {
int i;
pn->rule = P_RULE_INSTANTIATE;
pn->parent1 = initial_step->id;
for (i = 0; i < MAX_VARS; i++)
pn->subst[i] = vars[i];
pn->backward_subst = TRUE;
}
}
}
else if (c->parents->i == COPY_RULE &&
c->parents->next->next->i == PROPOSITIONAL_RULE) {
/* special case */
struct proof_object_node *prop_node;
id = c->parents->next->i;
pn = retrieve_from_gen_tab(New_proof_old_id_tab, id);
prop_node = connect_new_node(new_proof);
prop_node->parent1 = pn->id;
prop_node->c = cl_copy(c);
prop_node->rule = P_RULE_PROPOSITIONAL;
prop_node->old_id = c->id;
prop_node->map = match_clauses(c, prop_node->c);
rc = insert_into_gen_tab(New_proof_old_id_tab,c->id,prop_node);
}
else {
rule = c->parents->i;
switch (rule) {
case NEW_DEMOD_RULE :
/*
* This is kludgey. The proof object doesn't have separate
* steps for NEW_DEMOD, so we just refer to the regular copy.
* This means that the old_id field is not quite correct.
* Recall that new_demod has old_id 1 greater than its parent.
*/
id = c->parents->next->i; /* ID of regular copy */
pn = retrieve_from_gen_tab(New_proof_old_id_tab, id);
rc = insert_into_gen_tab(New_proof_old_id_tab, c->id, pn);
break;
case COPY_RULE :
id = c->parents->next->i;
pn = retrieve_from_gen_tab(New_proof_old_id_tab, id);
rc = finish_translating(c, c->parents->next->next,
pn, new_proof);
break;
case BINARY_RES_RULE :
case BACK_UNIT_DEL_RULE :
rc = translate_resolution(c, new_proof);
break;
case HYPER_RES_RULE :
rc = translate_hyper(c, new_proof);
break;
case UR_RES_RULE :
rc = translate_ur(c, new_proof);
break;
case FACTOR_RULE :
rc = translate_factor(c, new_proof);
break;
case PARA_INTO_RULE :
case PARA_FROM_RULE :
rc = translate_paramod(c, new_proof);
break;
case BACK_DEMOD_RULE :
id = c->parents->next->i;
pn = retrieve_from_gen_tab(New_proof_old_id_tab, id);
rc = finish_translating(c, c->parents->next->next,
pn, new_proof);
break;
#ifdef SCOTT
case SEM_RES_RULE :
// just a stub for the moment
//rc = translate_sem_res(c, new_proof);
break;
#endif
default :
fprintf(stderr, "translate_step: rule %d not handled.\n", rule);
rc = 0;
break;
}
}
return(rc);
} /* translate_step */
/*************
*
* contains_answer_literal()
*
*************/
int contains_answer_literal(struct clause *c)
{
struct literal *lit;
for (lit = c->first_lit; lit; lit = lit->next_lit)
if (answer_lit(lit))
return(1);
return(0);
} /* contains_answer_literal */
/*************
*
* contains_rule()
*
*************/
int contains_rule(struct clause *c,
int rule)
{
struct int_ptr *ip;
for (ip = c->parents; ip; ip = ip->next)
if (ip->i == rule)
return(1);
return(0);
} /* contains_rule */
/*************
*
* zap_int_ptr_list(p) -- Free a list of integers
*
*************/
void zap_int_ptr_list(struct int_ptr *p)
{
struct int_ptr *q;
while (p) {
q = p;
p = p->next;
free_int_ptr(q);
}
} /* zap_int_ptr_list */
/*************
*
* trans_2_pos()
*
*************/
struct int_ptr *trans_2_pos(int id,
struct int_ptr *pos)
{
int n, i;
struct clause *c;
struct proof_object_node *pn;
struct int_ptr *new, *p1;
if (pos == NULL)
abend("trans_2_pos: NULL pos");
pn = retrieve_from_gen_tab(New_proof_tab, id);
if (pn == NULL)
abend("trans_2_pos: proof node not found");
c = pn->c;
if (c == NULL)
abend("trans_2_pos: clause not found");
if (num_literals(c) == 0)
abend("trans_2_pos: empty clause");
n = num_literals(c);
new = copy_int_ptr_list(pos->next); /* copy all but first */
if (pos->i != n) {
p1 = get_int_ptr();
p1->i = 1;
p1->next = new;
new = p1;
}
for (i = 2; i <= pos->i; i++) {
p1 = get_int_ptr();
p1->i = 2;
p1->next = new;
new = p1;
}
return new;
} /* trans_2_pos */
/*************
*
* type_2_trans()
*
* Change the given proof object from type 1 to a type 2 by
* changing the position vectors in the justifications.
*
*************/
void type_2_trans(struct proof_object *po)
{
struct proof_object_node *pn;
struct int_ptr *ip;
for (pn = po->first; pn; pn = pn->next) {
if (pn->parent1 != 0 && pn->position1) {
ip = trans_2_pos(pn->parent1, pn->position1);
zap_int_ptr_list(pn->position1);
pn->position1 = ip;
}
if (pn->parent2 != 0 && pn->position2) {
ip = trans_2_pos(pn->parent2, pn->position2);
zap_int_ptr_list(pn->position2);
pn->position2 = ip;
}
}
} /* type_2_trans */
/*************
*
* build_proof_object()
*
* Given a clause (not necessarily empty), build and print the proof
* object corresponding to the clause.
*
*************/
void build_proof_object(struct clause *c)
{
struct clause_ptr *cp1, *cp2;
struct int_ptr *ip1;
int level, i, rc;
struct clause *d;
struct proof_object *new_proof;
if (!Flags[ORDER_HISTORY].val)
abend("build_proof_object: flag order_history must be set");
else if (!Flags[DETAILED_HISTORY].val)
abend("build_proof_object: flag detailed_history must be set");
cp1 = NULL;
level = get_ancestors(c, &cp1, &ip1);
for (cp2 = cp1; cp2; cp2 = cp2->next) {
if (contains_answer_literal(cp2->c))
abend("build_proof_object: proof objects cannot contain answer literals");
else if (contains_rule(cp2->c, NEG_HYPER_RES_RULE))
abend("build_proof_object: neg_hyper_res not allowed");
#ifdef SCOTT
else if (contains_rule(cp2->c, SEM_RES_RULE))
abend("build_proof_object: sem_res not allowed");
#endif
else if (contains_rule(cp2->c, GEO_RULE))
abend("build_proof_object: gL rule not allowed");
else if (contains_rule(cp2->c, GEO_ID_RULE))
abend("build_proof_object: gL-id not allowed");
else if (contains_rule(cp2->c, LINKED_UR_RES_RULE))
abend("build_proof_object: linked_ur_res not allowed");
else if (contains_rule(cp2->c, EVAL_RULE))
abend("build_proof_object: eval rule not allowed");
else if (contains_rule(cp2->c, CLAUSIFY_RULE))
abend("build_proof_object: clausify rule not allowed");
}
/* Old_proof_tab has the original clauses, indexed by their own IDs.
New_proof_old_id_tab has proof nodes, indexed by original IDs.
New_proof_tab has proof nodes, indexed by their own IDs.
*/
new_proof = retrieve_initial_proof_object();
/* If an intial proof object already exists, then New_proof_tab
already exists also (it was built at the same time). Unfortunately,
we have a problem if there is an initial proof object and this
is the second call to build_proof object: New_proof_tab has
been changed, so we cannot use it as we start building from
the initial proof object. Therefore, we allow at most one proof
when we are using initial proof objects. See abend below.
(I think this can be fixed by keeping a copy of New_proof_tab
when the initial proof object is created.
*/
/* If we don't have an initial proof object, start a new one. */
if (new_proof == NULL) {
new_proof = get_proof_object();
New_proof_tab = init_gen_tab();
}
else {
if (Old_proof_tab != NULL)
abend("build_proof_object, at most one proof object can be built when an initial proof object is given");
}
Old_proof_tab = init_gen_tab();
New_proof_old_id_tab = init_gen_tab();
for (cp2 = cp1; cp2; cp2 = cp2->next) {
i = insert_into_gen_tab(Old_proof_tab, cp2->c->id, cp2->c);
}
for (cp2 = cp1, rc = 1; cp2 && rc; cp2 = cp2->next) {
d = (struct clause *) retrieve_from_gen_tab(Old_proof_tab, cp2->c->id);
rc = translate_step(cp2->c, new_proof);
}
if (Flags[BUILD_PROOF_OBJECT_2].val)
type_2_trans(new_proof); /* translate to type 2 proof object */
printf("\n;; BEGINNING OF PROOF OBJECT\n");
p_proof_object(new_proof);
printf(";; END OF PROOF OBJECT\n");
} /* build_proof_object */
/************************************************************/
void init_proof_object_environment(void)
{
New_proof_tab = init_gen_tab();
}
./otter/check.h 0000744 0002044 0001012 00000001505 11120534441 011673 0 ustar beeson #define MAX_LITS 10
/* Types of step in the proof object */
#define P_RULE_UNDEFINED 0
#define P_RULE_INPUT 1
#define P_RULE_EQ_AXIOM 2
#define P_RULE_INSTANTIATE 3
#define P_RULE_PROPOSITIONAL 4
#define P_RULE_RESOLVE 5
#define P_RULE_PARAMOD 6
#define P_RULE_FLIP 7
struct proof_object_node {
int id;
int rule;
int parent1, parent2;
struct int_ptr *position1, *position2;
BOOLEAN backward_subst;
struct term *subst[2*MAX_VARS];
struct clause *c;
int old_id; /* id of original clause */
struct int_ptr *map; /* position of literals in original clause */
struct proof_object_node *next;
};
struct proof_object {
int steps;
struct proof_object_node *first;
struct proof_object_node *last;
};
./otter/clause.c 0000744 0002044 0001012 00000233044 11120534442 012073 0 ustar beeson /*
* clause.c -- This file has routines associated with the clause data type.
*
*/
// #define IS_TREE_DIAGNOSTICS // For Beeson's debugging
#include "header.h"
#include "bterms.h" // Beeson 10.6.02, for set_vars2
#include "beta.h" // Beeson 5.30.03, for get_context2
#include "unify2.h" // Beeson 6.18.03, for max_vars
#ifdef SCOTT
#include "called_by_otter.h"
#endif
#define CLAUSE_TAB_SIZE 1000
#ifdef THINK_C
#define CLAUSE_TAB_SIZE 100
#endif
/* hash table for accessing clauses by ID */
static struct clause_ptr *Clause_tab[CLAUSE_TAB_SIZE];
/* clause ID counter */
static int Clause_id_count;
/* back subsumed, demodulated put here, not deleted */
static struct clause *Hidden_clauses;
/* array to mark mapped literals during subsumption */
#define MAX_LITS 100
static char Map_array[MAX_LITS];
/*************
*
* reset_clause_counter()
*
*************/
void reset_clause_counter(void)
{
Clause_id_count = 0;
} /* reset_clause_counter */
/*************
*
* int next_cl_num()
*
* What is the next clause number? Do not increment the count.
*
*************/
int next_cl_num(void)
{
return(Clause_id_count + 1);
} /* next_cl_num */
/*************
*
* assign_cl_id()
*
* Assign a unique clause identifier and insert into the clause table.
*
*************/
void assign_cl_id(struct clause *c)
{
c->id = ++Clause_id_count;
cl_insert_tab(c);
/* Turn debugging mode on when DEBUG_FIRST - 1 is assigned. */
if ( (c->id == (Parms[DEBUG_FIRST].val - 1)) && !Flags[VERY_VERBOSE].val)
{
Flags[VERY_VERBOSE].val = 1;
fprintf(stdout, "\n\n***** Turn Debugging Mode ON *****\n\n");
}
/* Turn debugging mode off when DEBUG_LAST + 1 is assigned. */
if ( (c->id == (Parms[DEBUG_LAST].val + 1)) && Flags[VERY_VERBOSE].val)
{
Flags[VERY_VERBOSE].val = 0;
fprintf(stdout, "\n\n***** Turn Debugging Mode OFF *****\n\n");
}
} /* assign_cl_id */
/*************
*
* hot_cl_integrate(c)
*
* Integrate a hot-list clause. All this does is assign a clause ID.
* The subterms are not put into the shared data structures, because
* this interferes with the kludgy way I implemented hot-list inference.
* In particular, hot paramodulation from the new clause can't
* handle going into hot-list clauses that are integrated in the
* normal way.
*
*************/
void hot_cl_integrate(struct clause *c)
{
struct literal *lit;
assign_cl_id(c);
for (lit = c->first_lit; lit; lit = lit->next_lit) {
set_up_pointers(lit->atom);
lit->atom->occ.lit = lit;
}
} /* hot_cl_integrate */
/*************
*
* cl_integrate(c) -- integrate a clause
*
* This routine integrates most subterms of the atoms. (Incoming clause must
* already have back pointers from literal to clause and atom to literal.)
*
* The atoms are not shared, and arguments of positive equality literals
* are not shared.
*
* A clause is integrated iff its ID is > 0.
*
*************/
void cl_integrate(struct clause *c)
{
struct literal *lit;
struct term *atom;
struct rel *r, *r1;
if (c->id != 0) {
fprintf(stdout, "WARNING, cl_integrate gets clause with ID: ");
print_clause(stdout, c);
}
else {
assign_cl_id(c);
lit = c->first_lit;
while (lit) {
atom = lit->atom;
if (atom->varnum == POS_EQ ||
atom->varnum == LEX_DEP_DEMOD ||
atom->varnum == CONDITIONAL_DEMOD) {
/* do not share (condition), alpha, beta */
r1 = atom->farg;
while (r1) { /* for alpha and beta */
if (Flags[BACK_DEMOD].val)
/* put it where back demod can find it */
bd_kludge_insert(r1->argval);
if (r1->argval->type == COMPLEX) {
r = r1->argval->farg;
while (r) {
r->argval = integrate_term(r->argval);
r->argof = r1->argval;
r->nocc = r->argval->occ.rel;
r->argval->occ.rel = r;
r = r->narg;
}
}
r1->argof = atom;
r1->argval->occ.rel = r1;
r1 = r1->narg;
}
}
else if (atom->type == COMPLEX) {
r = atom->farg;
while (r) {
r->argval = integrate_term(r->argval);
r->argof = atom;
r->nocc = r->argval->occ.rel;
r->argval->occ.rel = r;
r = r->narg;
}
}
lit = lit->next_lit;
} // end while(lit)
} // end else
} /* cl_integrate */
/*************
*
* cl_del_int(c) -- deallocate an integrated clause.
*
*************/
void cl_del_int(struct clause *c)
{
struct literal *lit, *plit;
struct rel *r, *r2, *pr, *r1;
struct term *atom;
struct int_ptr *ip1, *ip2;
lit = c->first_lit;
while (lit) {
atom = lit->atom;
if (atom->varnum == POS_EQ || atom->varnum == LEX_DEP_DEMOD ||
atom->varnum == CONDITIONAL_DEMOD) {
/* (condition), alpha, beta not shared */
r1 = atom->farg;
while(r1) { /* for alpha and beta */
if (Flags[BACK_DEMOD].val)
bd_kludge_delete(r1->argval); /* back demod kludge */
r = r1->argval->farg;
while (r) {
r2 = r->argval->occ.rel;
pr = NULL;
while (r2 && r2 != r) {
pr = r2;
r2 = r2->nocc;
}
if (!r2) {
print_clause(stdout, c);
abend("cl_del_int, bad equality clause.");
}
if (pr)
pr->nocc = r->nocc;
else
r->argval->occ.rel = r->nocc;
if (!r->argval->occ.rel)
disintegrate_term(r->argval);
pr = r;
r = r->narg;
free_rel(pr);
}
free_term(r1->argval); /* alpha or beta */
pr = r1;
r1 = r1->narg;
free_rel(pr);
}
}
else if (atom->type == COMPLEX) {
r = atom->farg;
while (r) {
r2 = r->argval->occ.rel;
pr = NULL;
while (r2 && r2 != r) {
pr = r2;
r2 = r2->nocc;
}
if (!r2) {
print_clause(stdout, c);
abend("cl_del_int, bad clause.");
}
if (!pr)
r->argval->occ.rel = r->nocc;
else
pr->nocc = r->nocc;
if (!r->argval->occ.rel)
disintegrate_term(r->argval);
pr = r;
r = r->narg;
free_rel(pr);
}
}
free_term(atom);
plit = lit;
lit = lit->next_lit;
free_literal(plit);
}
ip1 = c->parents;
while (ip1) {
ip2 = ip1;
ip1 = ip1->next;
free_int_ptr(ip2);
}
cl_delete_tab(c);
/* If there is other memory associated with clause, free it here */
delete_attributes(c);
free_clause(c);
} /* cl_del_int */
/*************
*
* cl_del_non(c) -- deallocate a nonintegrated clause.
*
*************/
void cl_del_non(struct clause *c)
{
struct literal *lit, *plit;
struct int_ptr *ip1, *ip2;
lit = c->first_lit;
while (lit) {
lit->atom->occ.lit = NULL;
zap_term(lit->atom);
plit = lit;
lit = lit->next_lit;
free_literal(plit);
}
ip1 = c->parents;
while (ip1) {
ip2 = ip1;
ip1 = ip1->next;
free_int_ptr(ip2);
}
/* If there is other memory associated with clause, free it here */
delete_attributes(c);
free_clause(c);
} /* cl_del_non */
/*************
*
* cl_int_chk(c) -- check structure of clause -- for debugging
*
*************/
void cl_int_chk(struct clause *c)
{
struct literal *lit;
printf("checking clause, address:%x " , (unsigned) c);
print_clause(stdout, c);
lit = c->first_lit;
while (lit) {
printf(" literal, address:%x sign:%d type:%d; atom:", (unsigned) lit, lit->sign, lit->atom->varnum);
print_term(stdout, lit->atom); printf("\n");
printf(" cont_cl:%x, atom container:%x\n", (unsigned) lit->container, (unsigned) lit->atom->occ.lit);
lit = lit->next_lit;
}
} /* cl_int_chk */
/*************
*
* struct term *literals_to_term(l)
*
* Convert list of literals to right-associated "|" term.
*
*************/
static struct term *literals_to_term(struct literal *l)
{
struct term *t, *t1, *t2;
struct rel *r1, *r2;
if (l->sign)
t1 = copy_term(l->atom);
else {
t1 = get_term();
r1 = get_rel();
t1->farg = r1;
t1->type = COMPLEX;
t1->sym_num = str_to_sn("-", 1);
r1->argval = copy_term(l->atom);
}
if (l->next_lit) {
t2 = literals_to_term(l->next_lit);
t = get_term(); r1 = get_rel(); r2 = get_rel();
t->farg = r1; r1->narg = r2;
r1->argval = t1; r2->argval = t2;
t->type = COMPLEX;
t->sym_num = str_to_sn("|", 2);
}
else
t = t1;
return(t);
} /* literals_to_term */
/*************
*
* struct term *clause_to_term(c)
*
*************/
struct term *clause_to_term(struct clause *c)
{
struct term *t;
if (c->first_lit)
t = literals_to_term(c->first_lit);
else {
t = get_term();
t->type = NAME;
t->sym_num = str_to_sn("$F", 0);
}
return(t);
} /* clause_to_term */
/*************
*
* struct literal *term_to_literals(t, lits)
*
*************/
static struct literal *term_to_literals(struct term *t,
struct literal *lits)
{
struct literal *l;
if (!is_symbol(t, "|", 2)) {
l = get_literal();
l->next_lit = lits;
l->sign = !is_symbol(t, "-", 1);
if (l->sign)
l->atom = copy_term(t);
else
l->atom = copy_term(t->farg->argval);
return(l);
}
else {
l = term_to_literals(t->farg->narg->argval, lits);
l = term_to_literals(t->farg->argval, l);
return(l);
}
} /* term_to_literals */
/*************
*
* struct clause *term_to_clause(t)
*
* If error found, print message and return NULL.
*
*************/
struct clause *term_to_clause(struct term *t)
{
struct clause *c;
struct literal *l;
c = get_clause();
if (is_symbol(t, "#", 2)) {
/* Right arg is attributes, left arg is clause. */
c->attributes = term_to_attributes(t->farg->narg->argval);
if (!c->attributes)
return(NULL);
else
t = t->farg->argval;
}
c->first_lit = term_to_literals(t, (struct literal *) NULL);
for (l = c->first_lit; l; l = l->next_lit) {
if (l->atom->type == VARIABLE) {
fprintf(stdout, "\nERROR, clause contains variable literal:\n");
print_term(stdout, t); printf(".\n\n");
return(NULL);
}
else {
l->container = c;
l->atom->occ.lit = l;
mark_literal(l);
}
}
return(c);
} /* term_to_clause */
/*************
*
* struct clause *read_sequent_clause(fp, retcd_ptr)
*
* retcd - 0: error (NULL returned)
* 1: ok (NULL returned if EOF encountered)
*
* a,b,c->d,e,f.
* ->d,e,f.
* a,b,c->.
* ->.
*
* This is really ugly, kludgey code.
*
*************/
struct clause *read_sequent_clause(FILE *fp,
int *rcp)
{
struct clause *c;
struct literal *l, *prev;
struct rel *r1, *r2;
char buf1[MAX_BUF+1];
char buf2[MAX_BUF+6];
int rc, i1, i2;
struct term *hyps, *concs, *t;
rc = read_buf(fp, buf1);
if (rc == 0) { /* error */
*rcp = 0;
return(NULL);
}
if (buf1[0] == '\0') { /* ok. EOF */
*rcp = 1;
return(NULL);
}
/* Kludge - make it into a string readable by regular parser. */
/* "a,b,c->d,e,f" becomes "$Hyps(a,b,c)->$Concs(d,e,f)" */
/* "->d,e,f" becomes "$Hyps->$Concs(d,e,f)" */
/* "a,b,c->" becomes "$Hyps(a,b,c)->$Concs" */
/* "->" becomes "$Hyps->$Concs" */
i1 = 0;
skip_white(buf1, &i1);
/* first check for "end_of_list" */
if (initial_str("end_of_list", buf1+i1)) {
i1 += 11;
skip_white(buf1, &i1);
if (buf1[i1] == '.') {
t = get_term(); t->type = NAME;
t->sym_num = str_to_sn("end_of_list", 0);
c = get_clause(); l = get_literal(); c->first_lit = l;
l->atom = t;
*rcp = 1;
return(c);
}
}
/* now reset and start again */
i1 = 0;
skip_white(buf1, &i1);
i2 = 0;
buf2[i2++] = '$';
buf2[i2++] = 'H';
buf2[i2++] = 'y';
buf2[i2++] = 'p';
buf2[i2++] = 's';
if (buf1[i1] != '-' || buf1[i1+1] != '>') {
/* Hyps not empty */
buf2[i2++] = '(';
while (buf1[i1] != '-' || buf1[i1+1] != '>') {
if (buf1[i1] == '.') {
fprintf(stdout, "\nERROR, arrow not found in sequent:\n");
print_error(stdout, buf1, i1);
*rcp = 0;
return(NULL);
}
buf2[i2++] = buf1[i1++];
}
buf2[i2++] = ')';
}
buf2[i2++] = '-';
buf2[i2++] = '>';
buf2[i2++] = '$';
buf2[i2++] = 'C';
buf2[i2++] = 'o';
buf2[i2++] = 'n';
buf2[i2++] = 'c';
buf2[i2++] = 's';
i1 += 2; /* skip over "->" */
skip_white(buf1, &i1);
if (buf1[i1] != '.') {
/* concs not empty */
buf2[i2++] = '(';
while (buf1[i1] != '.') {
buf2[i2++] = buf1[i1++];
}
buf2[i2++] = ')';
}
buf2[i2++] = '.';
buf2[i2++] = '\0';
#if 0
printf("before: %s\n", buf1);
printf("after: %s\n", buf2);
#endif
i2 = 0;
t = str_to_term(buf2, &i2, 0);
if (!t) {
*rcp = 0;
return(NULL);
}
else {
skip_white(buf2, &i2);
if (buf2[i2] != '.') {
fprintf(stdout, "\nERROR, text after term:\n");
print_error(stdout, buf2, i2);
*rcp = 0;
return(NULL);
}
}
t = term_fixup(t);
if (!set_vars(t)) {
fprintf(stdout, "\nERROR, input clause contains too many variables:\n");
print_term(stdout, t); printf(".\n\n");
zap_term(t);
*rcp = 0;
return(NULL); /* error */
}
else if (contains_skolem_symbol(t)) {
fprintf(stdout, "\nERROR, input clause contains Skolem symbol:\n");
print_term(stdout, t); printf(".\n\n");
zap_term(t);
*rcp = 0;
return(NULL); /* error */
}
hyps = t->farg->argval;
concs = t->farg->narg->argval;
free_rel(t->farg->narg);
free_rel(t->farg);
free_term(t);
/* ok, now we have hypotheses and conclusion */
c = get_clause();
r1 = hyps->farg;
prev = NULL;
while (r1) {
l = get_literal();
if (prev)
prev->next_lit = l;
else
c->first_lit = l;
prev = l;
l->sign = 0;
l->atom = r1->argval;
r2 = r1;
r1 = r1->narg;
free_rel(r2);
}
free_term(hyps);
r1 = concs->farg;
while (r1) {
l = get_literal();
if (prev)
prev->next_lit = l;
else
c->first_lit = l;
prev = l;
l->sign = 1;
l->atom = r1->argval;
r2 = r1;
r1 = r1->narg;
free_rel(r2);
}
free_term(concs);
for (l = c->first_lit; l; l = l->next_lit) {
l->container = c;
l->atom->occ.lit = l;
mark_literal(l);
if (contains_skolem_symbol(l->atom)) {
fprintf(stdout,"\nERROR, input literal contains Skolem symbol:\n");
print_term(stdout, l->atom); printf(".\n\n");
*rcp = 0;
return(NULL);
}
}
*rcp = 1;
return(c);
} /* read_sequent_clause */
/*************
*
* struct clause *read_clause(fp, retcd_ptr)
*
* retcd - 0: error (NULL returned)
* 1: ok (NULL returned if EOF encountered)
*
*************/
struct clause *read_clause(FILE *fp,
int *rcp)
{
struct term *t;
struct clause *cl;
int rc;
int nvars;
if (Flags[INPUT_SEQUENT].val)
return(read_sequent_clause(fp, rcp));
t = read_term(fp, &rc);
if (!rc) {
*rcp = 0;
return(NULL); /* error reading term */
}
else if (!t) {
*rcp = 1;
return(NULL); /* EOF */
}
else if (set_vars2(t,&nvars) != 0) { // Beeson added nvars 10.6.02
fprintf(stdout, "\nERROR, input clause contains too many variables:\n");
print_term(stdout, t); printf(".\n\n");
zap_term(t);
*rcp = 0;
return(NULL); /* error */
}
else if (contains_skolem_symbol(t)) {
fprintf(stdout, "\nERROR, input clause contains Skolem symbol:\n");
print_term(stdout, t); printf(".\n\n");
zap_term(t);
*rcp = 0;
return(NULL); /* error */
}
else {
cl = term_to_clause(t);
if(cl)
cl->next_var = nvars; // Beeson 10.6.02
zap_term(t);
if (cl)
*rcp = 1;
else
*rcp = 0; /* error */
return(cl);
}
} /* read_clause */
/*************
*
* struct list *read_cl_list(fp, errors_ptr)
*
* Read clauses until EOF or the term `end_of_list' is reached.
*
*************/
struct list *read_cl_list(FILE *fp,
int *ep)
{
struct list *lst;
struct clause *cl, *pcl;
int rc;
Internal_flags[REALLY_CHECK_ARITY] = 1;
*ep = 0;
lst = get_list();
pcl = NULL;
cl = read_clause(fp, &rc);
while (rc == 0) { /* while errors */
(*ep)++;
cl = read_clause(fp, &rc);
}
while (cl && !(cl->first_lit &&
is_symbol(cl->first_lit->atom, "end_of_list", 0))) {
if (!pcl)
lst->first_cl = cl;
else
pcl->next_cl = cl;
cl->prev_cl = pcl;
cl->container = lst;
pcl = cl;
cl = read_clause(fp, &rc);
while (rc == 0) { /* while errors */
(*ep)++;
cl = read_clause(fp, &rc);
}
}
if (cl)
cl_del_non(cl); /* "end_of_list" term */
lst->last_cl = pcl;
Internal_flags[REALLY_CHECK_ARITY] = 0;
return(lst);
} /* read_cl_list */
/*************
*
* int set_vars_cl(cl) -- decide which terms are variables
*
*************/
int set_vars_cl(struct clause *cl)
{
struct literal *lit;
char *varnames[MAX_VARS];
int i;
for (i=0; i<MAX_VARS; i++)
varnames[i] = NULL;
lit = cl->first_lit;
while (lit) {
if (set_vars_term(lit->atom, varnames))
lit = lit->next_lit;
else
return(0);
}
return(1);
} /* set_vars_cl */
/*************
*
* print_sequent_clause()
*
* Clause number and parents have already been printed.
*
*************/
void print_sequent_clause(FILE *fp,
struct clause *c)
{
struct literal *l;
int first;
for (l = c->first_lit, first = 1; l; l = l->next_lit) {
if (!l->sign) {
if (!first)
fprintf(fp, ", ");
print_term(fp, l->atom);
first = 0;
}
}
fprintf(fp, " -> ");
for (l = c->first_lit, first = 1; l; l = l->next_lit) {
if (l->sign) {
if (!first)
fprintf(fp, ", ");
print_term(fp, l->atom);
first = 0;
}
}
} /* print_sequent_clause */
/*************
*
* print_clause(fp, clause)
*
*************/
void print_clause(FILE *fp,
struct clause *cl)
{
struct literal *lit;
struct int_ptr *ip;
struct term *t;
fprintf(fp, "%d ", cl->id);
if (cl->heat_level > 0)
fprintf(fp, "(heat=%d) ", (int) (cl->heat_level));
fprintf(fp,"[");
for (ip = cl->parents; ip; ip = ip->next) {
if (ip->i <= LIST_RULE) {
/* LIST_RULE is a large negative number. */
/* If ip->i is less than LIST_RULE, then a list follows. */
int i;
int j = LIST_RULE - ip->i;
for (i = 1; i <= j; i++) {
ip = ip->next;
if(ip->i != TRUE_LIT) // Beeson 10.13.02
fprintf(fp, ".%d", ip->i);
}
}
else {
if (ip != cl->parents)
fprintf(fp, ",");
switch (ip->i) {
case BINARY_RES_RULE : fprintf(fp, "binary"); break;
case HYPER_RES_RULE : fprintf(fp, "hyper"); break;
case NEG_HYPER_RES_RULE : fprintf(fp, "neg_hyper"); break;
case UR_RES_RULE : fprintf(fp, "ur"); break;
case PARA_INTO_RULE : fprintf(fp, "para_into"); break;
case PARA_FROM_RULE : fprintf(fp, "para_from"); break;
case FACTOR_RULE : fprintf(fp, "factor"); break;
case FACTOR_SIMP_RULE : fprintf(fp, "factor_simp"); break;
case NEW_DEMOD_RULE : fprintf(fp, "new_demod"); break;
case BACK_DEMOD_RULE : fprintf(fp, "back_demod"); break;
case DEMOD_RULE : fprintf(fp, "demod"); break;
case UNIT_DEL_RULE : fprintf(fp, "unit_del"); break;
case LINKED_UR_RES_RULE : fprintf(fp, "linked_ur"); break;
case EVAL_RULE : fprintf(fp, "eval"); break;
case GEO_ID_RULE : fprintf(fp, "gL-id"); break;
case GEO_RULE : fprintf(fp, "gL"); break;
case COPY_RULE : fprintf(fp, "copy"); break;
case FLIP_EQ_RULE : fprintf(fp, "flip"); break;
case CLAUSIFY_RULE : fprintf(fp, "clausify"); break;
case BACK_UNIT_DEL_RULE : fprintf(fp, "back_unit_del"); break;
case SPLIT_RULE : fprintf(fp, "split"); break;
case SPLIT_NEG_RULE : fprintf(fp, "split_neg"); break;
case PROPOSITIONAL_RULE : fprintf(fp, "propositional"); break;
case BETA_REDUCTION : fprintf(fp, "beta"); break; // Beeson, 8.5.02
case RESOLVE_WITH_TRUE: fprintf(fp, "true"); break; // Beeson, 8.13.02
case SPLIT_NOT_OR : fprintf(fp, "split -or"); break; // Beeson 2.10.03
case SPLIT_NOT_AND : fprintf(fp, "split -and"); break; // Beeson 2.20.03
case SPLIT_OR : fprintf(fp, "split or"); break; // Beeson 7.24.05
case SPLIT_AND : fprintf(fp, "split and"); break; // Beeson 7.24.05
case SIMPLIFY_RULE : fprintf(fp, "simplify"); break; // Beeson 11.1.03
case SOLVE_RULE : fprintf(fp, "solve"); break; // Beeson 11.1.03
case TRUE_LIT : break; // without printing, Beeson 8.13.02
#ifdef SCOTT
case SEM_RES_RULE : fprintf(fp, "sem_res"); break;
#endif
default : fprintf(fp, "%d", ip->i); break;
}
}
}
fprintf(fp, "] ");
#ifdef SCOTT
print_scott_sets(fp,cl);
#endif
if (Flags[PRETTY_PRINT].val) {
int parens;
fprintf(fp, "\n");
lit = cl->first_lit;
while (lit) {
parens = !lit->sign && sn_to_node(lit->atom->sym_num)->special_op;
if (!lit->sign)
fprintf(fp, "-");
if (parens)
fprintf(fp, "(");
pretty_print_term(fp, lit->atom, 0);
if (parens)
fprintf(fp, ")");
lit = lit->next_lit;
if (lit)
fprintf(fp, " |\n");
}
}
else if (Flags[OUTPUT_SEQUENT].val) {
print_sequent_clause(fp, cl);
}
else {
#if 0
struct rel *r;
lit = cl->first_lit;
while (lit) {
if (!lit->sign) {
/* This is so that lit gets correctly parenthesized. */
t = get_term();
r = get_rel();
t->farg = r;
t->type = COMPLEX;
r->argval = lit->atom;
t->sym_num = str_to_sn("-", 1);
print_term(fp, t);
free_rel(r);
free_term(t);
}
else
print_term(fp, lit->atom);
lit = lit->next_lit;
if (lit)
fprintf(fp, " | ");
}
#else
t = clause_to_term(cl);
t = term_fixup_2(t); /* Change -(=(a,b)) to !=(a,b). */
print_term(fp, t);
zap_term(t);
#endif
}
if (cl->attributes)
print_attributes(fp, cl->attributes);
fprintf(fp, ".\n");
} /* print_clause */
/*************
*
* p_clause(clause)
*
*************/
void p_clause(struct clause *cl)
{
print_clause(stdout, cl);
} /* p_clause */
/*************
*
* print_cl_list(fp, lst)
*
*************/
void print_cl_list(FILE *fp,
struct list *lst)
{
struct clause *cl;
if (!lst)
fprintf(fp, "(list nil)\n");
else {
cl = lst->first_cl;
while (cl) {
print_clause(fp, cl);
cl = cl->next_cl;
}
fprintf(fp, "end_of_list.\n");
}
} /* print_cl_list */
/*************
*
* cl_merge(cl) -- merge identical literals (keep leftmost occurrence)
*
*************/
void cl_merge(struct clause *c)
{
struct literal *l1, *l2, *l_prev;
l1 = c->first_lit;
while (l1) {
l2 = l1->next_lit;
l_prev = l1;
while (l2)
if (l1->sign == l2->sign && term_ident(l1->atom, l2->atom)) {
l_prev->next_lit = l2->next_lit;
l2->atom->occ.lit = NULL;
zap_term(l2->atom);
free_literal(l2);
l2 = l_prev->next_lit;
}
else {
l_prev = l2;
l2 = l2->next_lit;
}
l1 = l1->next_lit;
}
} /* cl_merge */
/*************0
*
* int tautology(c) -- Is clause c a tautology?
*
*************/
int tautology(struct clause *c)
{
struct literal *l1, *l2;
int taut;
taut = 0;
l1 = c->first_lit;
while (l1 && !taut) {
l2 = l1->next_lit;
while (l2 && !taut) {
taut = (l1->sign != l2->sign && term_ident(l1->atom, l2->atom));
l2 = l2->next_lit;
}
l1 = l1->next_lit;
}
return(taut);
} /* tautology */
/*************
*
* prf_weight()
*
* Return the number of leaves (i.e., occurrences of input clauses)
* in the proof tree.
*
*************/
int prf_weight(struct clause *c)
{
struct int_ptr *ip;
struct clause *d;
int sum = 0;
for (ip = c->parents; ip; ip = ip->next) {
if (ip->i <= LIST_RULE) {
/* LIST_RULE is a large negative number. */
/* If ip->i is less than LIST_RULE, then a list follows. */
int i;
int j = LIST_RULE - ip->i; /* size of list */
/* Make ip point at the last element of the list. */
for (i = 1; i <= j; i++)
ip = ip->next;
}
else if (ip->i >= 0) {
d = cl_find(ip->i);
if (d)
sum += prf_weight(d);
}
}
return(sum == 0 ? 1 : sum);
} /* prf_weight */
/*************
*
* int proof_length(c)
*
* Return length of proof. If demod_history is clear, demodulation
* steps are not counted. "new_demod" steps are not counted.
*
*************/
int proof_length(struct clause *c)
{
struct clause_ptr *cp1, *cp2;
struct int_ptr *ip1, *ip2;
int count, level;
cp1 = NULL;
level = get_ancestors(c, &cp1, &ip1);
for (count = 0; cp1; ) {
if (cp1->c->parents && cp1->c->parents->i != NEW_DEMOD_RULE)
count++;
cp2 = cp1; cp1 = cp1->next; free_clause_ptr(cp2);
ip2 = ip1; ip1 = ip1->next; free_int_ptr(ip2);
}
return(count);
} /* proof_length */
/*************
*
* int subsume(c, d) -- does clause c subsume clause d?
*
*************/
int subsume(struct clause *c,
struct clause *d)
{
struct context *s;
struct trail *tr;
int subsumed;
if(Flags[LAMBDA_FLAG].val) // Beeson 6.26.03
s = get_context2(c,0); // Beeson 6.26.03
else // Beeson 6.26.03
s = get_context();
tr = NULL;
subsumed = map_rest(c, d, s, &tr);
if (subsumed)
clear_subst_1(tr);
free_context(s);
return(subsumed);
} /* subsume */
/*************
*
* int map_rest(c, d, s, trp) - map rest of literals - for subsumption
*
*************/
int map_rest(struct clause *c,
struct clause *d,
struct context *s,
struct trail **trp)
{
struct literal *c_lit, *d_lit;
struct term *c_atom, *d_atom;
struct trail *t_pos;
int subsumed, i;
/* get the first unmarked literal */
c_lit = c->first_lit;
i = 0;
while (c_lit && Map_array[i] == 1) {
c_lit = c_lit->next_lit;
i++;
}
if (!c_lit)
return(1); /* all lits of c mapped, so c subsumes d */
else if (answer_lit(c_lit)) { /* if answer literal, skip it */
c_atom = c_lit->atom;
Map_array[i] = 1; /* mark as mapped */
subsumed = map_rest(c, d, s, trp);
Map_array[i] = 0; /* remove mark */
return(subsumed);
}
else {
c_atom = c_lit->atom;
Map_array[i] = 1; /* mark as mapped */
d_lit = d->first_lit;
subsumed = 0;
while (d_lit && !subsumed) {
d_atom = d_lit->atom;
t_pos = *trp; /* save position in trail in case of failure */
if (c_lit->sign == d_lit->sign && otter_match(c_atom, s, d_atom, trp)) {
if (map_rest(c, d, s, trp))
subsumed = 1;
else {
clear_subst_2(*trp, t_pos);
*trp = t_pos;
}
}
d_lit = d_lit->next_lit;
}
Map_array[i] = 0; /* remove mark */
return(subsumed);
}
} /* map_rest */
/*************
*
* int anc_subsume(c, d)
*
* We already know that c subsumes d. Check if d subsumes c and
* ancestors(c) <= ancestors(d).
*
*************/
int anc_subsume(struct clause *c,
struct clause *d)
{
if (subsume(d,c)) {
if (Flags[PROOF_WEIGHT].val)
return(prf_weight(c) <= prf_weight(d));
else
return(proof_length(c) <= proof_length(d));
}
else
return(1);
} /* anc_subsume */
/*************
*
* struct clause *for_sub_prop(d)
*
* Attempt to find a clause that propositionally subsumes d.
*
*************/
struct clause *for_sub_prop(struct clause *d)
{
struct clause *c;
for (c = Usable->first_cl; c; c = c->next_cl)
if (ordered_sub_clause(c, d))
return(c);
for (c = Sos->first_cl; c; c = c->next_cl)
if (ordered_sub_clause(c, d))
return(c);
return(NULL);
} /* for_sub_prop */
/*************
*
* struct clause *forward_subsume(d)
*
* Attempt to find a clause that subsumes d.
*
*************/
struct clause *forward_subsume(struct clause *d)
{
int subsumed;
struct literal *d_lit;
struct clause *c = NULL;
struct term *c_atom, *d_atom;
struct context *s;
struct trail *tr;
struct is_tree *is_db;
struct fsub_pos *pos;
struct fpa_index *fpa_db;
struct fpa_tree *ut;
int c_size, factor, i;
int d_size = -1;
struct literal *lit;
if (Flags[PROPOSITIONAL].val)
return(for_sub_prop(d));
subsumed = 0;
s = get_context();
factor = Flags[FACTOR].val;
if (factor) /* if factor don't let long clauses subsume short */
d_size = num_literals(d);
if (!Flags[FOR_SUB_FPA].val) { /* if `is' indexing */
d_lit = d->first_lit;
while (d_lit && !subsumed) {
/* Is_pos_lits and Is_neg_lits are global variables */
is_db = d_lit->sign ? Is_pos_lits : Is_neg_lits;
c_atom = fs_retrieve(d_lit->atom, s, is_db, &pos);
while (c_atom && !subsumed) {
#ifdef IS_TREE_DIAGNOSTICS
fprintf(stdout,"does the clause containing");print_term_nl(stdout,c_atom); fprintf(stdout," subsume "); print_term_nl(stdout,d_lit->atom); // DEBUG
#endif
c = c_atom->occ.lit->container;
c_size = num_literals(c);
if (c_size > MAX_LITS)
abend("forward_subsume, MAX_LITS too small.");
if (literal_number(c_atom->occ.lit) == 1 && (!factor || c_size <= d_size)) {
for (i = 0, lit = c->first_lit;
lit->atom != c_atom;
i++, lit = lit->next_lit); /* empty body */
Map_array[i] = 1; /* mark as mapped*/
tr = NULL;
subsumed = map_rest(c, d, s, &tr);
Map_array[i] = 0; /* remove mark */
clear_subst_1(tr);
}
if (subsumed && Flags[ANCESTOR_SUBSUME].val) {
/* Removed variable renumbering 4/4/2001; shouldn't be necessary */
subsumed = anc_subsume(c,d);
if (!subsumed)
Stats[CL_NOT_ANC_SUBSUMED]++;
}
/* BV(970327) : forward sub only if sub goes both ways */
if (subsumed && Flags[FOR_SUB_EQUIVALENTS_ONLY].val)
subsumed = subsume(d,c);
if (!subsumed)
{ c_atom = fs_retrieve((struct term *) NULL, s, is_db, &pos);
#ifdef IS_TREE_DIAGNOSTICS
if(c_atom) // DEBUG
fprintf(stdout,"\nOK, does the clause containing "), print_term_nl(stdout,c_atom), fprintf(stdout, "subsume the clause containing"), print_term_nl(stdout,d_lit->atom); // DEBUG
else
fprintf(stdout,"No more terms retrieved by keying on that literal.\n");
#endif
}
else
canc_fs_pos(pos, s);
}
d_lit = d_lit->next_lit;
}
}
else { /* fpa indexing */
d_lit = d->first_lit;
while (d_lit && !subsumed) {
fpa_db = (d_lit->sign ? Fpa_pos_lits : Fpa_neg_lits);
d_atom = d_lit->atom;
ut = build_tree(d_atom, MORE_GEN, Parms[FPA_LITERALS].val, fpa_db);
c_atom = next_term(ut, 0);
while (c_atom && !subsumed) {
tr = NULL;
c = c_atom->occ.lit->container;
c_size = num_literals(c);
if (c_size > MAX_LITS) {
abend("forward_subsume, MAX_LITS too small.");
}
if (literal_number(c_atom->occ.lit) == 1 &&
(!factor || c_size <= d_size) &&
otter_match(c_atom, s, d_atom, &tr)) {
for (i = 0, lit = c->first_lit;
lit->atom != c_atom;
i++, lit = lit->next_lit); /* empty body */
Map_array[i] = 1; /* mark as mapped*/
subsumed = map_rest(c, d, s, &tr);
Map_array[i] = 0; /* remove mark */
clear_subst_1(tr);
}
if (subsumed && Flags[ANCESTOR_SUBSUME].val) {
/* Removed variable renumbering 4/4/2001; shouldn't be necessary */
subsumed = anc_subsume(c,d);
if (!subsumed)
Stats[CL_NOT_ANC_SUBSUMED]++;
}
/* BV(970327) : forward sub only if sub goes both ways */
if (subsumed && Flags[FOR_SUB_EQUIVALENTS_ONLY].val)
subsumed = subsume(d,c);
if (!subsumed)
c_atom = next_term(ut, 0);
else
zap_prop_tree(ut);
}
d_lit = d_lit->next_lit;
}
} // end else(fpa_indexing)
free_context(s);
if (subsumed)
return(c);
else
return(NULL);
} /* forward_subsume */
/*************
*
* struct clause_ptr *back_subsume(c)
*
* Get the list of clauses subsumed by c.
*
*************/
struct clause_ptr *back_subsume(struct clause *c)
{
int subsumed, c_size, factor, i;
struct literal *c_lit;
struct clause *d;
struct clause_ptr *subsumed_clauses;
struct term *c_atom, *d_atom;
struct context *s;
struct fpa_tree *ut;
struct trail *tr;
factor = Flags[FACTOR].val;
c_size = num_literals(c);
if (c_size > MAX_LITS) {
abend("back_subsume, MAX_LITS too small.");
}
if(Flags[LAMBDA_FLAG].val) // Beeson 6.26.03
s = get_context2(c,0); // Beeson 6.26.03
else // Beeson 6.26.03
s = get_context();
c_lit = c->first_lit;
/* get first non-answer literal */
i = 0;
while (c_lit && answer_lit(c_lit)) {
c_lit = c_lit->next_lit;
i++;
}
if (!c_lit) {
fprintf(stdout, "\nNOTE: back_subsume called with empty clause.\n");
return(NULL);
}
c_atom = c_lit->atom;
ut = build_tree(c_atom, INSTANCE, Parms[FPA_LITERALS].val,
c_lit->sign ? Fpa_pos_lits : Fpa_neg_lits);
/* Fpa_pos_lits and Fpa_neg_lits are global variables */
subsumed_clauses = NULL;
d_atom = next_term(ut, 0);
while (d_atom) {
d = d_atom->occ.lit->container;
tr = NULL;
if (c != d && (!factor || c_size <= num_literals(d))
&& otter_match(c_atom, s, d_atom, &tr)) {
Map_array[i] = 1; /* mark as mapped */
subsumed = map_rest(c, d, s, &tr);
Map_array[i] = 0; /* remove mark */
clear_subst_1(tr);
if (subsumed && Flags[ANCESTOR_SUBSUME].val)
subsumed = anc_subsume(c, d);
if (subsumed)
#ifdef SCOTT
{
c->back_subs++;
insert_clause(d, &subsumed_clauses);
}
#else
insert_clause(d, &subsumed_clauses);
#endif
}
d_atom = next_term(ut, 0);
}
#ifdef SCOTT
if (c->back_subs) c->pick_weight += get_back_sub_wt_val();
#endif
free_context(s);
return(subsumed_clauses);
} /* back_subsume */
/*************
*
* struct clause_ptr *unit_conflict(c)
*
* Search for unit conflict. Return empty clause if found,
* return NULL if not found.
*
* IT IS ASSUMED THAT c IS A UNIT CLAUSE!!
*
*************/
struct clause_ptr *unit_conflict(struct clause *c)
{
struct clause *d, *e;
struct fpa_tree *ut;
struct term *f_atom;
struct literal *lit;
int go, mp, ec;
struct context *c1, *c2;
struct trail *tr;
struct clause_ptr *cp_return, *cp_prev, *cp_curr;
int saveit = c->next_var; // Beeson 6.18.03
if(Flags[LAMBDA_FLAG].val) // Beeson 6.26.03
{ c1 = get_context2(c,0); // Beeson 6.26.03
c2 = get_context2(c,1);
}
else
{ c1 = get_context();
c1->multiplier = 0;
c2 = get_context();
c2->multiplier = 1;
}
lit = c->first_lit;
while (answer_lit(lit)) /* skip answer literals */
lit = lit->next_lit;
ut = build_tree(lit->atom, UNIFY, Parms[FPA_LITERALS].val,
lit->sign ? Fpa_neg_lits : Fpa_pos_lits);
f_atom = next_term(ut, 0);
// fprintf(stdout,"next_term returned: "); // DEBUG
// print_term_nl(stdout,f_atom); // DEBUG
go = 1;
cp_return = cp_prev = NULL;
while (go && f_atom) {
tr = NULL;
d = f_atom->occ.lit->container;
if(Flags[LAMBDA_FLAG].val) // Beeson 4.4.04
// Clear out what was in c2 from the previous f_atom
{ memset(c2->bound,0,MAX_VARS*sizeof(char)); // Beeson 4.4.04
clear_forbidden(c2); // Beeson 4.4.04
}
if(num_literals(d) == 1) // Beeson 6.13.03
{ c1->next_var = max_vars(c, f_atom); // Beeson 6.13.03
c2->next_var = c1->next_var; // Beeson 7.16.03
forbid_bound(c2,f_atom); // Beeson 7.16.03
}
if (num_literals(d) == 1 && unify(lit->atom, c1, f_atom, c2, &tr)) {
e = build_bin_res(lit->atom, c1, f_atom, c2);
if(Flags[LAMBDA_FLAG].val) // Beeson 8.7.03
renumber_vars(e); // Beeson 8.7.03
clear_subst_1(tr);
cl_merge(e); /* answer literals */
cp_curr = get_clause_ptr();
cp_curr->c = e;
if (cp_prev)
cp_prev->next = cp_curr;
else
cp_return = cp_curr;
cp_prev = cp_curr;
ec = ++Stats[EMPTY_CLAUSES];
mp = Parms[MAX_PROOFS].val;
if (mp != -1 && ec >= mp)
/* do not look for more proofs */
go = 0;
}
if (go)
{ f_atom = next_term(ut, 0);
// fprintf(stdout,"next_term returned: "); // DEBUG
// print_term_nl(stdout,f_atom); // DEBUG
}
else
zap_prop_tree(ut);
}
free_context(c1);
free_context(c2);
c->next_var = saveit; // Beeson 6.18.03
return(cp_return);
} /* unit_conflict */
/*************
*
* int propositional_clause(c)
*
* Is this a propositional clause?
*
*************/
int propositional_clause(struct clause *c)
{
struct literal *lit;
lit = c->first_lit;
while (lit)
if (lit->atom->type != NAME)
return(0);
else
lit = lit->next_lit;
return(1);
} /* propositional_clause */
/*************
*
* int xx_resolvable(c)
*
* Does the nonunit clause c have a literal that can resolve with x = x?
*
*************/
int xx_resolvable(struct clause *c)
{
if (unit_clause(c))
return(0);
else {
struct literal *lit;
lit = c->first_lit;
while (lit) {
if (!lit->sign && is_eq(lit->atom->sym_num)) {
struct term *a1 = lit->atom->farg->argval;
struct term *a2 = lit->atom->farg->narg->argval;
if (a1->type == VARIABLE && !occurs_in(a1, a2))
return(1);
else if (a2->type == VARIABLE && !occurs_in(a2, a1))
return(1);
}
lit = lit->next_lit;
}
return(0);
}
} /* xx_resolvable */
/*************
*
* int pos_clause(c)
*
* Is this a positive clause (excluding answer lits) ?
*
*************/
int pos_clause(struct clause *c)
{
struct literal *lit;
lit = c->first_lit;
while (lit)
if (!lit->sign && !answer_lit(lit))
return(0); /* fail because found negative non-anser literal */
else
lit = lit->next_lit;
return(1);
} /* pos_clause */
/*************
*
* int answer_lit(lit) -- Is this an answer literal?
*
*************/
int answer_lit(struct literal *lit)
{
return(lit->atom->varnum == ANSWER);
} /* answer_lit */
/*************
*
* int pos_eq_lit(lit) -- Is this a positive equality literal?
*
*************/
int pos_eq_lit(struct literal *lit)
{
return(lit->atom->varnum == POS_EQ);
} /* pos_eq_lit */
/*************
*
* int neg_eq_lit(lit) -- Is this a negative equality literal?
*
*************/
int neg_eq_lit(struct literal *lit)
{
return(lit->atom->varnum == NEG_EQ);
} /* neg_eq_lit */
/*************
*
* int eq_lit(lit) -- Is this an equality literal (pos or neg)?
*
*************/
int eq_lit(struct literal *lit)
{
return(pos_eq_lit(lit) || neg_eq_lit(lit));
} /* eq_lit */
/*************
*
* int neg_clause(c)
*
* Is this a negative clause (excluding answer lits) ?
*
*************/
int neg_clause(struct clause *c)
{
struct literal *lit;
lit = c->first_lit;
while (lit)
if (lit->sign && !answer_lit(lit))
return(0); /* fail because found positive non-answer literal */
else
lit = lit->next_lit;
return(1);
} /* neg_clause */
/*************
*
* int num_literals(c) -- How many literals (excluding answer literals)?
*
*************/
int num_literals(struct clause *c)
{
int i;
struct literal *lit;
i = 0;
lit = c->first_lit;
while (lit) {
if (!answer_lit(lit)) /* if not answer literal */
i++;
lit = lit->next_lit;
}
return(i);
} /* num_literals */
/*************
*
* int num_answers(c) -- How many answer literals?
*
*************/
int num_answers(struct clause *c)
{
int i;
struct literal *lit;
i = 0;
lit = c->first_lit;
while (lit) {
if (answer_lit(lit))
i++;
lit = lit->next_lit;
}
return(i);
} /* num_answers */
/*************
*
* int num_literals_including_answers(c) -- How many literals?
*
*************/
int num_literals_including_answers(struct clause *c)
{
int i;
struct literal *lit;
for (i = 0, lit = c->first_lit; lit; i++, lit = lit->next_lit);
return(i);
} /* num_literals_including_answers */
/*************
*
* int literal_number(lit)
*
* lit is which literal (excluding answers) in the clause that contains it.
*
*************/
int literal_number(struct literal *lit)
{
int i;
struct literal *l;
if(lit == NULL || lit->container == NULL) // Beeson 10.13.02
return TRUE_LIT; // Beeson 10.12.02
i = 1;
l = lit->container->first_lit;
while (l != lit) {
if (!answer_lit(l))
i++;
l = l->next_lit;
}
return(i);
} /* literal_number */
/*************
*
* int unit_clause(c) -- Is it a unit clause (don't count answers)?
*
*************/
int unit_clause(struct clause *c)
{
return(num_literals(c) == 1);
} /* unit_clause */
/*************
*
* int horn_clause(c)
*
* Is c a Horn clause (at most one positive literal)?
*
* Ignore answer literals.
*
*************/
int horn_clause(struct clause *c)
{
struct literal *lit;
int i;
for (lit = c->first_lit, i = 0; lit; lit = lit->next_lit)
if (lit->sign && !answer_lit(lit))
i++;
return(i <= 1);
} /* horn_clause */
/*************
*
* int equality_clause(c)
*
* Does c contain any equality literals (pos or neg)?
*
*************/
int equality_clause(struct clause *c)
{
struct literal *lit;
for (lit = c->first_lit; lit; lit = lit->next_lit)
if (pos_eq_lit(lit) || neg_eq_lit(lit))
return(1);
return(0);
} /* equality_clause */
/*************
*
* int symmetry_clause(c)
*
* Is c a clause for symmetry of equality?
*
*************/
int symmetry_clause(struct clause *c)
{
struct literal *l1, *l2;
if (num_literals(c) != 2)
return(0);
else {
l1 = c->first_lit; l2 = l1->next_lit;
if (l1->sign == l2->sign)
return(0);
else if (!eq_lit(l1) || l1->atom->sym_num != l2->atom->sym_num)
return(0);
else if (!l1->atom->farg->argval->type == VARIABLE)
return(0);
else if (!l2->atom->farg->argval->type == VARIABLE)
return(0);
else if (!term_ident(l1->atom->farg->argval,
l2->atom->farg->narg->argval))
return(0);
else if (!term_ident(l1->atom->farg->narg->argval,
l2->atom->farg->argval))
return(0);
else
return(1);
}
} /* symmetry_clause */
/*************
*
* struct literal *ith_literal(c, n)
*
* Return the i-th (non-answer) literal.
*
*************/
struct literal *ith_literal(struct clause *c,
int n)
{
int i;
struct literal *lit;
lit = c->first_lit;
i = 0;
while(lit) {
if (!answer_lit(lit))
i++;
if (i == n)
return(lit);
else
lit = lit->next_lit;
}
return(lit);
} /* ith_literal */
/*************
*
* append_cl(lst, cl)
*
*************/
void append_cl(struct list *l,
struct clause *c)
{
c->next_cl = NULL;
c->prev_cl = l->last_cl;
if (!l->first_cl)
l->first_cl = c;
else
l->last_cl->next_cl = c;
l->last_cl = c;
c->container = l;
#ifdef SCOTT
scott_insert(l,c);
#endif
if (l == Usable)
Stats[USABLE_SIZE]++;
else if (l == Sos)
Stats[SOS_SIZE]++;
else if (l == Demodulators)
Stats[DEMODULATORS_SIZE]++;
} /* append_cl */
/*************
*
* prepend_cl(lst, cl)
*
*************/
void prepend_cl(struct list *l,
struct clause *c)
{
c->prev_cl = NULL;
c->next_cl = l->first_cl;
if (!l->last_cl)
l->last_cl = c;
else
l->first_cl->prev_cl = c;
l->first_cl = c;
c->container = l;
#ifdef SCOTT
scott_insert(l,c);
#endif
if (l == Usable)
Stats[USABLE_SIZE]++;
else if (l == Sos)
Stats[SOS_SIZE]++;
else if (l == Demodulators)
Stats[DEMODULATORS_SIZE]++;
} /* prepend_cl */
/*************
*
* insert_before_cl(c, c_new)
*
*************/
void insert_before_cl(struct clause *c,
struct clause *c_new)
{
struct list *l;
l = c->container;
c_new->next_cl = c;
c_new->prev_cl = c->prev_cl;
c->prev_cl = c_new;
if (!c_new->prev_cl)
l->first_cl = c_new;
else
c_new->prev_cl->next_cl = c_new;
c_new->container = l;
#ifdef SCOTT
scott_insert(l,c_new);
#endif
if (l == Usable)
Stats[USABLE_SIZE]++;
else if (l == Sos)
Stats[SOS_SIZE]++;
else if (l == Demodulators)
Stats[DEMODULATORS_SIZE]++;
} /* insert_before_cl */
/*************
*
* insert_after_cl(c, c_new)
*
*************/
void insert_after_cl(struct clause *c,
struct clause *c_new)
{
struct list *l;
l = c->container;
c_new->prev_cl = c;
c_new->next_cl = c->next_cl;
c->next_cl = c_new;
if (!c_new->next_cl)
l->last_cl = c_new;
else
c_new->next_cl->prev_cl = c_new;
c_new->container = l;
#ifdef SCOTT
scott_insert(l,c_new);
#endif
if (l == Usable)
Stats[USABLE_SIZE]++;
else if (l == Sos)
Stats[SOS_SIZE]++;
else if (l == Demodulators)
Stats[DEMODULATORS_SIZE]++;
} /* insert_after_cl */
/*************
*
* rem_from_list(c)
*
*************/
void rem_from_list(struct clause *c)
{
struct clause *p, *n;
p = c->prev_cl;
n = c->next_cl;
if (!n)
c->container->last_cl = p;
else
n->prev_cl = p;
if (!p)
c->container->first_cl = n;
else
p->next_cl = n;
#ifdef SCOTT
scott_delete(c->container,c);
#endif
if (c->container == Usable)
Stats[USABLE_SIZE]--;
else if (c->container == Sos)
Stats[SOS_SIZE]--;
else if (c->container == Demodulators)
Stats[DEMODULATORS_SIZE]--;
c->container = NULL;
c->prev_cl = NULL;
c->next_cl = NULL;
} /* rem_from_list */
/*************
*
* insert_clause(clause, *clause_ptr)
*
* If not already there, insert clause into list of clause pointers.
*
*************/
void insert_clause(struct clause *c,
struct clause_ptr **cpp)
{
struct clause_ptr *curr, *prev, *new;
curr = *cpp;
prev = NULL;
while (curr && curr->c->id > c->id) {
prev = curr;
curr = curr->next;
}
if (!curr || curr->c->id != c->id) {
new = get_clause_ptr();
new->c = c;
new->next = curr;
if (prev)
prev->next = new;
else
*cpp = new;
}
} /* insert_clause */
/*************
*
* max_literal_weight()
*
*************/
int max_literal_weight(struct clause *c,
struct is_tree *wt_index)
{
struct literal *lit;
int wt, max;
max = -INT_MAX;
for (lit = c->first_lit; lit != NULL; lit = lit->next_lit) {
if (!answer_lit(lit)) {
wt = weight(lit->atom, wt_index);
max = (wt > max ? wt : max);
}
}
return(max);
} /* max_literal_weight */
/*************
*
* int weight_cl(c, wt_index) -- Weigh a clause.
*
* Also weigh answer lits, which have default weight 0.
*
*************/
int weight_cl(struct clause *c,
struct is_tree *wt_index)
{
if (Flags[LITERALS_WEIGH_ONE].val)
return num_literals(c);
else {
int w, neg_weight;
struct literal *lit;
neg_weight = Parms[NEG_WEIGHT].val;
w = 0;
lit = c->first_lit;
while (lit) {
w += weight(lit->atom, wt_index);
if (!answer_lit(lit) && !lit->sign)
w += neg_weight;
lit = lit->next_lit;
}
return(w);
}
} /* weight_cl */
/*************
*
* hide_clause(c) -- c must be integrated
*
* Clauses can be hidden instead of deallocated so that they can
* be printed later on (mostly so that a child can know its parent).
*
*************/
void hide_clause(struct clause *c)
{
c->next_cl = Hidden_clauses;
Hidden_clauses = c;
} /* hide_clause */
/*************
*
* del_hidden_clauses() -- deallocate all hidden clauses
*
*************/
void del_hidden_clauses(void)
{
struct clause *c;
while (Hidden_clauses) {
c = Hidden_clauses;
Hidden_clauses = Hidden_clauses->next_cl;
cl_del_int(c);
}
} /* del_hidden_clauses */
/*************
*
* struct clause *cl_copy(c)
*
* Do not copy the list of parents.
*
*************/
struct clause *cl_copy(struct clause *c)
{
struct clause *d;
struct literal *l, *l1, *l2;
d = get_clause();
d->type = c->type;
d->next_var = c->next_var; // Beeson 5.28.03
l = c->first_lit;
l2 = NULL;
while (l) {
l1 = get_literal();
l1->target = l->target;
l1->container = d;
l1->sign = l->sign;
l1->atom = copy_term(l->atom);
remove_var_syms(l1->atom); /* nullify variable symbols (if present) */
l1->atom->occ.lit = l1;
if (!l2)
d->first_lit = l1;
else
l2->next_lit = l1;
l2 = l1;
l = l->next_lit;
}
return(d);
} /* cl_copy */
/*************
*
* clause_ident(c1, c2)
*
* Don't check permutations.
*
*************/
int clause_ident(struct clause *c1,
struct clause *c2)
{
struct literal *l1, *l2;
int ok;
for (l1 = c1->first_lit, l2 = c2->first_lit, ok = 1;
l1 && l2 && ok;
l1 = l1->next_lit, l2 = l2->next_lit)
ok = (l1->sign == l2->sign && term_ident(l1->atom, l2->atom));
return(ok && l1 == NULL && l2 == NULL);
} /* cl_copy */
/*************
*
* remove_var_syms(t)
*
* Variable terms normally do not have sym_nums. This
* routine removes any that are present.
*
*************/
void remove_var_syms(struct term *t)
{
struct rel *r;
if (t->type == VARIABLE)
t->sym_num = 0;
else if (t->type == COMPLEX)
for (r = t->farg; r; r = r->narg)
remove_var_syms(r->argval);
} /* remove_var_syms */
/*************
*
* cl_insert_tab(c)
*
*************/
void cl_insert_tab(struct clause *c)
{
struct clause_ptr *cp1, *cp2, *cp3;
int hashval, id;
id = c->id;
hashval = id % CLAUSE_TAB_SIZE;
cp1 = Clause_tab[hashval];
cp2 = NULL;
/* keep the chains ordered--increasing id */
while (cp1 && cp1->c->id < id) {
cp2 = cp1;
cp1 = cp1->next;
}
if (cp1 && cp1->c->id == id) {
print_clause(stdout, c);
abend("cl_insert_tab, clause already there.");
}
else {
cp3 = get_clause_ptr();
cp3->c = c;
cp3->next = cp1;
if (!cp2)
Clause_tab[hashval] = cp3;
else
cp2->next = cp3;
}
} /* cl_insert_tab */
/*************
*
* cl_delete_tab(c)
*
*************/
void cl_delete_tab(struct clause *c)
{
struct clause_ptr *cp1, *cp2;
int hashval, id;
id = c->id;
hashval = id % CLAUSE_TAB_SIZE;
cp1 = Clause_tab[hashval];
cp2 = NULL;
/* chains are ordered--increasing id */
while (cp1 && cp1->c->id < id) {
cp2 = cp1;
cp1 = cp1->next;
}
if (!cp1 || cp1->c->id != id) {
print_clause(stdout, c);
abend("cl_delete_tab, clause not found.");
}
else {
if (!cp2)
Clause_tab[hashval] = cp1->next;
else
cp2->next = cp1->next;
free_clause_ptr(cp1);
}
} /* cl_delete_tab */
/*************
*
* struct clause *cl_find(id)
*
*************/
struct clause *cl_find(int id)
{
struct clause_ptr *cp1;
int hashval;
hashval = id % CLAUSE_TAB_SIZE;
cp1 = Clause_tab[hashval];
/* lists are ordered--increasing id */
while (cp1 && cp1->c->id < id)
cp1 = cp1->next;
if (!cp1 || cp1->c->id != id)
return(NULL);
else
return(cp1->c);
} /* cl_find */
/*************
*
* int lit_compare(l1, l2)
*
* 1. positive > negative
* 2. answer > nonanswer
* 3. lex
*
*************/
int lit_compare(struct literal *l1,
struct literal *l2)
{
if (l1->sign > l2->sign)
return(GREATER_THAN);
else if (l1->sign < l2->sign)
return(LESS_THAN);
else if (answer_lit(l1) && !answer_lit(l2))
return(GREATER_THAN);
else if (!answer_lit(l1) && answer_lit(l2))
return(LESS_THAN);
else {
if (Flags[PROPOSITIONAL].val) {
if (l1->atom->sym_num == l2->atom->sym_num)
return(SAME_AS);
else if (l1->atom->sym_num > l2->atom->sym_num)
return(GREATER_THAN);
else
return(LESS_THAN);
}
else
return(lex_order_vars(l1->atom, l2->atom));
}
} /* lit_compare */
/*************
*
* int ordered_sub_clause(c, d)
*
* True iff each literal of c occurs in d.
* Literals assumed to be ordered by lit_compare.
*
* This routine treats any answer literals as ordinary literals.
* Although this might be considered a bug, I decided to write it
* this way, because it is designed for propositional clauses
* which usually don't have answer literals, and checking for
* answer literals will slow it too much.
*
*************/
int ordered_sub_clause(struct clause *c1,
struct clause *c2)
{
struct literal *l1, *l2;
int i;
l1 = c1->first_lit;
l2 = c2->first_lit;
while (l1 && l2) {
i = lit_compare(l1, l2);
if (i == SAME_AS) {
l1 = l1->next_lit;
l2 = l2->next_lit;
}
else if (i == GREATER_THAN)
l2 = l2->next_lit;
else if (i == LESS_THAN)
l2 = NULL;
else
abend("ordered_sub_clause: not total.");
}
#if 0
printf("\n c1:%d ", l1 == NULL); p_clause(c1);
printf("\n c2: "); p_clause(c2);
#endif
return(l1 == NULL);
} /* ordered_sub_clause */
/*************
*
* int sub_clause(c, d)
*
* True iff each literal of c occurs in d.
* Literals are not assumed to be ordered.
*
* This routine treats any answer literals as ordinary literals.
* Although this might be considered a bug, I decided to write it
* this way, because it is designed for propositional clauses
* which usually don't have answer literals, and checking for
* answer literals will slow it too much.
*
*************/
int sub_clause(struct clause *c1,
struct clause *c2)
{
struct literal *l1, *l2;
int found;
for(l1 = c1->first_lit; l1; l1 = l1->next_lit) {
l2 = c2->first_lit;
found = 0;
while (l2 && !found) {
if (l1->sign == l2->sign && l1->atom->sym_num == l2->atom->sym_num)
found = 1;
else
l2 = l2->next_lit;
}
if (!found)
return(0);
}
return(1);
} /* sub_clause */
/*************
*
* sort_lits(c) -- sort literals
*
*************/
int sort_lits(struct clause *c)
{
struct literal *sorted, *prev, *curr, *next, *insert;
int changed = 0;
/* This is an insertion sort. Use lit_compare */
if (c->first_lit) {
sorted = c->first_lit;
insert = sorted->next_lit;
sorted->next_lit = NULL;
while(insert) {
prev = NULL;
curr = sorted;
while (curr && lit_compare(insert, curr) == GREATER_THAN) {
prev = curr;
curr = curr->next_lit;
}
if (curr != NULL)
changed = 1;
next = insert->next_lit;
insert->next_lit = curr;
if (prev)
prev->next_lit = insert;
else
sorted = insert;
insert = next;
}
c->first_lit = sorted;
}
return changed;
} /* sort lits */
/*************
*
* all_cont_cl(t, cpp) - insert containing clauses of t into *cpp
*
*************/
void all_cont_cl(struct term *t,
struct clause_ptr **cpp)
{
struct rel *r;
struct clause *c;
struct list *l;
if (t->type != VARIABLE && t->varnum != 0) { /* atom */
c = t->occ.lit->container;
l = c->container;
if (l == Usable || l == Sos || l == Demodulators)
insert_clause(c, cpp);
}
else { /* term */
r = t->occ.rel;
while (r) {
all_cont_cl(r->argof, cpp);
r = r->nocc;
}
}
} /* all_cont_cl */
/*************
*
* zap_cl_list(lst)
*
*************/
void zap_cl_list(struct list *lst)
{
struct clause *c1, *c2;
c1 = lst->first_cl;
while (c1) {
c2 = c1;
c1 = c1->next_cl;
cl_del_non(c2);
}
free_list(lst);
} /* zap_cl_list */
/*************
*
* is_eq()
*
*************/
int is_eq(int sym_num)
{
char *name;
name = sn_to_str(sym_num);
if (Flags[TPTP_EQ].val)
return(sn_to_arity(sym_num) == 2 && str_ident("equal", name));
else
return(sn_to_arity(sym_num) == 2 &&
(initial_str("EQ", name) ||
initial_str("Eq", name) ||
initial_str("eq", name) ||
str_ident("=", name)));
} /* is_eq */
/*************
*
* mark_literal(lit)
*
* Atoms have varnum > 0. This routine inserts the appropriate code.
*
*************/
void mark_literal(struct literal *lit)
{
char *name;
struct term *a;
a = lit->atom;
name = sn_to_str(a->sym_num);
if (initial_str("$ANS", name) || initial_str("$Ans", name) ||
initial_str("$ans", name))
a->varnum = ANSWER; /* answer literal */
else if (is_eq(a->sym_num)) {
if (lit->sign)
a->varnum = POS_EQ; /* positive equality */
else
a->varnum = NEG_EQ; /* negative equality */
}
else if (sn_to_ec(a->sym_num) > 0)
a->varnum = EVALUABLE; /* $ID, $LE, $AND, ... */
else if (is_symbol(a, "->", 2) && is_eq(a->farg->narg->argval->sym_num))
a->varnum = CONDITIONAL_DEMOD;
else
a->varnum = NORM_ATOM; /* normal atom */
} /* mark_literal */
/*************
*
* int get_ancestors(c, cpp, ipp)
*
* cpp is the list under construction, sorted by ID.
* ipp is a corresponding list of the level of each clause.
*
* Return the level of the proof.
*
* The justification list of a clause (c->parents) is a list
* of integers. Usually, negative integers represent inference
* rules, and positive integers are the IDs of parent clauses.
* Exception: LIST_RULE is a large negative integer. If a member
* is <= LIST_RULE, then a list of length (LIST_RULE-member) follows
* (and typically represents a position in a clause).
*
*************/
int get_ancestors(struct clause *c,
struct clause_ptr **cpp,
struct int_ptr **ipp)
{
struct clause_ptr *cp1, *cp2, *cp3;
struct int_ptr *ip1, *ip2, *ip3;
struct int_ptr *ip;
struct clause *d;
int max, lev, n;
cp1 = *cpp; ip1 = *ipp;
cp3 = NULL; ip3 = NULL;
/* First check to see if the clause has already been processed. */
while (cp1 && cp1->c->id < c->id) {
cp3 = cp1; cp1 = cp1->next;
ip3 = ip1; ip1 = ip1->next;
}
if (!cp1 || cp1->c->id > c->id) {
/* Process the clause. */
cp2 = get_clause_ptr();
ip2 = get_int_ptr();
cp2->c = c;
if (!cp3) {
cp2->next = *cpp; *cpp = cp2;
ip2->next = *ipp; *ipp = ip2;
}
else {
cp2->next = cp3->next; cp3->next = cp2;
ip2->next = ip3->next; ip3->next = ip2;
}
max = -1;
for (ip = c->parents; ip; ip = ip->next) {
if (ip->i <= LIST_RULE) {
/* LIST_RULE is a large negative number. */
/* If ip->i is less than LIST_RULE, then a list follows. */
int i;
int j = LIST_RULE - ip->i; /* size of list */
/* Make ip point at the last element of the list. */
for (i = 1; i <= j; i++)
ip = ip->next;
}
else if (ip->i >= 0) {
/* < 0 means it's a code for an inference rule */
d = cl_find(ip->i);
if (!d)
printf("WARNING, clause %d not found, proof is incomplete.\n", ip->i);
else {
n = get_ancestors(d, cpp, ipp);
max = (n > max ? n : max);
}
}
}
if (!c->parents)
lev = 0;
else if (c->parents->i == NEW_DEMOD_RULE)
lev = max;
else
lev = max + 1;
ip2->i = lev;
#if 0
printf("level %d: ", lev); p_clause(c);
#endif
return(lev);
}
else {
/* The clause has already been processed, so just return its level. */
return(ip1->i);
}
} /* get_ancestors */
/*************
*
* int renumber_vars_term(c)
*
* Renumber the variables of a term, starting with 0. `c' must
* be nonintegrated. return(0) if more than MAXVARS distinct variables.
*
* This is very special-purpose. Ordinarily, you'll call renumber_vars(c)
* on clauses.
*
*************/
int renumber_vars_term(struct term *t)
{
int varnums[MAX_VARS];
int i;
for (i = 0; i < MAX_VARS; i++)
varnums[i] = -1;
return renum_vars_term(t, varnums);
} /* renumber_vars_term */
/*************
*
* int renumber_vars(c)
*
* Renumber the variables of a clause, starting with 0. `c' must
* be nonintegrated. return(0) if more than MAXVARS distinct variables.
*
*************/
int renumber_vars(struct clause *c)
{
struct literal *lit;
int varnums[MAX_VARS];
int i, ok;
ok = 1;
for (i = 0; i < MAX_VARS; i++)
varnums[i] = -1;
lit = c->first_lit;
while (lit) {
if (renum_vars_term(lit->atom, varnums) == 0)
ok = 0;
lit = lit->next_lit;
}
c->next_var = 0; // Beeson 5.28.03
for(i=0; i< MAX_VARS;i++){ // Beeson 8.16.02
if(varnums[i] == -1) // Beeson 8.16.02
{ c->next_var = i; // Beeson 8.16.02
break; // Beeson 8.16.02
} // Beeson 8.16.02
}
return(ok);
} /* renumber_vars */
/*************
*
* int renum_vars_term(term, varnums) -- called from renumber_vars.
*
*************/
int renum_vars_term(struct term *t,
int *varnums)
{
struct rel *r;
int i, ok;
if (t->type == NAME)
return(1);
else if (t->type == COMPLEX) {
ok = 1;
r = t->farg;
while (r) {
if (renum_vars_term(r->argval, varnums) == 0)
ok = 0;
r = r->narg;
}
return(ok);
}
else {
i = 0;
while (i < MAX_VARS && varnums[i] != -1 && varnums[i] != t->varnum)
i++;
if (i == MAX_VARS)
return(0);
else {
if (varnums[i] == -1) {
varnums[i] = t->varnum;
t->varnum = i;
}
else
t->varnum = i;
return(1);
}
}
} /* renum_vars_term */
/*************
*
* clear_var_names(t) -- set sym_num field of all variables to NULL
*
*************/
void clear_var_names(struct term *t)
{
struct rel *r;
if (t->type == VARIABLE)
t->sym_num = 0;
else {
for (r = t->farg; r; r = r->narg)
clear_var_names(r->argval);
}
} /* clear_var_names */
/*************
*
* cl_clear_vars(c)
*
*************/
void cl_clear_vars(struct clause *c)
{
struct literal *lit;
for (lit = c->first_lit; lit; lit = lit->next_lit)
clear_var_names(lit->atom);
}
/*************
*
* void distinct_vars_rec(t, a, max) -- called by distinct_vars
*
*************/
static void distinct_vars_rec(struct term *t,
int *a,
int *max)
{
struct rel *r;
int i, vn;
if (t->type == VARIABLE) {
vn = t->varnum;
for (i = 0; i < MAX_VARS && a[i] != -1 && a[i] != vn; i++);
if (i != MAX_VARS && a[i] == -1) {
a[i] = vn;
*max = i+1;
}
}
else if (t->type == COMPLEX) {
for (r = t->farg; r && *max < MAX_VARS; r = r->narg)
distinct_vars_rec(r->argval, a, max);
}
} /* distinct_vars_rec */
/*************
*
* int distinct_vars(c) -- number of variables in a clause.
*
* if >= MAX_VARS, return MAX_VARS.
*
*************/
int distinct_vars(struct clause *c)
{
struct literal *lit;
int a[MAX_VARS], i, max;
for (i = 0; i < MAX_VARS; i++)
a[i] = -1;
for (lit = c->first_lit, max = 0; lit; lit = lit->next_lit)
distinct_vars_rec(lit->atom, a, &max);
return(max);
} /* distinct_vars */
/*************
*
* struct clause *find_first_cl(l)
*
*************/
struct clause *find_first_cl(struct list *l)
{
struct clause *c;
if (!l->first_cl)
return(NULL);
else {
c = l->first_cl;
return(c);
}
} /* find_first_cl */
/*************
*
* struct clause *find_last_cl(l)
*
*************/
struct clause *find_last_cl(struct list *l)
{
struct clause *c;
if (!l->last_cl)
return(NULL);
else {
c = l->last_cl;
return(c);
}
} /* find_last_cl */
/*************
*
* struct clause *find_random_cl(l)
*
*************/
struct clause *find_random_cl(struct list *l)
{
struct clause *c;
int i, j;
if (l->first_cl == NULL)
return(NULL);
else {
j = (rand() % Stats[SOS_SIZE]) + 1;
c = l->first_cl;
i = 1;
while (i < j && c != NULL) {
c = c->next_cl;
i++;
}
if (c == NULL)
abend("find_random_cl, sos bad.");
return(c);
}
} /* find_random_cl */
/*************
*
* get_clauses_of_wt_range()
*
*************/
struct clause_ptr *get_clauses_of_wt_range(struct clause *c,
int min, int max)
{
if (c == NULL)
return NULL;
else if (c->pick_weight >= min && c->pick_weight <= max) {
struct clause_ptr *p = get_clause_ptr();
p->c = c;
p->next = get_clauses_of_wt_range(c->next_cl, min, max);
return p;
}
else
return get_clauses_of_wt_range(c->next_cl, min, max);
} /* get_clauses_of_wt_range */
/*************
*
* clause_ptr_list_size()
*
*************/
int clause_ptr_list_size(struct clause_ptr *p)
{
if (p == NULL)
return 0;
else
return (1 + clause_ptr_list_size(p->next));
} /* clause_ptr_list_size */
/*************
*
* nth_clause() -- this counts from 1.
*
*************/
struct clause *nth_clause(struct clause_ptr *p, int n)
{
if (p == NULL)
return NULL;
else if (n == 1)
return p->c;
else
return nth_clause(p->next, n-1);
} /* nth_clause */
/*************
*
* zap_clause_ptr_list(p)
*
* Free the nodes, but not the clauses they point to.
*
*************/
void zap_clause_ptr_list(struct clause_ptr *p)
{
if (p != NULL) {
zap_clause_ptr_list(p->next);
free_clause_ptr(p);
}
} /* zap_clause_ptr_list */
/*************
*
* struct clause *find_random_lightest_cl(l)
*
*************/
struct clause *find_random_lightest_cl(struct list *l)
{
struct clause *c = find_lightest_cl(l);
if (c == NULL)
return NULL;
else {
int wt = c->pick_weight;
struct clause_ptr *p = get_clauses_of_wt_range(l->first_cl, wt, wt);
int n = clause_ptr_list_size(p);
int j = (rand() % n) + 1;
c = nth_clause(p, j);
zap_clause_ptr_list(p);
return c;
}
} /* find_random_lightest_cl */
/*************
*
* struct clause *find_mid_lightest_cl(l)
*
*************/
struct clause *find_mid_lightest_cl(struct list *l)
{
struct clause *c = find_lightest_cl(l);
if (c == NULL)
return NULL;
else {
int wt = c->pick_weight;
struct clause_ptr *p = get_clauses_of_wt_range(l->first_cl, wt, wt);
int n = clause_ptr_list_size(p);
int j = (n / 2) + 1;
c = nth_clause(p, j);
zap_clause_ptr_list(p);
return c;
}
} /* find_mid_lightest_cl */
/*************
*
* struct clause *find_lightest_cl(l)
*
* If more than one of mimimum weight, return first or last of those,
* according to the flag PICK_LAST_LIGHTEST.
*
* Input sos clauses might have weight field set to -MAX_INT so that
* they are returned first (in order).
*
*************/
struct clause *find_lightest_cl(struct list *l)
{
if (l->first_cl == NULL)
return NULL;
else {
struct clause *cm = l->first_cl;
int wm = cm->pick_weight;
struct clause *c = cm->next_cl;
while (c) {
int w = c->pick_weight;
if (Flags[PICK_LAST_LIGHTEST].val ? (w <= wm) : (w < wm)) {
wm = w;
cm = c;
}
c = c->next_cl;
}
return cm;
}
} /* find_lightest_cl */
/*************
*
* struct clause *find_lightest_geo_child(l)
*
* Find the lightest clause c for which child_of_geometry(c) holds.
* If there are no children of geometry, return NULL.
* If more than one of mimimum weight, return first of those.
*
*************/
struct clause *find_lightest_geo_child(struct list *l)
{
struct clause *c, *cmin;
int w, wmin;
for (c = l->first_cl, cmin = NULL, wmin = MAX_INT; c; c = c->next_cl) {
if (child_of_geometry(c)) {
w = c->pick_weight;
if (!cmin || w < wmin) {
wmin = w;
cmin = c;
}
}
}
return(cmin);
} /* find_lightest_geo_child */
/*************
*
* struct clause *find_interactive_cl()
*
*************/
struct clause *find_interactive_cl(void)
{
FILE *fin, *fout;
fin = fopen("/dev/tty", "r");
fout = fopen("/dev/tty", "w");
if (!fin || !fout) {
printf("interaction failure: cannot find tty.\n");
fprintf(stderr, "interaction failure: cannot find tty.\n");
return(NULL);
}
else {
int id;
struct clause *c = NULL;
int done = 0;
char s[256];
while (!done) {
fprintf(fout,"\nEnter clause number of next given clause, or 0 to terminate\ninteractive_given mode, or -1 to print list sos.\n? ");
fscanf(fin, "%s", s);
if (!str_int(s, &id)) {
fprintf(fout, "%c\nNot an integer: \"%s\", try again.\n", Bell, s);
}
else if (id == 0) {
printf("\nTurning off interactive_given mode.\n");
fprintf(fout, "\nTurning off interactive_given mode.\n");
Flags[INTERACTIVE_GIVEN].val = 0;
c = NULL;
done = 1;
}
else if (id == -1) {
struct clause *c;
for (c = Sos->first_cl; c; c = c->next_cl)
print_clause(fout, c);
}
else {
c = cl_find(id);
if (!c)
fprintf(fout, "%c\nClause %d not found.\n", Bell, id);
else if (c->container != Sos)
fprintf(fout, "%c\nClause %d not in sos.\n", Bell, id);
else {
done = 1;
fprintf(fout, "\nOk, clause %d will be given.\n", id);
}
}
}
fclose(fin);
fclose(fout);
return(c);
}
} /* find_interactive_cl */
/*************
*
* struct clause *find_given_clause()
*
*************/
struct clause *find_given_clause(void)
{
struct clause *giv_cl;
if (Flags[INTERACTIVE_GIVEN].val) {
giv_cl = find_interactive_cl();
if (giv_cl)
return(giv_cl);
}
#ifdef SCOTT
if (get_semantic_guidance_flag())
giv_cl = semantic_selection(Sos);
else if (First->first_cl)
return First->first_cl;
else
#endif
if (Flags[SOS_QUEUE].val)
giv_cl = find_first_cl(Sos);
else if (Flags[SOS_STACK].val)
giv_cl = find_last_cl(Sos);
else if (Parms[PICK_GIVEN_RATIO].val != -1 &&
Stats[CL_GIVEN] % (Parms[PICK_GIVEN_RATIO].val + 1) == 0)
giv_cl = find_first_cl(Sos);
else if (Parms[PICK_DIFF].val != -1)
giv_cl = find_pickdiff_cl(Sos, Usable);
else if (Flags[PICK_RANDOM_LIGHTEST].val)
giv_cl = find_random_lightest_cl(Sos);
else if (Flags[PICK_MID_LIGHTEST].val)
giv_cl = find_mid_lightest_cl(Sos);
else if (Parms[GEO_GIVEN_RATIO].val != -1) {
if (Stats[CL_GIVEN] % (Parms[GEO_GIVEN_RATIO].val + 1) == 0) {
giv_cl = find_lightest_geo_child(Sos);
if (!giv_cl)
giv_cl = find_lightest_cl(Sos);
}
else
giv_cl = find_lightest_cl(Sos);
}
else /* this is the default */
giv_cl = find_lightest_cl(Sos);
return(giv_cl);
} /* find_given_clause */
/*************
*
* struct clause *extract_given_clause()
*
*************/
struct clause *extract_given_clause(void)
{
struct clause *giv_cl;
CLOCK_START(PICK_GIVEN_TIME);
giv_cl = find_given_clause();
if (giv_cl) {
rem_from_list(giv_cl);
}
CLOCK_STOP(PICK_GIVEN_TIME);
return(giv_cl);
} /* extract_given_clause */
/*************
*
* int unit_del(c) -- unit deletion
*
* Delete any literals that are subsumed by a unit with opposite sign.
*
* Answer literals on the units complicate things. In particular,
* if they contain variables not in the regular literal.
*
* This assumes that FOR_SUB_FPA is clear, because the discrimination
* index is used.
*
* Return 1 if any deletions occur.
*
*************/
int unit_del(struct clause *c)
{
struct clause *d;
struct literal *prev, *curr, *next, *answers, *l1, *l2;
struct term *d_atom;
struct context *s;
struct is_tree *is_db;
struct fsub_pos *pos;
struct int_ptr *ip0, *ip, *lp;
int deleted, return_val;
return_val = 0;
if(Flags[LAMBDA_FLAG].val)
s = get_context2(c,1); // Beeson
else
{ s = get_context();
s->multiplier = 1;
}
/* first get last parent */
lp = c->parents;
if (lp)
while (lp->next)
lp = lp->next;
ip0 = lp; /* save position to insert "ud" if any deleted */
answers = NULL;
prev = NULL;
next = c->first_lit;
while (next) {
curr = next;
next = next->next_lit;
is_db = curr->sign ? Is_neg_lits : Is_pos_lits;
d_atom = fs_retrieve(curr->atom, s, is_db, &pos);
deleted = 0;
while (d_atom && !deleted) {
d = d_atom->occ.lit->container;
if (d->container != Passive && num_literals(d) == 1) {
return_val = 1;
if (prev)
prev->next_lit = next;
else
c->first_lit = next;
ip = get_int_ptr(); /* append to history */
ip->i = d->id;
if (!lp)
c->parents = ip;
else
lp->next = ip;
lp = ip;
l2 = d->first_lit; /* now append any answer literals */
while (l2) {
if (answer_lit(l2)) {
l1 = get_literal();
l1->container = c;
l1->sign = l2->sign;
l1->atom = apply(l2->atom, s);
s->multiplier++; /* in case answer has lone vars */
l1->atom->varnum = ANSWER;
l1->atom->occ.lit = l1;
l1->next_lit = answers;
answers = l1;
}
l2 = l2->next_lit;
}
curr->atom->occ.lit = NULL; /* so zap_term won't complain */
zap_term(curr->atom);
free_literal(curr);
canc_fs_pos(pos, s);
Stats[UNIT_DELETES]++;
deleted = 1;
}
else
d_atom = fs_retrieve((struct term *) NULL, s, is_db, &pos);
}
if (!deleted)
prev = curr;
}
if (!prev)
c->first_lit = answers;
else
prev->next_lit = answers;
if (lp != ip0) { /* at least one deletion occurred */
if (s->multiplier != 1) {
/* Answer lits added; renumber in case new vars introduced. */
if (renumber_vars(c) == 0) {
print_clause(stdout, c);
abend("unit_del, too many variables introduced.");
}
}
ip = get_int_ptr();
ip->i = UNIT_DEL_RULE;
if (!ip0) {
ip->next = c->parents;
c->parents = ip;
}
else {
ip->next = ip0->next;
ip0->next = ip;
}
}
free_context(s);
return(return_val);
} /* unit_del */
/*************
*
* back_unit_deletion()
*
*************/
void back_unit_deletion(struct clause *c,
int input)
{
struct clause *d, *resolvent;
struct literal *c_lit;
struct term *c_atom, *d_atom;
struct context *c_subst, *d_subst;
struct fpa_tree *ut;
struct trail *tr;
struct list *source_list;
c_lit = ith_literal(c,1);
c_atom = c_lit->atom;
ut = build_tree(c_lit->atom, INSTANCE, Parms[FPA_LITERALS].val,
c_lit->sign ? Fpa_neg_lits : Fpa_pos_lits);
d_atom = next_term(ut, 0);
if(Flags[LAMBDA_FLAG].val) // Beeson 6.26.03
{ c_subst = get_context2(c,0); // Beeson 6.26.03
d_subst = get_context2(c,1); // Beeson 6.26.03
} // Beeson 6.26.03
else // Beeson 6.26.03
{ c_subst = get_context();
d_subst = get_context(); /* This will stay empty */
}
while (d_atom) {
d = d_atom->occ.lit->container;
source_list = d->container;
tr = NULL;
if (source_list == Usable || source_list == Sos) {
if (otter_match(c_atom, c_subst, d_atom, &tr)) {
resolvent = build_bin_res(c_atom, c_subst, d_atom, d_subst);
resolvent->parents->i = BACK_UNIT_DEL_RULE;
clear_subst_1(tr);
Stats[CL_GENERATED]++;
Stats[BACK_UNIT_DEL_GEN]++;
#if 1
if (source_list == Usable) {
SET_BIT(resolvent->bits, SCRATCH_BIT);
/* printf("Clause destined for Usable:\n"); */
p_clause(resolvent);
}
#endif
CLOCK_STOP(BACK_UNIT_DEL_TIME);
pre_process(resolvent, input, Sos);
CLOCK_START(BACK_UNIT_DEL_TIME);
}
}
d_atom = next_term(ut, 0);
}
free_context(c_subst);
free_context(d_subst);
} /* back_unit_deletion */
./otter/clocks.c 0000744 0002044 0001012 00000007616 11120534442 012101 0 ustar beeson /*
* clocks.c -- This file has various timing routines. (Some of them
* have been moved to macros.h.)
*
*/
#include "header.h"
/*************
*
* clock_init() - Initialize all clocks.
*
*************/
void clock_init(void)
{
int i;
#ifdef THINK_C /* kludge for mac: see run_time */
long l;
l = run_time();
#endif
for (i=0; i<MAX_CLOCKS; i++)
clock_reset(i);
} /* clock_init */
/*
*
* CPU_TIME(sec, usec) - It has been sec seconds + usec microseconds
* since the start of this process.
*
*/
/* This routine has been made into a macro. */
/*
*
* CLOCK_START(clock_num) - Start or continue timing.
*
* If the clock is already running, a warning message is printed.
*
*/
/* This routine has been made into a macro. */
/*
*
* CLOCK_STOP(clock_num) - Stop timing and add to accumulated total.
*
* If the clock not running, a warning message is printed.
*
*/
/* This routine has been made into a macro. */
/*************
*
* long clock_val(clock_num) - Returns accumulated time in milliseconds.
*
* Clock need not be stopped.
*
*************/
long clock_val(int c)
{
long sec, usec, i, j;
i = (Clocks[c].accum_sec * 1000) + (Clocks[c].accum_usec / 1000);
if (Clocks[c].curr_sec == -1)
return(i);
else {
CPU_TIME(sec, usec)
j = ((sec - Clocks[c].curr_sec) * 1000) +
((usec - Clocks[c].curr_usec) / 1000);
return(i+j);
}
} /* clock_val */
/*************
*
* clock_reset(clock_num) - Clocks must be reset before being used.
*
*************/
void clock_reset(int c)
{
Clocks[c].accum_sec = Clocks[c].accum_usec = 0;
Clocks[c].curr_sec = Clocks[c].curr_usec = -1;
} /* clock_reset */
/*************
*
* char *get_time() - get a string representation of current date and time
*
*************/
char *get_time(void)
{
#ifdef TP_ABSOLUTELY_NO_CLOCKS
return("(date unknown).\n");
#else
time_t i;
i = time((time_t *) NULL);
return(asctime(localtime(&i)));
#endif
} /* get_time */
/*************
*
* long system_time() - Return system time in milliseconds.
*
*************/
long system_time(void)
{
#ifdef TP_ABSOLUTELY_NO_CLOCKS
return(0);
#else
#ifdef TP_RUSAGE
struct rusage r;
long sec, usec;
getrusage(RUSAGE_SELF, &r);
sec = r.ru_stime.tv_sec;
usec = r.ru_stime.tv_usec;
return((sec * 1000) + (usec / 1000));
#else
return(0);
#endif
#endif
} /* system_time */
/*************
*
* long run_time() - Return run time in milliseconds.
*
* This is used instead of the normal clock routines in case
* progam is complied with TP_NO_CLOCKS.
*
*************/
long run_time(void)
{
#ifdef TP_ABSOLUTELY_NO_CLOCKS
return((long) 0);
#else
#ifdef THINK_C /* Macintosh */
long ticks;
long sec;
/* following kludge is because mac gives ticks since
* power up, instead of ticks since start of process. */
static int first_call = 1;
static long start;
if (first_call) {
first_call = 0;
start = clock();
}
ticks = clock();
sec = ((double) (ticks - start) / CLOCKS_PER_SEC) * 1000;
return(sec);
#else
#ifdef TP_RUSAGE
struct rusage r;
long sec, usec;
getrusage(RUSAGE_SELF, &r);
sec = r.ru_utime.tv_sec;
usec = r.ru_utime.tv_usec;
return((sec * 1000) + (usec / 1000));
#else
long ticks;
long sec;
ticks = clock();
sec = (long) ((double) ticks / CLOCKS_PER_SEC) * 1000; // (long) added by Beeson, 7.23.02
return(sec);
#endif
#endif
#endif
} /* run_time */
/*************
*
* wall_seconds()
*
*************/
long wall_seconds(void)
{
#ifdef TP_ABSOLUTELY_NO_CLOCKS
return((long) 0);
#else
/* This is ANSI, and it seems to work for many OS. */
time_t i;
i = time((time_t *) NULL);
return((long) i);
#endif
} /* wall_seconds */
./otter/contexts 0000744 0002044 0001012 00000000000 11026756616 012243 0 ustar beeson ./otter/cos.h 0000744 0002044 0001012 00000042513 11120534442 011407 0 ustar beeson /*
* cos.h -- preprocessor definitions of indices for arrays of
* flags, parameters, statistics, clocks, and internal flags.
*
*/
/*************
*
* Flags are boolean valued options. To install a new flag, append
* a new name and index to the end of this list, then insert code to
* initialize it in the routine `init_options'.
* Example access: if (Flags[PARA_FROM_LEFT].val) {
* See routine `init_options' for defaults.
*
*************/
#define MAX_FLAGS 150 /* increase if necessary */
#define SOS_QUEUE 1 /* first clause on sos is given clause */
#define SOS_STACK 2 /* pick last sos clause as given clause */
#define INPUT_SOS_FIRST 3 /* use input sos before generated sos */
#define INTERACTIVE_GIVEN 4 /* user selects given cls interactively */
#define PRINT_GIVEN 5 /* print given clauses */
#define PRINT_LISTS_AT_END 6 /* print clause lists at end of run */
#define BINARY_RES 7 /* binary resolution */
#define HYPER_RES 8 /* hyperresolution */
#define NEG_HYPER_RES 9 /* negatve hyperresolution inf rule */
#define UR_RES 10 /* UR-resolution */
#define PARA_INTO 11 /* `into' paramodulation inference rule */
#define PARA_FROM 12 /* `from' paramodulation inference rule */
#define DEMOD_INF 13 /* apply demodulation as an inference rule */
#define PARA_FROM_LEFT 14 /* allow paramodulation from left sides */
#define PARA_FROM_RIGHT 15 /* allow paramodulation from right sides */
#define PARA_INTO_LEFT 16 /* allow paramodulation into left args of = */
#define PARA_INTO_RIGHT 17 /* allow paramodulation into right args of = */
#define PARA_FROM_VARS 18 /* allow paramodulation from variables */
#define PARA_INTO_VARS 19 /* allow paramodulation into variables */
#define PARA_FROM_UNITS_ONLY 20 /* from clause must be unit */
#define PARA_INTO_UNITS_ONLY 21 /* into clause must be unit */
#define PARA_SKIP_SKOLEM 22 /* Skolem function restriction strategy */
#define PARA_ONES_RULE 23 /* paramod only into first args of terms */
#define PARA_ALL 24 /* paramodulate all occurrences of into term */
#define DETAILED_HISTORY 25 /* store literal numbers and position vectors */
#define ORDER_HISTORY 26 /* Nucleus number first for hyper, UR. */
#define UNIT_DELETION 28 /* unit deletion processing */
#define DELETE_IDENTICAL_NESTED_SKOLEM 29 /* delete clauses containing */
#define SORT_LITERALS 30 /* sort literals in pre_process */
#define FOR_SUB 31 /* forward subsumption */
#define BACK_SUB 35 /* back subsumption */
#define FACTOR 38 /* factor during post_process */
#define DEMOD_HISTORY 39 /* build history in demodulation */
#define ORDER_EQ 40 /* flip equalities (+ and -) if right arg heavier */
#define EQ_UNITS_BOTH_WAYS 41 /* nonoriented eq units both ways */
#define DEMOD_LINEAR 42 /* use linear search instead of index tree */
#define DEMOD_OUT_IN 43 /* demodulate outside-in, (leftmost) */
#define DYNAMIC_DEMOD 44 /* dynamic addition of demodulators */
#define DYNAMIC_DEMOD_ALL 45 /* try to make all equalities into demodulators */
#define DYNAMIC_DEMOD_LEX_DEP 46 /* allow lex-dep dynamic demodulators */
#define BACK_DEMOD 47 /* back demodulation */
#define KNUTH_BENDIX 48 /* Attempt Knuth-Bendix completion */
#define LRPO 49 /* lexicographic recursive path ordering */
#define LEX_ORDER_VARS 50 /* consider variables when lex_checking terms */
#define SYMBOL_ELIM 51 /* orient equalities to eliminate symbols */
#define CHECK_ARITY 55 /* require symbols to have fixed arities */
#define PROLOG_STYLE_VARIABLES 57 /* vars start with A-Z */
#define ECHO_INCLUDED_FILES 60 /* Echo input from included files */
#define SIMPLIFY_FOL 59 /* attempt to simplify during cnf translation */
#define PROCESS_INPUT 58 /* process input usable and sos */
#define VERY_VERBOSE 27 /* print generated clauses */
#define PRINT_KEPT 32 /* print kept clauses */
#define PRINT_PROOFS 33 /* print all proofs found */
#define PRINT_NEW_DEMOD 34 /* print new demodultors */
#define PRINT_BACK_DEMOD 37 /* print back demodulated clauses */
#define PRINT_BACK_SUB 36 /* print back subsumed clauses */
#define DISPLAY_TERMS 56 /* print terms in internal format */
#define PRETTY_PRINT 61 /* Pretty print requested by Boyle */
#define INDEX_FOR_BACK_DEMOD 79 /* index (FPA) all terms for back demod */
#define FOR_SUB_FPA 52 /* forward subsump with FPA, not index tree */
#define NO_FAPL 53 /* don't FPA index all positive literals */
#define NO_FANL 54 /* don't FPA index all negative literals */
#define CONTROL_MEMORY 62 /* automatically adjust max_weight */
#define ORDER_HYPER 63 /* ordered hyperresolution (satellites) */
#define PROPOSITIONAL 64 /* some propositional optimizations */
#define REALLY_DELETE_CLAUSES 65 /* delete back demod and back_subed cls */
#define ATOM_WT_MAX_ARGS 66 /* weight of atom is max of weights of arguments */
#define TERM_WT_MAX_ARGS 67 /* weight of term is max of weights of arguments */
#define FREE_ALL_MEM 68 /* free all memory to avail lists at end of run */
/* Fringe */
#define AUTO 69 /* select the current AUTO mode (see AUTO*) */
#define ANCESTOR_SUBSUME 70 /* ancestor subsumption */
#define INPUT_SEQUENT 71 /* input clauses in sequent notation */
#define OUTPUT_SEQUENT 72 /* output clauses in sequent notation */
#define GEOMETRIC_RULE 73 /* RP's inference rule, with unification */
#define LINKED_UR_RES 75 /* linked UR resolution inference rule */
#define LINKED_UR_TRACE 76 /* trace linked UR res inference rule */
#define LINKED_SUB_UNIT_USABLE 77 /* use Usable list to subsume subsumable */
/* intermediate unit clauses or target */
/* during linked UR resolution. */
#define LINKED_SUB_UNIT_SOS 78 /* use Sos list to subsume subsumable */
/* intermediate unit clauses or target */
/* during linked UR resolution. */
#define LINKED_UNIT_DEL 80 /* use Unit Deletion during linked UR resolution. */
/* Any unit cl in Usable or Sos list that resolves*/
/* a non-target literal without instantiating it */
/* will be the only resolver against that literal.*/
#define LINKED_TARGET_ALL 81 /* If set, all literals are targets. */
#define LINKED_HYPER_RES 82 /* Linked hyper inference rule */
/* others */
#define PROG_SYNTHESIS 83 /* program synthesis mode */
#define BIRD_PRINT 84 /* output a(_,_) terms in CL notation */
#define BUILD_PROOF_OBJECT 86 /* build proof to be checked elsewhere */
#define LOG_FOR_X_SHOW 87 /* Log some events for X display */
#define GEOMETRIC_REWRITE_BEFORE 88 /* RP's inference rule as a rewrite */
#define GEOMETRIC_REWRITE_AFTER 89 /* RP's inference rule as a rewrite */
#define FORMULA_HISTORY 90 /* Make input clauses point at formula parent */
#define KEEP_HINT_SUBSUMERS 91 /* Do not delete if it subsumes a hint. */
#define PROOF_WEIGHT 92 /* Calculate proof weight (ancestor bag). */
#define HYPER_SYMMETRY_KLUDGE 93 /* Secret flag */
#define GL_DEMOD 94 /* Delay demodulation. */
#define DP_INT_DOMAIN 95 /* Integers in DP input are domain elements. */
#define DISCARD_NON_ORIENTABLE_EQ 96 /* Secret flag */
#define DISCARD_XX_RESOLVABLE 97 /* Secret flag */
#define TPTP_EQ 98 /* for TPTP: "equal" is the only equality */
#define AUTO1 99 /* original AUTO mode (3.0.4) */
#define AUTO2 100 /* revised AUTO mode (3.0.5) */
#define BELL 101 /* Ring the bell for important events? */
#define BACK_UNIT_DELETION 102 /* like back demodulation, but for literals */
#define SPLIT_CLAUSE 103 /* case splitting with fork */
#define SPLIT_WHEN_GIVEN 109 /* Split clauses when given */
#define SPLIT_ATOM 107 /* Split on atoms instead of clauses */
#define SPLIT_POS 104 /* Split on positive clauses only */
#define SPLIT_NEG 105 /* Split on negatvie clauses only */
#define SPLIT_NONHORN 110 /* Split on negatvie clauses only */
#define SPLIT_MIN_MAX 106 /* Split on clause with min max-literal */
#define SPLIT_POPULAR 108 /* Split on most popular atoms */
#define UNIT_RES 111 /* Unit resolution restriction */
#define BUILD_PROOF_OBJECT_2 112 /* build new kind of proof object */
#define SIGINT_INTERACT 113 /* interact on SIGINT */
#define UR_LAST 114 /* restrict UR: target literal is last */
#define LITERALS_WEIGH_ONE 115
#define PICK_DIFF_SIM 116 /* selection of given clause */
#define PICK_RANDOM_LIGHTEST 117 /* selection of given clause */
#define PICK_LAST_LIGHTEST 118 /* selection of given clause */
#define PICK_MID_LIGHTEST 119 /* selection of given clause */
#define SOS_ARG 120 /* otter argument appended to SOS */
#define FOR_SUB_EQUIVALENTS_ONLY 121 /* forward subsumption iff equivalent */
#define KEEP_HINT_EQUIVALENTS 122 /* see hint_keep_test() */
#define LAMBDA_FLAG 123 /* added by Beeson 8.1.02, name changed 5.6.04 */
#define CASES_FLAG 124 /* added by Beeson 7.23.03 */
#define TYPES_FLAG 125 /* added by Beeson 5.10.04 */
#define INDUCTION_FLAG 126 /* added by Beeson 7.23.03 */
#define BIGNUM_FLAG 127 /* added by Beeson 10.21.03 */
#define SIMPLIFY_FLAG 128 /* added by Beeson 10.21.03 */
#define SOLVE_FLAG 129 /* added by Beeson 11.01.03 */
#define SIMPLIFYRULE_FLAG 130 /* added by Beeson 7.22.05 */
#define TYPESAFE_FLAG 131 /* added by Beeson 7.29.05 */
/* end of Flags */
/*************
*
* Parms are integer valued options. To install a new parm, append
* a new name and index to the end of this list, then insert code to
* initialize it in the routine `init_options'.
* Example access: if (Parms[FPA_LITERALS].val == 4) {
* See routine `init_options' for defaults.
*
*************/
#define MAX_PARMS 60 /* increase if necessary */
#define REPORT 1 /* output stats and times every n seconds */
#define MAX_SECONDS 2 /* stop search after this many seconds */
#define MAX_GEN 3 /* stop search after this many generated clauses */
#define MAX_KEPT 4 /* stop search after this many kept clauses */
#define MAX_GIVEN 5 /* stop search after this many given clauses */
#define MAX_MEM 6 /* stop search after this many K bytes allocated */
#define MAX_LITERALS 7 /* max # of lits in kept clause (0 -> no limit) */
#define MAX_WEIGHT 8 /* maximum weight of kept clauses */
#define MAX_DISTINCT_VARS 9 /* max # of variables in kept clause */
#define FPA_LITERALS 10 /* FPA indexing depth for literals */
#define FPA_TERMS 11 /* FPA indexing depth for terms */
#define PICK_GIVEN_RATIO 12 /* pick lightest n times, then pick first */
#define INTERRUPT_GIVEN 13 /* call interact after this many given cls */
#define DEMOD_LIMIT 14 /* Limit on number of rewrites per clause */
#define MAX_PROOFS 15 /* stop search after this many empty clauses */
#define MIN_BIT_WIDTH 16 /* minimum field for bit strings */
#define NEG_WEIGHT 17 /* add this value to wight of negative literals */
#define PRETTY_PRINT_INDENT 22 /* indent for pretty print */
#define STATS_LEVEL 18 /* higher stats_level -> output more statistics */
/* fringe */
#define CHANGE_LIMIT_AFTER 19 /* replace reduce_weight_limit */
#define NEW_MAX_WEIGHT 20 /* replace reduce_weight_limit */
#define GEO_GIVEN_RATIO 21 /* like pick_given_ratio, for geo children */
#define MAX_UR_DEPTH 23 /* max depth for linked UR (normal depth = 0) */
#define MAX_UR_DED_SIZE 24 /* max resolutions in a single linked UR */
#define HEAT 26 /* maximum heat level */
#define DYNAMIC_HEAT_WEIGHT 27 /* max weigth of dynamic hot clause */
#define MAX_ANSWERS 28 /* maximum number of answer literals */
#define DEBUG_FIRST 29 /* turn debugging on */
#define DEBUG_LAST 30 /* turn debugging off */
#define FSUB_HINT_ADD_WT 31 /* add to pick-given wt */
#define BSUB_HINT_ADD_WT 32 /* add to pick-given wt */
#define EQUIV_HINT_ADD_WT 33 /* add to pick-given wt */
#define VERBOSE_DEMOD_SKIP 34 /* debugging option */
#define FSUB_HINT_WT 35 /* pick-given wt */
#define BSUB_HINT_WT 36 /* pick-given wt */
#define EQUIV_HINT_WT 37 /* pick-given wt */
#define DYNAMIC_DEMOD_DEPTH 38
#define DYNAMIC_DEMOD_RHS 39
#define AGE_FACTOR 40 /* to adjust the pick-given weight */
#define DISTINCT_VARS_FACTOR 41 /* to adjust the pick-given weight */
#define NEW_SYMBOL_LEX_POSITION 42
#define WARN_MEM 43 /* reset max_weight at this memory usage */
#define WARN_MEM_MAX_WEIGHT 44 /* new max_weight */
#define SPLIT_SECONDS 45 /* time to search before splitting */
#define SPLIT_GIVEN 46 /* given clauses before splitting */
#define SPLIT_DEPTH 47 /* maximum splitting depth */
#define PICK_DIFF 50 /* selection of given clause */
#define PICK_DIFF_RANGE 51 /* selection of given clause */
#define MAX_UNIFIERS 52 /* for Beeson's multiple unifiers */
#define MAX_BINDING_DEPTH 53 /* maximum number of nested lambdas -- Beeson */
/* end of Parms */
/*************
*
* Statistics. To install a new statistic, append a new name and index
* to the end of this list, then insert the code to output it in the
* routine `print_stats'.
* Example access: Stats[INPUT_ERRORS]++;
*
*************/
#define MAX_STATS 50
#define INPUT_ERRORS 0
#define CL_INPUT 1
#define CL_GENERATED 2
#define CL_KEPT 3
#define CL_FOR_SUB 4
#define CL_BACK_SUB 5
#define CL_TAUTOLOGY 6
#define CL_GIVEN 7
#define CL_WT_DELETE 8
#define REWRITES 9
#define UNIT_DELETES 11
#define EMPTY_CLAUSES 12
#define FPA_OVERLOADS 13 /* not output if 0 */
#define FPA_UNDERLOADS 14 /* not output if 0 */
#define CL_VAR_DELETES 15 /* not output if 0 */
#define FOR_SUB_SOS 16
#define NEW_DEMODS 17
#define CL_BACK_DEMOD 18
#define LINKED_UR_DEPTH_HITS 19
#define LINKED_UR_DED_HITS 20
#define SOS_SIZE 21
#define K_MALLOCED 22
#define CL_NOT_ANC_SUBSUMED 23
/* end of Otter 2.2 Stats */
#define USABLE_SIZE 24
#define DEMODULATORS_SIZE 25
#define DEMOD_LIMITS 26 /* not output if 0 */
#define INIT_WALL_SECONDS 27
#define BINARY_RES_GEN 28
#define HYPER_RES_GEN 29
#define NEG_HYPER_RES_GEN 30
#define UR_RES_GEN 31
#define PARA_INTO_GEN 32
#define PARA_FROM_GEN 33
#define LINKED_UR_RES_GEN 34
#define GEO_GEN 35
#define DEMOD_INF_GEN 36
#define FACTOR_GEN 37
#define HOT_GENERATED 38
#define HOT_KEPT 39
#define FACTOR_SIMPLIFICATIONS 40
#define HOT_SIZE 41
#define PASSIVE_SIZE 42
#define BACK_UNIT_DEL_GEN 43
/* end of Stats */
/*************
*
* Clocks. To install a new clock, append a new name and index
* to the end of this list, then insert the code to output it in the
* routine `print_times'. Example of use: CLOCK_START(INPUT_TIME),
* CLOCK_STOP(INPUT_TIME), micro_sec = clock_val(INPUT_TIME);.
* See files macros.h and clocks.c.
*
*************/
#define MAX_CLOCKS 50
#define INPUT_TIME 0
#define CLAUSIFY_TIME 1
#define PROCESS_INPUT_TIME 2
#define BINARY_TIME 3
#define HYPER_TIME 4
#define NEG_HYPER_TIME 5
#define UR_TIME 6
#define PARA_INTO_TIME 7
#define PARA_FROM_TIME 8
#define LINKED_UR_TIME 9
#define PRE_PROC_TIME 10
#define RENUMBER_TIME 11
#define DEMOD_TIME 12
#define ORDER_EQ_TIME 13
#define UNIT_DEL_TIME 14
#define WEIGH_CL_TIME 15
#define SORT_LITS_TIME 27
#define FOR_SUB_TIME 16
#define DEL_CL_TIME 17
#define KEEP_CL_TIME 18
#define PRINT_CL_TIME 19
#define CONFLICT_TIME 20
#define NEW_DEMOD_TIME 21
#define POST_PROC_TIME 22
#define BACK_DEMOD_TIME 23
#define BACK_SUB_TIME 24
#define FACTOR_TIME 25
#define UN_INDEX_TIME 26
#define HOT_TIME 28
#define FACTOR_SIMP_TIME 29
#define HINTS_TIME 30
#define HINTS_KEEP_TIME 31
#define BACK_UNIT_DEL_TIME 33
#define PICK_GIVEN_TIME 34
/* end of Clocks */
/*************
*
* internal flags--invisible to users
*
*************/
#define MAX_INTERNAL_FLAGS 10
#define SPECIAL_UNARY_PRESENT 0
#define DOLLAR_PRESENT 1
#define LEX_VALS_SET 2
#define REALLY_CHECK_ARITY 3
#define INT_ATTR 0
#define BOOL_ATTR 1
#define DOUBLE_ATTR 2
#define STRING_ATTR 3
#define TERM_ATTR 4
/*************
*
* clause attributes
*
*************/
#define MAX_ATTRIBUTES 50
#define BSUB_HINT_WT_ATTR 1
#define FSUB_HINT_WT_ATTR 2
#define EQUIV_HINT_WT_ATTR 3
#define BSUB_HINT_ADD_WT_ATTR 4
#define FSUB_HINT_ADD_WT_ATTR 5
#define EQUIV_HINT_ADD_WT_ATTR 6
#define LABEL_ATTR 7
./otter/debug.bat 0000744 0002044 0001012 00000000023 11120534442 012216 0 ustar beeson cd ..\otter2\debug
./otter/demod.c 0000744 0002044 0001012 00000125561 11120534443 011714 0 ustar beeson /*
* demod.c -- Demodulation (rewriting) routines.
*
*/
#include "header.h"
#include "beta.h" // Added by Beeson 7.25.02
#include "bterms.h" // Added by Beeson 8.3.02
#include "bsym.h" // Added by Beeson 8.4.02
#ifdef NOMATHXPERT
static int eval_bignum(char *x, unsigned n, int m, char *s, char *t)
{ return 1;
}
#else
extern int eval_bignum(char *,unsigned, int, char *, char *); // Added by Beeson 10.23.03
#endif
/*************
*
* struct term *contract_lin(term, demods, context, demod_id_p)
*
* Attempt to rewrite the top level of `term', using a
* sequential search of `demods'. If success, term is freed; if fail,
* NULL is returned.
*
*************/
static struct term *contract_lin(struct term *t,
int *demods,
struct context *c,
int *demod_id_p)
{
struct term *atom, *contractum, *t2, *t3, *beta;
struct rel *alpha_rel;
struct trail *tr;
struct clause *p;
struct list *d;
int mult_flag, dummy, ok;
tr = NULL;
d = (struct list *) demods;
if (d == NULL)
return(NULL);
p = d->first_cl;
contractum = NULL;
while (p && contractum == NULL) {
atom = ith_literal(p,1)->atom;
alpha_rel = (atom->varnum == CONDITIONAL_DEMOD ?
atom->farg->narg->argval->farg :
atom->farg);
tr = NULL;
if (otter_match(alpha_rel->argval, c, t, &tr)) {
if (atom->varnum == CONDITIONAL_DEMOD) {
/* rewrite instantiated condition */
t2 = apply_demod(atom->farg->argval, c, &dummy);
t3 = convenient_demod(t2);
ok = is_symbol(t3, "$T", 0);
zap_term(t3);
}
else
ok = 1;
if (ok) {
beta = alpha_rel->narg->argval;
mult_flag = 0;
contractum = apply_demod(beta, c, &mult_flag);
if (mult_flag)
c->multiplier++;
/* varnum == LEX_DEP_DEMOD means it's lex-dependent */
if (atom->varnum != LEX_DEP_DEMOD)
ok = 1;
else if (Flags[LRPO].val)
ok = lrpo_greater(t, contractum);
else
ok = lex_check(contractum, t) == LESS_THAN;
if (ok) {
zap_term_special(t);
*demod_id_p = p->id;
}
else {
zap_term_special(contractum);
contractum = NULL;
}
}
clear_subst_1(tr);
}
p = p->next_cl;
} // close while
return(contractum); /* may be NULL */
} /* contract_lin */
/*************
*
* dollar_out_non_list(t) - Process $OUT(t).
*
*************/
static void dollar_out_non_list(struct term *t)
{
int i;
if (t->sym_num == Chr_sym_num && str_int(sn_to_str(t->farg->argval->sym_num), &i))
printf("%c", i);
else
print_term(stdout, t);
} /* dollar_out_non_list */
/*************
*
* dollar_out(t) - Process $OUT(t) or $OUT([t1,...,tn]).
*
*************/
static void dollar_out(struct term *t)
{
struct term *t1;
if (proper_list(t)) {
printf("\n");
for (t1 = t; t1->sym_num != Nil_sym_num; t1 = t1->farg->narg->argval) {
if (t != t1)
printf(" ");
dollar_out_non_list(t1->farg->argval);
}
printf(".\n\n");
}
else
dollar_out_non_list(t);
} /* dollar_out */
/*************
*
* struct term *dollar_contract(t) - evaluate $EQ, $SUM, ...
*
* If t is evaluated, it is deallocated and the result is returned.
* If t cannot be evaluated, it is left alone and NULL is returned.
*
* Here are the current built-ins. (int is actually long, and
* float is actually double. Recall that floats are always
* surrouded by double quotes.)
*
* int x int -> int $SUM, $PROD, $DIFF, $DIV, $MOD
* int x int -> bool $EQ, $NE, $LT, $LE, $GT, $GE
* float x float -> float $FSUM, $FPROD, $FDIFF, $FDIV
* float x float -> bool $FEQ, $FNE, $FLT, $FLE, $FGT, $FGE
* term x term -> bool $ID, $LNE, $LLT, $LLE, $LGT, $LGE,
* $OCCURS, $VOCCURS, VFREE
* bool x bool -> bool $AND, $OR
* bool -> bool $TRUE, $NOT
* -> bool $T, $F
* term -> bool $ATOMIC, $INT, $BITS, $VAR
* -> int $NEXT_CL_NUM
* bool x term x term -> term $IF
* term -> bool $GROUND
* bits x bits -> bits $BIT_AND, $BIT_OR, $BIT_XOR
* bits x int -> bits $SHIFT_LEFT, $SHIFT_RIGHT
* bits -> bits $BIT_NOT
* bits -> int $BITS_OT_INT
* int -> bits $INT_TO_BITS
*
*************/
static struct term *dollar_contract(struct term *t)
{
static int unique_num = 0;
long i1, i2;
long i3 = 0;
unsigned long u1, u2;
unsigned long u3 = 0;
int b1, op_code, op_type, s1t, s1f, s2t, s2f;
int b3 = 0;
double d1, d2;
double d3 = 0.0;
char *s1, *s2, str[MAX_NAME];
struct term *t1, *ta, *tb;
op_code = sn_to_ec(t->sym_num); /* get eval code */
if (op_code < 1)
return(NULL);
else if (op_code <= MAX_USER_EVALUABLE)
return(evaluate_user_function(t, op_code));
else {
switch(op_code) {
case SUM_SYM:
case PROD_SYM:
case DIFF_SYM:
case DIV_SYM:
case MOD_SYM: op_type = 1; break; /* int x int -> int */
case EQ_SYM:
case NE_SYM:
case LT_SYM:
case LE_SYM:
case GT_SYM:
case GE_SYM: op_type = 2; break; /* int x int -> bool */
case AND_SYM:
case OR_SYM: op_type = 3; break; /* bool x bool -> bool */
case TRUE_SYM:
case NOT_SYM: op_type = 4; break; /* bool -> bool */
case IF_SYM: op_type = 5; break; /* bool x term x term -> term */
case LLT_SYM:
case LLE_SYM:
case LGT_SYM:
case LGE_SYM:
case LNE_SYM:
case ID_SYM: op_type = 6; break; /* term x term -> bool (lex) */
case NEXT_CL_NUM_SYM: op_type = 7; break; /* -> int */
case ATOMIC_SYM:
case BITS_SYM:
case INT_SYM:
case GROUND_SYM:
case VAR_SYM: op_type = 8; break; /* term -> bool */
case T_SYM: return(NULL);
case F_SYM: return(NULL);
case OUT_SYM: op_type = 9; break; /* term -> same_term_with_output */
case BIT_NOT_SYM: op_type = 10; break; /* bits -> bits */
case FSUM_SYM:
case FPROD_SYM:
case FDIFF_SYM:
case FDIV_SYM: op_type = 11; break; /* float x float -> float */
case FEQ_SYM:
case FNE_SYM:
case FLT_SYM:
case FLE_SYM:
case FGT_SYM:
case FGE_SYM: op_type = 12; break; /* float x float -> bool */
case BIT_AND_SYM:
case BIT_OR_SYM:
case BIT_XOR_SYM: op_type = 13; break; /* bits x bits -> bits */
case SHIFT_RIGHT_SYM:
case SHIFT_LEFT_SYM: op_type = 14; break; /* bits x int -> bits */
case INT_TO_BITS_SYM: op_type = 15; break; /* int -> bits */
case BITS_TO_INT_SYM: op_type = 16; break; /* bits -> int */
case OCCURS_SYM:
case VOCCURS_SYM:
case VFREE_SYM:
case RENAME_SYM: op_type = 17; break; /* term x term -> bool (misc) */
case UNIQUE_NUM_SYM: op_type = 18; break; /* -> int */
default: printf("ERROR, dollar_contract, bad op_code: %d.\n", op_code); return(NULL);
}
switch (op_type) {
case 1: /* int x int -> int */
ta = t->farg->argval;
tb = t->farg->narg->argval;
if (ta->type != NAME || tb->type != NAME)
return(NULL);
s1 = sn_to_str(ta->sym_num);
s2 = sn_to_str(tb->sym_num);
// Following code modified by Beeson 10.26.03
if ((op_code == DIV_SYM || op_code == MOD_SYM) &&
str_long(s2,&i2) != 0 && i2 == 0
) {
print_term_nl(stdout, t);
abend("integer divide by 0.");
}
if (Flags[BIGNUM_FLAG].val){
if(eval_bignum(str,MAX_NAME, op_code,s1,s2))
{ char buffer[100];
sprintf(buffer,"bignum exceeded %d decimal digits", MAX_NAME);
abend(buffer);
}
}
else {
if (str_long(s1, &i1) == 0 || str_long(s2, &i2) == 0)
return NULL; // McCune's original code
switch (op_code) {
case SUM_SYM: i3 = i1 + i2; break;
case PROD_SYM: i3 = i1 * i2; break;
case DIFF_SYM: i3 = i1 - i2; break;
case DIV_SYM: i3 = i1 / i2; break;
case MOD_SYM: i3 = i1 % i2; break;
}
long_str(i3, str);
}
zap_term_special(t);
t1 = get_term();
t1->type = NAME;
t1->sym_num = str_to_sn(str, 0);
return(t1);
case 2: /* int x int -> bool */
ta = t->farg->argval;
tb = t->farg->narg->argval;
if (ta->type != NAME || tb->type != NAME)
return(NULL);
s1 = sn_to_str(ta->sym_num);
s2 = sn_to_str(tb->sym_num);
if (str_long(s1, &i1) == 0 || str_long(s2, &i2) == 0)
return(NULL);
switch (op_code) {
case EQ_SYM: b3 = i1 == i2; break;
case NE_SYM: b3 = i1 != i2; break;
case LT_SYM: b3 = i1 < i2; break;
case LE_SYM: b3 = i1 <= i2; break;
case GT_SYM: b3 = i1 > i2; break;
case GE_SYM: b3 = i1 >= i2; break;
}
t->occ.lit = NULL; /* in case t is a literal */
zap_term_special(t);
t1 = get_term();
t1->type = NAME;
t1->sym_num = str_to_sn(b3 ? "$T" : "$F", 0);
return(t1);
case 3: /* bool x bool -> bool */
s1 = sn_to_str(t->farg->argval->sym_num);
s2 = sn_to_str(t->farg->narg->argval->sym_num);
s1t = str_ident(s1,"$T");
s1f = str_ident(s1,"$F");
s2t = str_ident(s2,"$T");
s2f = str_ident(s2,"$F");
if ((s1t == 0 && s1f == 0) || (s2t == 0 && s2f == 0))
return(NULL);
switch (op_code) {
case AND_SYM: b3 = s1t && s2t; break;
case OR_SYM: b3 = s1t || s2t; break;
}
t->occ.lit = NULL; /* in case t is a literal */
zap_term_special(t);
t1 = get_term();
t1->type = NAME;
t1->sym_num = str_to_sn(b3 ? "$T" : "$F", 0);
return(t1);
case 4: /* bool -> bool $NOT(x), $TRUE(x) */
s1 = sn_to_str(t->farg->argval->sym_num);
s1t = str_ident(s1,"$T");
s1f = str_ident(s1,"$F");
if (s1t == 0 && s1f == 0)
return(NULL);
t->occ.lit = NULL; /* in case t is a literal */
zap_term_special(t);
t1 = get_term();
t1->type = NAME;
switch (op_code) {
case NOT_SYM: t1->sym_num = str_to_sn(s1t ? "$F" : "$T", 0);
break;
case TRUE_SYM: t1->sym_num = str_to_sn(s1t ? "$T" : "$F", 0);
break;
}
return(t1);
case 5: /* bool x term x term -> term $IF(x,y,z) */
s1 = sn_to_str(t->farg->argval->sym_num);
s1t = str_ident(s1,"$T");
s1f = str_ident(s1,"$F");
if (s1t == 0 && s1f == 0)
return(NULL);
if (s1t)
t1 = t->farg->narg->argval;
else
t1 = t->farg->narg->narg->argval;
t1->fpa_id++; /* one more pointer to t1 */
zap_term_special(t); /* one less pointer to t */
return(t1);
case 6: /* term x term -> bool (lexical comparisons) */
ta = t->farg->argval;
tb = t->farg->narg->argval;
b1 = lex_check(ta, tb);
switch (op_code) {
case ID_SYM: b3 = (b1 == SAME_AS); break;
case LNE_SYM: b3 = (b1 != SAME_AS); break;
case LLT_SYM: b3 = (b1 == LESS_THAN); break;
case LLE_SYM: b3 = (b1 == LESS_THAN || b1 == SAME_AS); break;
case LGT_SYM: b3 = (b1 == GREATER_THAN); break;
case LGE_SYM: b3 = (b1 == GREATER_THAN || b1 == SAME_AS); break;
}
t->occ.lit = NULL; /* in case t is a literal */
zap_term_special(t);
t1 = get_term();
t1->type = NAME;
t1->sym_num = str_to_sn(b3 ? "$T" : "$F", 0);
return(t1);
case 7: /* -> int */
int_str(next_cl_num(), str);
t->sym_num = str_to_sn(str, 0);
return(t);
case 8: /* term -> bool (metalogical properties) */
ta = t->farg->argval;
switch (op_code) {
case ATOMIC_SYM: b3 = ta->type == NAME; break;
case INT_SYM:
b3 = ( ta->type == NAME &&
str_long(sn_to_str(ta->sym_num), &i1));
break;
case BITS_SYM:
b3 = ( ta->type == NAME &&
bits_ulong(sn_to_str(ta->sym_num), &u1));
break;
case VAR_SYM: b3 = ta->type == VARIABLE; break;
case GROUND_SYM: b3 = ground(ta); break;
}
t->occ.lit = NULL; /* in case t is a literal */
zap_term_special(t);
t1 = get_term();
t1->type = NAME;
t1->sym_num = str_to_sn(b3 ? "$T" : "$F", 0);
return(t1);
case 9: /* term -> same_term_with_output */
dollar_out(t->farg->argval);
return(NULL);
case 10: /* bits -> bits */
s1 = sn_to_str(t->farg->argval->sym_num);
if (bits_ulong(s1, &u1) == 0)
return(NULL);
switch (op_code) {
case BIT_NOT_SYM: u3 = ~u1;
break;
}
zap_term_special(t);
t1 = get_term();
t1->type = NAME;
ulong_bits(u3, str);
t1->sym_num = str_to_sn(str, 0);
return(t1);
case 11: /* float x float -> float */
ta = t->farg->argval;
tb = t->farg->narg->argval;
if (ta->type != NAME || tb->type != NAME)
return(NULL);
s1 = sn_to_str(ta->sym_num);
s2 = sn_to_str(tb->sym_num);
if (str_double(s1, &d1) == 0 || str_double(s2, &d2) == 0)
return(NULL);
if (op_code == FDIV_SYM && d2 == 0) {
print_term_nl(stdout, t);
abend("float divide by 0.");
}
switch (op_code) {
case FSUM_SYM: d3 = d1 + d2; break;
case FPROD_SYM: d3 = d1 * d2; break;
case FDIFF_SYM: d3 = d1 - d2; break;
case FDIV_SYM: d3 = d1 / d2; break;
}
zap_term_special(t);
t1 = get_term();
t1->type = NAME;
double_str(d3, str);
t1->sym_num = str_to_sn(str, 0);
return(t1);
case 12: /* float x float -> bool */
ta = t->farg->argval;
tb = t->farg->narg->argval;
if (ta->type != NAME || tb->type != NAME)
return(NULL);
s1 = sn_to_str(ta->sym_num);
s2 = sn_to_str(tb->sym_num);
if (str_double(s1, &d1) == 0 || str_double(s2, &d2) == 0)
return(NULL);
switch (op_code) {
case FEQ_SYM: b3 = d1 == d2; break;
case FNE_SYM: b3 = d1 != d2; break;
case FLT_SYM: b3 = d1 < d2; break;
case FLE_SYM: b3 = d1 <= d2; break;
case FGT_SYM: b3 = d1 > d2; break;
case FGE_SYM: b3 = d1 >= d2; break;
}
t->occ.lit = NULL; /* in case t is a literal */
zap_term_special(t);
t1 = get_term();
t1->type = NAME;
t1->sym_num = str_to_sn(b3 ? "$T" : "$F", 0);
return(t1);
case 13: /* bits x bits -> bits */
ta = t->farg->argval;
tb = t->farg->narg->argval;
if (ta->type != NAME || tb->type != NAME)
return(NULL);
s1 = sn_to_str(ta->sym_num);
s2 = sn_to_str(tb->sym_num);
if (bits_ulong(s1, &u1) == 0 || bits_ulong(s2, &u2) == 0)
return(NULL);
switch (op_code) {
case BIT_AND_SYM: u3 = u1 & u2; break;
case BIT_OR_SYM: u3 = u1 | u2; break;
case BIT_XOR_SYM: u3 = u1 ^ u2; break;
}
zap_term_special(t);
t1 = get_term();
t1->type = NAME;
ulong_bits(u3, str);
t1->sym_num = str_to_sn(str, 0);
return(t1);
case 14: /* bits x int -> bits */
ta = t->farg->argval;
tb = t->farg->narg->argval;
if (ta->type != NAME || tb->type != NAME)
return(NULL);
s1 = sn_to_str(ta->sym_num);
s2 = sn_to_str(tb->sym_num);
if (bits_ulong(s1, &u1) == 0 || str_long(s2, &i2) == 0)
return(NULL);
switch (op_code) {
case SHIFT_RIGHT_SYM: u3 = u1 >> i2; break;
case SHIFT_LEFT_SYM: u3 = u1 << i2; break;
}
zap_term_special(t);
t1 = get_term();
t1->type = NAME;
ulong_bits(u3, str);
t1->sym_num = str_to_sn(str, 0);
return(t1);
case 15: /* int -> bits */
s1 = sn_to_str(t->farg->argval->sym_num);
if (str_long(s1, &i1) == 0)
return(NULL);
switch (op_code) {
case INT_TO_BITS_SYM: u3 = i1;
break;
}
zap_term_special(t);
t1 = get_term();
t1->type = NAME;
ulong_bits(u3, str);
t1->sym_num = str_to_sn(str, 0);
return(t1);
case 16: /* bits -> int */
s1 = sn_to_str(t->farg->argval->sym_num);
if (bits_ulong(s1, &u1) == 0)
return(NULL);
switch (op_code) {
case BITS_TO_INT_SYM: i3 = u1;
break;
}
zap_term_special(t);
t1 = get_term();
t1->type = NAME;
long_str(i3, str);
t1->sym_num = str_to_sn(str, 0);
return(t1);
case 17: /* term x term -> bool (misc) */
ta = t->farg->argval;
tb = t->farg->narg->argval;
switch (op_code) {
case RENAME_SYM: b3 = same_structure(ta, tb); break;
case OCCURS_SYM: b3 = occurs_in(ta, tb); break;
case VOCCURS_SYM: b3 = ta->type == VARIABLE && occurs_in(ta, tb); break;
case VFREE_SYM: b3 = ta->type == VARIABLE && !occurs_in(ta, tb); break;
default: b3 = 0;
}
t->occ.lit = NULL; /* in case t is a literal */
zap_term_special(t);
t1 = get_term();
t1->type = NAME;
t1->sym_num = str_to_sn(b3 ? "$T" : "$F", 0);
return(t1);
case 18: /* -> int */
unique_num++;
int_str(unique_num, str);
t->sym_num = str_to_sn(str, 0);
return(t);
}
printf("ERROR, dollar_contract, bad op_type: %d.\n", op_type);
return(NULL);
}
} /* dollar_contract */
/*************
*
*
*
*************/
static struct term *replace_special(struct term *t,
struct term *target,
struct term *replacement)
{
struct rel *r;
if (term_ident(t, target)) {
zap_term_special(t);
replacement->fpa_id++;
return(replacement);
}
else if (t->type == COMPLEX) {
for (r = t->farg; r; r = r->narg)
r->argval = replace_special(r->argval, target, replacement);
return(t);
}
else
return(t);
} /* replace_special */
/*************
*
* struct term *demod(term, contract_proc, demods, count, context, histp)
*
* Demodulate a term.
*
* The demodulated term is returned, and the given term
* becomes garbage, so a good way to invoke is `t = demod(t, demods, ...'.
* A context must be allocated before the call--the same one is used
* for all subterms--this saves allocating and deallocating at
* each subterm. `count' is pointer to the maximum number of
* rewrites that will be applied. `contract_proc' is a pointer to the
* routine that looks for demodulators and does the rewriting.
* The type of `demods' depends on `contract_proc'.
*
*************/
static struct term *demod(struct term *t,
struct term *(*contract_proc)(struct term *t,
int *demods,
struct context *c,
int *demod_id_p),
int *demods,
long int *count,
struct context *c,
struct int_ptr **histp)
{
struct rel *r;
struct term *t1;
struct int_ptr *ip;
int demod_id;
if (t->type == VARIABLE || TP_BIT(t->bits, SCRATCH_BIT) || *count <= 0)
/* don't try to demodulate if a var or if already fully demodulated */
return t;
else if (t->type == COMPLEX) {
if(Flags[LAMBDA_FLAG].val && // Beeson 7.29.05
FUNCTOR(t) == AP && ARG0(t)->type == VARIABLE && // Beeson 7.29.05
c->terms[ARG0(t)->varnum] == NULL // Beeson 7.29.05
) // Beeson 7.29.05
return t; // Don't demodulate Ap(X,w) terms // Beeson 7.29.05
/* if $IF, evaluate right now! */
if (Internal_flags[DOLLAR_PRESENT] && sn_to_ec(t->sym_num) == IF_SYM) {
/* first reduce condition */
t->farg->argval = demod(t->farg->argval, contract_proc, demods, count, c, histp);
/* now evaluate $IF */
t1 = dollar_contract(t);
if (t1 != NULL) {
(*count)--;
return(demod(t1, contract_proc, demods, count, c, histp));
}
if(t->sym_num == AP && FUNCTOR(ARG0(t)) == LAMBDA &&
!otter_contains(ARG1(ARG0(t)),ARG0(ARG0(t)))
){
/* ap(lambda x. t, r), when x doesn't occur in t, don't reduce r,
just reduce t and return the result */
return demod(ARG1(ARG0(t)),contract_proc, demods,count,c,histp);
}
}
#if 0
else if (Internal_flags[DOLLAR_PRESENT] && sn_to_ec(t->sym_num) == COMMON_EXPRESSION_SYM) {
t->farg->narg->argval = demod(t->farg->narg->argval, contract_proc, demods, count, c, histp);
t->farg->narg->narg->argval = replace_special(t->farg->narg->narg->argval, t->farg->argval, t->farg->narg->argval);
t1 = t->farg->narg->narg->argval;
t1->fpa_id++;
zap_term_special(t);
return(demod(t1, contract_proc, demods, count, c, histp));
}
#endif
/* Fully demodulate subterms. Do not demod subterms of $RENAME(_,_). */
if (!Internal_flags[DOLLAR_PRESENT] || sn_to_ec(t->sym_num) != RENAME_SYM) {
r = t->farg;
while (r && *count > 0) {
r->argval = demod(r->argval, contract_proc, demods, count, c, histp);
r = r->narg;
}
}
}
if (*count > 0) {
int debug = Flags[VERY_VERBOSE].val &&
(Parms[DEMOD_LIMIT].val - *count) >= Parms[VERBOSE_DEMOD_SKIP].val;
if (debug) {
fprintf(stdout, " demod term: ");
print_term_nl(stdout, t);
fflush(stdout);
}
t1 = (*contract_proc)(t, demods, c, &demod_id);
if (t1 != NULL) {
if (debug) {
fprintf(stdout, " --> result: ");
print_term(stdout, t1);
fprintf(stdout, " demod<%d>\n", demod_id);
fflush(stdout);
}
(*count)--;
if (*histp != NULL) {
ip = get_int_ptr();
ip->i = demod_id;
(*histp)->next = ip;
*histp = ip;
}
t = demod(t1, contract_proc, demods, count, c, histp);
}
else if (Internal_flags[DOLLAR_PRESENT]) {
t1 = dollar_contract(t);
if (t1 != NULL) {
( *count)--;
t = t1;
}
}
else if(FUNCTOR(t) == AP && FUNCTOR(ARG0(t)) == LAMBDA)
{ t1 = beta_reduce(t,c); // Beeson 7.25.02 added this and the next few lines
if(debug)
{ printf("\n beta reducing: ");
print_term(stdout,t);
printf(" = \n");
print_term(stdout,t1);
}
if(t1 != NULL) {
if (debug) {
fprintf(stdout, " --> result: ");
print_term(stdout, t1);
fprintf(stdout, " beta reduce <%d>\n", demod_id);
fflush(stdout);
}
(*count)--;
if (*histp != NULL) {
ip = get_int_ptr();
ip->i = BETA_REDUCTION;
(*histp)->next = ip;
*histp = ip;
}
t = demod(t1, contract_proc, demods, count, c, histp);
}
}
SET_BIT(t->bits, SCRATCH_BIT);
}
return(t);
} /* demod */
/*************
*
* struct term *left_most_one_step(t, contract_proc, demods, c, histp)
*
*************/
static struct term *left_most_one_step(struct term *t,
struct term *(*contract_proc)(struct term *t,
int *demods,
struct context *c,
int *demod_id_p),
int *demods,
struct context *c,
struct int_ptr **histp)
{
struct term *t1;
struct int_ptr *ip;
struct rel *r;
int demod_id;
if (t->type == VARIABLE || TP_BIT(t->bits, SCRATCH_BIT))
return(NULL);
else {
t1 = (*contract_proc)(t, demods, c, &demod_id);
if (t1 != NULL) {
if (*histp != NULL) {
ip = get_int_ptr();
ip->i = demod_id;
(*histp)->next = ip;
*histp = ip;
}
}
else {
if (Internal_flags[DOLLAR_PRESENT]) {
t1 = dollar_contract(t);
}
}
if (t1 != NULL)
return(t1);
else {
r = t->farg;
while (r != NULL) {
t1 = left_most_one_step(r->argval, contract_proc, demods, c, histp);
if (t1 != NULL) {
r->argval = t1;
return(t);
}
SET_BIT(r->argval->bits, SCRATCH_BIT);
r = r->narg;
}
return(NULL);
}
}
} /* left_most_one_step */
/*************
*
* struct term *demod_out_in(term, contract_proc, demods, count, subst, histp)
*
*************/
static struct term *demod_out_in(struct term *t,
struct term *(*contract_proc)(struct term *t,
int *demods,
struct context *c,
int *demod_id_p),
int *demods,
long int *count,
struct context *c,
struct int_ptr **histp)
{
struct term *t1;
t1 = left_most_one_step(t, contract_proc, demods, c, histp);
while (t1 != NULL) {
(*count)--;
if (*count <= 0)
return(t1);
else {
t = t1;
t1 = left_most_one_step(t, contract_proc, demods, c, histp);
}
}
return(t);
} /* demod_out_in */
/*************
*
* un_share_special(term)
*
* Given a term in which some of the subterms (not the term
* itself) may be referenced more than once (fpa_id > 0),
* transform it into a term in which all of the subterms
* are referenced exactly once (a normal nonintegrated term)
* by copying the appropriate subterms.
* Also clear the SCRATCH bit in all subterms visited.
*
*************/
static void un_share_special(struct term *t)
{
struct rel *r;
CLEAR_BIT(t->bits, SCRATCH_BIT);
if (t->type != COMPLEX)
return;
else {
r = t->farg;
while (r != NULL) {
if (r->argval->fpa_id != 0) {
r->argval->fpa_id--;
r->argval = copy_term(r->argval);
}
else
un_share_special(r->argval);
r = r->narg;
}
}
} /* un_share_special */
/*************
*
* convenient_demod(t)
*
*************/
struct term *convenient_demod(struct term *t)
{
struct term *t1;
struct context *c;
struct int_ptr *hist;
long limit;
limit = Parms[DEMOD_LIMIT].val;
limit = (limit == -1 ? MAX_LONG_INT : limit);
hist = NULL; /* so that history will not be kept */
c = get_context();
if (Flags[DEMOD_LINEAR].val)
t1 = demod(t, contract_lin, (int *) Demodulators, &limit, c, &hist);
else
t1 = demod(t, contract_imd, (int *) Demod_imd, &limit, c, &hist);
free_context(c);
un_share_special(t1);
return(t1);
} /* convenient_demod */
/*************
*
* zap_term_special(term) -- Special term deletion.
*
* Deletion of nonintegrated term in which the term and
* some of its subterms might be referenced more than once.
* term->fpa_id is a count of the number of extra references.
* If we get to a term with more than one reference, then
* decrement the number of references; else recurse on the
* subterms and free the node.
*
*************/
void zap_term_special(struct term *t)
{
struct rel *r1, *r2;
if (t->occ.rel != NULL) {
return; // Beeson 8.12.08
printf("WARNING, zap_term_special called with contained term: ");
print_term(stdout, t);
printf("\n");
}
else if (t->fpa_id != 0)
t->fpa_id--;
else {
if (t->type == COMPLEX) { /* complex term */
r1 = t->farg;
while (r1 != NULL) {
zap_term_special(r1->argval);
r2 = r1;
r1 = r1->narg;
free_rel(r2);
}
}
free_term(t);
}
} /* zap_term_special */
/*************
*
* struct term *apply_demod(t, context, mult_flag_ptr)
*
* Special purpose apply -- for demodulation.
*
* If t is a variable instantiated to some term t2,
* then increment the reference count of t2, and return t2;
* else create a new node and recurse on any subterms.
*
* mult_flag_ptr is a pointer to flag for incrementing multiplier
* for demodulators that have a variable on the right that doesn't
* occur on the left: If an uninstantiated variable is encountered,
* then the flag is set; when finished applying to beta, if the
* flag is set, then the multiplier is incremented.
* (It may be the case that demods of this type are not allowed.)
*
*************/
struct term *apply_demod(struct term *t,
struct context *c,
int *pf)
{
struct term *t2;
struct rel *r1, *r2, *r3;
if (t->type == VARIABLE && c->terms[t->varnum] != NULL) { /* bound var */
t2 = c->terms[t->varnum];
t2->fpa_id++; /* count of extra references to a term */
return(t2);
}
if (t->type == VARIABLE) { /* unbound variable */
if(Flags[LAMBDA_FLAG].val && c->bound[t->varnum]) // Beeson 6.9.04
{ if(c->next_var == 0) // Beeson 6.9.04
{ t->fpa_id++; // Beeson 6.9.04
return(t); // Beeson 6.9.04
} // Beeson 6.9.04
else // Beeson 6.9.04
{ t2 = get_term(); // Beeson 6.9.04
t2->type = VARIABLE; // Beeson 6.9.04
t2->varnum = c->next_var + t->varnum; // Beeson 6.9.04
// but do not increment c->next_var, as it // Beeson 6.9.04
// is OK to have multiple occurrences of the // Beeson 6.9.06
// same bound variable, even nested. // Beeson 6.9.06
if(t2->varnum >= MAX_VARS) // Beeson 6.9.04
abend("Too many variables"); // Beeson 6.9.04
return t2; // Beeson 6.9.04
} // Beeson 6.9.04
} // Beeson 6.9.04
t2 = get_term();
t2->type = VARIABLE;
if(Flags[LAMBDA_FLAG].val) // Beeson 6.4.04
{ t2->varnum = c->next_var + t->varnum; // Beeson 6.4.04
if(t2->varnum >= MAX_VARS) // Beeson 6.9.04
abend("Too many variables"); // Beeson 6.9.04
++c->next_var; // Beeson 6.4.04
} // Beeson 6.4.04
else // Beeson 6.4.04
{ t2->varnum = c->multiplier * MAX_VARS + t->varnum;
*pf = 1; /* when finished applying to beta, increment multiplier */
}
return(t2);
}
else if (t->type == NAME) { /* name */
t2 = get_term();
t2->type = NAME;
t2->sym_num = t->sym_num;
return(t2);
}
else { /* complex term */
int vn, saveit; // Beeson 6.9.04
t2 = get_term();
t2->type = COMPLEX;
t2->sym_num = t->sym_num;
r3 = NULL;
if(BINDER(t->sym_num)) // Beeson 6.9.04
{ vn = ARG0(t)->varnum; // Beeson 6.9.04
saveit = c->bound[vn];
c->bound[vn] = 1; // Beeson 6.9.04
} // Beeson 6.9.04
r1 = t->farg;
while (r1 != NULL ) {
r2 = get_rel();
if (r3 == NULL)
t2->farg = r2;
else
r3->narg = r2;
r2->argval = apply_demod(r1->argval, c, pf);
r3 = r2;
r1 = r1->narg;
}
if(BINDER(t->sym_num)) // Beeson 6.9.04
c->bound[vn] = saveit; // Beeson 6.9.04
return(t2);
}
} /* apply_demod */
/*************
*
* demod_cl(c) -- demodulate a clause
*
*************/
void demod_cl(struct clause *c)
{
struct literal *lit;
struct term *atom;
int linear, out_in, hist;
long limit_save, limit;
struct context *subst;
struct int_ptr *ip_save, *ip_send, *ip_d;
int *d;
static int limit_warning_issued;
linear = Flags[DEMOD_LINEAR].val;
limit = Parms[DEMOD_LIMIT].val;
out_in = Flags[DEMOD_OUT_IN].val;
limit_save = limit = (limit == -1 ? MAX_LONG_INT : limit);
hist = Flags[DEMOD_HISTORY].val;
if (c->parents == NULL)
ip_d = ip_save = get_int_ptr();
else {
ip_save = c->parents;
while (ip_save->next != NULL)
ip_save = ip_save->next;
ip_d = NULL;
}
/* ip_save saves position to insert "d" if any demodulation occurs */
ip_send = (hist ? ip_save : NULL);
if(Flags[LAMBDA_FLAG].val)
subst = get_context2(c,0); // Beeson. 0 means we're always going to renumber_vars after
else
{ subst = get_context(); // original Otter code
subst->multiplier = 1;
}
if (linear)
d = (int *) Demodulators;
else
d = (int *) Demod_imd;
lit = c->first_lit;
while (lit != NULL && limit > 0) {
atom = lit->atom;
atom->occ.lit = NULL; /* reset at end of loop */
if (out_in) {
if (linear)
atom = demod_out_in(atom, contract_lin, d, &limit, subst, &ip_send);
else
atom = demod_out_in(atom, contract_imd, d, &limit, subst, &ip_send);
}
else {
if (linear)
atom = demod(atom, contract_lin, d, &limit, subst, &ip_send);
else
{ // printf("\ndemod literal: "); // DEBUG
// print_term_nl(stdout,atom); // DEBUG
atom = demod(atom, contract_imd, d, &limit, subst, &ip_send);
}
}
un_share_special(atom);
if (atom->varnum == TERM) { /* if the atom itself was changed */
lit->atom = atom;
mark_literal(lit);
}
atom->occ.lit = lit;
lit = lit->next_lit;
}
if (subst->multiplier != 1) {
/* new variables were introduced */
if (renumber_vars(c) == 0) {
print_clause(stdout, c);
abend("demod_cl, demodulation introduced too many variables.");
}
}
if (limit <= 0) {
Stats[DEMOD_LIMITS]++;
if (!limit_warning_issued) {
printf("WARNING, demod_limit (given clause %ld): ", Stats[CL_GIVEN]);
print_clause(stdout, c);
fprintf(stderr, "\n%cWARNING, demod_limit stopped the demodulation of a clause.\nThis warning will not be repeated.\n\n", Bell);
limit_warning_issued = 1;
}
else
printf("WARNING, demod_limit.\n");
}
/* if some demodulation occured, insert DEMOD_RULE into parent list */
if (limit_save > limit) {
if (ip_d != NULL) {
c->parents = ip_d;
}
else {
ip_d = get_int_ptr();
ip_d->next = ip_save->next;
ip_save->next = ip_d;
}
ip_d->i = DEMOD_RULE;
}
else if (ip_d != NULL)
free_int_ptr(ip_d);
Stats[REWRITES] += (limit_save - limit);
free_context(subst);
} /* demod_cl */
/*************
*
* back_demod(d, c, input, lst) - back demodulate with d
*
* But don't back demodulate d or c
*
*************/
void back_demod(struct clause *d,
struct clause *c,
int input,
struct list *lst)
{
struct term *atom;
struct term_ptr *tp, *tp2;
struct clause_ptr *cp, *cp2;
struct int_ptr *ip0, *ip1;
struct clause *c1, *c2;
int ok;
atom = ith_literal(d,1)->atom;
if (Flags[INDEX_FOR_BACK_DEMOD].val)
tp = all_instances_fpa(atom);
else
tp = all_instances(atom);
cp = NULL;
while (tp) {
all_cont_cl(tp->term, &cp);
tp2 = tp;
tp = tp->next;
free_term_ptr(tp2);
}
while (cp) {
c1 = cp->c;
ok = 0;
if (c1 == d || c1 == c)
ok = 0; /* don't back demodulate yourself */
else if (c1->container == Usable) {
ok = 1;
CLOCK_START(UN_INDEX_TIME);
un_index_lits_all(c1);
un_index_lits_clash(c1);
CLOCK_STOP(UN_INDEX_TIME);
}
else if (c1->container == Sos) {
ok = 1;
CLOCK_START(UN_INDEX_TIME);
un_index_lits_all(c1);
CLOCK_STOP(UN_INDEX_TIME);
}
else if (c1->container == Demodulators) {
if (ith_literal(c1,1)->atom->varnum == CONDITIONAL_DEMOD)
ok = 0;
else {
if (Flags[DEMOD_LINEAR].val == 0) {
CLOCK_START(UN_INDEX_TIME);
imd_delete(c1, Demod_imd);
CLOCK_STOP(UN_INDEX_TIME);
}
if (c1->parents != NULL && c1->parents->i == NEW_DEMOD_RULE) {
/* just delete it. this works because list is decreasing; */
/* dynamic demodulator has id greater than parent. */
rem_from_list(c1);
hide_clause(c1);
ok = 0;
}
else {
ith_literal(c1,1)->atom->varnum = POS_EQ; /* in case lex-dep */
ok = 1;
}
}
}
if (ok) {
Stats[CL_BACK_DEMOD]++;
if (Flags[PRINT_BACK_DEMOD].val || input)
printf(" >> back demodulating %d with %d.\n", c1->id, d->id);
rem_from_list(c1);
c2 = cl_copy(c1);
ip0 = get_int_ptr(); ip0->i = BACK_DEMOD_RULE;
ip1 = get_int_ptr(); ip1->i = c1->id;
c2->parents = ip0; ip0->next = ip1;
hide_clause(c1);
CLOCK_STOP(BACK_DEMOD_TIME);
CLOCK_STOP(POST_PROC_TIME);
pre_process(c2, 0,lst);
CLOCK_START(POST_PROC_TIME);
CLOCK_START(BACK_DEMOD_TIME);
}
cp2 = cp;
cp = cp->next;
free_clause_ptr(cp2);
}
} /* back_demod */
/*************
*
* int lit_t_f_reduce(c) -- evaluate evaluable literals
*
* delete any false literals, $F or -$T.
*
* return: 0 -- clause evaluated successfully.
* 1 -- clause evaluated successfully to TRUE (clause/lits
* not deallocated).
*
*************/
int lit_t_f_reduce(struct clause *c)
{
struct literal *lit, *prev_lit, *next_lit;
int atom_true, atom_false;
char *s;
int changed = 0;
int eval_to_true = 0;
lit = c->first_lit;
prev_lit = NULL;
while (lit != NULL && !eval_to_true) {
next_lit = lit->next_lit;
if (lit->atom->varnum == EVALUABLE) {
s = sn_to_str(lit->atom->sym_num);
atom_true = str_ident(s, "$T");
atom_false = str_ident(s, "$F");
if (atom_true || atom_false) {
changed = 1;
if ((atom_true && lit->sign ) ||
(atom_false && lit->sign == 0 ))
eval_to_true = 1;
else if ((atom_false && lit->sign) ||
(atom_true && lit->sign == 0 )) {
/* lit is false, so delete it */
if (prev_lit == NULL) {
c->first_lit = next_lit;
lit->atom->occ.lit = NULL;
zap_term(lit->atom);
free_literal(lit);
lit = NULL;
}
else {
prev_lit->next_lit = next_lit;
lit = prev_lit;
}
}
}
}
prev_lit = lit;
lit = next_lit;
}
if (changed) {
/* append "PROPOSITIONAL_RULE" to list of parents */
struct int_ptr *p1, *p2, *p3;
for (p1 = NULL, p2 = c->parents; p2; p1 = p2, p2 = p2->next);
p3 = get_int_ptr();
p3->i = PROPOSITIONAL_RULE;
if (p1)
p1->next = p3;
else
c->parents = p3;
}
return(eval_to_true);
} /* lit_t_f_reduce */
/*************
*
* int check_input_demod(c)
*
* Check if it is a valid demodulator, possibly flipping and
* making lex_dependent.
*
*************/
int check_input_demod(struct clause *c)
{
struct term *atom, *alpha, *beta;
if (!unit_clause(c))
return(0);
else if (num_literals_including_answers(c) != 1)
return(0);
else {
/* exactly one literal, which is non-answer */
atom = ith_literal(c,1)->atom;
if (atom->varnum == CONDITIONAL_DEMOD) {
alpha = atom->farg->narg->argval->farg->argval;
beta = atom->farg->narg->argval->farg->narg->argval;
return(!term_ident(alpha, beta));
}
else if (atom->varnum != POS_EQ)
return(0);
else {
alpha = atom->farg->argval;
beta = atom->farg->narg->argval;
if (term_ident(alpha, beta))
return(0);
else {
/* it can be a demodulator */
if (!Flags[LRPO].val) {
if (term_ident_x_vars(alpha, beta)) {
printf("lex dependent demodulator: ");
print_clause(stdout, c);
atom->varnum = LEX_DEP_DEMOD;
}
}
else {
if (lrpo_greater(alpha, beta))
; /* do nothing */
else if (lrpo_greater(beta, alpha)) {
/* flip args */
printf("Flipping following input demodulator due to lrpo ordering: ");
print_clause(stdout, c);
atom->farg->argval = beta;
atom->farg->narg->argval = alpha;
}
else {
printf("LRPO dependent demodulator: ");
print_clause(stdout, c);
atom->varnum = LEX_DEP_DEMOD;
}
}
#if 0
if (!var_subset(atom->farg->narg->argval,atom->farg->argval)) {
printf("beta has a variable not in alpha: ");
return(0);
}
else
#endif
return(1);
}
}
}
} /* check_input_demod */
/*************
*
* dynamic_demodulator(c)
*
* return 0: don't make it a demodulator
* 1: regular demodulator
* 2: lex- or lrpo- dependent demodulator
*
*************/
int dynamic_demodulator(struct clause *c)
{
struct literal *l;
struct term *alpha, *beta;
int wt_left, wt_right;
l = ith_literal(c, 1);
alpha = l->atom->farg->argval;
beta = l->atom->farg->narg->argval;
if (TP_BIT(l->atom->bits, ORIENTED_EQ_BIT)) {
if (Flags[LRPO].val)
return(1);
else if (var_subset(beta, alpha)) {
if (Flags[DYNAMIC_DEMOD_ALL].val)
return(1);
else {
wt_left = weight(alpha, Weight_terms_index);
wt_right = weight(beta, Weight_terms_index);
if (wt_right <= Parms[DYNAMIC_DEMOD_RHS].val &&
wt_left - wt_right >= Parms[DYNAMIC_DEMOD_DEPTH].val)
return(1);
}
}
}
if (!Flags[DYNAMIC_DEMOD_LEX_DEP].val)
return(0);
else if (Flags[LRPO].val) {
if (var_subset(beta, alpha) && !term_ident(alpha, beta))
return(2);
else
return(0);
}
else {
if (!Flags[DYNAMIC_DEMOD_ALL].val)
return(0);
else if (term_ident_x_vars(alpha, beta) && !term_ident(alpha, beta))
return(2);
else
return(0);
}
} /* dynamic_demodulator */
/*************
*
* new_demod(c, demod_flag)
*
* Make an equality unit into a demodulator.
* It has already been checked (in order_equalities) if
* alpha > beta. (Don't flip or back demodulate.)
*
* If demod_flag == 2, make it lex-dependent.
*
* If back_demod is set, set SCRATCH_BIT in the atom so that
* post_process knows to back demodulate.
*
* Return the new demodulator.
*
*************/
struct clause *new_demod(struct clause *c,
int demod_flag)
{
struct clause *d;
struct int_ptr *ip0, *ip1;
Stats[NEW_DEMODS]++;
d = cl_copy(c);
cl_integrate(d);
if (demod_flag == 2)
ith_literal(d,1)->atom->varnum = LEX_DEP_DEMOD;
if (Flags[BACK_DEMOD].val) {
struct term *atom;
atom = ith_literal(c,1)->atom;
SET_BIT(atom->bits, SCRATCH_BIT);
}
ip0 = get_int_ptr(); ip0->i = NEW_DEMOD_RULE;
ip1 = get_int_ptr(); ip1->i = c->id;
d->parents = ip0; ip0->next = ip1;
if (Flags[DEMOD_LINEAR].val == 0) {
if (Demod_imd == NULL)
Demod_imd = get_imd_tree();
imd_insert(d, Demod_imd);
}
append_cl(Demodulators, d);
return(d);
} /* new_demod */
./otter/foreign.c 0000744 0002044 0001012 00000024201 11120534443 012242 0 ustar beeson /*
* foreign.c -- routines for interface to user-supplied evaluable functions
*
*/
#include "header.h"
/*************
*
* foo
*
*************/
long foo(long int l,
double d,
char *s)
{
printf("enter foo with args: %ld %f %s.\n", l, d, s);
return (long) (l+d); // cast added by Beeson 7/23/02
} /* foo */
/*************
*
* user_test_long
*
*************/
long user_test_long(long int l,
double d,
int b,
char *s,
struct term *t)
{
printf("enter user_test_long: %ld %f %d %s ", l, d, b, s);
p_term(t);
return(l+3);
} /* user_test_long */
/*************
*
* user_test_double
*
*************/
double user_test_double(long int l,
double d,
int b,
char *s,
struct term *t)
{
printf("enter user_test_double: %ld %f %d %s ", l, d, b, s);
p_term(t);
return(d+3.0);
} /* user_test_double */
/*************
*
* user_test_bool
*
*************/
int user_test_bool(long int l,
double d,
int b,
char *s,
struct term *t)
{
printf("enter user_test_bool: %ld %f %d %s ", l, d, b, s);
p_term(t);
return(!b);
} /* user_test_bool */
/*************
*
* user_test_string
*
*************/
char *user_test_string(long int l,
double d,
int b,
char *s,
struct term *t)
{
printf("enter user_test_string: %ld %f %d %s ", l, d, b, s);
p_term(t);
return("\"Returned string\"");
} /* user_test_string */
/*************
*
* user_test_term
*
*************/
struct term *user_test_term(long int l,
double d,
int b,
char *s,
struct term *t)
{
struct term *t1;
printf("enter user_test_term: %ld %f %d %s ", l, d, b, s);
p_term(t);
t1 = get_term(); t1->type = NAME; t1->sym_num = str_to_sn("new_term", 0);
return(t1);
} /* user_test_term */
/*************
*
* declare_user_functions()
*
*************/
void declare_user_functions(void)
{
struct sym_ent *se;
struct user_function *p;
/* Here is an example of how to declare a function.
START OF TEMPLATE (note that arity is specified twice)
se = insert_sym("$FOO_BAR", 5); se->eval_code = FOO_BAR_FUNC;
p = &(User_functions[FOO_BAR_FUNC]);
p->arity = 5;
p->arg_types[0] = LONG_TYPE;
p->arg_types[1] = DOUBLE_TYPE;
p->arg_types[2] = BOOL_TYPE;
p->arg_types[3] = STRING_TYPE;
p->arg_types[4] = TERM_TYPE;
p->result_type = LONG_TYPE;
END OF TEMPLATE
*/
/********************************/
se = insert_sym("$FOO", 3); se->eval_code = FOO_FUNC;
p = &(User_functions[FOO_FUNC]);
p->arity = 3;
p->arg_types[0] = LONG_TYPE;
p->arg_types[1] = DOUBLE_TYPE;
p->arg_types[2] = STRING_TYPE;
p->result_type = LONG_TYPE;
/********************************/
se = insert_sym("$TEST_LONG", 5); se->eval_code = TEST_LONG_FUNC;
p = &(User_functions[TEST_LONG_FUNC]);
p->arity = 5;
p->arg_types[0] = LONG_TYPE;
p->arg_types[1] = DOUBLE_TYPE;
p->arg_types[2] = BOOL_TYPE;
p->arg_types[3] = STRING_TYPE;
p->arg_types[4] = TERM_TYPE;
p->result_type = LONG_TYPE;
/********************************/
se = insert_sym("$TEST_DOUBLE", 5); se->eval_code = TEST_DOUBLE_FUNC;
p = &(User_functions[TEST_DOUBLE_FUNC]);
p->arity = 5;
p->arg_types[0] = LONG_TYPE;
p->arg_types[1] = DOUBLE_TYPE;
p->arg_types[2] = BOOL_TYPE;
p->arg_types[3] = STRING_TYPE;
p->arg_types[4] = TERM_TYPE;
p->result_type = DOUBLE_TYPE;
/********************************/
se = insert_sym("$TEST_BOOL", 5); se->eval_code = TEST_BOOL_FUNC;
p = &(User_functions[TEST_BOOL_FUNC]);
p->arity = 5;
p->arg_types[0] = LONG_TYPE;
p->arg_types[1] = DOUBLE_TYPE;
p->arg_types[2] = BOOL_TYPE;
p->arg_types[3] = STRING_TYPE;
p->arg_types[4] = TERM_TYPE;
p->result_type = BOOL_TYPE;
/********************************/
se = insert_sym("$TEST_STRING", 5); se->eval_code = TEST_STRING_FUNC;
p = &(User_functions[TEST_STRING_FUNC]);
p->arity = 5;
p->arg_types[0] = LONG_TYPE;
p->arg_types[1] = DOUBLE_TYPE;
p->arg_types[2] = BOOL_TYPE;
p->arg_types[3] = STRING_TYPE;
p->arg_types[4] = TERM_TYPE;
p->result_type = STRING_TYPE;
/********************************/
se = insert_sym("$TEST_TERM", 5); se->eval_code = TEST_TERM_FUNC;
p = &(User_functions[TEST_TERM_FUNC]);
p->arity = 5;
p->arg_types[0] = LONG_TYPE;
p->arg_types[1] = DOUBLE_TYPE;
p->arg_types[2] = BOOL_TYPE;
p->arg_types[3] = STRING_TYPE;
p->arg_types[4] = TERM_TYPE;
p->result_type = TERM_TYPE;
/********************************/
} /* declare_user_functions */
/*************
*
* int get_args_for_user_function
*
*************/
int get_args_for_user_function(struct term *t,
int op_code,
long int *long_args,
double *double_args,
int *bool_args,
char **string_args,
struct term **term_args)
{
int i;
long l;
double d;
struct rel *r;
struct term *ti;
struct user_function *p;
char *s;
p = &(User_functions[op_code]);
for (r = t->farg, i=0; r; r = r->narg, i++);
if (i != p->arity) {
abend("get_args, bad arity.");
}
for (r = t->farg, i=0; r; r = r->narg, i++) {
ti = r->argval;
switch (p->arg_types[i]) {
case LONG_TYPE:
if (ti->type != NAME)
return(0);
else if (!str_long(sn_to_str(ti->sym_num), &l))
return(0);
else
long_args[i] = l;
break;
case DOUBLE_TYPE:
if (ti->type != NAME)
return(0);
else if (!str_double(sn_to_str(ti->sym_num), &d))
return(0);
else
double_args[i] = d;
break;
case BOOL_TYPE:
if (ti->type != NAME)
return(0);
else {
s = sn_to_str(ti->sym_num);
if (str_ident(s,"$T"))
bool_args[i] = 1;
else if (str_ident(s,"$F"))
bool_args[i] = 0;
else
return(0);
}
break;
case STRING_TYPE:
if (ti->type != NAME)
return(0);
else
string_args[i] = sn_to_str(ti->sym_num);
break;
case TERM_TYPE:
term_args[i] = ti;
break;
default:
abend("get_args, bad arg type.");
}
}
return(1);
} /* get_args_for_user_function */
/*************
*
* long_to_term -- Build a constant (NAME) term corresp. to a C long.
*
*************/
struct term *long_to_term(long int i)
{
struct term *t;
char s[MAX_NAME];
t = get_term();
t->type = NAME;
long_str(i, s);
t->sym_num = str_to_sn(s, 0);
return(t);
} /* long_to_term */
/*************
*
* double_to_term -- Build a constant (NAME) term corresp. to a C double.
*
*************/
struct term *double_to_term(double d)
{
struct term *t;
char s[MAX_NAME];
t = get_term();
t->type = NAME;
double_str(d, s);
t->sym_num = str_to_sn(s, 0);
return(t);
} /* double_to_term */
/*************
*
* bool_to_term -- Build a constant (NAME) term corresp. to a C boolean.
*
*************/
struct term *bool_to_term(int i)
{
struct term *t;
t = get_term();
t->type = NAME;
t->sym_num = str_to_sn(i ? "$T" : "$F", 0);
return(t);
} /* bool_to_term */
/*************
*
* string_to_term -- Build a constant (NAME) term corresp. to a string.
*
*************/
struct term *string_to_term(char *s)
{
struct term *t;
t = get_term();
t->type = NAME;
t->sym_num = str_to_sn(s, 0);
return(t);
} /* string_to_term */
/*************
*
* evaluate_user_function
*
*************/
struct term *evaluate_user_function(struct term *t,
int op_code)
{
long long_args[MAX_USER_ARGS];
double double_args[MAX_USER_ARGS];
int bool_args[MAX_USER_ARGS];
char *string_args[MAX_USER_ARGS];
struct term *term_args[MAX_USER_ARGS];
long l;
double d;
int b;
char *s;
struct term *t1;
if (!get_args_for_user_function(t, op_code, long_args, double_args,
bool_args, string_args, term_args))
return(NULL); /* arg types wrong, so do nothing */
else {
switch (op_code) {
/* Here is an example of how to call your function. This example
takes one arg of each type. The call for a function taking
two doubles and returning a double would be
d = foo_bar(double_args[0],double_args[1]);
The routines to translate the C result to an Otter term are
long_to_term, double_to_term, bool_to_term, and string_to_term.
START OF TEMPLATE
case FOO_BAR_FUNC:
l = foo_bar(long_args[0],
double_args[1],
bool_args[2],
string_args[3],
term_args[4]);
return(long_to_term(l));
END OF TEMPLATE
*/
/******************************/
case FOO_FUNC:
l = foo(long_args[0],
double_args[1],
string_args[2]);
return(long_to_term(l));
/******************************/
case TEST_LONG_FUNC:
l = user_test_long(long_args[0],
double_args[1],
bool_args[2],
string_args[3],
term_args[4]);
return(long_to_term(l));
/******************************/
case TEST_DOUBLE_FUNC:
d = user_test_double(long_args[0],
double_args[1],
bool_args[2],
string_args[3],
term_args[4]);
return(double_to_term(d));
/******************************/
case TEST_BOOL_FUNC:
b = user_test_bool(long_args[0],
double_args[1],
bool_args[2],
string_args[3],
term_args[4]);
return(bool_to_term(b));
/******************************/
case TEST_STRING_FUNC:
s = user_test_string(long_args[0],
double_args[1],
bool_args[2],
string_args[3],
term_args[4]);
return(string_to_term(s));
/******************************/
case TEST_TERM_FUNC:
t1 = user_test_term(long_args[0],
double_args[1],
bool_args[2],
string_args[3],
term_args[4]);
return(t1);
/******************************/
default:
abend("evaluate_user_function, bad code.");
}
return(NULL); /* to quiet lint */
}
} /* evaluate_user_function */
./otter/foreign.h 0000744 0002044 0001012 00000007772 11120534443 012265 0 ustar beeson /*
* foreign.h -- header file for user-defined foreign functions
*
*/
/*
HOW TO WRITE YOUR OWN C ROUTINE WHICH CAN BE
CALLED TO DEMODULATE A TERM DURING OTTER'S DEMODULATION
The Otter types don't correspond exactly to the C types. In Otter, the
types, except `term', are all constants (in the theorem-proving sense),
and in C, the types are what you would expect them to be.
TYPES:
- long In C and in Otter, a long integer.
- double In C, a double; in Otter, a double surrounded by double quotes.
- bool In C, an int; in Otter, $T or $F.
- string In C, a pointer to a string; in Otter, any constant.
- term An Otter term.
To include a new function, you have to (1) declare the function,
argument types, and result type, (2) insert a call to your function in
the Otter code, (3) write your C routine, and (4) remake Otter.
The only Otter files you need to change are foreign.h and foreign.c.
When Otter is demodulating and comes across a 'call' to your function,
it will first check the argument types. If they are incorrect (for
example a variable is not instantiated) the term will not be
rewritten; if the arguments are OK, your C routine will be called, and
the result of your C routine will be made into an appropriate Otter
term which is the result of the rewriting step.
(Don't forget that many times you can avoid having to do all of
this by just writing your function with demodulators and using
existing built in functions. For example, if you need the
max of two doubles, you can just use the demodulator
float_max(x,y) = $IF($FGT(x,y), x, y). For other examples of
programming with demodulators, see eval.in in the Otter test suite.
See file demod.c, routine dollar_contract, for the current set
of evaluable functions.)
STEP-BY-STEP INSTRUCTIONS
0. Say you want to write a function foo that takes
a long, a double, and a string as arguments and produces a long, i.e.,
long foo(long n, double x, char *s)
The Otter-language name must start with $, say $FOO, and you
will be evaluating Otter terms like $FOO(32, "-4.5e-10", flag32)
1. To declare the function and its types,
(A) In the file foreign.h, #define a symbol, which will be used
as an index into a table (see FOO_FUNC in foreign.h).
(B) In file foreign.c, in routine declare_user_functions, declare
the function and its types (look for FOO_FUNC in foreign.c).
The types are LONG_TYPE, DOUBLE_TYPE, BOOL_TYPE, STRING_TYPE,
and TERM_TYPE.
2. In file foreign.c, in routine evaluate_user_function, insert a call
to your function and a call to translate the result to an Otter
term (look for FOO_FUNC in foreign.c). The routines to translate
C types to otter terms are long_to_term, double_to_term, bool_to_term,
and string_to_term. See foreign.c for examples.
3. Write your C routine. I have inserted the test routines into
foreign.c, but you may wish to organize yours into separate
files. (If your routines involve TERM_TYPE, you must
#include "header.h".)
4. Remake Otter; foreign.c is the only Otter file that will need
to be recompiled.
5. Test your new function by using the input file foreign.in.
*/
#define MAX_USER_ARGS 20 /* maximum arity for user-defined C functions */
#define LONG_TYPE 1 /* types for user-defined C functions */
#define DOUBLE_TYPE 2
#define BOOL_TYPE 3
#define STRING_TYPE 4
#define TERM_TYPE 5
struct user_function { /* entry in table of user-defined functions */
int arity;
int arg_types[MAX_USER_ARGS];
int result_type;
};
#define MAX_USER_FUNCTIONS 100 /* size of table */
/* indexes into table of user-defined functions */
#define FOO_FUNC 1
#define TEST_LONG_FUNC 2
#define TEST_DOUBLE_FUNC 3
#define TEST_BOOL_FUNC 4
#define TEST_STRING_FUNC 5
#define TEST_TERM_FUNC 6
./otter/formula.c 0000744 0002044 0001012 00000212167 11120534443 012270 0 ustar beeson /*
* formula.c
*
* This file has routines to input and output quantified formulas and
* to convert them to lists of clauses (Skolemization and CNF translation).
*
*/
#include "header.h"
static int Sk_func_num, Sk_const_num; /* for creating new skolem symbols */
/*************
*
* print_formula(fp, t) -- print a formula to a file.
*
*************/
void print_formula(FILE *fp,
struct formula *f)
{
#if 1
struct term *t;
t = formula_to_term(f);
t = term_fixup_2(t);
print_term(fp, t);
zap_term(t);
#else
char op[MAX_NAME];
struct formula *f1;
if (f == NULL)
fprintf(fp, "(nil)");
else if (f->type == ATOM_FORM) {
print_term(fp, f->t);
}
else if (f->type == NOT_FORM) {
fprintf(fp, "-");
print_formula(fp, f->first_child);
}
else if (f->type == AND_FORM && f->first_child == NULL)
fprintf(fp, "TRUE");
else if (f->type == OR_FORM && f->first_child == NULL)
fprintf(fp, "FALSE");
else if (f->type == QUANT_FORM) {
fprintf(fp, "(");
if (f->quant_type == ALL_QUANT)
fprintf(fp, "all ");
else
fprintf(fp, "exists ");
print_term(fp, f->t);
fprintf(fp, " ");
print_formula(fp, f->first_child);
fprintf(fp, ")");
}
else {
if (f->type == AND_FORM)
strcpy(op, "& ");
else if (f->type == OR_FORM)
strcpy(op, "| ");
else if (f->type == IMP_FORM)
strcpy(op, "-> ");
else if (f->type == IFF_FORM)
strcpy(op, "<-> ");
else
op[0] = '\0';
fprintf(fp, "(");
for (f1 = f->first_child; f1; f1 = f1->next) {
print_formula(fp, f1);
if (f1->next)
fprintf(fp, " %s", op);
}
fprintf(fp, ")");
}
#endif
} /* print_formula */
/*************
*
* p_formula(f) -- print formula to standard output
*
*************/
void p_formula(struct formula *f)
{
print_formula(stdout, f);
} /* p_formula */
/*************
*
* struct term *formula_args_to_term(f, type)
*
* Conver list of formulas to right-associated term.
* Works for AND_FORM, OR_FORM, IMP_FORM, IFF_FORM.
*
*************/
static struct term *formula_args_to_term(struct formula *f,
int type)
{
struct term *t, *t1, *t2;
struct rel *r1, *r2;
if (!f) { /* empty disjunction or conjunction */
t = get_term();
t->type = NAME;
if (type == AND_FORM)
t->sym_num = str_to_sn("TRUE", 0);
else
t->sym_num = str_to_sn("FALSE", 0);
}
else {
t1 = formula_to_term(f);
if (f->next) {
t2 = formula_args_to_term(f->next, type);
t = get_term(); r1 = get_rel(); r2 = get_rel();
t->farg = r1; r1->narg = r2;
r1->argval = t1; r2->argval = t2;
t->type = COMPLEX;
switch (type) {
case AND_FORM: t->sym_num = str_to_sn("&", 2); break;
case OR_FORM: t->sym_num = str_to_sn("|", 2); break;
case IMP_FORM: t->sym_num = str_to_sn("->", 2); break;
case IFF_FORM: t->sym_num = str_to_sn("<->", 2); break;
}
}
else
t = t1;
}
return(t);
} /* formula_args_to_term */
/*************
*
* struct term *formula_to_term(f)
*
*************/
struct term *formula_to_term(struct formula *f)
{
struct term *t, *t1;
struct rel *r, *r1, *prev_r;
int prev_q, i;
struct formula *f1;
switch (f->type) {
case ATOM_FORM: t = copy_term(f->t); break;
case IMP_FORM:
case IFF_FORM:
case AND_FORM:
case OR_FORM: t = formula_args_to_term(f->first_child, f->type); break;
case NOT_FORM:
t = get_term();
t->type = COMPLEX;
t->sym_num = str_to_sn("-", 1);
r = get_rel();
t->farg = r;
r->argval = formula_to_term(f->first_child);
break;
case QUANT_FORM:
t = get_term();
t->type = COMPLEX;
i = 0; prev_q = MAX_INT; prev_r = NULL;
for (f1 = f; f1->type == QUANT_FORM; f1 = f1->first_child) {
if (f1->quant_type != prev_q) {
i++;
t1 = get_term();
r1 = get_rel();
r1->argval = t1;
if (!t->farg)
t->farg = r1;
else
prev_r->narg = r1;
prev_r = r1;
t1->type = NAME;
if (f1->quant_type == ALL_QUANT)
t1->sym_num = str_to_sn("all", 0);
else
t1->sym_num = str_to_sn("exists", 0);
prev_q = f1->quant_type;
}
i++;
r1 = get_rel();
r1->argval = copy_term(f1->t); /* variable */
prev_r->narg = r1;
prev_r = r1;
}
t->sym_num = str_to_sn("$Quantified", i);
r1 = get_rel();
prev_r->narg = r1;
r1->argval = formula_to_term(f1);
break;
default: t = NULL;
}
return(t);
} /* formula_to_term */
/*************
*
* struct formula *term_to_formula(t)
*
*************/
struct formula *term_to_formula(struct term *t)
{
struct formula *f1, *f2, *f3;
struct rel *r;
int type;
type = MAX_INT;
if (is_symbol(t, "&", 2))
type = AND_FORM;
else if (is_symbol(t, "|", 2))
type = OR_FORM;
else if (is_symbol(t, "->", 2))
type = IMP_FORM;
else if (is_symbol(t, "<->", 2))
type = IFF_FORM;
if (type != MAX_INT) {
f1 = get_formula();
f1->type = type;
f1->first_child = term_to_formula(t->farg->argval);
f1->first_child->next = term_to_formula(t->farg->narg->argval);
if (type == AND_FORM || type == OR_FORM)
flatten_top(f1);
}
else if (is_symbol(t, "-", 1)) {
f1 = get_formula();
f1->type = NOT_FORM;
f1->first_child = term_to_formula(t->farg->argval);
}
else if (t->type == COMPLEX &&
str_ident(sn_to_str(t->sym_num), "$Quantified")) {
f3 = f1 = NULL;
for (r = t->farg; r->narg; r = r->narg) {
if (is_symbol(r->argval, "all", 0))
type = ALL_QUANT;
else if (is_symbol(r->argval, "exists", 0))
type = EXISTS_QUANT;
else {
f2 = get_formula();
if (f3)
f3->first_child = f2;
else
f1 = f2;
f2->type = QUANT_FORM;
f2->quant_type = type;
f2->t = copy_term(r->argval);
f3 = f2;
}
}
f3->first_child = term_to_formula(r->argval);
}
else { /* assume atomic formula */
f1 = get_formula();
f1->type = ATOM_FORM;
f1->t = copy_term(t);
}
return(f1);
} /* term_to_formula */
/*************
*
* struct formula *read_formula(fp, rcp) -- read a formula from a file
*
* The return code *rcp:
* 0 - an error was encountered and reported; NULL is returned.
* 1 - OK; if EOF was found instead of a formula, NULL is returned.
*
*************/
struct formula *read_formula(FILE *fp,
int *rcp)
{
int rc;
struct formula *f;
struct term *t;
t = read_term(fp, &rc);
if (!rc) {
*rcp = 0;
return(NULL);
}
else if (t == NULL) {
*rcp = 1;
return(NULL);
}
else {
if (contains_skolem_symbol(t)) {
fprintf(stdout, "\nERROR, input formula contains Skolem symbol:\n");
print_term(stdout, t); printf(".\n\n");
zap_term(t);
*rcp = 0;
return(NULL);
}
else {
f = term_to_formula(t);
zap_term(t);
*rcp = 1;
return(f);
}
}
} /* read_formula */
/*************
*
* struct term_ptr *read_formula_list(file_ptr, errors_ptr)
*
* Read and return a list of quantified formulas.
*
* The list must be terminated either with the term `end_of_list.'
* or with an actual EOF.
* Set errors_ptr to point to the number of errors found.
*
*************/
struct formula_ptr *read_formula_list(FILE *fp,
int *ep)
{
struct formula_ptr *p1, *p2, *p3;
struct formula *f;
int rc;
Internal_flags[REALLY_CHECK_ARITY] = 1;
*ep = 0;
p3 = NULL;
p2 = NULL;
f = read_formula(fp, &rc);
while (rc == 0) {
(*ep)++;
f = read_formula(fp, &rc);
}
/* keep going until f == NULL || f is end marker */
while (f && !(f->type == ATOM_FORM &&
is_symbol(f->t, "end_of_list", 0))) {
p1 = get_formula_ptr();
p1->f = f;
if (p2 == NULL)
p3 = p1;
else
p2->next = p1;
p2 = p1;
f = read_formula(fp, &rc);
while (rc == 0) {
(*ep)++;
f = read_formula(fp, &rc);
}
}
if (f != NULL)
zap_formula(f);
Internal_flags[REALLY_CHECK_ARITY] = 0;
return(p3);
} /* read_formula_list */
/*************
*
* print_formula_list(file_ptr, term_ptr)
*
* Print a list of quantified formulas.
*
* The list is printed with periods after each quantified formula, and
* the list is terminated with `end_of_list.' so that it can
* be read with read_formula_list.
*
*************/
void print_formula_list(FILE *fp,
struct formula_ptr *p)
{
while (p != NULL) {
print_formula(fp, p->f); fprintf(fp, ".\n");
p = p->next;
}
fprintf(fp, "end_of_list.\n");
} /* print_formula_list */
/*************
*
* struct formula *copy_formula(f)
*
* Copy a formula. copy_term is used to copy atoms and quantified vars.
*
*************/
struct formula *copy_formula(struct formula *f)
{
struct formula *f_new, *f_sub, *f_prev, *f3;
f_new = get_formula();
f_new->type = f->type;
if (f->type == ATOM_FORM)
f_new->t = copy_term(f->t);
else if (f->type == QUANT_FORM) {
f_new->quant_type = f->quant_type;
f_new->t = copy_term(f->t);
f_new->first_child = copy_formula(f->first_child);
}
else {
f_prev = NULL;
for (f_sub = f->first_child; f_sub; f_sub = f_sub->next) {
f3 = copy_formula(f_sub);
if (f_prev)
f_prev->next = f3;
else
f_new->first_child = f3;
f_prev = f3;
}
}
return(f_new);
} /* copy_formula */
/*************
*
* void zap_formula(f)
*
* Free a formula and all of its subformulas and subterms.
*
*************/
void zap_formula(struct formula *f)
{
struct formula *f1, *f2;
if (f->type == ATOM_FORM)
zap_term(f->t);
else {
f1 = f->first_child;
while (f1) {
f2 = f1;
f1 = f1->next;
zap_formula(f2);
}
if (f->type == QUANT_FORM)
zap_term(f->t);
}
free_formula(f);
} /* zap_formula */
/*************
*
* struct formula *negate_formula(f)
*
* f is changed to its negation. (Do not move negation signs inward.)
*
*************/
struct formula *negate_formula(struct formula *f)
{
struct formula *f1, *f_save;
/* save next pointer */
f_save = f->next; f->next = NULL;
if (f->type == NOT_FORM) {
f1 = f->first_child;
free_formula(f);
}
else {
f1 = get_formula();
f1->type = NOT_FORM;
f1->first_child = f;
}
/* restore next pointer */
f1->next = f_save;
return(f1);
} /* negate_formula */
/*************
*
* struct formula *nnf(f)
*
* f is changed into its negation normal form (NNF) by removing
* -> and <-> and moving negation signs all the way in.
*
* (A <-> B) (not negated) rewrites to ((-a | b) & (-b | a)).
* -(A <-> B) rewrites to ((a | b) & (-a | -b)).
*
* because conjunctions are favored.
*
*************/
struct formula *nnf(struct formula *f)
{
struct formula *f1, *f2, *next, *prev, *fn;
switch (f->type) {
case ATOM_FORM:
return(f); /* f is atomic */
case IFF_FORM:
f1 = get_formula();
f1->type = AND_FORM;
f1->first_child = f;
f1->next = f->next;
f2 = copy_formula(f);
f2->type = OR_FORM;
f2->first_child->next = negate_formula(f2->first_child->next);
f->type = OR_FORM;
f->first_child = negate_formula(f->first_child);
f->next = f2;
return(nnf(f1));
case IMP_FORM:
f->type = OR_FORM;
f->first_child = negate_formula(f->first_child);
return(nnf(f));
case QUANT_FORM:
f->first_child = nnf(f->first_child);
return(f);
case AND_FORM:
case OR_FORM:
prev = NULL;
f1 = f->first_child;
while(f1) {
next = f1->next; f1->next = NULL;
f2 = nnf(f1);
if (prev)
prev->next = f2;
else
f->first_child = f2;
prev = f2;
f1 = next;
}
return(f);
case NOT_FORM:
fn = f->first_child;
switch (fn->type) {
case ATOM_FORM:
return(f);
case IFF_FORM:
f2 = copy_formula(fn);
f2->type = OR_FORM;
fn->type = OR_FORM;
f2->first_child = negate_formula(f2->first_child);
f2->first_child->next = negate_formula(f2->first_child->next);
fn->next = f2;
f->type = AND_FORM;
f->first_child = fn;
return(nnf(f));
case IMP_FORM:
fn->type = OR_FORM;
fn->first_child = negate_formula(fn->first_child);
return(nnf(f));
case QUANT_FORM:
fn->quant_type = (fn->quant_type == ALL_QUANT ? EXISTS_QUANT : ALL_QUANT);
fn->first_child = nnf(negate_formula(fn->first_child));
fn->next = f->next;
free_formula(f);
return(fn);
case AND_FORM:
case OR_FORM:
prev = NULL;
f1 = fn->first_child;
while(f1) {
next = f1->next; f1->next = NULL;
f2 = nnf(negate_formula(f1));
if (prev)
prev->next = f2;
else
fn->first_child = f2;
prev = f2;
f1 = next;
}
fn->type = (fn->type == AND_FORM ? OR_FORM : AND_FORM);
fn->next = f->next;
free_formula(f);
return(fn);
case NOT_FORM: /* double negation */
f1 = fn->first_child;
f1->next = f->next;
free_formula(f);
free_formula(fn);
return(nnf(f1));
}
}
return(NULL); /* ERROR */
} /* nnf */
/*************
*
* static void rename_free_formula(f, old_sn, new_sn)
*
* Rename free occurrences of old_sn in NAMEs to new_sn.
* Recall that variables in formulas are really NAMEs.
*
*************/
static void rename_free_formula(struct formula *f,
int old_sn,
int new_sn)
{
struct formula *f1;
if (f->type == ATOM_FORM)
subst_sn_term(old_sn, f->t, new_sn, NAME);
else if (f->type == QUANT_FORM) {
if (old_sn != f->t->sym_num)
rename_free_formula(f->first_child, old_sn, new_sn);
}
else {
for (f1 = f->first_child; f1; f1 = f1->next)
rename_free_formula(f1, old_sn, new_sn);
}
} /* rename_free_formula */
/*************
*
* static struct formula *skolem(f, vars)
*
* Skolemize f w.r.t universally quantified vars.
* Called by skolemize.
*
*************/
static struct formula *skolem(struct formula *f,
struct term *vars)
{
struct formula *f1, *f2, *prev, *next;
struct rel *end, *r2;
int sn;
if (f->type == NOT_FORM && f->first_child->type != ATOM_FORM) {
printf("ERROR, skolem gets negated non-atom: ");
print_formula(stdout, f);
printf("\n");
}
else if (f->type == IMP_FORM || f->type == IFF_FORM) {
printf("ERROR, skolem gets: ");
print_formula(stdout, f);
printf("\n");
}
else if (f->type == AND_FORM || f->type == OR_FORM) {
prev = NULL;
f1 = f->first_child;
while(f1) {
next = f1->next; f1->next = NULL;
f2 = skolem(f1, vars);
if (prev)
prev->next = f2;
else
f->first_child = f2;
prev = f2;
f1 = next;
}
}
else if (f->type == QUANT_FORM) {
if (f->quant_type == ALL_QUANT) {
if (occurs_in(f->t, vars)) {
/*
rename current variable, because we are already in the
scope of a universally quantified var with that name.
*/
sn = new_var_name();
rename_free_formula(f->first_child, f->t->sym_num, sn);
f->t->sym_num = sn;
}
r2 = get_rel();
r2->argval = f->t;
/* Install variable at end of vars. */
for (end = vars->farg; end && end->narg; end = end->narg);
if (end)
end->narg = r2;
else
vars->farg = r2;
f->first_child = skolem(f->first_child, vars);
/* Remove variable from vars. */
free_rel(r2);
if (end)
end->narg = NULL;
else
vars->farg = NULL;
}
else { /* existential quantifier */
/*
must skolemize subformula first to avoid problem in
Ax...Ey...Ex F(x,y).
*/
f->first_child = skolem(f->first_child, vars);
gen_sk_sym(vars); /* fills in sym_num and assigns type */
subst_free_formula(f->t, f->first_child, vars);
vars->type = COMPLEX; /* so that occurs_in above works */
f1 = f->first_child;
zap_term(f->t);
free_formula(f);
f = f1;
}
}
return(f);
} /* skolem */
/*************
*
* struct formula *skolemize(f) -- Skolemize a formula
*
* This routine assumes that f is in negation normal form.
* The existential quantifiers are deleted.
*
*************/
struct formula *skolemize(struct formula *f)
{
struct term *vars;
vars = get_term();
vars->type = COMPLEX;
f = skolem(f, vars);
free_term(vars);
return(f);
} /* skolemize */
/*************
*
* struct formula *anti_skolemize(f) -- Anti-Skolemize a formula
*
* The dual of skolemize: universal quantifiers are removed.
*
*************/
struct formula *anti_skolemize(struct formula *f)
{
return(nnf(negate_formula(skolemize(nnf(negate_formula(f))))));
} /* anti_skolemize */
/*************
*
* static void subst_free_term(var, t, sk)
*
* Substitute free occurrences of var in t with copies of sk.
*
*************/
static void subst_free_term(struct term *var,
struct term *t,
struct term *sk)
{
struct rel *r;
if (t->type != COMPLEX)
return;
else {
r = t->farg;
for (r = t->farg; r; r = r->narg) {
if (term_ident(var, r->argval)) {
zap_term(r->argval);
r->argval = copy_term(sk);
}
else
subst_free_term(var, r->argval, sk);
}
}
} /* subst_free_term */
/*************
*
* void subst_free_formula(var, f, sk)
* Substitute free occurrences of var in f with copies of sk.
*
*************/
void subst_free_formula(struct term *var,
struct formula *f,
struct term *sk)
{
struct formula *f1;
if (f->type == ATOM_FORM)
subst_free_term(var, f->t, sk);
else if (f->type == QUANT_FORM) {
if (!term_ident(f->t, var))
subst_free_formula(var, f->first_child, sk);
}
else {
for (f1 = f->first_child; f1; f1 = f1->next)
subst_free_formula(var, f1, sk);
}
} /* subst_free_formula */
/*************
*
* gen_sk_sym(t) -- generate a fresh skolem symbol for term t.
*
* Assign type field as well as sym_num field to term t.
*
*************/
void gen_sk_sym(struct term *t)
{
int arity;
struct rel *r;
char s1[MAX_NAME], s2[MAX_NAME];
arity = 0;
r = t->farg;
while (r != NULL) {
arity++;
r = r->narg;
}
if (arity == 0) {
t->type = NAME;
int_str(++Sk_const_num, s1);
cat_str("$c", s1, s2);
}
else {
t->type = COMPLEX;
int_str(++Sk_func_num, s1);
cat_str("$f", s1, s2);
}
t->sym_num = str_to_sn(s2, arity);
mark_as_skolem(t->sym_num);
} /* gen_sk_sym */
/*************
*
* int skolem_symbol(sn) -- Is sn the symbol number of a skolem symbol?
*
* Check if it is "$cn" or "$fn" for integer n.
* Do not check the skolem flag in the symbol node.
*
*************/
int skolem_symbol(int sn)
{
char *s;
int dummy;
s = sn_to_str(sn);
return(*s == '$' &&
(*(s+1) == 'c' || *(s+1) == 'f') &&
str_int(s+2,&dummy));
} /* skolem_symbol */
/*************
*
* int contains_skolem_symbol(t)
*
* Check if any of the NAMEs in t are "$cn" or "$fn", for integer n.
*
*************/
int contains_skolem_symbol(struct term *t)
{
struct rel *r;
if (t->type == VARIABLE)
return(0);
else if (t->type == NAME)
return(skolem_symbol(t->sym_num));
else { /* COMPLEX */
if (skolem_symbol(t->sym_num))
return(1);
else {
for (r = t->farg; r; r = r->narg)
if (contains_skolem_symbol(r->argval))
return(1);
return(0);
}
}
} /* contains_skolem_symbol */
/*************
*
* int new_var_name() -- return a sym_num for a new VARIABLE symbol
*
* Check and make sure that the new symbol does not occur in the
* symbol table.
*
*************/
int new_var_name(void)
{
char s1[MAX_NAME], s2[MAX_NAME];
static int var_num;
char c[2];
c[0] = (Flags[PROLOG_STYLE_VARIABLES].val ? 'X' : 'x');
c[1] = '\0';
int_str(++var_num, s1);
cat_str(c, s1, s2);
while (in_sym_tab(s2)) {
int_str(++var_num, s1);
cat_str(c, s1, s2);
}
return(str_to_sn(s2, 0));
} /* new_var_name */
/*************
*
* int new_functor_name(arity) -- return a sym_num for a new symbol.
*
* Check and make sure that the new symbol does not occur in the symbol table.
*
*************/
int new_functor_name(int arity)
{
char s1[MAX_NAME], s2[MAX_NAME];
static int functor_num;
int_str(++functor_num, s1);
cat_str("k", s1, s2);
while (in_sym_tab(s2)) {
int_str(++functor_num, s1);
cat_str("k", s1, s2);
}
return(str_to_sn(s2, arity));
} /* new_functor_name */
/*************
*
* static void uq_all(f, vars) -- called by unique_all
*
*************/
static void uq_all(struct formula *f,
struct term *vars)
{
struct rel *r1;
struct formula *f1;
int sn;
switch (f->type) {
case ATOM_FORM: break;
case NOT_FORM:
case AND_FORM:
case OR_FORM:
for (f1 = f->first_child; f1; f1 = f1->next)
uq_all(f1, vars);
break;
case QUANT_FORM:
if (occurs_in(f->t, vars)) {
/*
rename current variable, because already have
a quantified var with that name.
*/
sn = new_var_name();
rename_free_formula(f->first_child, f->t->sym_num, sn);
f->t->sym_num = sn;
}
else {
r1 = get_rel();
r1->argval = f->t;
r1->narg = vars->farg;
vars->farg = r1;
}
/* recursive call on quantified formula */
uq_all(f->first_child, vars);
break;
}
} /* uq_all */
/*************
*
* void unique_all(f) -- make all universally quantified variables unique
*
* It is assumed that f is in negation normal form and is Skolemized (no
* existential quantifiers).
*
*************/
void unique_all(struct formula *f)
{
struct term *vars;
struct rel *r1, *r2;
vars = get_term();
vars->type = COMPLEX;
uq_all(f, vars);
r1 = vars->farg;
while (r1 != NULL) {
r2 = r1;
r1 = r1->narg;
free_rel(r2);
}
free_term(vars);
} /* unique_all */
/*************
*
* static mark_free_var_term(v, t) -- mark free occurrences of v in t
*
* Each free NAME in t with sym_num == v->sym_num is marked as
* a VARIABLE by setting the type field to VARIABLE.
*
*************/
static void mark_free_var_term(struct term *v,
struct term *t)
{
struct rel *r;
struct term *t1;
if (t->type != COMPLEX)
return;
else {
r = t->farg;
for (r = t->farg; r; r = r->narg) {
t1 = r->argval;
if (t1->type == NAME) {
if (t1->sym_num == v->sym_num) {
t1->type = VARIABLE;
/*
bug fix 31-Jan-91. WWM. The following line was added
because term-ident (called if simplify_fol) does not
check sym_num field for vars. It is a trick.
*/
t1->varnum = t1->sym_num;
}
}
else
mark_free_var_term(v, t1);
}
}
} /* mark_free_var_term */
/*************
*
* static void mark_free_var_formula(v, f)
*
*************/
static void mark_free_var_formula(struct term *v,
struct formula *f)
{
struct formula *f1;
if (f->type == ATOM_FORM)
mark_free_var_term(v, f->t);
else {
for (f1 = f->first_child; f1; f1 = f1->next)
mark_free_var_formula(v, f1);
}
} /* mark_free_var_formula */
/*************
*
* struct term *zap_quant(f)
*
* Delete quantifiers and mark quantified variables.
*
* It is assumed that f is skolemized nnf with unique universally
* quantified variables. For each universal quantifier,
* mark all occurrences of the quantified variable by setting the type field
* to VARIABLE, then delete the quantifier.
* All QUANT_FORM nodes are deleted as well.
*
*************/
struct formula *zap_quant(struct formula *f)
{
struct formula *f1, *f2, *prev, *next;
switch (f->type) {
case ATOM_FORM:
break;
case NOT_FORM:
case AND_FORM:
case OR_FORM:
prev = NULL;
f1 = f->first_child;
while(f1) {
next = f1->next; f1->next = NULL;
f2 = zap_quant(f1);
if (prev)
prev->next = f2;
else
f->first_child = f2;
prev = f2;
f1 = next;
}
break;
case QUANT_FORM:
mark_free_var_formula(f->t, f->first_child);
f1 = f->first_child;
f1->next = f->next;
free_formula(f);
f = zap_quant(f1);
break;
}
return(f);
} /* zap_quant */
/*************
*
* static void flatten_top_2(f, start, end_p) -- called by flatten_top.
*
*************/
static void flatten_top_2(struct formula *f,
struct formula *start,
struct formula **end_p)
{
struct formula *f1, *f2;
f1 = f->first_child;
while (f1) {
f2 = f1;
f1 = f1->next;
if (f2->type == f->type) {
flatten_top_2(f2, start, end_p);
free_formula(f2);
}
else {
if (*end_p)
(*end_p)->next = f2;
else
start->first_child = f2;
*end_p = f2;
}
}
} /* flatten_top_2 */
/*************
*
* void flatten_top(f) -- flatten conjunctions or disjunctions
*
* The top part of f is flattened. Subtrees below
* a node of the oppposite type are not flattened. For example, in
* (a or (b and (c or (d or e)))), the formula (c or (d or e)) is never
* flattened.
*
*************/
void flatten_top(struct formula *f)
{
struct formula *end;
if (f->type == AND_FORM || f->type == OR_FORM) {
end = NULL;
flatten_top_2(f, f, &end);
if (end)
end->next = NULL;
else
f->first_child = NULL;
}
} /* flatten_top */
/*************
*
* static struct formula *distribute(f) -- distribute OR over AND.
*
* f is an OR node whose subterms are in CNF. This routine returns
* a CNF of f.
*
*************/
static struct formula *distribute(struct formula *f)
{
struct formula *f_new, *f1, *f2, *f3, *f4, *f_prev, *f_save;
int i, j;
f_save = f->next; f->next = NULL;
if (f->type != OR_FORM)
return(f);
else {
flatten_top(f);
if (Flags[SIMPLIFY_FOL].val) {
conflict_tautology(f);
f = subsume_disj(f);
}
if (f->type != OR_FORM)
return(f);
else {
/* find first AND subformula */
i = 1;
f_prev = NULL;
for (f1 = f->first_child; f1 && f1->type != AND_FORM; f1 = f1->next) {
i++;
f_prev = f1;
}
if (f1 == NULL)
return(f); /* nothing to distribute */
else {
/* unhook AND */
if (f_prev)
f_prev->next = f1->next;
else
f->first_child = f1->next;
f2 = f1->first_child;
f_new = f1;
f_prev = NULL;
while (f2) {
f3 = f2->next;
if (f3)
f1 = copy_formula(f);
else
f1 = f;
if (i == 1) {
f2->next = f1->first_child;
f1->first_child = f2;
}
else {
j = 1;
for (f4 = f1->first_child; j < i-1; f4 = f4->next)
j++;
f2->next = f4->next;
f4->next = f2;
}
f1 = distribute(f1);
if (f_prev)
f_prev->next = f1;
else
f_new->first_child = f1;
f_prev = f1;
f2 = f3;
}
f_new->next = f_save;
flatten_top(f_new);
if (Flags[SIMPLIFY_FOL].val) {
conflict_tautology(f_new);
f_new = subsume_conj(f_new);
}
return(f_new);
}
}
}
} /* distribute */
/*************
*
* struct formula *cnf(f) -- convert nnf f to conjunctive normal form.
*
*************/
struct formula *cnf(struct formula *f)
{
struct formula *f1, *f2, *f_prev, *f_next, *f_save;
f_save = f->next; f->next = NULL;
if (f->type == AND_FORM || f->type == OR_FORM) {
/* first convert subterms to CNF */
f_prev = NULL;
f1 = f->first_child;
while(f1) {
f_next = f1->next;
f2 = cnf(f1);
if (f_prev)
f_prev->next = f2;
else
f->first_child = f2;
f_prev = f2;
f1 = f_next;
}
if (f->type == AND_FORM) {
flatten_top(f);
if (Flags[SIMPLIFY_FOL].val) {
conflict_tautology(f);
f = subsume_conj(f);
}
}
else
f = distribute(f); /* flatten and simplify in distribute */
}
f->next = f_save;
return(f);
} /* cnf */
/*************
*
* struct formula *dnf(f) -- convert f to disjunctive normal form.
*
*************/
struct formula *dnf(struct formula *f)
{
return(nnf(negate_formula(cnf(nnf(negate_formula(f))))));
} /* dnf */
/*************
*
* static void rename_syms_term(t, fr)
*
* Called from rename_syms_formula.
*
*************/
static void rename_syms_term(struct term *t,
struct formula *fr)
{
struct rel *r;
int sn;
if (t->type == NAME) {
if (var_name(sn_to_str(t->sym_num))) {
fprintf(stderr,"\nWARNING, the following formula has constant '%s', whose\nname may be misinterpreted by the user as a variable.\n", sn_to_str(t->sym_num));
print_formula(stderr, fr); fprintf(stderr, "\n");
#if 0 /* replaced 18 June 91 WWM */
sn = new_functor_name(0); /* with arity 0 */
subst_sn_formula(t->sym_num, fr, sn, NAME);
#endif
}
}
else if (t->type == VARIABLE) {
if (!var_name(sn_to_str(t->sym_num))) {
sn = new_var_name();
subst_sn_formula(t->sym_num, fr, sn, VARIABLE);
}
}
else {
r = t->farg;
while(r != NULL) {
rename_syms_term(r->argval, fr);
r = r->narg;
}
}
} /* rename_syms_term */
/*************
*
* void rename_syms_formula(f, fr)
*
* Rename VARIABLEs so that they conform to the rule for clauses.
*
*************/
void rename_syms_formula(struct formula *f,
struct formula *fr)
{
struct formula *f1;
if (f->type == ATOM_FORM)
rename_syms_term(f->t, fr);
else {
for (f1 = f->first_child; f1; f1 = f1->next)
rename_syms_formula(f1, fr);
}
} /* rename_syms_formula */
/*************
*
* void subst_sn_term(old_sn, t, new_sn, type)
*
*************/
void subst_sn_term(int old_sn,
struct term *t,
int new_sn,
int type)
{
struct rel *r;
if (t->type == NAME) {
if (type == NAME && t->sym_num == old_sn)
t->sym_num = new_sn;
}
else if (t->type == VARIABLE) {
if (type == VARIABLE && t->sym_num == old_sn)
t->sym_num = new_sn;
}
else {
for (r = t->farg; r; r = r->narg)
subst_sn_term(old_sn, r->argval, new_sn, type);
}
} /* subst_sn_term */
/*************
*
* void subst_sn_formula(old_sn, f, new_sn, type)
*
*************/
void subst_sn_formula(int old_sn,
struct formula *f,
int new_sn,
int type)
{
struct formula *f1;
if (f->type == ATOM_FORM)
subst_sn_term(old_sn, f->t, new_sn, type);
else {
for (f1 = f->first_child; f1; f1 = f1->next)
subst_sn_formula(old_sn, f1, new_sn, type);
}
} /* subst_sn_formula */
/*************
*
* int gen_subsume_prop(c, d) -- does c gen_subsume_prop d?
*
* This is generalized propositional subsumption. If given
* quantified formulas, they are treated as atoms (formula_ident
* determines outcome).
*
*************/
int gen_subsume_prop(struct formula *c,
struct formula *d)
{
struct formula *f;
/* The order of these tests is important. For example, if */
/* the last test is moved to the front, c=(p|q) will not */
/* subsume d=(p|q|r). */
if (c->type == OR_FORM) { /* return(each c_i subsumes d) */
for (f = c->first_child; f && gen_subsume_prop(f, d); f = f->next);
return(f == NULL);
}
else if (d->type == AND_FORM) { /* return(c subsumes each d_i) */
for (f = d->first_child; f && gen_subsume_prop(c, f); f = f->next);
return(f == NULL);
}
else if (c->type == AND_FORM) { /* return(one c_i subsumes d) */
for (f = c->first_child; f && ! gen_subsume_prop(f, d); f = f->next);
return(f != NULL);
}
else if (d->type == OR_FORM) { /* return(c subsumes one d_i) */
for (f = d->first_child; f && ! gen_subsume_prop(c, f); f = f->next);
return(f != NULL);
}
else /* c and d are NOT, ATOM, or QUANT */
return(formula_ident(c, d));
} /* gen_subsume_prop */
/*************
*
* struct formula *subsume_conj(c)
*
* Given a conjunction, discard weaker conjuncts.
* This is like deleting subsumed clauses.
* The result is equivalent.
*
*************/
struct formula *subsume_conj(struct formula *c)
{
struct formula *f1, *f2, *f3, *prev;
if (c->type != AND_FORM || c->first_child == NULL)
return(c);
else {
/* start with second child */
prev = c->first_child;
f1 = prev->next;
while (f1) {
/* first do forward subsumption of part already processed */
f2 = c->first_child;
while (f2 != f1 && ! gen_subsume_prop(f2, f1))
f2 = f2->next;;
if (f2 != f1) { /* delete f1 */
prev->next = f1->next;
zap_formula(f1);
f1 = prev;
}
else {
/* back subsumption on part already processed */
/* delete all previous that are subsumed by f1 */
f2 = c->first_child;
prev = NULL;
while (f2 != f1) {
if (gen_subsume_prop(f1, f2)) {
if (prev == NULL)
c->first_child = f2->next;
else
prev->next = f2->next;
f3 = f2;
f2 = f2->next;
zap_formula(f3);
}
else {
prev = f2;
f2 = f2->next;
}
}
}
prev = f1;
f1 = f1->next;
}
/* If just one child left, replace input formula with child. */
if (c->first_child->next == NULL) {
f1 = c->first_child;
f1->next = c->next;
free_formula(c);
return(f1);
}
else
return(c);
}
} /* subsume_conj */
/*************
*
* struct formula *subsume_disj(c)
*
* Given a disjunction, discard stronger disjuncts.
* The result is equivalent. This the dual of
* normal clause subsumption.
*
*************/
struct formula *subsume_disj(struct formula *c)
{
struct formula *f1, *f2, *f3, *prev;
if (c->type != OR_FORM || c->first_child == NULL)
return(c);
else {
/* start with second child */
prev = c->first_child;
f1 = prev->next;
while (f1) {
/* delete f1 if it subsumes anything previous */
f2 = c->first_child;
while (f2 != f1 && ! gen_subsume_prop(f1, f2))
f2 = f2->next;;
if (f2 != f1) { /* delete f1 */
prev->next = f1->next;
zap_formula(f1);
f1 = prev;
}
else {
/* delete all previous that subsume f1 */
f2 = c->first_child;
prev = NULL;
while (f2 != f1) {
if (gen_subsume_prop(f2, f1)) {
if (prev == NULL)
c->first_child = f2->next;
else
prev->next = f2->next;
f3 = f2;
f2 = f2->next;
zap_formula(f3);
}
else {
prev = f2;
f2 = f2->next;
}
}
}
prev = f1;
f1 = f1->next;
}
/* If just one child left, replace input formula with child. */
if (c->first_child->next == NULL) {
f1 = c->first_child;
f1->next = c->next;
free_formula(c);
return(f1);
}
else
return(c);
}
} /* subsume_disj */
/*************
*
* int formula_ident(f1, f2)
*
* Do not permute ANDs, ORs, or like quantifiers.
*
*************/
int formula_ident(struct formula *f,
struct formula *g)
{
struct formula *f1, *g1;
if (f->type != g->type)
return(0);
else if (f->type == ATOM_FORM)
return(term_ident(f->t, g->t));
else if (f->type == QUANT_FORM) {
if (f->quant_type != g->quant_type || ! term_ident(f->t, g->t))
return(0);
else
return(formula_ident(f->first_child, g->first_child));
}
else { /* AND_FORM || OR_FORM || IFF_FORM || IMP_FORM || NOT_FORM */
for (f1 = f->first_child, g1 = g->first_child; f1 && g1;
f1 = f1->next, g1 = g1->next)
if (! formula_ident(f1, g1))
return(0);
return(f1 == NULL && g1 == NULL);
}
} /* formula_ident */
/*************
*
* conflict_tautology(f)
*
* If f is an AND_FORM, reduce to empty disjunction (FALSE)
* if conflicting conjuncts occur.
* If f is an OR_FORM, reduce to empty conjunction (TRUE)
* if conflicting disjuncts occur.
*
*************/
void conflict_tautology(struct formula *f)
{
struct formula *f1, *f2, *a1, *a2;
int f1_sign, f2_sign;
/* note possible return from inner loop */
if (f->type == AND_FORM || f->type == OR_FORM) {
for (f1 = f->first_child; f1; f1 = f1->next) {
f1_sign = (f1->type != NOT_FORM);
a1 = (f1_sign ? f1 : f1->first_child);
for (f2 = f1->next; f2; f2 = f2->next) {
f2_sign = (f2->type != NOT_FORM);
if (f1_sign != f2_sign) {
a2 = (f2_sign ? f2 : f2->first_child);
if (formula_ident(a1, a2)) {
f1 = f->first_child;
while (f1) {
f2 = f1;
f1 = f1->next;
zap_formula(f2);
}
f->first_child = NULL;
/* switch types */
f->type = (f->type == AND_FORM ? OR_FORM : AND_FORM);
return;
}
}
}
}
}
} /* conflict_tautology */
/*************
*
* void ts_and_fs(f)
*
* Simplify if f is AND or OR, and an immediate subformula is
* TRUE (empty AND) or FALSE (empty OR).
*
*************/
void ts_and_fs(struct formula *f)
{
struct formula *f1, *f2, *f_prev;
int f_type;
f_type = f->type;
if (f_type != AND_FORM && f_type != OR_FORM)
return;
else {
f_prev = NULL;
f1 = f->first_child;
while (f1 != NULL) {
if ((f1->type == AND_FORM || f1->type == OR_FORM) &&
f1->first_child == NULL) {
if (f_type != f1->type) {
f->type = f1->type;
f1 = f->first_child;
while (f1) {
f2 = f1;
f1 = f1->next;
zap_formula(f2);
}
f->first_child = NULL;
/* switch types */
f->type = (f->type == AND_FORM ? OR_FORM : AND_FORM);
return;
}
else {
if (f_prev == NULL)
f->first_child = f1->next;
else
f_prev->next = f1->next;
f2 = f1;
f1 = f1->next;
free_formula(f2);
}
}
else {
f_prev = f1;
f1 = f1->next;
}
}
}
} /* ts_and_fs */
/*************
*
* static int set_vars_term_2(term, sn)
*
* Called from set_vars_cl_2.
*
*************/
static int set_vars_term_2(struct term *t,
int *sn)
{
struct rel *r;
int i, rc;
if (t->type == COMPLEX) {
r = t->farg;
rc = 1;
while (rc && r != NULL) {
rc = set_vars_term_2(r->argval, sn);
r = r->narg;
}
return(rc);
}
else if (t->type == NAME)
return(1);
else {
i = 0;
while (i < MAX_VARS && sn[i] != -1 && sn[i] != t->sym_num)
i++;
if (i == MAX_VARS)
return(0);
else {
if (sn[i] == -1)
sn[i] = t->sym_num;
t->varnum = i;
/* include following to destroy input variable names
t->sym_num = 0;
*/
return(1);
}
}
} /* set_vars_term_2 */
/*************
*
* static int set_vars_cl_2(cl) -- give variables var_nums
*
* This is different from set_vars_cl bacause variables have
* already been identified: type==VARIABLE. Identical
* variables have same sym_num.
*
*************/
static int set_vars_cl_2(struct clause *cl)
{
struct literal *lit;
int sn[MAX_VARS];
int i;
for (i=0; i<MAX_VARS; i++)
sn[i] = -1;
lit = cl->first_lit;
while (lit != NULL) {
if (set_vars_term_2(lit->atom, sn))
lit = lit->next_lit;
else
return(0);
}
return(1);
} /* set_vars_cl_2 */
/*************
*
* static struct clause *disj_to_clause(f)
*
*************/
static struct clause *disj_to_clause(struct formula *f)
{
struct formula *f1, *f2;
struct clause *c;
struct literal *lit, *prev;
c = get_clause();
if (f->type == ATOM_FORM || f->type == NOT_FORM) {
lit = get_literal();
lit->sign = (f->type == ATOM_FORM);
lit->atom = (f->type == ATOM_FORM ? f->t : f->first_child->t);
if (f->type == NOT_FORM)
free_formula(f->first_child);
free_formula(f);
lit->atom->occ.lit = lit;
lit->container = c;
mark_literal(lit); /* atoms have varnum > 0 */
c->first_lit = lit;
}
else { /* OR_FORM */
prev = NULL;
f1 = f->first_child;
while (f1) {
f2 = f1;
f1 = f1->next;
lit = get_literal();
lit->sign = (f2->type == ATOM_FORM);
lit->atom = (f2->type == ATOM_FORM ? f2->t : f2->first_child->t);
if (f2->type == NOT_FORM)
free_formula(f2->first_child);
free_formula(f2);
lit->atom->occ.lit = lit;
lit->container = c;
mark_literal(lit); /* atoms have varnum > 0 */
if (prev == NULL)
c->first_lit = lit;
else
prev->next_lit = lit;
prev = lit;
}
free_formula(f);
}
if (set_vars_cl_2(c) == 0) {
char s[500];
print_clause(stdout, c);
sprintf(s, "disj_to_clause, too many variables in clause, max is %d.", MAX_VARS);
abend(s);
}
cl_merge(c); /* merge identical literals */
return(c);
} /* disj_to_clause */
/*************
*
* static struct list *cnf_to_list(f)
*
* Convert a CNF formula to a list of clauses.
* This includes assigning variable numbers to the varnum fileds of VARIABLES.
* An ABEND occurs if a clause has too many variables.
*
*************/
static struct list *cnf_to_list(struct formula *f)
{
struct formula *f1, *f2;
struct list *l;
struct clause *c;
l = get_list();
if (f->type != AND_FORM) {
c = disj_to_clause(f);
append_cl(l, c);
}
else { /* OR_FORM || ATOM_FORM || NOT_FORM */
f1 = f->first_child;
while (f1) {
f2 = f1;
f1 = f1->next;
c = disj_to_clause(f2); /* zaps f2 */
append_cl(l, c);
}
free_formula(f);
}
return(l);
} /* cnf_to_list */
/*************
*
* struct list *clausify(f) -- Skolem/CNF tranformation.
*
* Convert a quantified formula to a list of clauses.
*
*************/
struct list *clausify(struct formula *f)
{
struct list *l;
f = nnf(f);
f = skolemize(f);
unique_all(f);
f = zap_quant(f);
rename_syms_formula(f, f);
f = cnf(f);
l = cnf_to_list(f);
return(l);
} /* clausify */
/*************
*
* struct list *clausify_formula_list(fp)
*
* Clausify a set of formulas, and return a list of clauses.
* The set of formulas is deallocated.
*
*************/
struct list *clausify_formula_list(struct formula_ptr *fp)
{
struct list *l, *l1;
struct formula_ptr *fp1, *fp2;
l = get_list();
fp1 = fp;
while (fp1 != NULL) {
if (Flags[FORMULA_HISTORY].val) {
int f_id;
struct clause *c = get_clause();
struct literal *lit = get_literal();
struct int_ptr *ip1 = get_int_ptr();
struct int_ptr *ip2 = get_int_ptr();
c->first_lit = lit;
lit->sign = 1;
lit->atom = formula_to_term(fp1->f);
assign_cl_id(c);
f_id = c->id;
hide_clause(c);
l1 = clausify(fp1->f);
for (c = l1->first_cl; c; c = c->next_cl) {
ip1 = get_int_ptr();
ip2 = get_int_ptr();
c->parents = ip1;
ip1->next = ip2;
ip1->i = CLAUSIFY_RULE;
ip2->i = f_id;
}
}
else
l1 = clausify(fp1->f);
append_lists(l, l1);
fp2 = fp1;
fp1 = fp1->next;
free_formula_ptr(fp2);
}
return(l);
} /* clausify_formula_list */
/*************
*
* struct formula *negation_inward(f)
*
* If f is a negated conjunction, disjunction, or quantified formula,
* move the negation sign in one level.
*
*************/
struct formula *negation_inward(struct formula *f)
{
struct formula *f1, *f2, *prev, *f_save;
if (f->type == NOT_FORM) {
f1 = f->first_child;
if (f1->type == AND_FORM || f1->type == OR_FORM || f1->type == QUANT_FORM) {
f_save = f->next;
f = negate_formula(f);
f->next = f_save;
if (f->type == AND_FORM || f->type == OR_FORM) {
/* apply DeMorgan's laws */
f->type = (f->type == AND_FORM ? OR_FORM : AND_FORM);
f1 = f->first_child;
prev = NULL;
while (f1) {
f2 = f1;
f1 = f1->next;
f2 = negate_formula(f2);
if (prev)
prev->next = f2;
else
f->first_child = f2;
prev = f2;
}
}
else { /* QUANT_FORM */
f->quant_type = (f->quant_type==ALL_QUANT ? EXISTS_QUANT : ALL_QUANT);
f->first_child = negate_formula(f->first_child);
}
}
}
return(f);
} /* negation_inward */
/*************
*
* struct formula *expand_imp(f)
*
* Change (P -> Q) to (-P | Q).
*
*************/
struct formula *expand_imp(struct formula *f)
{
if (f->type != IMP_FORM)
return(f);
else {
f->type = OR_FORM;
f->first_child = negate_formula(f->first_child);
return(f);
}
} /* expand_imp */
/*************
*
* struct formula *iff_to_conj(f)
*
* Change (P <-> Q) to ((P -> Q) & (Q -> P)).
*
*************/
struct formula *iff_to_conj(struct formula *f)
{
struct formula *f1, *f2, *f_save;
if (f->type != IFF_FORM)
return(f);
else {
f_save = f->next;
f1 = copy_formula(f);
f->type = f1->type = IMP_FORM;
/* flip args of f1 */
f2 = f1->first_child;
f1->first_child = f2->next;
f2->next = NULL;
f1->first_child->next = f2;
f->next = f1;
f1->next = NULL;
/* build conjunction */
f2 = get_formula();
f2->type = AND_FORM;
f2->first_child = f;
f2->next = f_save;
return(f2);
}
} /* iff_to_conj */
/*************
*
* struct formula *iff_to_disj(f)
*
* Change (P <-> Q) to ((P & Q) | (-Q & -P)).
*
*************/
struct formula *iff_to_disj(struct formula *f)
{
struct formula *f1, *f2, *f_save;
if (f->type != IFF_FORM)
return(f);
else {
f_save = f->next;
f1 = copy_formula(f);
f->type = f1->type = AND_FORM;
f1->first_child->next = negate_formula(f1->first_child->next);
f1->first_child = negate_formula(f1->first_child);
f->next = f1;
f1->next = NULL;
/* build disjunction */
f2 = get_formula();
f2->type = OR_FORM;
f2->first_child = f;
f2->next = f_save;
return(f2);
}
} /* iff_to_disj */
/*************
*
* struct formula *nnf_cnf(f)
*
*************/
struct formula *nnf_cnf(struct formula *f)
{
return(cnf(nnf(f)));
} /* nnf_cnf */
/*************
*
* struct formula *nnf_dnf(f)
*
*************/
struct formula *nnf_dnf(struct formula *f)
{
return(dnf(nnf(f)));
} /* nnf_dnf */
/*************
*
* struct formula *nnf_skolemize(f)
*
*************/
struct formula *nnf_skolemize(struct formula *f)
{
return(skolemize(nnf(f)));
} /* nnf_skolemize */
/*************
*
* struct formula *clausify_formed(f)
*
*************/
struct formula *clausify_formed(struct formula *f)
{
f = nnf(f);
f = skolemize(f);
unique_all(f);
f = zap_quant(f);
rename_syms_formula(f, f);
f = cnf(f);
return(f);
} /* clausify_formed */
/*************
*
* rms_conflict_tautology(f)
*
* If f is an AND_FORM, reduce to empty disjunction (FALSE)
* if conflicting conjuncts occur.
* If f is an OR_FORM, reduce to empty conjunction (TRUE)
* if conflicting disjuncts occur.
*
*************/
void rms_conflict_tautology(struct formula *f)
{
struct formula *f1, *f2;
/* note possible return from inner loop */
if (f->type == AND_FORM) {
for (f1 = f->first_child; f1; f1 = f1->next) {
for (f2 = f1->next; f2; f2 = f2->next) {
if (gen_conflict(f1, f2)) {
f1 = f->first_child;
while (f1) {
f2 = f1;
f1 = f1->next;
zap_formula(f2);
}
f->first_child = NULL;
/* switch types */
f->type = OR_FORM;
return;
}
}
}
}
else if (f->type == OR_FORM) {
for (f1 = f->first_child; f1; f1 = f1->next) {
for (f2 = f1->next; f2; f2 = f2->next) {
if (gen_tautology(f1, f2)) {
f1 = f->first_child;
while (f1) {
f2 = f1;
f1 = f1->next;
zap_formula(f2);
}
f->first_child = NULL;
/* switch types */
f->type = AND_FORM;
return;
}
}
}
}
} /* rms_conflict_tautology */
/*************
*
* struct formula *rms_subsume_conj(c)
*
* Given a conjunction, discard weaker conjuncts.
* This is like deleting subsumed clauses.
* The result is equivalent.
*
*************/
struct formula *rms_subsume_conj(struct formula *c)
{
struct formula *f1, *f2, *f3, *prev;
if (c->type != AND_FORM || c->first_child == NULL)
return(c);
else {
/* start with second child */
prev = c->first_child;
f1 = prev->next;
while (f1) {
/* first do forward subsumption of part already processed */
f2 = c->first_child;
while (f2 != f1 && ! gen_subsume(f2, f1))
f2 = f2->next;;
if (f2 != f1) { /* delete f1 */
prev->next = f1->next;
zap_formula(f1);
f1 = prev;
}
else {
/* back subsumption on part already processed */
/* delete all previous that are subsumed by f1 */
f2 = c->first_child;
prev = NULL;
while (f2 != f1) {
if (gen_subsume(f1, f2)) {
if (prev == NULL)
c->first_child = f2->next;
else
prev->next = f2->next;
f3 = f2;
f2 = f2->next;
zap_formula(f3);
}
else {
prev = f2;
f2 = f2->next;
}
}
}
prev = f1;
f1 = f1->next;
}
/* If just one child left, replace input formula with child. */
if (c->first_child->next == NULL) {
f1 = c->first_child;
f1->next = c->next;
free_formula(c);
return(f1);
}
else
return(c);
}
} /* rms_subsume_conj */
/*************
*
* struct formula *rms_subsume_disj(c)
*
* Given a disjunction, discard stronger disjuncts.
* The result is equivalent. This the dual of
* normal clause subsumption.
*
*************/
struct formula *rms_subsume_disj(struct formula *c)
{
struct formula *f1, *f2, *f3, *prev;
if (c->type != OR_FORM || c->first_child == NULL)
return(c);
else {
/* start with second child */
prev = c->first_child;
f1 = prev->next;
while (f1) {
/* delete f1 if it subsumes anything previous */
f2 = c->first_child;
while (f2 != f1 && ! gen_subsume(f1, f2))
f2 = f2->next;;
if (f2 != f1) { /* delete f1 */
prev->next = f1->next;
zap_formula(f1);
f1 = prev;
}
else {
/* delete all previous that subsume f1 */
f2 = c->first_child;
prev = NULL;
while (f2 != f1) {
if (gen_subsume(f2, f1)) {
if (prev == NULL)
c->first_child = f2->next;
else
prev->next = f2->next;
f3 = f2;
f2 = f2->next;
zap_formula(f3);
}
else {
prev = f2;
f2 = f2->next;
}
}
}
prev = f1;
f1 = f1->next;
}
/* If just one child left, replace input formula with child. */
if (c->first_child->next == NULL) {
f1 = c->first_child;
f1->next = c->next;
free_formula(c);
return(f1);
}
else
return(c);
}
} /* rms_subsume_disj */
/*************
*
* int free_occurrence(v, f)
*
* Does v have a free occurrence in f?
*
*************/
int free_occurrence(struct term *v,
struct formula *f)
{
struct formula *f1;
int free;
switch (f->type) {
case ATOM_FORM:
free = occurs_in(v, f->t);
break;
case NOT_FORM:
case AND_FORM:
case OR_FORM:
case IMP_FORM:
case IFF_FORM:
for (free = 0, f1 = f->first_child; f1 && ! free; f1 = f1->next)
free = free_occurrence(v, f1);
break;
case QUANT_FORM:
if (term_ident(v, f->t))
free = 0;
else
free = free_occurrence(v, f->first_child);
break;
default: free = 0;
}
return(free);
} /* free_occurrence */
/*************
*
* struct formula *rms_distribute_quants(f)
*
* f is universally quantified formula.
* Child is conjunction in RMS.
* Distribute quantifier to conjuncts.
* Return a RMS of f.
*
*************/
struct formula *rms_distribute_quants(struct formula *f_quant)
{
struct formula *f_conj, *f1, *f2, *f3;
f_conj = f_quant->first_child;
f3 = NULL;
f1 = f_conj->first_child;
while (f1) {
f2 = get_formula();
f2->type = QUANT_FORM;
f2->quant_type = ALL_QUANT;
f2->first_child = f1;
f2->t = copy_term(f_quant->t);
f1 = f1->next;
f2->first_child->next = NULL;
f2 = rms_quantifiers(f2); /* indirect recursive call */
if (f3)
f3->next = f2;
else
f_conj->first_child = f2;
f3 = f2;
}
zap_term(f_quant->t);
free_formula(f_quant);
flatten_top(f_conj);
rms_conflict_tautology(f_conj);
f_conj = rms_subsume_conj(f_conj);
return(f_conj);
} /* rms_distribute_quants */
/*************
*
* void separate_free(v, f, free, not_free)
*
*************/
static void separate_free(struct term *v,
struct formula *f,
struct formula **p_free,
struct formula **p_not_free)
{
struct formula *f1, *not_free, *f2, *f3, *prev;
not_free = f2 = f3 = prev = NULL;
f1 = f->first_child;
while (f1) {
f2 = f1;
f1 = f1->next;
if (!free_occurrence(v, f2)) {
f2->next = NULL;
if (not_free)
f3->next = f2;
else
not_free = f2;
f3 = f2;
if (prev == NULL)
f->first_child = f1;
else
prev->next = f1;
}
else
prev = f2;
}
if (f->first_child == NULL) {
*p_free = NULL;
free_formula(f);
}
else if (f->first_child->next == NULL) {
*p_free = f->first_child;
free_formula(f);
}
else
*p_free = f;
if (not_free == NULL)
*p_not_free = NULL;
else if (not_free->next == NULL)
*p_not_free = not_free;
else {
f1 = get_formula();
f1->type = OR_FORM;
f1->first_child = not_free;
*p_not_free = f1;
}
} /* separate_free */
/*************
*
* struct formula *rms_push_free(f)
*
* f is universally quantifierd formula.
* The child of f is a (simple) disjunction in RMS.
* Reduce scopes based on free variables.
* Result is in RMS, either a quantified formula or a disjunction.
*
*************/
struct formula *rms_push_free(struct formula *f)
{
struct formula *f2, *free, *not_free;
separate_free(f->t, f->first_child, &free, ¬_free);
if (!free) { /* var doesn't occur free in any subformula. */
abend("rms_push_free has extra quantifier.");
}
if (not_free) {
f->first_child = free;
f = rms_quantifiers(f);
f->next = NULL;
if (not_free->type == OR_FORM) {
/* Install f as last disjunct. */
for (f2 = not_free->first_child; f2->next; f2 = f2->next);
f2->next = f;
f2 = not_free;
}
else {
f2 = get_formula();
f2->type = OR_FORM;
f2->first_child = not_free;
not_free->next = f;
}
/* f2 is disjunction */
rms_conflict_tautology(f2);
f2 = rms_subsume_disj(f2);
return(f2);
}
else
return(f);
} /* rms_push_free */
/*************
*
* struct formula *rms_quantifiers(f)
*
* f is a quantified formula whose child is in RMS.
* This function returns a RMS of f.
*
*************/
struct formula *rms_quantifiers(struct formula *f)
{
struct formula *f1, *f2, *f_save;
int negate_flag;
f_save = f->next;
f->next = NULL;
if (!free_occurrence(f->t, f->first_child)) {
f1 = f->first_child;
zap_term(f->t);
free_formula(f);
f1->next = f_save;
return(f1);
}
if (f->quant_type == EXISTS_QUANT) {
f = nnf(negate_formula(f));
negate_flag = 1;
/* If f is an OR with and AND child, call rms to make conjunction. */
if (f->first_child->type == OR_FORM) {
for(f1 = f->first_child->first_child;
f1 && f1->type != AND_FORM;
f1 = f1->next);
if (f1)
f->first_child = rms(f->first_child);
}
}
else
negate_flag = 0;
/* Now, "all" is the quantifier, and child is RMS. */
if (f->first_child->type == AND_FORM)
f = rms_distribute_quants(f);
else if (f->first_child->type == OR_FORM)
f = rms_push_free(f);
/* else atomic or negated atomic, so do nothing */
/* f is now not necessarily QUANT_FORM. */
if (negate_flag) {
f = nnf(negate_formula(f));
if (f->type == QUANT_FORM)
f2 = f->first_child;
else
f2 = f;
/* If f2 is an OR with and AND child, call rms to make conjunction. */
if (f2->type == OR_FORM) {
for(f1 = f2->first_child;
f1 && f1->type != AND_FORM;
f1 = f1->next);
if (f1) {
if (f == f2)
f = rms(f2);
else
f->first_child = rms(f2);
}
}
}
f->next= f_save;
return(f);
} /* rms_quantifiers */
/*************
*
* static struct formula *rms_distribute(f) -- rms_distribute OR over AND.
*
* f is an OR node whose subterms are in Reduced MiniScope (RMS).
* This routine returns a RMS of f.
*
*************/
static struct formula *rms_distribute(struct formula *f)
{
struct formula *f_new, *f1, *f2, *f3, *f4, *f_prev, *f_save;
int i, j;
f_save = f->next; f->next = NULL;
if (f->type != OR_FORM)
return(f);
else {
flatten_top(f);
rms_conflict_tautology(f);
f = rms_subsume_disj(f);
if (f->type != OR_FORM)
return(f);
else {
/* find first AND subformula */
i = 1;
f_prev = NULL;
for (f1 = f->first_child; f1 && f1->type != AND_FORM; f1 = f1->next) {
i++;
f_prev = f1;
}
if (f1 == NULL)
return(f); /* nothing to rms_distribute */
else {
/* unhook AND */
if (f_prev)
f_prev->next = f1->next;
else
f->first_child = f1->next;
f2 = f1->first_child;
f_new = f1;
f_prev = NULL;
while (f2) {
f3 = f2->next;
if (f3)
f1 = copy_formula(f);
else
f1 = f;
if (i == 1) {
f2->next = f1->first_child;
f1->first_child = f2;
}
else {
j = 1;
for (f4 = f1->first_child; j < i-1; f4 = f4->next)
j++;
f2->next = f4->next;
f4->next = f2;
}
f1 = rms_distribute(f1);
if (f_prev)
f_prev->next = f1;
else
f_new->first_child = f1;
f_prev = f1;
f2 = f3;
}
f_new->next = f_save;
flatten_top(f_new);
rms_conflict_tautology(f_new);
f_new = rms_subsume_conj(f_new);
return(f_new);
}
}
}
} /* rms_distribute */
/*************
*
* struct formula *rms(f) -- convert f to Reduced MiniScope (RMS)
*
*************/
struct formula *rms(struct formula *f)
{
struct formula *f1, *f2, *f_prev, *f_next, *f_save;
f_save = f->next; f->next = NULL;
if (f->type == AND_FORM || f->type == OR_FORM) {
/* first convert subterms to RMS */
f_prev = NULL;
f1 = f->first_child;
while(f1) {
f_next = f1->next;
f2 = rms(f1);
if (f_prev)
f_prev->next = f2;
else
f->first_child = f2;
f_prev = f2;
f1 = f_next;
}
if (f->type == AND_FORM) {
flatten_top(f);
rms_conflict_tautology(f);
f = rms_subsume_conj(f);
}
else
f = rms_distribute(f); /* flatten and simplify in distribute */
}
else if (f->type == QUANT_FORM) {
f->first_child = rms(f->first_child);
f = rms_quantifiers(f);
}
/* else f is atomic or negated atomic, so do nothing; */
f->next = f_save;
return(f);
} /* rms */
/*************
*
* static void introduce_var_term(t, v, vnum)
*
*************/
static void introduce_var_term(struct term *t,
struct term *v,
int vnum)
{
struct rel *r;
switch (t->type) {
case NAME:
if (term_ident(t,v)) {
t->type = VARIABLE;
t->varnum = vnum;
t->sym_num = 0;
}
break;
case VARIABLE:
break;
case COMPLEX:
for (r = t->farg; r; r = r->narg)
introduce_var_term(r->argval, v, vnum);
break;
}
} /* introduce_var_term */
/*************
*
* static void introduce_var(f, t, vnum)
*
* In formula f, replace all free occurrences of t with a variable
* (set type to VARIABLE) with number vnum.
*
*************/
static void introduce_var(struct formula *f,
struct term *t,
int vnum)
{
struct formula *f1;
switch (f->type) {
case ATOM_FORM:
introduce_var_term(f->t, t, vnum);
break;
case AND_FORM:
case OR_FORM:
case NOT_FORM:
for (f1 = f->first_child; f1; f1 = f1->next)
introduce_var(f1, t, vnum);
break;
case QUANT_FORM:
if (!term_ident(t, f->t))
introduce_var(f->first_child, t, vnum);
break;
default:
abend("introduce_var, bad formula.");
}
} /* introduce_var */
/*************
*
* struct formula *renumber_unique(f, vnum)
*
* f is NNF, and all quantifiers are unique.
* This function renumbers variables, starting with *vnum_p and
* removes quantifiers.
*
*************/
struct formula *renumber_unique(struct formula *f,
int *vnum_p)
{
struct formula *f1, *f2, *f_prev, *f_next;
switch (f->type) {
case ATOM_FORM:
return(f);
case AND_FORM:
case OR_FORM:
case NOT_FORM:
f_prev = NULL;
f1 = f->first_child;
while(f1) {
f_next = f1->next;
f2 = renumber_unique(f1, vnum_p);
if (f_prev)
f_prev->next = f2;
else
f->first_child = f2;
f_prev = f2;
f1 = f_next;
}
return(f);
case QUANT_FORM:
f1 = f->first_child;
introduce_var(f1, f->t, *vnum_p);
(*vnum_p)++;
if (*vnum_p == MAX_VARS) {
abend("renumber_unique, too many vars.");
}
f1->next = f->next;
f->first_child = NULL;
zap_formula(f);
return(renumber_unique(f1, vnum_p));
}
abend("renumber_unique, bad formula.");
return(f); /* to quiet lint */
} /* renumber_unique */
/*************
*
* int gen_subsume_rec(c, cs, d, ds, tr_p) -- does c gen_subsume_rec d?
*
* This is generalized subsumption on quantified formulas. It is
* not as complete as the Prolog version, because there is no
* backtracking to try alternatives in cases 3 and 4 below.
*
*************/
int gen_subsume_rec(struct formula *c,
struct context *cs,
struct formula *d,
struct context *ds,
struct trail **tr_p)
{
struct formula *f;
/* The order of these tests is important. For example, if */
/* the last test is moved to the front, c=(p|q) will not */
/* subsume d=(p|q|r). */
if (c->type == OR_FORM) { /* return(each c_i subsumes d) */
for (f = c->first_child; f && gen_subsume_rec(f, cs, d, ds, tr_p); f = f->next);
return(f == NULL);
}
else if (d->type == AND_FORM) { /* return(c subsumes each d_i) */
for (f = d->first_child; f && gen_subsume_rec(c, cs, f, ds, tr_p); f = f->next);
return(f == NULL);
}
else if (c->type == AND_FORM) { /* return(one c_i subsumes d) */
for (f = c->first_child; f && ! gen_subsume_rec(f, cs, d, ds, tr_p); f = f->next);
return(f != NULL);
}
else if (d->type == OR_FORM) { /* return(c subsumes one d_i) */
for (f = d->first_child; f && ! gen_subsume_rec(c, cs, f, ds, tr_p); f = f->next);
return(f != NULL);
}
else if (c->type != d->type)
return(0);
else if (c->type == NOT_FORM)
return(unify(c->first_child->t, cs, d->first_child->t, ds, tr_p));
else /* both ATOMs */
return(unify(c->t, cs, d->t, ds, tr_p));
} /* gen_subsume_rec */
/*************
*
* int gen_subsume(c, d) -- generalized subsumption on RMS formulas.
*
* If 1 is returned, (c -> d) holds.
*
*************/
int gen_subsume(struct formula *c,
struct formula *d)
{
struct formula *c1, *d1;
int result, i;
struct context *cs, *ds;
struct trail *tr;
Sk_const_num = Sk_func_num = 0;
i = 6;
c1 = renumber_unique(skolemize(copy_formula(c)),&i);
i = 6;
d1 = renumber_unique(anti_skolemize(copy_formula(d)),&i);
cs = get_context();
ds = get_context();
tr = NULL;
result = gen_subsume_rec(c1, cs, d1, ds, &tr);
clear_subst_1(tr);
free_context(cs);
free_context(ds);
zap_formula(c1);
zap_formula(d1);
return(result);
} /* gen_subsume */
/*************
*
* int gen_conflict(c, d)
*
* Try to show (c & d) inconsistent by showing (c -> -d).
*
* If 1 is returned, (c & d) is inconsistent.
*
*************/
int gen_conflict(struct formula *c,
struct formula *d)
{
struct formula *c1, *d1;
int result, i;
struct context *cs, *ds;
struct trail *tr;
Sk_const_num = Sk_func_num = 0;
i = 6;
c1 = renumber_unique(skolemize(copy_formula(c)),&i);
i = 6;
/* can skip nnf of negate_formula, because anti-skolemize re-negates */
d1 = renumber_unique(anti_skolemize(negate_formula(copy_formula(d))),&i);
cs = get_context();
ds = get_context();
tr = NULL;
result = gen_subsume_rec(c1, cs, d1, ds, &tr);
clear_subst_1(tr);
free_context(cs);
free_context(ds);
zap_formula(c1);
zap_formula(d1);
return(result);
} /* gen_conflict */
/*************
*
* int gen_tautology(c, d)
*
* Try to show (c | d) a tautology by showing (-c -> d).
*
* If 1 is returned, (c | d) is a tautology.
*
*************/
int gen_tautology(struct formula *c,
struct formula *d)
{
struct formula *c1, *d1;
int result, i;
struct context *cs, *ds;
struct trail *tr;
Sk_const_num = Sk_func_num = 0;
i = 6;
c1 = renumber_unique(skolemize(nnf(negate_formula(copy_formula(c)))),&i);
i = 6;
d1 = renumber_unique(anti_skolemize(copy_formula(d)),&i);
cs = get_context();
ds = get_context();
tr = NULL;
result = gen_subsume_rec(c1, cs, d1, ds, &tr);
clear_subst_1(tr);
free_context(cs);
free_context(ds);
zap_formula(c1);
zap_formula(d1);
return(result);
} /* gen_tautology */
/*************
*
* struct formula *rms_cnf(f)
*
*************/
struct formula *rms_cnf(struct formula *f)
{
return(rms(nnf(f)));
} /* rms_cnf */
/*************
*
* struct formula *rms_dnf(f)
*
*************/
struct formula *rms_dnf(struct formula *f)
{
return(nnf(negate_formula(rms(nnf(negate_formula(f))))));
} /* rms_dnf */
/*************
*
* struct formula *push_free(f)
*
* f is universally quantifierd formula
* The child of f is a disjunction.
* Reduce scopes 1 level based on free variables.
* Result is either a quantified formula or a disjunction.
*
*************/
static struct formula *push_free(struct formula *f)
{
struct formula *f2, *free, *not_free;
separate_free(f->t, f->first_child, &free, ¬_free);
if (!free) { /* var doesn't occur free in any subformula. */
not_free->next = f->next;
free_term(f->t);
free_formula(f);
return(not_free);
}
else if (!not_free) /* var occurs free in all subformulas */
return(f);
else { /* at least one of each */
f->first_child = free;
f->next = NULL;
if (not_free->type == OR_FORM) {
/* Install f as last disjunct. */
for (f2 = not_free->first_child; f2->next; f2 = f2->next);
f2->next = f;
f2 = not_free;
}
else {
f2 = get_formula();
f2->type = OR_FORM;
f2->first_child = not_free;
not_free->next = f;
}
/* f2 is disjunction */
return(f2);
}
} /* push_free */
/*************
*
* struct formula *distribute_quantifier(f)
*
* If f is (all x (f1 & ...)) or (exists x (f1 | ...)),
* distribute the quantifier to the subformulas (and delete
* the quantifier if the subformula has no free occurrences
* of the variable.
*
*************/
struct formula *distribute_quantifier(struct formula *f)
{
struct formula *f1, *f2, *f3, *prev, *save_next;
if (f->type == QUANT_FORM) {
save_next = f->next;
f->next = NULL;
f1 = f->first_child;
if ((f->quant_type == ALL_QUANT && f1->type == AND_FORM) ||
(f->quant_type == EXISTS_QUANT && f1->type == OR_FORM)) {
for (f2=f1->first_child, prev=NULL; f2; prev=f2, f2=f2->next) {
if (free_occurrence(f->t, f2)) {
f3 = get_formula();
f3->type = QUANT_FORM;
f3->quant_type = f->quant_type;
f3->t = copy_term(f->t); /* variable */
f3->next = f2->next;
f3->first_child = f2;
f2->next = NULL;
if (prev)
prev->next = f3;
else
f1->first_child = f3;
f2 = f3;
}
}
free_term(f->t);
free_formula(f);
f = f1;
}
else if (f->quant_type == ALL_QUANT && f1->type == OR_FORM) {
f = push_free(f);
}
else if (f->quant_type == EXISTS_QUANT && f1->type == AND_FORM) {
f = nnf(negate_formula(f));
f = push_free(f);
f = nnf(negate_formula(f));
}
f->next = save_next;
}
return(f);
} /* distribute_quantifier */
./otter/fpa.c 0000744 0002044 0001012 00000056212 11120534444 011367 0 ustar beeson /*
* fpa.c
*
* This file has the routines for FPA-path indexing. The indexing is
* similar to the FPA indexing in LMA/ITP, except that the properties
* are Stickel's "path properties". (An old property is something like
* "the term has symbol b in position 2 1 3", and a path property is
* something like
* "the term has a path p 2 h 1 f 3 b".)
*
* FPA indexing is used when searching for unifiable terms, as in inference
* rules and in unit conflict, and it is used when searching for instances,
* as in back subsumption. (It can also be used when searching for
* more general terms, as in forward subsumption, demodulation,
* and unit_deletion, but discrimination tree indexing is usually better.)
*
*/
/*
*
* A property is a sequence of integers which alternate between symbol
* identifiers and argument positions:
*
* <sym_num arg_pos sym_num arg_pos ... sym_num arg_pos sym_num>
*
* The last sym_num can be 0, indicating a variable.
*
* For example, the a in p(g(b),f(g(a),c)) has property <p 2 f 1 g 1 a>.
*
*/
/*
*
* MESSY IMPLEMENTATION DETAIL: Paths have one byte per member, plus
* a word of 0s to mark the end. When accessing members of a path,
* we treat a path as an array of unsigned chars. When comparing,
* copying, and hashing paths, we treat them as arrays of ints (for
* speed). The "official" form (argument passing, etc) is as an array
* of ints, because lint complains about possible alignment errors when
* casting (unsigned char *) to (int *).
*
* The current position in the path (usually variable j) counts in bytes.
*
*/
#include <assert.h> // Beeson 6.2.03
#include "header.h"
#include "bterms.h" // MAX_BUILTINS (Beeson)
#include "bsym.h" // Beeson for AP
#undef AND // Beeson 2.4.03
#undef OR // Beeson 2.4.03
#define AND 1
#define OR 2
#define LEAF 3
/* MAX_PATH is in ints. Overflow is not checked. If fpa_depth is n, */
/* paths can be 2n+1 bytes. */
#define MAX_PATH 110
/*************
*
* alloc_fpa_index()
*
*************/
struct fpa_index *alloc_fpa_index(void)
{
struct fpa_index *p;
int i;
p = (struct fpa_index *) tp_alloc((int) sizeof(struct fpa_index));
for (i = 0; i < FPA_SIZE; i++)
p->table[i] = NULL;
return(p);
} /* alloc_fpa_index */
/*************
*
* static void path_mark_end(path, j)
*
* j (which counts bytes) is one past last entry.
*
*************/
static void path_mark_end(int *path,
int j)
{
int i, k, m;
unsigned char *cpath;
cpath = (unsigned char *) path;
/* make sure the rest of the integer, starting with j, and the */
/* whole next integer (unless j is at beginning) are all 0. */
m = j % sizeof(int); /* position of j in an int */
if (m == 0)
i = sizeof(int); /* just fill int with 0s */
else
i = (2 * sizeof(int)) - m; /* 0 rest of int and next int */
for (k = 0; k < i; k++)
cpath[j++] = 0;
} /* path_mark_end */
/*************
*
* static int hash_path(path)
*
*************/
static int hash_path(int *path)
{
int i, val;
val = 0;
for (i = 0; path[i] != 0; i++)
val += path[i];
return((unsigned) val % FPA_SIZE);
} /* hash_path */
/*************
*
* static int path_comp(p1, p2)
*
*************/
static int path_comp(int *p1,
int *p2)
{
while (*p1 == *p2 && *p1 != 0 && *p2 != 0) {
p1++;
p2++;
}
if (*p1 < *p2)
return(-1);
else if (*p1 > *p2)
return(1);
else
return(0);
} /* path_comp */
/*************
*
* static int path_size(path) -- in ints, including 0 word at end
*
*************/
static int path_size(int *path)
{
int i;
int *p1;
for (i = 1, p1 = path; *p1 != 0; p1++, i++);
return(i);
} /* path_size */
/*************
*
* static int *path_copy(path)
*
*************/
static int *path_copy(int *path)
{
int i, j;
int *p2;
i = path_size(path);
p2 = (int *) tp_alloc(i * (int) sizeof(int));
for (j = 0; j < i; j++)
p2[j] = path[j];
return(p2);
} /* path_copy */
/*************
*
* static insert_fpa_tab(term, path, index)
*
* Insert a term into an FPA indexing list. Create a new list
* if necessary. The path is something like "1 f 2 g 4 h 3 a".
*
*************/
static void insert_fpa_tab(struct term *t,
int *path,
struct fpa_index *index)
{
int hashval, c;
struct term_ptr *tp1, *tp2, *tp3;
struct fpa_head *fp1, *fp2, *fp3;
/* Treat path as integers here. */
hashval = hash_path(path);
fp1 = index->table[hashval];
fp2 = NULL;
while (fp1 != NULL &&
(c = path_comp(fp1->path, path)) == -1) {
fp2 = fp1;
fp1 = fp1->next;
}
if (fp1 == NULL || c != 0) { /* need new fpa_head */
fp3 = get_fpa_head();
fp3->path = path_copy(path);
tp1 = get_term_ptr();
fp3->terms = tp1;
tp1->term = t;
if (fp2 == NULL) {
/* insert at beginning */
fp3->next = index->table[hashval];
index->table[hashval] = fp3;
}
else { /* insert after fp2 */
fp3->next = fp1;
fp2->next = fp3;
}
}
else { /* we have a matching fpa_head, so insert t in its list */
tp1 = fp1->terms;
tp2 = NULL;
/* keep list sorted, decreasing addresses */
while (tp1 != NULL && tp1->term->fpa_id > t->fpa_id) {
tp2 = tp1;
tp1 = tp1->next;
}
if (tp1 != NULL && tp1->term == t)
Stats[FPA_OVERLOADS]++; /* term already in list */
else {
tp3 = get_term_ptr();
tp3->term = t;
if (tp2 == NULL) { /* insert at beginning */
tp3->next = fp1->terms;
fp1->terms = tp3;
}
else { /* insert after tp2 */
tp3->next = tp1;
tp2->next = tp3;
}
}
}
} /* insert_fpa_tab */
/*************
*
* static delete_fpa_tab(term, path, database)
*
* Delete a term from an FPA indexing list. It is assumed that
* the corresponding `insert_fpa_tab' was previously made.
*
*************/
static void delete_fpa_tab(struct term *t,
int *path,
struct fpa_index *index)
{
int hashval;
struct term_ptr *tp1, *tp2;
struct fpa_head *fp1, *fp2;
/* Treat path as integers here. */
hashval = hash_path(path);
fp1 = index->table[hashval];
fp2 = NULL;
while (fp1 != NULL && path_comp(fp1->path, path) != 0) {
fp2 = fp1;
fp1 = fp1->next;
}
if (fp1 == NULL)
Stats[FPA_UNDERLOADS]++; /* fpa list not found */
else { /* we have a matching fpa_head, so look for t in its list */
tp1 = fp1->terms;
tp2 = NULL;
/* list is sorted, decreasing addresses */
while (tp1 != NULL && tp1->term->fpa_id > t->fpa_id) {
tp2 = tp1;
tp1 = tp1->next;
}
if (tp1 == NULL || tp1->term != t)
Stats[FPA_UNDERLOADS]++; /* term not found in list */
else {
if (tp2 == NULL) { /* delete from beginning */
fp1->terms = tp1->next;
if (fp1->terms == NULL) { /* delete fpa_head also */
if (fp2 == NULL)
index->table[hashval] = fp1->next;
else
fp2->next = fp1->next;
free_fpa_head(fp1);
/* don't worry about fp1->path; let it be lost forever */
}
}
else /* delete */
tp2->next = tp1->next;
free_term_ptr(tp1);
}
}
} /* delete_fpa_tab */
/*************
*
* void term_fpa_rec
*
* Recursive procedure called by fpa_insert and fpa_delete.
*
*************/
// Beeson made it static 2.1.03, as it's not called outside this file
static void term_fpa_rec(int insert,
struct term *t,
struct term *super_term,
struct fpa_index *index,
int *path,
int j,
int bound)
{
int i;
struct rel *r;
unsigned char *cpath;
cpath = (unsigned char *) path;
/* `path' has the path from super_term to t */
if (t->type == VARIABLE ) /* variable contributes nothing */
cpath[j++] = 0;
else
cpath[j++] = (unsigned char) t->sym_num; // cast added, Beeson 8.1.02--McCune says harmless
/* insert or delete path */
path_mark_end(path, j);
if (insert)
{ insert_fpa_tab(super_term, path, index);
// fprintf(stdout,"\ninserting at %d ", hash_path(path)); // DEBUG
// print_term(stdout,super_term); // DEBUG
}
else
delete_fpa_tab(super_term, path, index);
if(j > 0 && cpath[j-1]== AP && Flags[LAMBDA_FLAG].val) // Beeson 2.4.03
{ // also insert this term under the path it would have had if the Ap term were a variable
cpath[j-1] = 0;
if(insert)
{ insert_fpa_tab(super_term, path, index);
// fprintf(stdout,"\ninserting at %d ", hash_path(path)); // DEBUG
// print_term(stdout,super_term); // DEBUG
}
else
delete_fpa_tab(super_term, path,index);
cpath[j-1] = AP; // restore previous value
}
if (t->type == COMPLEX && bound > 0) {
i = 1;
r = t->farg;
while (r != NULL) {
cpath[j] = i++;
term_fpa_rec(insert, r->argval, super_term, index, path, j+1, bound-1);
r = r->narg;
}
}
} /* term_fpa_rec */
/*************
*
* void fpa_insert(term, level, database)
*
* Insert a term into an FPA indexing database. Level == 0
* gives indexing on functor only. With the term f(a,x,g(b)),
* Level == 1 gives indexing on f, a, x, and g.
*
*************/
void fpa_insert(struct term *t,
int level,
struct fpa_index *index)
{
static int atom_count, term_count;
int path[MAX_PATH];
/* t->fpa_id is used to order FPA lists. Assign one if necessary. */
if (t->fpa_id == 0) {
if (t->type != VARIABLE && t->varnum != 0)
t->fpa_id = ++atom_count;
else
t->fpa_id = ++term_count;
}
term_fpa_rec(1, t, t, index, path, 0, level);
} /* fpa_insert */
/*************
*
* void fpa_delete(term, level, database)
*
* Delete a term from an FPA indexing database. The level
* must be the same as when the term was given to fpa_insert.
*
*************/
void fpa_delete(struct term *t,
int level,
struct fpa_index *index)
{
int path[MAX_PATH];
term_fpa_rec(0, t, t, index, path, 0, level);
} /* fpa_delete */
/*************
*
* static struct fpa_tree *get_leaf_node(path, index)
*
* Given a path, if an FPA list exists, then return it in a
* leaf node; else return(NULL).
*
*************/
static struct fpa_tree *get_leaf_node(int *path,
struct fpa_index *index)
{
struct fpa_head *fp;
struct fpa_tree *pp;
int c=0;
fp = index->table[hash_path(path)];
while (fp && (c = path_comp(fp->path,path)) == -1)
fp = fp->next;
if (!fp || c != 0)
return(NULL);
else {
pp = get_fpa_tree();
pp->type = LEAF;
pp->path = path; /* Note that whole path is not being copied. */
pp->terms = fp->terms;
return(pp);
}
} /* get_leaf_node */
/*************
*
* static int all_args_vars(t) -- are all subterms variables?
*
*************/
static int all_args_vars(struct term *t)
{
struct rel *r;
if (t->type != COMPLEX)
return(0);
else {
r = t->farg;
while (r != NULL) {
if (r->argval->type != VARIABLE)
return(0);
r = r->narg;
}
return(1);
}
} /* all_args_vars */
/*************
*
* static struct fpa_tree *build_tree_local(term, unif_type, path, bound, database)
*
* Return an FPA indexing tree--to be used with a sequence
* of get_next calls.
*
* term: An error if (term->type == VARIABLE && unif_type != 3)
* because everything satisfies that query.
* unif_type: UNIFY, INSTANCE, MORE_GEN
* path: must be 0 on initial call
* bound: indexing bound (must be <= fpa_insert bound)
* database:
*
* Note: If an appropriate fpa list does not exit, then part of
* the tree can sometimes be deleted. For example, if you want
* a tree to find unifiers for p(a), then normally, the tree will be
*
* OR
* / \
* `variable' \
* AND
* / \
* / \
* `p a' \
* `p variable'
*
* But if the fpa list for `variable' does not exist, then this
* routine will produce
*
* AND
* / \
* / \
* `p a' \
* `p variable'
*
*************/
static struct fpa_tree *build_tree_local(struct term *t,
int u_type,
int *path,
int j,
int bound,
struct fpa_index *index)
{
int i, empty;
struct rel *r;
struct fpa_tree *p1, *p2, *p3;
unsigned char *cpath;
cpath = (unsigned char *) path;
/* `path' has the path to `t' */
if (t->type == VARIABLE) { /* variable */
if (u_type != MORE_GEN) { /* error if not "more general" */
abend("build_tree_local, var and not more general.");
return(NULL); /* to quiet lint */
}
else {
cpath[j++] = 0;
path_mark_end(path, j);
p1 = get_leaf_node(path, index);
return(p1);
}
}
else { /* NAME or COMPLEX */
if(Flags[LAMBDA_FLAG].val==1 && j > 0 && // Beeson 7.22.03; 7.1.05 inserted ==1
t->type == COMPLEX && FUNCTOR(t) == AP && // Beeson 7.20.03
ARG0(t)->type == VARIABLE // Beeson 7.20.03
)
{ cpath[j-1] = cpath[j] = 0; // Beeson 7.20.03
j--; // it should be odd
path_mark_end(path, j); // Beeson 7.20.03
p1 = get_leaf_node(path, index); // Beeson 7.20.03
return(p1); // Beeson 7.20.03
} // Beeson 7.20.03
cpath[j++] = (unsigned char) t->sym_num; // cast added Beeson 8.1.02--McCune says harmless
if (t->type == NAME || bound == 0 || (u_type != MORE_GEN && all_args_vars(t))) {
path_mark_end(path, j);
p2 = get_leaf_node(path, index);
}
else {
i = 1;
empty = 0;
p2 = NULL;
r = t->farg;
while (r != NULL && empty == 0) {
cpath[j] = i++;
/* skip this arg if var and "unify" or "instance" */
if (r->argval->type != VARIABLE || u_type == MORE_GEN){
p3 = build_tree_local(r->argval, u_type, path, j+1, bound-1, index);
if (p3 == NULL) {
if (p2 != NULL) {
zap_prop_tree(p2);
p2 = NULL;
}
empty = 1;
}
else if (p2 == NULL)
p2 = p3;
else {
p1 = get_fpa_tree();
p1->type = AND; /* and */
p1->left = p2;
p1->right = p3;
p2 = p1;
}
} // if
r = r->narg;
} //while
} // if(c->type == NAME...
if (u_type != INSTANCE) { /* if we don't want instances only, */
cpath[j-1] = 0;
path_mark_end(path, j);
p3 = get_leaf_node(path, index); /* variable */
}
else
p3 = NULL;
if (p2 == NULL)
return(p3);
else if (p3 == NULL)
return(p2);
else { /* OR them together */
p1 = get_fpa_tree();
p1->type = OR; /* OR */
p1->left = p2;
p1->right = p3;
return(p1);
} // else
} //else
} /* build_tree_local */
/*************
*
* struct fpa_tree *build_tree(t, u_type, bound, index)
*
*************/
struct fpa_tree *build_tree(struct term *t,
int u_type,
int bound,
struct fpa_index *index)
{
int path[MAX_PATH];
return(build_tree_local(t, u_type, path, 0, bound, index));
} /* build_tree */
/*************
*
* struct term *next_term(tree, maximum)
*
* Get the first or next term that satisfies a unification condition.
* (Unification conditions are provided by `build_tree'.)
* `maximum' must be 0 on nonrecursive calls. A return of NULL indicates
* that there are none or no more terms that satisfy (and the tree has
* been deallocated). If you want to stop getting terms before a NULL
* is returned, then please deallocate the tree with zap_prop_tree(tree).
*
* Warning: a return of NULL means that the tree has been deallocated
*
*************/
struct term *next_term(struct fpa_tree *n,
int max)
{
struct term_ptr *tp;
struct term *t1, *t2;
if (n == NULL)
return(NULL);
else if (n->type == LEAF) { /* LEAF node */
tp = n->terms; /* fpa lists: terms have decreasing addresses */
while (tp != NULL && max != 0 && tp->term->fpa_id > max)
tp = tp->next;
if (tp == NULL) {
zap_prop_tree(n);
return(NULL);
}
else {
n->terms = tp->next;
return(tp->term);
}
}
else if (n->type == AND) { /* AND node */
t1 = next_term(n->left, max);
if (t1 != NULL)
t2 = next_term(n->right, t1->fpa_id);
else
t2 = (struct term *) 1; /* anything but NULL */
while (t1 != t2 && t1 != NULL && t2 != NULL) {
if (t1->fpa_id > t2->fpa_id)
t1 = next_term(n->left, t2->fpa_id);
else
t2 = next_term(n->right, t1->fpa_id);
}
if (t1 == NULL || t2 == NULL) {
if (t1 == NULL)
n->left = NULL;
if (t2 == NULL)
n->right = NULL;
zap_prop_tree(n);
return(NULL);
}
else
return(t1);
}
else { /* OR node */
/* first get the left term */
t1 = n->left_term;
if (t1 == NULL) {
/* it must be brought up */
if (n->left != NULL) {
t1 = next_term(n->left, max);
if (t1 == NULL)
n->left = NULL;
}
}
else /* it was saved from a previous call */
n->left_term = NULL;
/* at this point, n->left_term == NULL */
/* now do the same for the right side */
t2 = n->right_term;
if (t2 == NULL) {
if (n->right != NULL) {
t2 = next_term(n->right, max);
if (t2 == NULL)
n->right = NULL;
}
}
else
n->right_term = NULL;
/* now decide which of of t1 and t2 to return */
if (t1 == NULL) {
if (t2 == NULL) {
zap_prop_tree(n);
return(NULL);
}
else
return(t2);
}
else if (t2 == NULL)
return(t1);
else if (t1 == t2)
return(t1);
else if (t1->fpa_id > t2->fpa_id) {
n->right_term = t2; /* save t2 for next time */
return(t1);
}
else {
n->left_term = t1; /* save t1 for next time */
return(t2);
}
}
} /* next_term */
/*************
*
* struct fpa_tree *build_for_all(db)
*
* For those times when one must have everything (paramodulation
* from a variable, and paramodulation into a variable).
* (Build a tree that OR's together all of the FPA lists in db.)
*
*************/
struct fpa_tree *build_for_all(struct fpa_index *index)
{
struct fpa_head *h;
struct fpa_tree *p1, *p2, *p3;
int i;
p1 = NULL;
for (i = 0; i < FPA_SIZE; i++) {
h = index->table[i];
while (h != NULL) {
p2 = get_fpa_tree();
p2->type = LEAF;
p2->path = h->path;
p2->terms = h->terms;
if (p1 == NULL)
p1 = p2;
else {
p3 = get_fpa_tree();
p3->type = OR;
p3->left = p1;
p3->right = p2;
p1 = p3;
}
h = h->next;
}
}
return(p1);
} /* build_for_all */
/*************
*
* zap_prop_tree(tree) -- Dealocate an FPA indexing tree.
*
* `next_term' deallocates the tree as it proceeds, so it is not
* necessary to call zap_prop_tree if the most recent call to
* `next_term' returned NULL.
*
*************/
void zap_prop_tree(struct fpa_tree *n)
{
if (n != NULL) {
zap_prop_tree(n->left);
zap_prop_tree(n->right);
free_fpa_tree(n);
}
} /* zap_prop_tree */
/*************
*
* print_fpa_tab(file_ptr, database) -- Display all FPA lists in database.
*
*************/
void print_fpa_tab(FILE *fp,
struct fpa_index *index)
{
int i;
struct fpa_head *f;
struct term_ptr *tp;
fprintf(fp, "\nfpa index %d\n", (int) index);
for (i=0; i<FPA_SIZE; i++)
if (index->table[i] != NULL) {
fprintf(fp, "bucket %d\n", i);
f = index->table[i];
while (f != NULL) {
print_path(fp, f->path);
tp = f->terms;
while (tp != NULL) {
fprintf(fp, " ");
print_term(fp, tp->term);
tp = tp->next;
}
fprintf(fp, "\n");
f = f->next;
}
}
} /* print_fpa_tab */
/*************
*
* p_fpa_tab(index)
*
*************/
void p_fpa_tab(struct fpa_index *index)
{
print_fpa_tab(stdout, index);
} /* p_fpa_tab */
/*************
*
* print_prop_tree(file_ptr, tree, level)
*
* Display an FPA lookup tree that has been returned from
* build_tree. Level should be 0 on initial call.
*
*************/
void print_prop_tree(FILE *fp,
struct fpa_tree *n,
int level)
{
int i;
if (n != NULL) {
for (i=0; i<level; i++)
fprintf(fp, " ");
if (n->type == AND)
fprintf(fp, "and\n");
else if (n->type == OR)
fprintf(fp, "or\n");
else
print_path(fp, n->path);
print_prop_tree(fp, n->left, level+1);
print_prop_tree(fp, n->right, level+1);
}
} /* print_prop_tree */
/*************
*
* p_prop_tree(t)
*
*************/
void p_prop_tree(struct fpa_tree *n)
{
print_prop_tree(stdout, n, 0);
} /* p_prop_tree */
/*************
*
* print_path(fp, path) -- print an fpa path to a file
*
*************/
void print_path(FILE *fp,
int *path)
{
int i;
char *sym;
unsigned char *cpath;
cpath = (unsigned char *) path;
/* example [f,2,g,1,f,1,h,1,a] */
fprintf(fp, "[");
for (i = 0; cpath[i] != 0 || cpath[i+1] != 0 ; i++) {
if (i % 2 == 0) {
sym = sn_to_str( (short) cpath[i]);
if (sym[0] == '\0')
sym = "*";
fprintf(fp, "%s", sym);
}
else
fprintf(fp, "%d", cpath[i]);
if (cpath[i+1] != 0 || cpath[i+1] != 0)
fprintf(fp, ",");
else
fprintf(fp, "]\n");
}
} /* print_path */
/*************
*
* p_path(path) -- print an fpa path
*
*************/
void p_path(int *path)
{
print_path(stdout, path);
} /* p_path */
/*************
*
* int new_sym_num()
*
* Return the next available symbol number.
*
* The rightmost 8 bits will not be all zero.
* This is so that fpa will not map sym_nums to 0 (the
* code for variables).
*
*************/
int new_sym_num(void)
{
static int sym_ent_count = MAX_BUILTINS; // Beeson 8.3.02; leaving the first 256 available for built-ins
sym_ent_count++;
if (sym_ent_count % 256 == 0)
sym_ent_count++;
if (sym_ent_count > MAX_UNSIGNED_SHORT)
abend("new_sym_num: too many symbols requested.");
return(sym_ent_count);
} /* new_sym_num */
./otter/geometry.c 0000744 0002044 0001012 00000017401 11120534444 012451 0 ustar beeson /*
* geometry.c -- Padmanabhan's inference rule
*
* This is an inference rule of R. Padmanabhan. Assume f is a binary
* functor, left and right cancellation hold for f, and the following
* axiom holds: f(f(x,y),f(z,u)) = f(f(x,z),f(y,u)). Then the following
* inference rule is sound:
*
* Consider A=B, in which A and B are terms built from f, variables, and
* constants. (If other terms appear, we can treat them as constants.)
* If A and B have identical terms, say C, in corresponding positions,
* then infer A'=B', which is similar to A=B, except that the two occurrences
* of C have been replaced with a fresh variable.
*
* Of course, if two terms in corresponding positions can be made
* identical by unification, then we can instantiate that equality
* and replace the terms with a fresh variable.
*
* This file contains several versions of the inference rule.
*
* 1. As a rewrite rule (separate from demodulation) (without unification).
* routine geo_rewrite below.
*
* 2. As an inference rule (applied to given clause), with unification.
* routine geometry_rule_unif below.
*
*/
#include "header.h"
#define MAX_DEPTH 50
/*************
*
* is_geometry_symbol() -- THIS IS LIKELY TO CHANGE!!!
*
*************/
static int is_geometry_symbol(int sn)
{
#if 1 /* August 9. make gL apply everywhere. */
return(1);
#else
return(str_ident(sn_to_str(sn), "f") ||
str_ident(sn_to_str(sn), "g") ||
str_ident(sn_to_str(sn), "*"));
#endif
} /* is_geometry_symbol */
/*************
*
* geo_rewrite_recurse()
*
*************/
static int geo_rewrite_recurse(struct rel *a,
struct rel *b,
struct clause *cl,
int *next_var)
{
#if 0
if (a->argval->type == VARIABLE || b->argval->type == VARIABLE)
return(0);
else
#endif
if (term_ident(a->argval, b->argval)) {
if (a->argval->type == VARIABLE && occurrences(a->argval, cl->first_lit->atom) == 2)
/* a & b are the only occurrences, so there is no point in applying the rule. */
return(0);
else {
struct term *t;
struct int_ptr *p1, *p2;
if (*next_var == MAX_VARS) {
abend("geo_rewrite_recurse, too many variables.");
}
for (p1 = cl->parents; p1 && p1->next; p1 = p1->next);
p2 = get_int_ptr(); p2->i = GEO_ID_RULE; p2->next = NULL;
if (p1)
p1->next = p2;
else
cl->parents = p2;
zap_term(a->argval);
zap_term(b->argval);
t = get_term(); t->type = VARIABLE; t->varnum = *next_var; a->argval = t;
t = get_term(); t->type = VARIABLE; t->varnum = *next_var; b->argval = t;
(*next_var)++;
return(1);
}
}
else if (is_geometry_symbol(a->argval->sym_num) && a->argval->sym_num == b->argval->sym_num) {
int n;
struct rel *a1, *b1;
n = 0;
for (a1 = a->argval->farg, b1 = b->argval->farg; a1; a1 = a1->narg, b1 = b1->narg)
n += geo_rewrite_recurse(a1, b1, cl, next_var);
return(n);
}
else
return(0);
} /* geo_rewrite_recurse */
/*************
*
* geo_rewrite()
*
* This is a rewrite version of Padmanabhan's geometry law.
*
* When applied, this rule introduces a new variable, and the number
* of the new variable is 1 more than the greatest variable already
* in the equality.
*
* This routine applies the rule as much as possible.
*
*************/
int geo_rewrite(struct clause *c)
{
if (c->first_lit && !c->first_lit->next_lit && pos_eq_lit(c->first_lit)) {
struct rel *a, *b;
int next_var, replacements;
a = c->first_lit->atom->farg;
b = a->narg;
next_var = biggest_var(c->first_lit->atom) + 1;
replacements = geo_rewrite_recurse(a, b, c, &next_var);
return(replacements > 0);
}
else
return(0);
} /* geo_rewrite */
/*************
*
* geo_replace_unif()
*
*************/
static struct term *geo_replace_unif(struct term *t,
int *pos_vec,
int depth)
{
if (depth == 0) {
zap_term(t);
t = get_term();
t->type = VARIABLE;
t->varnum = MAX_VARS+1;
}
else {
struct rel *r;
int i;
for (i=1, r=t->farg; i < *pos_vec; i++, r = r->narg);
r->argval = geo_replace_unif(r->argval, pos_vec+1, depth-1);
}
return(t);
} /* geo_replace_unif */
/*************
*
* geo_generate_unif()
*
*************/
static void geo_generate_unif(struct clause *giv_cl,
int *pos_vec,
int depth,
struct context *subst)
{
struct clause *new_clause;
struct int_ptr *ip;
struct literal *lit;
new_clause = get_clause();
new_clause->type = giv_cl->type;
lit = get_literal();
lit->sign = giv_cl->first_lit->sign;
lit->container = new_clause;
new_clause->first_lit = lit;
lit->atom = apply(giv_cl->first_lit->atom, subst);
lit->atom->occ.lit = lit;
lit->atom->varnum = giv_cl->first_lit->atom->varnum; /* type of atom */
lit->atom->farg->argval = geo_replace_unif(lit->atom->farg->argval, pos_vec, depth);
lit->atom->farg->narg->argval = geo_replace_unif(lit->atom->farg->narg->argval, pos_vec, depth);
ip = get_int_ptr();
ip->i = GEO_RULE;
new_clause->parents = ip;
ip = get_int_ptr();
ip->i = giv_cl->id;
new_clause->parents->next = ip;
Stats[CL_GENERATED]++;
Stats[GEO_GEN]++;
pre_process(new_clause, 0, Sos);
} /* geo_generate_unif */
/*************
*
* geo_recurse_unif()
*
*************/
static void geo_recurse_unif(struct term *a,
struct term *b,
struct clause *giv_cl,
int *pos_vec,
int depth)
{
struct context *subst;
struct trail *tr;
subst = get_context();
subst->multiplier = 0;
tr = NULL;
if (unify(a, subst, b, subst, &tr)) {
geo_generate_unif(giv_cl, pos_vec, depth, subst);
clear_subst_1(tr);
}
if (is_geometry_symbol(a->sym_num) && a->sym_num == b->sym_num) {
struct rel *a1, *b1;
int i;
if (depth == MAX_DEPTH) {
abend("geo_recurse, MAX_DEPTH.");
}
for (i = 1, a1 = a->farg, b1 = b->farg; a1; i++, a1 = a1->narg, b1 = b1->narg) {
pos_vec[depth] = i;
geo_recurse_unif(a1->argval, b1->argval, giv_cl, pos_vec, depth+1);
}
pos_vec[depth] = 0; /* not really necessary */
}
} /* geo_recurse_unif */
/*************
*
* geometry_rule_unif()
*
* As in other inference rules, this rule assumes that the given clause
* has variables renumbered, in particular, that all variable numbers
* are < MAX_VARS. And as in other inference rules, clauses inferred by
* this rule may have variable numbers >= MAX_VARS.
*
*************/
void geometry_rule_unif(struct clause *giv_cl)
{
if (giv_cl->first_lit && !giv_cl->first_lit->next_lit &&
pos_eq_lit(giv_cl->first_lit)) {
struct term *a, *b;
int pos_vec[MAX_DEPTH];
a = giv_cl->first_lit->atom->farg->argval;
b = giv_cl->first_lit->atom->farg->narg->argval;
geo_recurse_unif(a, b, giv_cl, pos_vec, 0);
}
} /* geometry_rule_unif */
/*************
*
* child_of_geometry()
*
*************/
int child_of_geometry(struct clause *c)
{
struct int_ptr *p;
for (p = c->parents; p; p = p->next) {
if (p->i == GEO_ID_RULE ||
p->i == GEO_RULE)
return(1);
}
return(0);
} /* child_of_geometry */
/*************
*
* gl_demod()
*
* Copy, demodulate, then pre_process.
*
*************/
void gl_demod(struct clause *c,
struct list *lst)
{
struct clause *d;
struct int_ptr *ip1, *ip2;
d = cl_copy(c);
ip1 = get_int_ptr(); ip1->i = COPY_RULE; d->parents = ip1;
ip2 = get_int_ptr(); ip2->i = c->id; ip1->next = ip2;
demod_cl(d);
pre_process(d, 0, lst);
} /* gl_demod */
./otter/header.h 0000744 0002044 0001012 00000027034 11120534444 012056 0 ustar beeson #ifndef TP_HEADER_H /* to make sure we don't include this more than once */
#define TP_HEADER_H
/*
* header.h -- This is the main "include" file for Otter.
* All of the .c files include this file.
*
*/
/************ BASIC INCLUDES ************/
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
/*********** INCLUDES FOR TIMES AND DATES ************/
#include <time.h>
#ifdef TP_RUSAGE /* getrusage() */
# include <sys/time.h> /* needed for SunOS */
# include <sys/resource.h>
#endif
#ifdef HP_UX
# include <sys/syscall.h>
# define getrusage(a, b) syscall(SYS_GETRUSAGE, a, b)
#endif /* HP_UX */
/*********** SIZES OF INTEGERS ***************/
#include <limits.h> /* for sizes of integers, etc. */
#define MAX_LONG_INT LONG_MAX /* a big integer that fits into "long" */
#define MAX_INT INT_MAX /* a big integer that fits into "int" */
#define MAX_UNSIGNED_SHORT USHRT_MAX
/******** MISCELLANEOUS LIMITS *********/
#define MAX_NAME 256 /* max chars in any symbol (including '\0') */
#if defined(THINK_C)
# define MAX_BUF 3000 /* max chars in input string (including '\0') */
#else
# define MAX_BUF 100000 /* max chars in input string (including '\0') */
#endif
#define MAX_VARS 64 /* maximum # of distinct variables in clause */
/* MAX_VARS should always be a multiple of 8*sizeof(int),
so if ints become 64 bits, MAX_VARS should be 64 or 128;
while ints are still 32 bits, MAX_VARS could be 64, 96, 128,... */
#define VAR_TYPE unsigned short
/* must be able to hold MAX_VARS * (max-multiplier+1) */
#define FPA_SIZE 3793 /* size of FPA hash tables */ // Beeson changed from 500, 2.5.03
#define MAX_FS_TERM_DEPTH 300 /* max depth of terms in IS-tree */
#define MAX_AL_TERM_DEPTH 500 /* max depth of alphas in IMD-tree */
/******** TYPES *********/
#define NAME 1 /* basic types of term */
#define VARIABLE 2
#define COMPLEX 3
/* types of non-VARIABLE term -- varnum field is used */
#define TERM 0 /* not an atom */
#define NORM_ATOM 1 /* normal atom */
#define POS_EQ 2 /* positive equality atom */
#define NEG_EQ 3 /* negative equality atom */
#define ANSWER 4 /* answer literal atom */
#define LEX_DEP_DEMOD 5 /* lex-dependent demodulator atom */
#define EVALUABLE 6 /* $ID, $LT, etc */
#define CONDITIONAL_DEMOD 7 /* conditional demodulator */
/* types of unification property tree */
#define UNIFY 1
#define INSTANCE 2
#define MORE_GEN 3
/* integer codes for members of parent lists */
/* positive integers are clause IDs */
#define BINARY_RES_RULE -1
#define HYPER_RES_RULE -2
#define NEG_HYPER_RES_RULE -3
#define UR_RES_RULE -4
#define PARA_INTO_RULE -5
#define PARA_FROM_RULE -6
#define LINKED_UR_RES_RULE -7
#define GEO_RULE -8
#define FACTOR_RULE -9
#define NEW_DEMOD_RULE -10
#define BACK_DEMOD_RULE -11
#define DEMOD_RULE -12
#define UNIT_DEL_RULE -13
#define EVAL_RULE -14
#define GEO_ID_RULE -15
#define FACTOR_SIMP_RULE -16
#define COPY_RULE -17
#define FLIP_EQ_RULE -18
#define CLAUSIFY_RULE -19
#define BACK_UNIT_DEL_RULE -20
#define SPLIT_RULE -21
#define SPLIT_NEG_RULE -22
#define PROPOSITIONAL_RULE -23
#define BETA_REDUCTION -25 // Beeson 8.05.02
#define RESOLVE_WITH_TRUE -26 // Beeson 10.13.02
#define SPLIT_NOT_OR -27 // Beeson 2.10.03
#define SPLIT_NOT_AND -28 // Beeson 2.15.03
#define SPLIT_AND -29 // Beeson 7.24.05
#define SPLIT_OR -30 // Beeson 7.24.05
#define SIMPLIFY_RULE -31 // Beeson 11.1.03
#define SOLVE_RULE -32 // Beeson 11.1.03
#define TRUE_LIT -33
#ifdef SCOTT
#define SEM_RES_RULE -24
#endif
#define LIST_RULE -1000
/* integer codes for evaluable functions and predicates */
/* When adding more, update built_in_symbols in io.c. */
/* User-defined (foreign) evaluable functions are 0--1000 */
#define MAX_USER_EVALUABLE 1000
#define SUM_SYM 1001
#define PROD_SYM 1002
#define DIFF_SYM 1003
#define DIV_SYM 1004
#define MOD_SYM 1005
#define EQ_SYM 1006
#define NE_SYM 1007
#define LT_SYM 1008
#define LE_SYM 1009
#define GT_SYM 1010
#define GE_SYM 1011
#define AND_SYM 1012
#define OR_SYM 1013
#define NOT_SYM 1014
#define IF_SYM 1015
#define ID_SYM 1016
#define LNE_SYM 1017
#define LLT_SYM 1018
#define LLE_SYM 1019
#define LGT_SYM 1020
#define LGE_SYM 1021
#define T_SYM 1022
#define F_SYM 1023
#define NEXT_CL_NUM_SYM 1024
#define ATOMIC_SYM 1025
#define INT_SYM 1026
#define VAR_SYM 1027
#define TRUE_SYM 1028
#define OUT_SYM 1029
#define BIT_AND_SYM 1030
#define BIT_OR_SYM 1031
#define BIT_XOR_SYM 1032
#define BIT_NOT_SYM 1033
#define SHIFT_LEFT_SYM 1034
#define SHIFT_RIGHT_SYM 1035
#define GROUND_SYM 1036
#define FSUM_SYM 1037 /* floating point operators */
#define FPROD_SYM 1038
#define FDIFF_SYM 1039
#define FDIV_SYM 1040
#define FEQ_SYM 1041
#define FNE_SYM 1042
#define FLT_SYM 1043
#define FLE_SYM 1044
#define FGT_SYM 1045
#define FGE_SYM 1046
#define COMMON_EXPRESSION_SYM 1047
#define BITS_SYM 1048
#define INT_TO_BITS_SYM 1049
#define BITS_TO_INT_SYM 1050
#define RENAME_SYM 1051
#define UNIQUE_NUM_SYM 1052
#define OCCURS_SYM 1053
#define VOCCURS_SYM 1054
#define VFREE_SYM 1055
/* comparing symbols and terms */
#define LESS_THAN 1
#define GREATER_THAN 2
#define SAME_AS 3
#define NOT_COMPARABLE 4
#define NOT_GREATER_THAN 5
#define NOT_LESS_THAN 6
#define LRPO_MULTISET_STATUS 0 /* lex RPO multiset status */
#define LRPO_LR_STATUS 1 /* lex RPO left-right status */
/* (RL status removed for Otter 3.0 release.) */
/* Operator types */
#define XFX 1
#define XFY 2
#define YFX 3
#define FX 4
#define FY 5
#define XF 6
#define YF 7
/* linked-UR resolution inference rule. */
#define BOOLEAN char
#define FALSE 0
#define TRUE 1
#define UNDEFINED -1
#define NOT_SPECIFIED 0
#define NUCLEUS 1
#define LINK 2
#define BOTH 3
#define SATELLITE 4
/* first-order formulas */
#define ATOM_FORM 1
#define NOT_FORM 2
#define AND_FORM 3
#define OR_FORM 4
#define IMP_FORM 5
#define IFF_FORM 6
#define QUANT_FORM 7
#define ALL_QUANT 1
#define EXISTS_QUANT 2
/* exit codes */
#define KEEP_SEARCHING 100
#define INPUT_ERROR_EXIT 101
#define ABEND_EXIT 102
#define PROOF_EXIT 103
#define SOS_EMPTY_EXIT 104
#define MAX_GIVEN_EXIT 105
#define MAX_SECONDS_EXIT 106
#define MAX_GEN_EXIT 107
#define MAX_KEPT_EXIT 108
#define MAX_MEM_EXIT 109
#define MALLOC_NULL_EXIT 110
#define INTERACTIVE_EXIT 111
#define SEGV_EXIT 112
#define USR1_EXIT 113
#define POSSIBLE_MODEL_EXIT 114
#ifdef SCOTT
#define MAX_PICK_WT_EXIT 115
#endif
/************* END OF ALL GLOBAL CONSTANT DEFINITIONS ****************/
#ifdef IN_SCOTT /* these are soft links to the real files */
#include "otter_cos.h" /* flag, parameter, statistic, and clock names */
#include "otter_foreign.h" /* user-defined evaluable functions */
#include "otter_macros.h" /* preprocessor (#define) macros */
#else
#include "cos.h" /* flag, parameter, statistic, and clock names */
#include "foreign.h" /* user-defined evaluable functions */
#include "macros.h" /* preprocessor (#define) macros */
#endif
#ifdef SCOTT
#include "shared_defs.h" /* shared defs needed for types.h */
#endif
#ifdef IN_SCOTT /* these are soft links to the real files */
#include "otter_types.h" /* all of the type declarations */
#include "otter_protos.h" /* function prototypes */
#else
#include "types.h" /* all of the type declarations */
#include "proto.h" /* function prototypes */
#endif
/*********** GLOBAL VARIABLES ***********/
#ifdef IN_MAIN
# define CLASS /* empty string if included by main program */
#else
# define CLASS extern /* extern if included by anything else */
#endif
/* lists of clauses */
CLASS struct list *Usable;
CLASS struct list *Sos;
CLASS struct list *Demodulators;
CLASS struct list *Passive;
CLASS struct list *Hot;
CLASS struct list *Hints;
CLASS struct list *Mace_constraints;
CLASS struct list *Types; // Beeson 5.06.04
#ifdef SCOTT
CLASS struct list *First;
#endif
/* FPA (indexing) lists for resolution inference rules */
CLASS struct fpa_index *Fpa_clash_pos_lits;
CLASS struct fpa_index *Fpa_clash_neg_lits;
/* FPA lists for unit conflict and back subsumption */
CLASS struct fpa_index *Fpa_pos_lits;
CLASS struct fpa_index *Fpa_neg_lits;
/* FPA lists for paramodulation inference rules */
CLASS struct fpa_index *Fpa_clash_terms; /* clashable terms */
CLASS struct fpa_index *Fpa_alphas; /* alphas (left and right) */
/* FPA list for back demodulation */
CLASS struct fpa_index *Fpa_back_demod; /* back demod candidates */
/* discrimination tree forward subsumption index */
CLASS struct is_tree *Is_pos_lits; /* positive literals */
CLASS struct is_tree *Is_neg_lits; /* negative literals */
/* discrimination tree index for demodulators */
CLASS struct imd_tree *Demod_imd;
/* Lists of weight templates */
CLASS struct term_ptr *Weight_purge_gen; /* screen generated clauses */
CLASS struct term_ptr *Weight_pick_given; /* pick given clause */
CLASS struct term_ptr *Weight_terms; /* order terms */
/* Simple indexes (one level only) for weight templates */
CLASS struct is_tree *Weight_purge_gen_index;
CLASS struct is_tree *Weight_pick_given_index;
CLASS struct is_tree *Weight_terms_index;
/* options (Flags and Parms) */
CLASS struct { /* Flags are boolean valued options */
char *name;
int val;
} Flags[MAX_FLAGS];
CLASS struct { /* Parms are integer valued options */
char *name;
int val;
int min, max; /* minimum and maximum permissible values */
} Parms[MAX_PARMS];
CLASS int Internal_flags[MAX_INTERNAL_FLAGS]; /* invisible to user */
/* statistics */
CLASS long Stats[MAX_STATS];
CLASS int Subsume_count[100];
/* clocks */
CLASS struct clock Clocks[MAX_CLOCKS];
/* Other built-in symbols */
CLASS int Cons_sym_num, Nil_sym_num, Ignore_sym_num, Chr_sym_num, Dots_sym_num;
/* table of user functions */
CLASS struct user_function User_functions[MAX_USER_FUNCTIONS];
CLASS FILE *Null_output;
/* Miscellaneous global variables */
CLASS char Float_format[MAX_NAME];
CLASS struct term *Overbeek_terms; /* Special weighting */
CLASS struct term *Split_atoms; /* Atoms to split */
CLASS char Bell;
CLASS int Max_input_id; /* Maxumim ID of an input clause */
/* More special weighting */
CLASS struct term_ptr **Overbeek_world;
#endif /* ! TP_HEADER_H */
./otter/hints.c 0000744 0002044 0001012 00000017306 11120534444 011747 0 ustar beeson /*
* hints.c -- routines related to the hints strategy.
*
*/
/*
The main purpose of the hints mechanism is to set or adjust the
pick-given weight of clauses. A hint H can apply to a clause C
in 3 ways:
H subsumes C (forward subsume, fsub),
C subsumes H (back subsume, bsub), and
H is equivalent to C (equiv, which implies fsub and bsub).
2 more ways, which apply to unit clauses only, to be added later:
H and C unify
H anc C have the same shape (identical-except-variables)
Another purpose of hints is to retain clauses that would
otherwise be discarded because the purge-gen weight is
too high. The Flag KEEP_HINT_SUBSUMERS (default clear)
says to skip the purge-gen test on generated clauses that
subsume hints (i.e., bsub).
The Parms are
FSUB_HINT_WT FSUB_HINT_ADD_WT
BSUB_HINT_WT BSUB_HINT_ADD_WT
EQUIV_HINT_WT EQUIV_HINT_ADD_WT
These can be overridden for individual hints with corresponding
attributes on the hints, e.g.,
p0(a,x) # bsub_hint_wt(200) # fsub_hint_wt(100).
If the Parms (attributes) are not set, they are not used; if you
have a list of hints with no attributes, and you don't set any
hint parms, the hints won't be used for anything.
If more than Parm (attribute) might apply, equiv is tested
first, then fsub, then bsub. If you use both WT and ADD_WT,
then BOTH can apply, e.g., when the hint
p # bsub_hint_wt(200) # bsub_hint_add_wt(20).
applies to a clause, the clause gets pick-given weight 220.
The hint attributes and parameters are compiled into a special
structure that is attached to the hint clause with the parents
pointer. This causes several problems. (1) Compiled hints
must be printed with print_hint_clause() instead of print_clause(),
and (2) the Parms in effect at the start of the search are
compiled in; if the user changes hint parms during the search,
this will have no effect.
*/
#include "header.h"
/* Any hint-wt attributes on hints are compiled into a hint_data
* structure (attached to the hint with parent pointer)
* to avoid costly attribute processing when using the hints.
*/
struct hint_data {
char fsub, bsub, equiv;
int fsub_wt, bsub_wt, equiv_wt;
int fsub_add_wt, bsub_add_wt, equiv_add_wt;
};
/*************
*
* process_hint_attributes()
*
* Look for hint-wt attributes, put the data into a hint_data node.
*
*************/
void process_hint_attributes(struct clause *c)
{
struct cl_attribute *a;
struct hint_data *hd;
hd = (struct hint_data *) tp_alloc((int) sizeof(struct hint_data));
c->parents = (struct int_ptr *) hd;
hd->fsub = 0;
hd->fsub_wt = Parms[FSUB_HINT_WT].val;
hd->fsub_add_wt = Parms[FSUB_HINT_ADD_WT].val;
hd->bsub = 0;
hd->bsub_wt = Parms[BSUB_HINT_WT].val;
hd->bsub_add_wt = Parms[BSUB_HINT_ADD_WT].val;
hd->equiv = 0;
hd->equiv_wt = Parms[EQUIV_HINT_WT].val;
hd->equiv_add_wt = Parms[EQUIV_HINT_ADD_WT].val;
for (a = c->attributes; a; a = a->next) {
switch (a->name) {
case FSUB_HINT_WT_ATTR:
hd->fsub_wt = a->u.i; break;
case BSUB_HINT_WT_ATTR:
hd->bsub_wt = a->u.i; break;
case EQUIV_HINT_WT_ATTR:
hd->equiv_wt = a->u.i; break;
case FSUB_HINT_ADD_WT_ATTR:
hd->fsub_add_wt = a->u.i; break;
case BSUB_HINT_ADD_WT_ATTR:
hd->bsub_add_wt = a->u.i; break;
case EQUIV_HINT_ADD_WT_ATTR:
hd->equiv_add_wt = a->u.i; break;
}
}
hd->fsub = !(hd->fsub_wt == MAX_INT && hd->fsub_add_wt == 0);
hd->bsub = !(hd->bsub_wt == MAX_INT && hd->bsub_add_wt == 0);
hd->equiv = !(hd->equiv_wt == MAX_INT && hd->equiv_add_wt == 0);
if (hd->fsub == 0 && hd->bsub == 0 && hd->equiv == 0 &&
!Flags[KEEP_HINT_SUBSUMERS].val && !Flags[KEEP_HINT_EQUIVALENTS].val) {
printf("\n%cWARNING, hint will not be used, because no weights have been\nset for it: ", Bell);
print_hint_clause(stdout, c);
}
} /* process_hint_attributes */
/*************
*
* print_hint_clause()
*
* (Not in the same form as they were input.)
*
*************/
void print_hint_clause(FILE *fp,
struct clause *c)
{
struct hint_data *hd;
struct term *t;
hd = (struct hint_data *) c->parents;
fprintf(fp, "%d [", c->id);
if (hd && hd->fsub)
fprintf(fp, " fsub_wt=%d", hd->fsub_wt);
if (hd && hd->bsub)
fprintf(fp, " bsub_wt=%d", hd->bsub_wt);
if (hd && hd->equiv)
fprintf(fp, " equiv_wt=%d", hd->equiv_wt);
fprintf(fp, "] ");
t = clause_to_term(c);
t = term_fixup_2(t); /* Change -(=(a,b)) to !=(a,b). */
print_term(fp, t);
zap_term(t);
if (c->attributes)
print_attributes(fp, c->attributes);
fprintf(fp, ".\n");
} /* print_hint_clause */
/*************
*
* p_hint_clause()
*
*************/
void p_hint_clause(struct clause *c)
{
print_hint_clause(stdout, c);
} /* p_hint_clause */
/*************
*
* print_hints_cl_list()
*
*************/
void print_hints_cl_list(FILE *fp,
struct list *lst)
{
struct clause *cl;
if (!lst)
fprintf(fp, "(hints list nil)\n");
else {
cl = lst->first_cl;
while (cl) {
print_hint_clause(fp, cl);
cl = cl->next_cl;
}
fprintf(fp, "end_of_list.\n");
}
} /* print_hints_cl_list */
/*************
*
* print_hints_cl_list()
*
*************/
void p_hints_cl_list(struct list *lst)
{
print_hints_cl_list(stdout, lst);
} /* p_hints_cl_list */
/*************
*
* adjust_weight_with_hints()
*
* This routine uses the list Hints to adjust or resset
* the pick-given weight of a clause.
*
*************/
void adjust_weight_with_hints(struct clause *c)
{
int f_test, b_test, e_test;
int fsub, bsub, done;
struct hint_data *hd;
struct clause *h;
CLOCK_START(HINTS_TIME);
h = Hints->first_cl;
done = 0;
while (h && !done) {
hd = (struct hint_data *) h->parents;
f_test = hd->fsub;
b_test = hd->bsub;
e_test = hd->equiv;
if (f_test || e_test)
fsub = subsume(h, c);
else
fsub = 0;
if (b_test || e_test)
bsub = subsume(c, h);
else
bsub = 0;
if (e_test && fsub && bsub) {
if (hd->equiv_wt != MAX_INT)
c->pick_weight = hd->equiv_wt;
c->pick_weight += hd->equiv_add_wt;
done = 1;
}
else if (f_test && fsub) {
if (hd->fsub_wt != MAX_INT)
c->pick_weight = hd->fsub_wt;
c->pick_weight += hd->fsub_add_wt;
done = 1;
}
else if (b_test && bsub) {
if (hd->bsub_wt != MAX_INT)
c->pick_weight = hd->bsub_wt;
c->pick_weight += hd->bsub_add_wt;
done = 1;
}
if (!done)
h = h->next_cl;
}
if (done) {
/* The clause gets the label of the hint. */
struct cl_attribute *a1;
if ((a1 = get_attribute(h, LABEL_ATTR))) {
set_attribute(c, LABEL_ATTR, (void *) a1->u.s);
}
}
CLOCK_STOP(HINTS_TIME);
} /* adjust_weight_with_hints */
/*************
*
* hint_keep_test()
*
* We might want to speed this up with indexing, because it will be
* called with all generated clauses (if KEEP_HINT_SUBSUMERS is set).
*
*************/
int hint_keep_test(struct clause *c)
{
struct clause *h;
int ok = 0;
/* Note that KEEP_HINT_SUBSUMERS is ignored when
KEEP_HINT_EQUIVALENTS is set.
*/
CLOCK_START(HINTS_KEEP_TIME)
if (Flags[KEEP_HINT_EQUIVALENTS].val) {
for (h = Hints->first_cl; h && !ok; h = h->next_cl)
ok = subsume(c, h) && subsume(h, c);
}
else if (Flags[KEEP_HINT_SUBSUMERS].val) {
for (h = Hints->first_cl; h && !ok; h = h->next_cl)
ok = subsume(c, h);
}
CLOCK_STOP(HINTS_KEEP_TIME)
return(ok);
} /* hint_keep_test */
./otter/hot.c 0000744 0002044 0001012 00000016075 11120534445 011417 0 ustar beeson /*
* hot.c -- This file has routines hot-list inference.
*
*/
#include "header.h"
/* There are separate indexes for hot-list inference. They are analogous to
* the ordinary FPA indexes defined in header.h. They are used in
* a kludgey way.
*
* The indexing and inference operations refer to global pointers
* to the FPA indexes. (The indexes should be parameters, but they aren't.)
*
* In init_hot_list, pointers to the real FPA indexes are saved.
* During hot-list operations (index and inference) the ordinary
* indexes are temporarily replaced with the hot-list indexes;
* after the operation, the real fpa indexes are restored.
*/
/* These are the hot-list indexes. */
static struct fpa_index *Hot_clash_pos_lits;
static struct fpa_index *Hot_clash_neg_lits;
static struct fpa_index *Hot_alphas;
static struct fpa_index *Hot_clash_terms;
/* These are the ordinary indexes. */
static struct fpa_index *Ordinary_clash_pos_lits;
static struct fpa_index *Ordinary_clash_neg_lits;
static struct fpa_index *Ordinary_alphas;
static struct fpa_index *Ordinary_clash_terms;
/*************
*
* init_hot() -- initialize for hot-list inference.
*
*************/
void init_hot(void)
{
Ordinary_clash_pos_lits = Fpa_clash_pos_lits;
Ordinary_clash_neg_lits = Fpa_clash_neg_lits;
Ordinary_clash_terms = Fpa_clash_terms;
Ordinary_alphas = Fpa_alphas;
Hot_clash_pos_lits = alloc_fpa_index();
Hot_clash_neg_lits = alloc_fpa_index();
Hot_clash_terms = alloc_fpa_index();
Hot_alphas = alloc_fpa_index();
} /* init_hot */
/*************
*
* heat_is_on()
*
* Inference rules need to know if they are doing hot inference
* so that they can set the heat level of generated clauses.
* This kludgy routine is used instead of passing a parameter
* to all the inference routines.
*
*************/
int heat_is_on(void)
{
/* just check any one of the indexes */
return(Fpa_alphas == Hot_alphas);
} /* heat_is_on */
/*************
*
* switch_to_hot_index()
*
*************/
void switch_to_hot_index(void)
{
Fpa_clash_pos_lits = Hot_clash_pos_lits;
Fpa_clash_neg_lits = Hot_clash_neg_lits;
Fpa_clash_terms = Hot_clash_terms;
Fpa_alphas = Hot_alphas;
} /* switch_to_hot_index */
/*************
*
* switch_to_ordinary_index()
*
*************/
void switch_to_ordinary_index(void)
{
Fpa_clash_pos_lits = Ordinary_clash_pos_lits;
Fpa_clash_neg_lits = Ordinary_clash_neg_lits;
Fpa_clash_terms = Ordinary_clash_terms;
Fpa_alphas = Ordinary_alphas;
} /* switch_to_ordinary_index */
/*************
*
* hot_index_clause(c)
*
* Index a clause for hot inference.
*
*************/
void hot_index_clause(struct clause *c)
{
int already_hot = heat_is_on();
if (!already_hot)
switch_to_hot_index();
index_lits_clash(c);
if (!already_hot)
switch_to_ordinary_index();
} /* hot_index_clause */
/*************
*
* hot_dynamic(c)
*
* Insert a copy of c into the hot list.
*
*************/
void hot_dynamic(struct clause *c)
{
struct clause *hc;
hc = cl_copy(c);
hc->parents = copy_int_ptr_list(c->parents);
hc->heat_level = c->heat_level;
hot_cl_integrate(hc);
if (!Hot->first_cl)
init_hot();
hot_index_clause(hc);
append_cl(Hot, hc);
Stats[HOT_SIZE]++;
printf("\nHOT NEW CLAUSE!: "); print_clause(stdout, hc); printf("\n");
} /* hot_dynamic */
/*************
*
* hot_mark_clash(r)
*
* See hot_mark_clash_cl below.
*
*************/
static void hot_mark_clash(struct rel *r)
{
struct term *t;
struct rel *r1;
t = r->argval;
if (t->type == VARIABLE && Flags[PARA_INTO_VARS].val == 0)
return;
else {
r1 = t->occ.rel;
while (r1 != NULL && r1->clashable == 0)
r1 = r1->nocc;
r->clashable = 1;
if (r1 != NULL)
return; /* becuase t is already clashable */
else {
if (t->type == COMPLEX) {
if (Flags[PARA_SKIP_SKOLEM].val == 0 || is_skolem(t->sym_num) == 0) {
r = t->farg;
while (r != NULL) {
hot_mark_clash(r);
if (Flags[PARA_ONES_RULE].val)
r = NULL;
else
r = r->narg;
}
}
}
}
}
} /* hot_mark_clash */
/*************
*
* hot_unmark_clash(r)
*
* See hot_mark_clash_cl below.
*
*************/
static void hot_unmark_clash(struct rel *r)
{
struct term *t;
struct rel *r1;
t = r->argval;
if (t->type == VARIABLE && Flags[PARA_INTO_VARS].val == 0)
return;
else {
r->clashable = 0;
r1 = t->occ.rel;
while (r1 != NULL && r1->clashable == 0)
r1 = r1->nocc;
if (r1 != NULL)
return; /* becuase t is clashable from another containing term */
else {
if (t->type == COMPLEX) {
if (Flags[PARA_SKIP_SKOLEM].val == 0 || is_skolem(t->sym_num) == 0) {
r = t->farg;
while (r != NULL) {
hot_unmark_clash(r);
if (Flags[PARA_ONES_RULE].val)
r = NULL;
else
r = r->narg;
}
}
}
}
}
} /* hot_unmark_clash */
/*************
*
* hot_mark_clash_cl(c, mark)
*
* This is used for hot paramoudulation into the new clause.
* The clashable subterms have to be marked so that the ordinary
* para_into will work. This is similar to (un)index_mark_clash
* in index.c, but it marks/unmarks only---no indexing is done.
*
*************/
void hot_mark_clash_cl(struct clause *c,
int mark)
{
struct literal *lit;
for (lit = c->first_lit; lit; lit = lit->next_lit) {
if (!Flags[PARA_INTO_UNITS_ONLY].val || unit_clause(c)) {
if (eq_lit(lit)) {
if (Flags[PARA_INTO_LEFT].val) {
if (mark)
hot_mark_clash(lit->atom->farg);
else
hot_unmark_clash(lit->atom->farg);
}
if (Flags[PARA_INTO_RIGHT].val) {
if (mark)
hot_mark_clash(lit->atom->farg->narg);
else
hot_unmark_clash(lit->atom->farg->narg);
}
}
else {
struct rel *r;
for (r = lit->atom->farg; r; r = r->narg)
if (mark)
hot_mark_clash(r);
else
hot_unmark_clash(r);
}
}
}
} /* hot_mark_clash_cl */
/*************
*
* hot_inference(new_cl)
*
*************/
void hot_inference(struct clause *new_cl)
{
if (new_cl->heat_level < Parms[HEAT].val) {
CLOCK_START(HOT_TIME);
switch_to_hot_index(); /* Swap in hot indexes. */
if (Flags[BINARY_RES].val)
bin_res(new_cl);
if (Flags[HYPER_RES].val)
hyper_res(new_cl);
if (Flags[NEG_HYPER_RES].val)
neg_hyper_res(new_cl);
if (Flags[UR_RES].val)
ur_res(new_cl);
if (Flags[PARA_INTO].val) {
/* only need the clash marks, not the indexing */
hot_mark_clash_cl(new_cl, 1);
para_into(new_cl);
hot_mark_clash_cl(new_cl, 0);
}
if (Flags[PARA_FROM].val)
para_from(new_cl);
switch_to_ordinary_index(); /* Restore the ordinary indexes. */
CLOCK_STOP(HOT_TIME);
}
} /* hot_inference */
./otter/imd.c 0000744 0002044 0001012 00000032341 11120534445 011370 0 ustar beeson /*
*
* imd.c -- This file contains routines for discrimination
* tree indexing for demodulation.
*
*/
#include "header.h"
#include "bsym.h" // Beeson's header files
#include "bterms.h"
#include "beta.h"
/*************
*
* struct imd_tree *insert_imd_tree(t, imd) -- called by imd_insert
*
*************/
static struct imd_tree *insert_imd_tree(struct term *t,
struct imd_tree *imd)
{
struct rel *r;
struct imd_tree *i1, *i2, *i3;
int varnum, sym;
if (t->type == VARIABLE) {
i1 = imd->kids;
i2 = NULL;
varnum = t->varnum;
while (i1 != NULL && i1->type == VARIABLE && (int) i1->lab < varnum) {
i2 = i1;
i1 = i1->next;
}
if (i1 == NULL || i1->type != VARIABLE || i1->lab != varnum) {
i3 = get_imd_tree();
i3->type = VARIABLE;
i3->lab = varnum;
i3->next = i1;
if (i2 == NULL)
imd->kids = i3;
else
i2->next = i3;
return(i3);
}
else /* found node */
return(i1);
}
else { /* NAME || COMPLEX */
i1 = imd->kids;
i2 = NULL;
sym = t->sym_num; /* arities fixed: handle both NAME and COMPLEX */
while (i1 != NULL && i1->type == VARIABLE) { /* skip variables */
i2 = i1;
i1 = i1->next;
}
while (i1 != NULL && (int) i1->lab < sym) {
i2 = i1;
i1 = i1->next;
}
if (i1 == NULL || i1->lab != sym) {
i3 = get_imd_tree();
i3->type = t->type;
i3->lab = sym;
i3->next = i1;
i1 = i3;
}
else
i3 = NULL; /* new node not required at this level */
if (t->type == COMPLEX) {
r = t->farg;
while (r != NULL) {
i1 = insert_imd_tree(r->argval, i1);
r = r->narg;
}
}
if (i3 != NULL) { /* link in new subtree (possibly a leaf) */
if (i2 == NULL)
imd->kids = i3;
else
i2->next = i3;
}
return(i1); /* i1 is leaf corresp. to end of input term */
}
} /* insert_imd_tree */
/*************
*
* imd_insert(demod, imd)
*
* Insert the left argument of demod into the discrimination
* tree index for demodulation.
*
*************/
void imd_insert(struct clause *demod,
struct imd_tree *imd)
{
struct imd_tree *i1;
struct term *atom, *alpha, *beta;
struct term_ptr *tp;
int max;
atom = ith_literal(demod,1)->atom;
if (atom->varnum != CONDITIONAL_DEMOD) {
alpha = atom->farg->argval;
beta = atom->farg->narg->argval;
}
else { /* CONDITIONAL(cond, alpha, beta) */
alpha = atom->farg->narg->argval->farg->argval;
beta = atom->farg->narg->argval->farg->narg->argval;
}
if (term_ident(alpha, beta)) {
fprintf(stderr, "\nWARNING, instance of x=x cannot be inserted into demod_imd index: ");
print_clause(stderr, demod);
printf("\nWARNING, instance of x=x cannot be inserted into demod_imd index: ");
print_clause(stdout, demod);
}
else {
i1 = insert_imd_tree(alpha, imd);
tp = get_term_ptr();
tp->term = atom;
tp->next = i1->atoms;
if ((max = biggest_var(alpha)) == -1)
i1->max_vnum = 0; /* in case i->max_vnum is an unsigned char */
else
i1->max_vnum = max;
i1->atoms = tp;
}
} /* imd_insert */
/*************
*
* struct imd_tree *end_term_imd(t, imd, path_p)
*
* Given a discrimination tree (or a subtree) and a term, return the
* node in the tree that corresponds to the last symbol in t (or NULL
* if the node doesn't exist). *path_p is a list that is extended by
* this routine. It is a list of pointers to the
* nodes in path from the parent of the returned node up to imd.
* (It is needed for deletions, because nodes do not have pointers to
* parents.)
*
*************/
static struct imd_tree *end_term_imd(struct term *t,
struct imd_tree *imd,
struct term_ptr **path_p)
{
struct rel *r;
struct imd_tree *i1;
struct term_ptr *imdp;
int varnum, sym;
/* add current node to the front of the path list. */
imdp = get_term_ptr();
imdp->term = (struct term *) imd;
imdp->next = *path_p;
*path_p = imdp;
if (t->type == VARIABLE) {
i1 = imd->kids;
varnum = t->varnum;
while (i1 != NULL && i1->type == VARIABLE && (int) i1->lab < varnum)
i1 = i1->next;
if (i1 == NULL || i1->type != VARIABLE || i1->lab != varnum)
return(NULL);
else /* found node */
return(i1);
}
else { /* NAME || COMPLEX */
i1 = imd->kids;
sym = t->sym_num; /* arities fixed: handle both NAME and COMPLEX */
while (i1 != NULL && i1->type == VARIABLE) /* skip variables */
i1 = i1->next;
while (i1 != NULL && (int) i1->lab < sym)
i1 = i1->next;
if (i1 == NULL || i1->lab != sym)
return(NULL);
else {
if (t->type == NAME)
return(i1);
else {
r = t->farg;
while (r != NULL && i1 != NULL) {
i1 = end_term_imd(r->argval, i1, path_p);
r = r->narg;
}
return(i1);
}
}
}
} /* end_term_imd */
/*************
*
* imd_delete(demod, root_imd)
*
* Delete the left argument of demod from the demodulation discrimination tree.
*
*************/
void imd_delete(struct clause *demod,
struct imd_tree *root_imd)
{
struct imd_tree *end, *i2, *i3, *parent;
struct term_ptr *tp1, *tp2;
struct term_ptr *imdp, *path;
struct term *atom, *alpha;
/* First find the correct leaf. path is used to help with */
/* freeing nodes, because nodes don't have parent pointers. */
path = NULL;
atom = ith_literal(demod,1)->atom;
if (atom->varnum == CONDITIONAL_DEMOD)
alpha = atom->farg->narg->argval->farg->argval;
else
alpha = atom->farg->argval;
end = end_term_imd(alpha, root_imd, &path);
if (end == NULL) {
print_term_nl(stdout, alpha);
abend("imd_delete, can't find alpha.");
}
tp1 = end->atoms;
tp2 = NULL;
while (tp1 != NULL && tp1->term != atom) {
tp2 = tp1;
tp1 = tp1->next;
}
if (tp1 == NULL) {
print_term_nl(stdout, atom);
abend("imd_delete, can't find atom.");
}
if (tp2 == NULL)
end->atoms = tp1->next;
else
tp2->next = tp1->next;
free_term_ptr(tp1);
if (end->atoms == NULL) {
/* free tree nodes from bottom up, using path to get parents */
imdp = path;
while (end->kids == NULL && end != root_imd) {
parent = (struct imd_tree *) imdp->term;
imdp = imdp->next;
i2 = parent->kids;
i3 = NULL;
while (i2 != end) {
i3 = i2;
i2 = i2->next;
}
if (i3 == NULL)
parent->kids = i2->next;
else
i3->next = i2->next;
free_imd_tree(i2);
end = parent;
}
}
/* free path list */
while (path != NULL) {
imdp = path;
path = path->next;
free_term_ptr(imdp);
}
} /* imd_delete */
/*************
*
* struct term *contract_imd(t_in, demods, subst, demod_id_p)
*
* Attempt to contract (rewrite one step) a term (t_in) using demodulators
* in a discrimination tree index (demods). NULL is returned if t_in
* cannot be contracted. subst is an empty substitution.
* If success, *demod_id_p is set to the ID of the rewrite rule.
*
*************/
struct term *contract_imd(struct term *t_in,
int *demods,
struct context *subst,
int *demod_id_p)
{
struct rel *rel_stack[MAX_AL_TERM_DEPTH];
struct imd_tree *imd, *i1;
struct imd_pos *pos, *ip2;
struct term *t, *t2, *t3, *atom;
struct term *replacement = NULL;
struct term_ptr *tp;
int top, found, backup, varnum, j, reset, mult_flag, sym, ok, dummy;
imd = (struct imd_tree *) demods;
if(FUNCTOR(t_in) == AP && FUNCTOR(ARG0(t_in)) == LAMBDA)
{ struct term *t1 = beta_reduce(t_in,subst); // Beeson 10.6.02 added this and the next few lines
if(t1 != NULL)
{ *demod_id_p = BETA_REDUCTION;
return t1;
}
}
if (imd == NULL)
return(NULL);
pos = NULL;
top = -1;
backup = 0;
i1 = imd->kids;
t = t_in;
while(1) {
if (backup) {
if (pos == NULL)
return(NULL);
else { /* pop top of stack (most recent variable node)
and restore state */
top = pos->stack_pos;
for (j = 0; j <= top; j++)
rel_stack[j] = pos->rel_stack[j];
i1 = pos->imd;
t = subst->terms[i1->lab];
if (pos->reset) /* undo variable binding */
subst->terms[i1->lab] = NULL;
i1 = i1->next;
ip2 = pos;
pos = pos->next;
free_imd_pos(ip2);
}
}
/* at this point, i1 is the next node to try */
found = 0;
/* first try to match input term t with a variable node */
while (found == 0 && i1 != NULL && i1->type == VARIABLE) {
varnum = i1->lab;
if (subst->terms[varnum] == NULL) { /*if not bound, bind it */
subst->terms[varnum] = t;
subst->contexts[varnum] = NULL;
found = 1;
reset = 1;
}
else { /* bound variable, succeed iff identical */
found = term_ident(subst->terms[varnum], t);
reset = 0;
}
if (found) { /* save state */
ip2 = get_imd_pos();
ip2->next = pos;
pos = ip2;
pos->imd = i1;
pos->reset = reset;
for (j = 0; j <= top; j++)
pos->rel_stack[j] = rel_stack[j];
pos->stack_pos = top;
}
else /* try next variable */
i1 = i1->next;
} // while
backup = 0;
if (found == 0) { /* couldn't match t with (another) variable */
if (t->type == VARIABLE)
backup = 1; /* because we can't instantiate given term */
else { /* NAME or COMPLEX */
sym = t->sym_num;
while (i1 != NULL && (int) i1->lab < sym)
i1 = i1->next;
if (i1 == NULL || i1->lab != sym)
backup = 1;
else if (t->type == COMPLEX) {
top++;
if (top >= MAX_AL_TERM_DEPTH) {
abend("contract_imd, increase MAX_AL_TERM_DEPTH.");
return(NULL); /* to quiet lint */
}
rel_stack[top] = t->farg; /* save pointer to subterms */
}
} // else NAME or COMPLEX
} // if (found == 0)
if (backup == 0) { /* get next term from rel_stack */
while (top >= 0 && rel_stack[top] == NULL)
top--;
if (top == -1) { /* found potential demods */
tp = i1->atoms;
ok = 0;
while(tp != NULL && ok == 0) {
atom = tp->term;
mult_flag = 0;
if (atom->varnum == LEX_DEP_DEMOD) {
replacement = apply_demod(atom->farg->narg->argval, subst, &mult_flag);
if (Flags[LRPO].val)
ok = lrpo_greater(t_in, replacement);
else
ok = lex_check(replacement, t_in) == LESS_THAN;
if (ok == 0) {
zap_term_special(replacement);
tp = tp->next;
}
}
else if (atom->varnum == CONDITIONAL_DEMOD) {
/* apply subst to condition, then demodulate */
t2 = apply_demod(atom->farg->argval, subst, &dummy);
t3 = convenient_demod(t2);
ok = is_symbol(t3, "$T", 0);
zap_term_special(t3);
if (ok)
replacement = apply_demod(atom->farg->narg->argval->farg->narg->argval, subst, &mult_flag);
else
tp = tp->next;
}
else { /* regular demodulator */
replacement = apply_demod(atom->farg->narg->argval, subst, &mult_flag);
ok = 1;
}
} // while(tp != NULL...
if (ok) {
if (mult_flag)
subst->multiplier++;
for (j = 0; j <= (int) i1->max_vnum; j++) /* clear substitution */
subst->terms[j] = NULL;
free_imd_pos_list(pos);
zap_term_special(t_in);
*demod_id_p = tp->term->occ.lit->container->id;
return(replacement);
}
else /* failed lex_checks, so prepare to back up */
backup = 1;
} // if(top == -1)
else { /* pop a term and continue */
t = rel_stack[top]->argval;
rel_stack[top] = rel_stack[top]->narg;
i1 = i1->kids;
}
} // if(backup == 0)
} /* end of while(1) loop */
} /* contract_imd */
/*************
*
* print_imd_tree(file_pointer, imd_tree, level)
*
* Display an imd tree. Level == 0 on initial call.
*
*************/
void print_imd_tree(FILE *fp,
struct imd_tree *imd,
int level)
{
struct imd_tree *i1;
int i;
fprintf(fp, "%x ", (unsigned) imd);
for (i = 0; i < level; i++)
fprintf(fp, " ");
if (imd->type == 0)
fprintf(fp, "start of index-match-demodulate tree");
else if (imd->type == VARIABLE)
fprintf(fp, "v%d ", imd->lab);
else
fprintf(fp, "%s ", sn_to_str((int) imd->lab));
if (imd->atoms != NULL) {
fprintf(fp, " demod=");
print_term(fp, imd->atoms->term);
}
fprintf(fp, "\n");
i1 = imd->kids;
while (i1 != NULL) {
print_imd_tree(fp, i1, level + 1);
i1 = i1->next;
}
} /* print_imd_tree */
/*************
*
* p_imd_tree(imd_tree)
*
* Display an imd tree. Level == 0 on initial call.
*
*************/
void p_imd_tree(struct imd_tree *imd)
{
print_imd_tree(stdout, imd, 0);
} /* p_imd_tree */
./otter/index.c 0000744 0002044 0001012 00000021517 11120534445 011731 0 ustar beeson /*
* index.c -- Routines for indexing and unindexing clauses.
*
*/
#include "header.h"
/*************
*
* index_mark_clash(r) -- recursive routine to mark and index
* clashable terms (terms that can be used by paramodulation).
*
*************/
static void index_mark_clash(struct rel *r)
{
struct term *t;
struct rel *r1;
t = r->argval;
if (t->type == VARIABLE && Flags[PARA_INTO_VARS].val == 0)
return;
else {
r1 = t->occ.rel;
while (r1 != NULL && r1->clashable == 0)
r1 = r1->nocc;
r->clashable = 1;
if (r1 != NULL)
return; /* because t is already clashable */
else {
if (Flags[PARA_FROM].val)
fpa_insert(t, Parms[FPA_TERMS].val, Fpa_clash_terms);
if (t->type == COMPLEX) {
if (Flags[PARA_SKIP_SKOLEM].val == 0 || is_skolem(t->sym_num) == 0) {
r = t->farg;
while (r != NULL) {
index_mark_clash(r);
if (Flags[PARA_ONES_RULE].val)
r = NULL;
else
r = r->narg;
}
}
}
}
}
} /* index_mark_clash */
/*************
*
* un_index_mark_clash(r)
*
* See index_mark_clash.
*
*************/
static void un_index_mark_clash(struct rel *r)
{
struct term *t;
struct rel *r1;
t = r->argval;
if (t->type == VARIABLE && Flags[PARA_INTO_VARS].val == 0)
return;
else {
r->clashable = 0;
r1 = t->occ.rel;
while (r1 != NULL && r1->clashable == 0)
r1 = r1->nocc;
if (r1 != NULL)
return; /* because t is clashable from another containing term */
else {
if (Flags[PARA_FROM].val)
fpa_delete(t, Parms[FPA_TERMS].val, Fpa_clash_terms);
if (t->type == COMPLEX) {
if (Flags[PARA_SKIP_SKOLEM].val == 0 || is_skolem(t->sym_num) == 0) {
r = t->farg;
while (r != NULL) {
un_index_mark_clash(r);
if (Flags[PARA_ONES_RULE].val)
r = NULL;
else
r = r->narg;
}
}
}
}
}
} /* un_index_mark_clash */
/*************
*
* index_paramod(atom) -- index for paramodulation inference rules
*
* Index clashable terms for `from' paramodulation, and
* index clashable args of equality for `into' paramodulation.
*
* Also mark clashable terms for the paramodulation routines.
*
*************/
static void index_paramod(struct term *atom)
{
struct rel *r;
struct literal *lit;
lit = atom->occ.lit;
if (eq_lit(lit)&&term_ident(atom->farg->argval, atom->farg->narg->argval))
return;
/* First index clashable `into' terms for `from' paramodulation. */
if (!Flags[PARA_INTO_UNITS_ONLY].val || unit_clause(lit->container)) {
if (pos_eq_lit(lit) || neg_eq_lit(lit)) {
if (Flags[PARA_INTO_LEFT].val)
index_mark_clash(atom->farg);
if (Flags[PARA_INTO_RIGHT].val)
index_mark_clash(atom->farg->narg);
}
else {
for (r = atom->farg; r; r = r->narg)
index_mark_clash(r);
}
}
/* Now index clashable `from' terms for `into' paramodulation. */
if (!Flags[PARA_FROM_UNITS_ONLY].val || unit_clause(lit->container)) {
if (pos_eq_lit(lit) && Flags[PARA_INTO].val) {
if (Flags[PARA_FROM_LEFT].val) {
if (Flags[PARA_FROM_VARS].val || atom->farg->argval->type != VARIABLE)
fpa_insert(atom->farg->argval, Parms[FPA_TERMS].val, Fpa_alphas);
}
if (Flags[PARA_FROM_RIGHT].val) {
if (Flags[PARA_FROM_VARS].val || atom->farg->narg->argval->type != VARIABLE)
fpa_insert(atom->farg->narg->argval, Parms[FPA_TERMS].val, Fpa_alphas);
}
}
}
} /* index_paramod */
/*************
*
* un_index_paramod(atom)
*
* See index_paramod.
*
*************/
static void un_index_paramod(struct term *atom)
{
struct rel *r;
struct literal *lit;
lit = atom->occ.lit;
if (eq_lit(lit)&&term_ident(atom->farg->argval, atom->farg->narg->argval))
return;
if (!Flags[PARA_INTO_UNITS_ONLY].val || unit_clause(lit->container)) {
if (pos_eq_lit(lit) || neg_eq_lit(lit)) {
if (Flags[PARA_INTO_LEFT].val)
un_index_mark_clash(atom->farg);
if (Flags[PARA_INTO_RIGHT].val)
un_index_mark_clash(atom->farg->narg);
}
else {
for (r = atom->farg; r; r = r->narg)
un_index_mark_clash(r);
}
}
if (!Flags[PARA_FROM_UNITS_ONLY].val || unit_clause(lit->container)) {
if (pos_eq_lit(lit) && Flags[PARA_INTO].val) {
if (Flags[PARA_FROM_LEFT].val)
if (Flags[PARA_FROM_VARS].val || atom->farg->argval->type != VARIABLE)
fpa_delete(atom->farg->argval, Parms[FPA_TERMS].val, Fpa_alphas);
if (Flags[PARA_FROM_RIGHT].val)
if (Flags[PARA_FROM_VARS].val || atom->farg->narg->argval->type != VARIABLE)
fpa_delete(atom->farg->narg->argval, Parms[FPA_TERMS].val, Fpa_alphas);
}
}
} /* un_index_paramod */
/*************
*
* index_lits_all(c)
*
* Index literals for forward subsumption, back subsumption, and
* unit conflict.
* Positive and negative literals go into different indexes.
* The NO_FAPL, NO_FANL and FOR_SUB_FPA flags are checked to determine
* what and how to index.
*
* NO_FAPL can be set if you are generating only positive clauses
* and back subsumption is off. It surpresses indexing of positive
* literals in the non-clashable index. (The index for subsumption
* and unit conflict.)
* Similarly for negative literals with NO_FANL.
*
*************/
void index_lits_all(struct clause *c)
{
struct literal *lit;
lit = c->first_lit;
while (lit != NULL) {
if (lit->atom->varnum == ANSWER)
; /* skip answer literal */
else if (lit->sign) {
if (Flags[NO_FAPL].val == 0)
fpa_insert(lit->atom, Parms[FPA_LITERALS].val, Fpa_pos_lits);
if ((Flags[FOR_SUB_FPA].val == 0 && Flags[FOR_SUB].val) ||
(Flags[UNIT_DELETION].val && num_literals(c) == 1))
is_insert(lit->atom, Is_pos_lits);
}
else {
if (Flags[NO_FANL].val == 0)
fpa_insert(lit->atom, Parms[FPA_LITERALS].val, Fpa_neg_lits);
if ((Flags[FOR_SUB_FPA].val == 0 && Flags[FOR_SUB].val) ||
(Flags[UNIT_DELETION].val && num_literals(c) == 1))
is_insert(lit->atom, Is_neg_lits);
}
lit = lit->next_lit;
}
} /* index_lits_all */
/*************
*
* un_index_lits_all(c)
*
* See index_lits_all.
*
*************/
void un_index_lits_all(struct clause *c)
{
struct literal *lit;
lit = c->first_lit;
while (lit != NULL) {
if (lit->atom->varnum == ANSWER)
; /* skip answer literal */
else if (lit->sign) {
if (Flags[NO_FAPL].val == 0)
fpa_delete(lit->atom, Parms[FPA_LITERALS].val, Fpa_pos_lits);
if ((Flags[FOR_SUB_FPA].val == 0 && Flags[FOR_SUB].val) ||
(Flags[UNIT_DELETION].val && num_literals(c) == 1)
)
is_delete(lit->atom, Is_pos_lits);
}
else {
if (Flags[NO_FANL].val == 0)
fpa_delete(lit->atom, Parms[FPA_LITERALS].val, Fpa_neg_lits);
if ((Flags[FOR_SUB_FPA].val == 0 && Flags[FOR_SUB].val) ||
(Flags[UNIT_DELETION].val && num_literals(c) == 1))
is_delete(lit->atom, Is_neg_lits);
}
lit = lit->next_lit;
}
} /* un_index_lits_all */
/*************
*
* index_lits_clash(c)
*
* Index literals for inference rules, and index terms for paramodulation if
* any paramodulation inference rules are set.
*
*************/
void index_lits_clash(struct clause *c)
{
struct literal *lit;
lit = c->first_lit;
while (lit != NULL) {
if (lit->atom->varnum == ANSWER || lit->atom->varnum == EVALUABLE)
; /* skip answer literals and evaluable literals */
else if (lit->sign)
{ fpa_insert(lit->atom, Parms[FPA_LITERALS].val, Fpa_clash_pos_lits);
}
else
fpa_insert(lit->atom, Parms[FPA_LITERALS].val, Fpa_clash_neg_lits);
if (Flags[PARA_FROM].val || Flags[PARA_INTO].val)
index_paramod(lit->atom);
lit = lit->next_lit;
if (Flags[HYPER_SYMMETRY_KLUDGE].val)
break;
}
} /* index_lits_clash */
/*************
*
* un_index_lits_clash(c)
*
* See index_lits_clash.
*
*************/
void un_index_lits_clash(struct clause *c)
{
struct literal *lit;
lit = c->first_lit;
while (lit != NULL) {
if (lit->atom->varnum == ANSWER || lit->atom->varnum == EVALUABLE)
; /* skip answer literals and evaluable literals */
else if (lit->sign)
fpa_delete(lit->atom, Parms[FPA_LITERALS].val, Fpa_clash_pos_lits);
else
fpa_delete(lit->atom, Parms[FPA_LITERALS].val, Fpa_clash_neg_lits);
if (Flags[PARA_FROM].val || Flags[PARA_INTO].val)
un_index_paramod(lit->atom);
lit = lit->next_lit;
if (Flags[HYPER_SYMMETRY_KLUDGE].val)
break;
}
} /* un_index_lits_clash */
./otter/io.c 0000744 0002044 0001012 00000200077 11120534445 011231 0 ustar beeson /* 7.24.02, Beeson added AP and LAMBDA
*/
/*
* io.c -- input/output routines
*
*/
/* to do for new operator stuff:
*
* 5. optimize seq_to_term?
* 8. can protect cl when in list with parens, but output does not get parens.
* 10. -3 should be a number, -(3) should not. Same for unary +.
* 11. Check arity problem?
* 12. check set_variables?
*
*/
#include "header.h"
#include "bsym.h" // Beeson 8.03.02
#define SYM_TAB_SIZE 150 /* Beeson changed from 50, 8.3.02 */
#define MAX_COMPLEX 1000 /* number of operators/terms */
/* Following structure is to store data on symbol that might be special op. */
struct sequence_member {
struct term *t;
short binary_type;
short binary_prec;
short unary_type;
short unary_prec;
};
static struct sym_ent *Sym_tab[SYM_TAB_SIZE]; /* Symbol Table */
/* The following is in different .h files on different OSs, so I'll
* just cheat and declare it myself.
*/
#if 0
#ifndef THINK_C /* if not Macintosh */
extern double strtod();
#endif
#endif
/*************
*
* int str_double(string, double_ptr) -- Translate a string to a double.
*
* Return(1) iff success.
*
*************/
int str_double(char *s,
double *dp)
{
char *end;
double d;
if (*s != '\"')
return(0);
else if (*(s+1) == '\"')
return(0);
else {
d = strtod(s+1, &end);
*dp = d;
return (*end == '\"');
}
} /* str_double */
/*************
*
* double_str(double, str) -- translate a double to a string
*
* Like sprintf, except that format is built in and string is
* surrounded by double quotes.
*
*************/
void double_str(double d,
char *s)
{
int i, n;
sprintf(s, Float_format, d);
n = strlen(s);
for (i=n; i>0; i--)
s[i] = s[i-1];
s[0] = '\"';
s[n+1] = '\"';
s[n+2] = '\0';
} /* double_str */
/*************
*
* int str_int(string, int_ptr) -- Translate a string to an integer.
*
* String has optional '+' or '-' as first character.
* Return(1) iff success.
*
*************/
int str_int(char *s,
int *np)
{
int i, sign, n;
i = 0;
sign = 1;
if (s[0] == '+' || s[0] == '-') {
if (s[0] == '-')
sign = -1;
i = 1;
}
if (s[i] == '\0')
return(0);
else {
n = 0;
for( ; s[i] >= '0' && s[i] <= '9'; i++)
n = n * 10 + s[i] - '0';
*np = n * sign;
return(s[i] == '\0');
}
} /* str_int */
/*************
*
* int_str(int, str) -- translate an integer to a string
*
*************/
void int_str(int i,
char *s)
{
int j, sign;
if ((sign = i) < 0)
i = -i;
j = 0;
if (i == 0)
s[j++] = '0';
else {
while (i > 0) {
s[j++] = i % 10 + '0';
i = i / 10;
}
}
if (sign < 0)
s[j++] = '-';
s[j] = '\0';
reverse(s);
} /* int_str */
/*************
*
* int str_long(string, long_ptr) -- Translate a string to a long.
*
* String has optional '+' or '-' as first character.
* Return(1) iff success.
*
*************/
int str_long(char *s,
long int *np)
{
int i, sign;
long n;
i = 0;
sign = 1;
if (s[0] == '+' || s[0] == '-') {
if (s[0] == '-')
sign = -1;
i = 1;
}
if (s[i] == '\0')
return(0);
else {
n = 0;
for( ; s[i] >= '0' && s[i] <= '9'; i++)
n = n * 10 + s[i] - '0';
*np = n * sign;
return(s[i] == '\0');
}
} /* str_long */
/*************
*
* int bits_ulong(string, long_ptr) -- Translate a string to a long.
*
* String must consist only of 0's and 1's.
*
* Return(1) iff success.
*
*************/
int bits_ulong(char *s,
long unsigned int *np)
{
int i;
unsigned long n;
n = 0;
for(i = 0 ; s[i] == '0' || s[i] == '1'; i++)
n = n * 2 + s[i] - '0';
*np = n;
return(s[i] == '\0');
} /* bits_ulong */
/*************
*
* long_str(int, str) -- translate a long to a string
*
*************/
void long_str(long int i,
char *s)
{
int j;
long sign;
if ((sign = i) < 0)
i = -i;
j = 0;
if (i == 0)
s[j++] = '0';
else {
while (i > 0) {
s[j++] = (char) (i % 10 + '0'); // Beeson added cast 10.2.02 to silence a warning
i = i / 10;
}
}
if (sign < 0)
s[j++] = '-';
s[j] = '\0';
reverse(s);
} /* long_str */
/*************
*
* ulong_bits(int, str) -- translate a long to a base-2 string.
*
*************/
void ulong_bits(long unsigned int i,
char *s)
{
unsigned long j;
int n, k;
/* Set n to the number of places we'll use. */
/* First ignore leading 0's, then increase if necessary. */
for (j = i, n = 0; j > 0; j = j >> 1, n++);
n = (n < Parms[MIN_BIT_WIDTH].val ? Parms[MIN_BIT_WIDTH].val : n);
/* build the string */
for (k = 0; k < n; k++)
s[k] = '0' + (char) ((i >> (n-(k+1))) & 1); // cast added by Beeson 7.23.02
s[n] = '\0';
} /* ulong_bits */
/*************
*
* cat_str(s1, s2, s3)
*
*************/
void cat_str(char *s1,
char *s2,
char *s3)
{
int i, j;
for (i = 0; s1[i] != '\0'; i++)
s3[i] = s1[i];
for (j = 0; s2[j] != '\0'; j++, i++)
s3[i] = s2[j];
s3[i] = '\0';
} /* cat_str */
/*************
*
* int str_ident(s, t) -- Identity of strings
*
*************/
int str_ident(char *s,
char *t)
// return 1 if s is an initial segment of t, 0 otherwise
{
for ( ; *s == *t; s++, t++)
if (*s == '\0') return(1);
return(0);
} /* str_ident */
/*************
*
* reverse(s) -- reverse a string
*
*************/
void reverse(char *s)
{
int i, j;
char temp;
for (i = 0, j = strlen(s)-1; i<j; i++, j--) {
temp = s[i];
s[i] = s[j];
s[j] = temp;
}
} /* reverse */
/*************
*
* struct sym_ent *insert_sym(string, arity)
*
* Insert string/arity into the symbol table and return the symbol
* table node. Do not check if string/arity is already there.
*
*************/
struct sym_ent *insert_sym(char *s,
int arity)
{
struct sym_ent *p;
int i;
p = get_sym_ent();
strcpy(p->name, s);
p->arity = arity;
p->lex_val = (2 * Parms[NEW_SYMBOL_LEX_POSITION].val) - 1;
if((p->sym_num = bsym(s,arity)) == 0)
p->sym_num = new_sym_num();
i = p->sym_num % SYM_TAB_SIZE;
p->next = Sym_tab[i];
Sym_tab[i] = p;
return(p);
} /* insert_sym */
/*************
*
* int str_to_sn(str, arity) -- Return a symbol number for string/arity.
*
* If the given string/arity is already in the global symbol table,
* then return symbol number; else, create a new symbol table entry and
* return a new symbol number
*
*************/
int str_to_sn(char *str,
int arity)
{
struct sym_ent *p, *save;
int i;
long dummy;
save = NULL;
for (i = 0; i < SYM_TAB_SIZE; i++) {
p = Sym_tab[i];
while (p != NULL) {
if (!str_ident(str, p->name))
p = p->next;
else if (p->arity != arity) {
save = p;
p = p->next;
}
else {
if (p->eval_code != 0)
/* recall that evaluable symbols are inserted in init */
Internal_flags[DOLLAR_PRESENT] = 1;
return(p->sym_num);
}
}
}
if (save && !save->special_op &&
Flags[CHECK_ARITY].val &&
Internal_flags[REALLY_CHECK_ARITY] &&
!str_ident(str, "$Quantified") &&
!str_ident(str, "$Hyps") &&
!str_ident(str, "$Concs") ) {
fprintf(stderr, "%c\n\nWARNING, multiple arity: %s/%d, %s/%d.\n\n", Bell,
save->name, save->arity, str, arity);
}
/* String/arity not in table, so create an entry. */
p = insert_sym(str, arity);
if (str[0] == '$' &&
p->sym_num != Cons_sym_num && /* Lists */
p->sym_num != Nil_sym_num &&
p->sym_num != Ignore_sym_num && /* Misc */
p->sym_num != Chr_sym_num &&
p->sym_num != Dots_sym_num &&
!initial_str("$Quantified", str) &&
!initial_str("$ANS", str) && /* Answer literals */
!initial_str("$Ans", str) &&
!initial_str("$ans", str) &&
!str_ident(str, "$NUCLEUS") && /* Linked inference */
!str_ident(str, "$BOTH") &&
!str_ident(str, "$LINK") &&
!str_ident(str, "$SATELLITE") &&
!str_ident(str, "$FSUB") && /* Hints */
!str_ident(str, "$BSUB") &&
!str_ident(str, "$EQUIV") &&
!str_ident(str, "$Concs") && /* Sequent i/o */
!str_ident(str, "$Hyps") &&
!skolem_symbol(p->sym_num) &&
!str_long(str+1, &dummy)) /* e.g., weight(f($3,a),-2) */
fprintf(stderr, "%c\n\nWARNING, unrecognized $ symbol: %s.\n\n", Bell, str);
return(p->sym_num);
} /* str_to_sn */
/*************
*
* print_syms(file_ptr) -- Display the symbol list.
*
*************/
void print_syms(FILE *fp)
{
struct sym_ent *p;
int i;
for (i = 0; i < SYM_TAB_SIZE; i++) {
p = Sym_tab[i];
while (p != NULL) {
fprintf(fp, "%d %s/%d, lex_val=%d\n", p->sym_num, p->name, p->arity, p->lex_val);
p = p->next;
}
}
} /* print_syms */
/*************
*
* p_syms()
*
*************/
void p_syms(void)
{
print_syms(stdout);
} /* p_syms */
/*************
*
* char *sn_to_str(sym_num) -- given a symbol number, return the name
*
*************/
char *sn_to_str(int sym_num)
{
struct sym_ent *p;
p = Sym_tab[sym_num % SYM_TAB_SIZE];
while (p != NULL && p->sym_num != sym_num)
p = p->next;
if (p == NULL)
return("");
else
return(p->name);
} /* sn_to_str */
/*************
*
* int sn_to_arity(sym_num) -- given a symbol number, return the arity
*
*************/
int sn_to_arity(int sym_num)
{
struct sym_ent *p;
p = Sym_tab[sym_num % SYM_TAB_SIZE];
while (p != NULL && p->sym_num != sym_num)
p = p->next;
if (p == NULL)
return(-1);
else
return(p->arity);
} /* sn_to_arity */
/*************
*
* int sn_to_node(sym_num)
*
* Given a symbol number, return the symbol table node.
*
*************/
struct sym_ent *sn_to_node(int sym_num)
{
struct sym_ent *p;
p = Sym_tab[sym_num % SYM_TAB_SIZE];
while (p != NULL && p->sym_num != sym_num)
p = p->next;
return(p); /* possibly NULL */
} /* sn_to_node */
/*************
*
* int sn_to_ec(sym_num)
*
* Given a symbol number, return the evaluation code.
*
*************/
int sn_to_ec(int sym_num)
{
struct sym_ent *p;
p = Sym_tab[sym_num % SYM_TAB_SIZE];
while (p != NULL && p->sym_num != sym_num)
p = p->next;
if (p == NULL)
return(-1);
else
return(p->eval_code);
} /* sn_to_ec */
/*************
*
* sym_tab_member(str, arity)
*
* Similar to str_to_sn, but do not insert if not there,
* and return node instead of sn.
*
*************/
struct sym_ent *sym_tab_member(char *str,
int arity)
{
struct sym_ent *p;
int i;
for (i = 0; i < SYM_TAB_SIZE; i++) {
p = Sym_tab[i];
while (p != NULL) {
if (!str_ident(str, p->name))
p = p->next;
else if (p->arity != arity)
p = p->next;
else
return(p);
}
}
return((struct sym_ent *) NULL);
} /* sym_tab_member */
/*************
*
* int in_sym_tab(s) -- is s in the symbol table?
*
*************/
int in_sym_tab(char *s)
{
struct sym_ent *p;
int i;
for (i = 0; i < SYM_TAB_SIZE; i++) {
p = Sym_tab[i];
while (p != NULL) {
if (str_ident(p->name, s))
return(1);
p = p->next;
}
}
return(0);
} /* in_sym_tab */
/*************
*
* free_sym_tab() -- free all symbols in the symbol table
*
*************/
void free_sym_tab(void)
{
struct sym_ent *p1, *p2;
int i;
for (i = 0; i < SYM_TAB_SIZE; i++) {
p1 = Sym_tab[i];
while (p1 != NULL) {
p2 = p1;
p1 = p1->next;
free_sym_ent(p2);
}
Sym_tab[i] = NULL;
}
} /* free_sym_tab */
/*************
*
* int is_symbol(t, str, arity)
*
* Does t have leading function symbol str with arity?
*
*************/
int is_symbol(struct term *t,
char *str,
int arity)
{
return((t->type == COMPLEX || t->type == NAME) &&
sn_to_arity(t->sym_num) == arity &&
str_ident(sn_to_str(t->sym_num), str));
} /* is_symbol */
/*************
*
* mark_as_skolem(sym_num)
*
*************/
void mark_as_skolem(int sym_num)
{
struct sym_ent *se;
se = sn_to_node(sym_num);
if (!se) {
char s[500];
sprintf(s, "mark_as_skolem, no symbol for %d.", sym_num);
abend(s);
}
else
se->skolem = 1;
} /* mark_as_skolem */
/*************
*
* int is_skolem(sym_num)
*
*************/
int is_skolem(int sym_num)
{
struct sym_ent *se;
se = sn_to_node(sym_num);
if (!se) {
char s[500];
sprintf(s, "is_skolem, no symbol for %d.", sym_num);
abend(s);
return(0); /* to quiet lint */
}
else
return(se->skolem);
} /* is_skolem */
/*************
*
* int initial_str(s, t) -- Is s an initial substring of t?
*
*************/
int initial_str(char *s,
char *t)
{
for ( ; *s == *t; s++, t++)
if (*s == '\0') return(1);
return(*s == '\0');
} /* initial_str */
/*************
* int set_vars(term) (McCune's function)
*
* Decide which of the names are really variables, and make
* into variables. (This routine is used only on input terms.)
* Preserve the user's variable names by keeping the pointer into
* the symbol list.
*
* If too many variables, return(0); else return(1).
*
*************/
int set_vars(struct term *t)
{ char *varnames[MAX_VARS];
memset(varnames,0,MAX_VARS * sizeof(char *)); // Beeson 10.6.02, replacing a for-loop
return (set_vars_term(t, varnames));
} /* set_vars */
/*************
*
* int set_vars_term(term, varnames)
*
*************/
int set_vars_term(struct term *t,
char **varnames)
{
struct rel *r;
int i, rc;
if (t->type == COMPLEX) {
r = t->farg;
rc = 1;
while (rc && r != NULL) {
rc = set_vars_term(r->argval, varnames);
r = r->narg;
}
return(rc);
}
else if (var_name(sn_to_str(t->sym_num)) == 0)
return(1);
else {
i = 0;
t->type = VARIABLE;
while (i < MAX_VARS && varnames[i] != NULL &&
varnames[i] != sn_to_str(t->sym_num)) // ok to use != since sn_to_str always returns
// a pointer to a string in the global Sym_tab
i++;
if (i == MAX_VARS)
return(0);
else {
if (varnames[i] == NULL)
varnames[i] = sn_to_str(t->sym_num);
t->varnum = i;
return(1);
/* t->sym_num = 0; include this to destroy input variable names */
}
}
} /* set_vars_term */
/*************
*
* int var_name(string) -- Decide if a string represents a variable.
*
* return 0 if string is not a variable, 1 if it is a
* variable.
*
*************/
int var_name(char *s)
/* Beeson modified 8.1.02 */
{
if (Flags[PROLOG_STYLE_VARIABLES].val)
return((*s >= 'A' && *s <= 'Z') || *s == '_');
if (Flags[LAMBDA_FLAG].val && *s >= 'U' && *s <= 'Z')
return 1;
return(*s >= 'u' && *s <= 'z');
} /* var_name */
/*************
*
* struct term *read_list(file_ptr, errors_ptr, integrate)
*
* Read and return a list of terms.
*
* The list must be terminated either with the term `end_of_list.'
* or with an actual EOF.
* Set errors_ptr to point to the number of errors found.
*
*************/
struct term_ptr *read_list(FILE *fp,
int *ep,
int integrate)
{
struct term_ptr *p1, *p2, *p3;
struct term *t;
int rc;
*ep = 0;
p3 = NULL;
p2 = NULL;
t = read_term(fp, &rc);
while (rc == 0) {
(*ep)++;
t = read_term(fp, &rc);
}
/* keep going until t == NULL || t is end marker */
while (t != NULL && (t->type != NAME ||
str_ident(sn_to_str(t->sym_num), "end_of_list") == 0)) {
if (integrate)
t = integrate_term(t);
p1 = get_term_ptr();
p1->term = t;
if (p2 == NULL)
p3 = p1;
else
p2->next = p1;
p2 = p1;
t = read_term(fp, &rc);
while (rc == 0) {
(*ep)++;
t = read_term(fp, &rc);
}
}
if (t == NULL)
return(p3);
else {
zap_term(t);
return(p3);
}
} /* read_list */
/*************
*
* print_list(file_ptr, term_ptr) -- Print a list of terms.
*
* The list is printed with periods after each term, and
* the list is terminated with `end_of_list.' so that it can
* be read with read_list.
*
*************/
void print_list(FILE *fp,
struct term_ptr *p)
{
while (p != NULL) {
print_term(fp, p->term); fprintf(fp, ".\n");
p = p->next;
}
fprintf(fp, "end_of_list.\n");
} /* print_list */
/*************
*
* bird_print(fp, t)
*
*************/
void bird_print(FILE *fp,
struct term *t)
{
struct rel *r;
if (t == NULL)
fprintf(fp, "(nil)");
else if (!is_symbol(t, "a", 2)) {
/* t is not of the form a(_,_), so print in prefix */
if (t->type == NAME) /* name */
fprintf(fp, "%s", sn_to_str(t->sym_num));
else if (t->type == VARIABLE) /* variable */
print_variable(fp, t);
else { /* complex */
fprintf(fp, "%s", sn_to_str(t->sym_num));
fprintf(fp, "(");
r = t->farg;
while(r != NULL) {
bird_print(fp, r->argval);
r = r->narg;
if(r != NULL)
fprintf(fp, ",");
}
fprintf(fp, ")");
}
}
else { /* t has form a(_,_), so print in bird notation */
if (is_symbol(t->farg->narg->argval, "a", 2)) {
bird_print(fp, t->farg->argval);
fprintf(fp, " (");
bird_print(fp, t->farg->narg->argval);
fprintf(fp, ")");
}
else {
bird_print(fp, t->farg->argval);
fprintf(fp, " ");
bird_print(fp, t->farg->narg->argval);
}
}
} /* bird_print */
/****************************************
write_term outputs a term in readable format (w.r.t. infix, prefix,
and postfix operators) and without extra parentheses. It it much
complicated by one feature: deciding where to omit space around
the special operators. For example, just as we can input a+b+c
instead of a + b + c, we wish to output without spaces where possible.
(I'm sorry the code is so complicated---I couldn't see a simpler way
of doing it.)
There are 2 types of constant/operator/functor:
NAME_SYM: string of alphanumerics, $, and _. Also quoted string.
SYM_SYM: string of *+-/\^<>=`~:?@&!;# and sometimes | (if not in list)
For completeness, the other characters are
,()[]{} and sometimes | (if in list) puctuation for building terms
. end of input term
% start of comment
"' for quoted strings
For this problem, tokens are of 4 types:
NAME_SYM
SYM_SYM
OPEN_PAREN '('
OTHER_PUNC other punctuation (including space)
Special ops that are NAME_SYMs are always surrounded by spaces.
Here are the space rules for SYM_SYM special ops:
infix
omit space before if preceding token is NAME_SYM or OTHER_PUNC
omit space after if next token is is NAME_SYM or OTHER_PUNC
(note that space is included if next is '(')
prefix
omit space before if preceding token is OTHER_PUNC
omit space after if next token is is NAME_SYM or OTHER_PUNC
postfix
omit space before if preceding token is NAME_SYM or OTHER_PUNC
always include space after (could omit if next token is OTHER_PUNC,
but current mechanism won't handle that, and it's not
that important)
*****************************************/
/* Token types */
#define OPEN_PAREN 1
#define OTHER_PUNC 2
#define NAME_SYM 6
#define SYM_SYM 7
/*************
*
* int next_token_type(t, n)
*
* Find the next token type that would be output for t.
* n is precedence parameter as in write term.
*
*************/
static int next_token_type(struct term *t,
int n)
{
struct sym_ent *s;
int na1;
char *str;
str = sn_to_str(t->sym_num);
if (t->type == NAME) {
if (str_ident(str, "$nil"))
return(OTHER_PUNC);
else
return(name_sym(str) ? NAME_SYM : SYM_SYM);
}
else if (t->type == VARIABLE) {
if (t->sym_num == 0)
return(NAME_SYM);
else
return(name_sym(str) ? NAME_SYM : SYM_SYM);
}
else { /* complex */
if (t->sym_num == str_to_sn("$cons", 2))
return(OTHER_PUNC);
else if (str_ident(sn_to_str(t->sym_num), "$Quantified")) {
/* parens if parent is special op */
if (n < 1000)
return(OPEN_PAREN);
else
return(next_token_type(t->farg->argval, 0));
}
else {
s = sn_to_node(t->sym_num);
if (s->special_op && s->arity == 2) {
na1 = s->op_prec;
if (s->op_type == XFX || s->op_type == XFY)
na1--;
if (s->op_prec > n)
return(OPEN_PAREN);
else
return(next_token_type(t->farg->argval, na1));
}
else if (s->special_op && s->arity == 1) {
na1 = s->op_prec;
if (s->op_type == FX || s->op_type == XF)
na1--;
if (s->op_prec > n)
return(OPEN_PAREN);
if (s->op_type == FX || s->op_type == FY)
return(name_sym(str) ? NAME_SYM : SYM_SYM);
else
return(next_token_type(t->farg->argval, na1));
}
else
return(name_sym(str) ? NAME_SYM : SYM_SYM);
}
}
} /* next_token_type */
/*************
*
* write_term(file_ptr, term, n, prev) -- print in readable form.
*
*************/
void write_term(FILE *fp,
struct term *t,
int n,
int *prev)
{
struct rel *r;
struct term *t1;
struct sym_ent *s;
int na1, na2, next;
char *str, *s1, *s2;
if (t == NULL) {
fprintf(fp, "<write_term gets NULL pointer>");
return;
}
if (t->type == NAME) {
str = sn_to_str(t->sym_num);
if (str_ident(str, "$nil"))
{ fprintf(fp, "[]"); *prev = OTHER_PUNC;}
else {
fprintf(fp, "%s", str);
*prev = (name_sym(str) ? NAME_SYM : SYM_SYM);
}
}
else if (t->type == VARIABLE) {
print_variable(fp, t);
if (t->sym_num == 0)
*prev = NAME_SYM;
else
*prev = (name_sym(sn_to_str(t->sym_num)) ? NAME_SYM : SYM_SYM);
}
else { /* complex */
str = sn_to_str(t->sym_num);
if (str_ident(str, "$Quantified")) { /* Quantified Formula */
/* parens if parent is special op */
if (n < 1000) {
fprintf(fp, "("); *prev = OPEN_PAREN;
}
for (r = t->farg; r; r = r->narg) {
/* parens if special op in child */
write_term(fp, r->argval, 0, prev);
if (r->narg) {
fprintf(fp, " "); *prev = OTHER_PUNC;
}
}
if (n < 1000) {
fprintf(fp, ")"); *prev = OTHER_PUNC;
}
} /* end Formula */
else if (is_symbol(t, "$cons", 2)) {
fprintf(fp, "["); *prev = OTHER_PUNC;
write_term(fp, t->farg->argval, 1000, prev);
t1 = t->farg->narg->argval;
while (t1->sym_num == str_to_sn("$cons", 2)) {
fprintf(fp, ","); *prev = OTHER_PUNC;
write_term(fp, t1->farg->argval, 1000, prev);
t1 = t1->farg->narg->argval;
}
if (t1->sym_num == str_to_sn("$nil", 0)) {
fprintf(fp, "]"); *prev = OTHER_PUNC;
}
else {
fprintf(fp, "|"); *prev = OTHER_PUNC;
write_term(fp, t1, 1000, prev);
fprintf(fp, "]"); *prev = OTHER_PUNC;
}
} /* end list */
else if (Flags[BIRD_PRINT].val &&is_symbol(t, "a", 2))
bird_print(fp, t);
else {
s = sn_to_node(t->sym_num);
if (s->special_op && s->arity == 2) { /* infix */
na1 = na2 = s->op_prec;
if (s->op_type == XFX || s->op_type == XFY)
na1--;
if (s->op_type == XFX || s->op_type == YFX)
na2--;
if (s->op_prec > n) {
fprintf(fp, "("); *prev = OPEN_PAREN;
}
write_term(fp, t->farg->argval, na1, prev);
/* Decide on spaces around infix op. */
if (name_sym(str))
s1 = s2 = " ";
else {
if (*prev == OTHER_PUNC || *prev == NAME_SYM)
s1 = "";
else
s1 = " ";
next = next_token_type(t->farg->narg->argval, na2);
if (next == OTHER_PUNC || next == NAME_SYM)
s2 = "";
else
s2 = " ";
}
fprintf(fp, "%s%s%s", s1,str,s2);
if (str_ident(s2, " "))
*prev = OTHER_PUNC;
else
*prev = (name_sym(str) ? NAME_SYM : SYM_SYM);
write_term(fp, t->farg->narg->argval, na2, prev);
if (s->op_prec > n) {
fprintf(fp, ")"); *prev = OTHER_PUNC;
}
}
else if (s->special_op && s->arity == 1) { /* prefix,postfix */
na1 = s->op_prec;
if (s->op_type == FX || s->op_type == XF)
na1--;
if (s->op_prec > n) {
fprintf(fp, "("); *prev = OPEN_PAREN;
}
if (s->op_type == FX || s->op_type == FY) {
/* Decide on spaces around special prefix op. */
if (name_sym(str))
s1 = s2 = " ";
else {
if (*prev == OTHER_PUNC || *prev == OPEN_PAREN)
s1 = "";
else
s1 = " ";
next = next_token_type(t->farg->argval, na1);
if (next == OTHER_PUNC || next == OPEN_PAREN || next == NAME_SYM)
s2 = "";
else
s2 = " ";
}
fprintf(fp, "%s%s%s", s1,str,s2);
if (str_ident(s2, " "))
*prev = OTHER_PUNC;
else
*prev = (name_sym(str) ? NAME_SYM : SYM_SYM);
write_term(fp, t->farg->argval, na1, prev);
}
else {
write_term(fp, t->farg->argval, na1, prev);
/* Decide on spaces around special postfix op. */
if (name_sym(str))
s1 = s2 = " ";
else {
if (*prev == OTHER_PUNC || *prev == NAME_SYM)
s1 = "";
else
s1 = " ";
/* Can't easily tell next token, so just output space. */
s2 = " ";
}
fprintf(fp, "%s%s%s", s1,str,s2);
*prev = OTHER_PUNC;
}
if (s->op_prec > n) {
fprintf(fp, ")"); *prev = OTHER_PUNC;
}
}
else { /* functor(args) */
fprintf(fp, "%s", str);
fprintf(fp, "("); *prev = OPEN_PAREN;
r = t->farg;
while(r != NULL) {
write_term(fp, r->argval, 1000, prev);
r = r->narg;
if(r != NULL) {
fprintf(fp, ","); *prev = OTHER_PUNC;
}
}
fprintf(fp, ")"); *prev = OTHER_PUNC;
}
}
}
} /* write_term */
/*************
*
* display_term(file_ptr, term) -- Display a term in internal form.
*
*************/
void display_term(FILE *fp,
struct term *t)
{
struct rel *r;
if (t == NULL)
fprintf(fp, "<display_term gets NULL pointer>");
else if (t->type == NAME) {
fprintf(fp, "%s", sn_to_str(t->sym_num));
}
else if (t->type == VARIABLE)
print_variable(fp, t);
else { /* complex */
fprintf(fp, "%s", sn_to_str(t->sym_num));
fprintf(fp, "(");
r = t->farg;
while(r != NULL) {
display_term(fp, r->argval);
r = r->narg;
if(r != NULL)
fprintf(fp, ",");
}
fprintf(fp, ")");
}
} /* display_term */
/*************
*
* print_term(file_ptr, term) -- Print a term to a file.
*
* Flag determines write_term vs. display_term.
*
*************/
void print_term(FILE *fp,
struct term *t)
{
int i;
if (Flags[DISPLAY_TERMS].val)
display_term(fp, t);
else {
i = OTHER_PUNC; /* Assume previous token is punctuation. */
write_term(fp, t, 1000, &i);
}
} /* print_term */
/*************
*
* p_term(term) -- print_term and \n to the standard output.
*
*************/
void p_term(struct term *t)
{
print_term(stdout, t);
printf("\n");
fflush(stdout);
} /* p_term */
/*************
*
* d_term(term) -- display_term and \n to the standard output.
*
*************/
void d_term(struct term *t)
{
display_term(stdout, t);
printf("\n");
fflush(stdout);
} /* p_term */
/*************
*
* print_term_nl(fp, term) -- print_term followed by period and newline
*
*************/
void print_term_nl(FILE *fp,
struct term *t)
{
print_term(fp, t);
fprintf(fp,".\n");
} /* print_term_nl */
/*************
*
* int print_term_length(t)
*
*************/
int print_term_length(struct term *t)
{
static FILE *tfp = NULL;
int i;
char s[MAX_BUF];
#if defined(DOS_GCC) || defined(THINK_C)
abend("print_term_length, pretty_print not available on this computer");
#else
if (!tfp)
tfp = tmpfile();
#endif
rewind(tfp);
print_term(tfp, t);
fprintf(tfp, "%c", '\0'); /* end marker */
fflush(tfp);
rewind(tfp);
for (i = 0, s[i]=getc(tfp); s[i] && i < MAX_BUF; s[++i]=getc(tfp));
#if 0
printf("%d: ", i); print_term(stdout, t);
#endif
return(i == MAX_BUF ? MAX_INT : i);
} /* print_term_length */
/*************
*
* pretty_print_term(fp, t, indents)
*
*************/
void pretty_print_term(FILE *fp,
struct term *t,
int indents)
{
int len, spaces_before_term, i;
spaces_before_term = indents * Parms[PRETTY_PRINT_INDENT].val;
for (i=0; i<spaces_before_term; i++)
fprintf(fp, " ");
if (t->type != COMPLEX)
print_term(fp, t);
else {
len = print_term_length(t);
if (spaces_before_term + len < 80)
print_term(fp, t);
else {
struct rel *r;
fprintf(fp, "%s", sn_to_str(t->sym_num));
fprintf(fp, "(\n");
r = t->farg;
while(r) {
pretty_print_term(fp, r->argval, indents+1);
r = r->narg;
if(r != NULL)
fprintf(fp, ",");
fprintf(fp, "\n");
}
for (i=0; i<spaces_before_term; i++)
fprintf(fp, " ");
fprintf(fp, ")");
}
}
} /* pretty_print_term */
/*************
*
* print_variable(fp, variable)
*
*************/
void print_variable(FILE *fp,
struct term *t)
{
int i;
if (t->sym_num != 0)
fprintf(fp, "%s", sn_to_str(t->sym_num));
else if (Flags[PROLOG_STYLE_VARIABLES].val) {
fprintf(fp, "%c", (t->varnum % 26) + 'A');
i = t->varnum / 26;
if (i > 0)
fprintf(fp, "%d", i);
}
else {
if (t->varnum <= 2)
fprintf(fp, "%c", 'x'+t->varnum);
else if (t->varnum <= 5)
fprintf(fp, "%c", 'r'+t->varnum);
else
fprintf(fp, "%c%d", 'v', t->varnum);
}
} /* print_variable */
/*************
*
* void built_in_symbols()
*
* note: in a similar way, user-defined evaluable functions are declared
* in `declare_user_functions'.
*
*************/
void built_in_symbols(void)
{
struct sym_ent *p;
p = insert_sym("$cons", 2); Cons_sym_num = p->sym_num;
p = insert_sym("$nil", 0); Nil_sym_num = p->sym_num;
p = insert_sym("$IGNORE", 1); Ignore_sym_num = p->sym_num;
p = insert_sym("$CHR", 1); Chr_sym_num = p->sym_num;
p = insert_sym("$dots", 1); Dots_sym_num = p->sym_num;
p = insert_sym("$", 1);
p = insert_sym("$SUM", 2); p->eval_code = SUM_SYM;
p = insert_sym("$PROD", 2); p->eval_code = PROD_SYM;
p = insert_sym("$DIFF", 2); p->eval_code = DIFF_SYM;
p = insert_sym("$DIV", 2); p->eval_code = DIV_SYM;
p = insert_sym("$MOD", 2); p->eval_code = MOD_SYM;
p = insert_sym("$EQ", 2); p->eval_code = EQ_SYM;
p = insert_sym("$NE", 2); p->eval_code = NE_SYM;
p = insert_sym("$LT", 2); p->eval_code = LT_SYM;
p = insert_sym("$LE", 2); p->eval_code = LE_SYM;
p = insert_sym("$GT", 2); p->eval_code = GT_SYM;
p = insert_sym("$GE", 2); p->eval_code = GE_SYM;
p = insert_sym("$AND", 2); p->eval_code = AND_SYM;
p = insert_sym("$OR", 2); p->eval_code = OR_SYM;
p = insert_sym("$NOT", 1); p->eval_code = NOT_SYM;
p = insert_sym("$TRUE", 1); p->eval_code = TRUE_SYM;
p = insert_sym("$T", 0); p->eval_code = T_SYM;
p = insert_sym("$F", 0); p->eval_code = F_SYM;
p = insert_sym("$ID", 2); p->eval_code = ID_SYM;
p = insert_sym("$LNE", 2); p->eval_code = LNE_SYM;
p = insert_sym("$LLT", 2); p->eval_code = LLT_SYM;
p = insert_sym("$LLE", 2); p->eval_code = LLE_SYM;
p = insert_sym("$LGT", 2); p->eval_code = LGT_SYM;
p = insert_sym("$LGE", 2); p->eval_code = LGE_SYM;
p = insert_sym("$BIT_AND", 2); p->eval_code = BIT_AND_SYM;
p = insert_sym("$BIT_OR", 2); p->eval_code = BIT_OR_SYM;
p = insert_sym("$BIT_XOR", 2); p->eval_code = BIT_XOR_SYM;
p = insert_sym("$BIT_NOT", 1); p->eval_code = BIT_NOT_SYM;
p = insert_sym("$SHIFT_LEFT", 2); p->eval_code = SHIFT_LEFT_SYM;
p = insert_sym("$SHIFT_RIGHT", 2); p->eval_code = SHIFT_RIGHT_SYM;
p = insert_sym("$INT_TO_BITS", 1); p->eval_code = INT_TO_BITS_SYM;
p = insert_sym("$BITS_TO_INT", 1); p->eval_code = BITS_TO_INT_SYM;
p = insert_sym("$IF", 3); p->eval_code = IF_SYM;
p = insert_sym("$NEXT_CL_NUM", 0); p->eval_code = NEXT_CL_NUM_SYM;
p = insert_sym("$ATOMIC", 1); p->eval_code = ATOMIC_SYM;
p = insert_sym("$INT", 1); p->eval_code = INT_SYM;
p = insert_sym("$BITS", 1); p->eval_code = BITS_SYM;
p = insert_sym("$VAR", 1); p->eval_code = VAR_SYM;
p = insert_sym("$GROUND", 1); p->eval_code = GROUND_SYM;
p = insert_sym("$OUT", 1); p->eval_code = OUT_SYM;
p = insert_sym("$FSUM", 2); p->eval_code = FSUM_SYM;
p = insert_sym("$FPROD", 2); p->eval_code = FPROD_SYM;
p = insert_sym("$FDIFF", 2); p->eval_code = FDIFF_SYM;
p = insert_sym("$FDIV", 2); p->eval_code = FDIV_SYM;
p = insert_sym("$FEQ", 2); p->eval_code = FEQ_SYM;
p = insert_sym("$FNE", 2); p->eval_code = FNE_SYM;
p = insert_sym("$FLT", 2); p->eval_code = FLT_SYM;
p = insert_sym("$FLE", 2); p->eval_code = FLE_SYM;
p = insert_sym("$FGT", 2); p->eval_code = FGT_SYM;
p = insert_sym("$FGE", 2); p->eval_code = FGE_SYM;
p = insert_sym("$COMMON_EXPRESSION", 3); p->eval_code = COMMON_EXPRESSION_SYM;
p = insert_sym("$RENAME", 2); p->eval_code = RENAME_SYM;
p = insert_sym("$UNIQUE_NUM", 0); p->eval_code = UNIQUE_NUM_SYM;
p = insert_sym("$OCCURS", 2); p->eval_code = OCCURS_SYM;
p = insert_sym("$VOCCURS", 2); p->eval_code = VOCCURS_SYM;
p = insert_sym("$VFREE", 2); p->eval_code = VFREE_SYM;
p = insert_sym("lambda",2); p->eval_code = 0; // Beeson
p = insert_sym("ap",2); p->eval_code = 0; // Beeson
p = insert_sym("cases",4); p->eval_code = 0; // Beeson
p = insert_sym("or",2); p->eval_code = 0; // Beeson
p = insert_sym("and",2); p->eval_code = 0; // Beeson
} /* built_in_symbols */
/*************
*
* int declare_op(prec, type, str)
*
*************/
int declare_op(int prec,
int type,
char *str)
{
int arity, sn, save_flag;
struct sym_ent *p;
if (prec < 1 || prec > 999)
return(0);
switch (type) {
case FX:
case FY:
case XF:
case YF: arity = 1; break;
case XFX:
case XFY:
case YFX: arity = 2; break;
default: return(0);
}
save_flag = Flags[CHECK_ARITY].val;
Flags[CHECK_ARITY].val = 0;
sn = str_to_sn(str, arity);
Flags[CHECK_ARITY].val = save_flag;
p = sn_to_node(sn);
/* Don't check if it's already special. Allow it to change. */
p->special_op = 1;
p->op_type = type;
p->op_prec = prec;
return(1);
} /* declare_op */
/*************
*
* init_special_ops()
*
* Declare the built-in special operators.
*
*************/
void init_special_ops(void)
{
int rc;
rc = declare_op(800, XFY, "#");
rc = declare_op(800, XFX, "->");
rc = declare_op(800, XFX, "<->");
rc = declare_op(790, XFY, "|");
rc = declare_op(780, XFY, "&");
rc = declare_op(700, XFX, "=");
rc = declare_op(700, XFX, "!=");
rc = declare_op(700, XFX, "<");
rc = declare_op(700, XFX, ">");
rc = declare_op(700, XFX, "<=");
rc = declare_op(700, XFX, ">=");
rc = declare_op(700, XFX, "==");
rc = declare_op(700, XFX, "=/=");
rc = declare_op(700, XFX, "@<");
rc = declare_op(700, XFX, "@>");
rc = declare_op(700, XFX, "@<=");
rc = declare_op(700, XFX, "@>=");
rc = declare_op(500, XFY, "+");
rc = declare_op(500, XFX, "-");
rc = declare_op(500, FX, "+");
rc = declare_op(500, FX, "-");
rc = declare_op(400, XFY, "*");
rc = declare_op(400, XFX, "/");
rc = declare_op(300, XFX, "mod");
} /* init_special_ops */
/*************
*
* int process_op_command(t)
*
*************/
int process_op_command(struct term *t)
{
int type, n, rc;
struct term *t1, *t2;
char *s;
if (sn_to_arity(t->sym_num) != 3) {
printf("op command must have arity 3.\n");
return(0);
}
t1 = t->farg->argval;
if (t1->type != NAME || !str_int(sn_to_str(t1->sym_num), &n) ||
n < 1 || n > 999) {
printf("\nERROR: first argument of op command must be 1..999.\n");
return(0);
}
t1 = t->farg->narg->argval;
s = sn_to_str(t1->sym_num);
if (str_ident(s, "xfx"))
type = XFX;
else if (str_ident(s, "xfy"))
type = XFY;
else if (str_ident(s, "yfx"))
type = YFX;
else if (str_ident(s, "fx"))
type = FX;
else if (str_ident(s, "xf"))
type = XF;
else if (str_ident(s, "fy"))
type = FY;
else if (str_ident(s, "yf"))
type = YF;
else
type = MAX_INT;
if (type == MAX_INT || t1->type != NAME) {
printf("\nERROR: second argument of op command must be xfx, xfy, yfx, xf, yf, fx, or fy.\n");
return(0);
}
t1 = t->farg->narg->narg->argval;
if (t1->type == NAME)
rc = declare_op(n, type, sn_to_str(t1->sym_num));
else if (proper_list(t1)) {
for ( ; t1->type == COMPLEX; t1 = t1->farg->narg->argval) {
t2 = t1->farg->argval;
if (t2->type != NAME) {
printf("\nERROR: list in op command must be all names.\n");
return(0);
}
rc = declare_op(n, type, sn_to_str(t2->sym_num));
}
}
else {
printf("\nERROR: third argument of op command must be a name or a list.\n");
return(0);
}
return(1);
} /* process_op_command */
/*************
*
* void fill_in_op_data(p, t)
*
*************/
static void fill_in_op_data(struct sequence_member *p,
struct term *t)
{
struct sym_ent *nd;
char *str;
int i, flag;
p->t = t;
p->binary_type = p->unary_type = 0;
p->binary_prec = p->unary_prec = 0;
if (t->type == NAME) {
str = sn_to_str(t->sym_num);
for (i = flag = 0; i < SYM_TAB_SIZE && flag < 2; i++) {
for (nd = Sym_tab[i]; nd && flag < 2; nd = nd->next) {
if (str_ident(str, nd->name) && nd->special_op) {
if (nd->arity == 1) {
p->unary_type = nd->op_type;
p->unary_prec = nd->op_prec;
}
else { /* must be binary */
p->binary_type = nd->op_type;
p->binary_prec = nd->op_prec;
}
}
}
}
}
} /* fill_in_op_data */
/*************
*
* int is_white(c) -- including start-of-comment '%'.
*
*************/
static int is_white(char c)
{
return(c == ' ' ||
c == '\t' || /* tab */
c == '\n' || /* newline */
c == '\v' || /* vertical tab */
c == '\r' || /* carriage return */
c == '\f' || /* form feed */
c == '%');
} /* is_white */
/*************
*
* skip_white(buffer, position)
*
* Advance the pointer to the next nonwhite, noncomment position.
*
*************/
void skip_white(char *buf,
int *p)
{
char c;
c = buf[*p];
while (is_white(c)) {
if (c == '%') /* skip over comment */
while (buf[++(*p)] != '\n' && buf[*p] != '\0') ;
if (buf[*p] == '\0')
c = '\0';
else
c = buf[++(*p)];
}
} /* skip_white */
/*************
*
* int is_symbol_char(c, in_list)
*
*************/
static int is_symbol_char(char c,
int in_list)
{
return(c == '+' ||
c == '-' ||
c == '*' ||
c == '/' ||
c == '\\' ||
c == '^' ||
c == '<' ||
c == '>' ||
c == '=' ||
c == '`' ||
c == '~' ||
c == ':' ||
c == '?' ||
c == '@' ||
c == '&' ||
(c == '|' && !in_list) ||
c == '!' ||
c == '#' ||
c == ';' );
} /* is_symbol_char */
/*************
*
* int is_alpha_numeric(c) -- including _ and $
*
*************/
static int is_alpha_numeric(char c)
{
return((c >= '0' && c <= '9') ||
(c >= 'a' && c <= 'z') ||
(c >= 'A' && c <= 'Z') ||
c == '_' ||
c == '$');
} /* is_alpha_numeric */
/*************
*
* int name_sym(s)
*
*************/
int name_sym(char *s)
{
if (*s == '\'' || *s == '\"')
return(1); /* quoted string ok */
else {
for ( ; *s; s++)
if (!is_alpha_numeric(*s))
return(0);
return(1);
}
} /* name_sym */
/*************
*
* get_name(buffer, position, name, in_list)
*
*************/
static void get_name(char *buf,
int *p,
char *name,
int in_list)
{
int i, ok, okq;
char c, q;
i = 0; ok = 1; okq = 1;
skip_white(buf, p);
c = buf[*p];
if (is_alpha_numeric(c)) {
while ((ok = i < MAX_NAME-1) && is_alpha_numeric(c)) {
name[i++] = c;
c = buf[++(*p)];
}
}
else if (is_symbol_char(c, in_list)) {
while ((ok = i < MAX_NAME-1) && is_symbol_char(c, in_list)) {
name[i++] = c;
c = buf[++(*p)];
}
}
else if (c == '\'' || c == '\"') {
q = c;
name[i++] = c;
c = buf[++(*p)];
while ((ok = i < MAX_NAME-1) && c != q && (okq = c != '\0')) {
name[i++] = c;
c = buf[++(*p)];
}
if (okq) {
name[i++] = c; /* quote char */
++(*p);
}
}
if (!ok) {
fprintf(stdout, "\nERROR, name too big, max is %d; ", MAX_NAME-1);
name[0] = '\0';
}
else if (!okq) {
fprintf(stdout, "\nERROR, quoted name has no end; ");
name[0] = '\0';
}
else
name[i] = '\0';
} /* get_name */
/*************
*
* print_error(fp, buf, pos)
*
*************/
void print_error(FILE *fp,
char *buf,
int pos)
{
#if 0
int i;
fprintf(fp, "%s\n", buf);
for (i = 0; i < pos; i++) {
if (buf[i] == '\t')
fprintf(fp, "--------"); /* doesn't always work */
else if (buf[i] == '\n')
fprintf(fp, "\n");
else
fprintf(fp, "-");
}
fprintf(fp, "^\n");
#else
int i;
i = 0;
if (buf[0] == '\n')
i = 1;
while (i < pos) {
if (buf[i] == '%') /* skip over comment */
while (buf[++i] != '\n') ;
fprintf(fp, "%c", buf[i++]);
}
fprintf(fp, " ***HERE*** ");
while (buf[i]) {
if (buf[i] == '%') /* skip over comment */
while (buf[++i] != '\n') ;
fprintf(fp, "%c", buf[i++]);
}
fprintf(fp, "\n");
#endif
} /* print_error */
/* We need this declaration, because seq_to_term is mutually recursive
with seq_to_quant_term
*/
static struct term *seq_to_term(struct sequence_member *seq,
int start,
int end,
int m);
/*************
*
* struct term *seq_to_quant_term(seq, n)
*
* Take a sequence of terms t1,...,tn and build term $Quantified(t1,...,tn).
* t1 is already known to be a quantifier, and n >= 3.
* Check that t2,...,tn-1 are all names.
* On success, the resulting term is an entirely new copy.
*
*************/
static struct term *seq_to_quant_term(struct sequence_member *seq,
int n)
{
struct rel *r_prev, *r_new;
struct term *t, *t1;
int i;
if (n == 1)
return(NULL);
for (i = 1; i < n-1; i++)
if (seq[i].t->type != NAME)
return(NULL);
/* Special case: negated formula need not be parenthesized.
* For example, all x -p(x) is OK. In this case, the sequence is
* [all, x, -, p(x)], so we must adjust things.
*/
if (str_ident(sn_to_str(seq[n-2].t->sym_num), "-")) {
if (n == 3)
return(NULL); /* all - p */
else {
struct term *t;
t = seq_to_term(seq, n-2, n-1, 1000);
printf("adjusted term: "); p_term(t);
if (t) {
zap_term(seq[n-2].t);
zap_term(seq[n-1].t);
fill_in_op_data(&seq[n-2], t);
/* caller will still think there are n terms */
seq[n-1].t = NULL;
n--;
}
else
return(NULL);
}
}
t = get_term();
t->type = COMPLEX;
t->sym_num = str_to_sn("$Quantified", n);
for (i = 0, r_prev = NULL; i < n; i++) {
r_new = get_rel();
if (!r_prev)
t->farg = r_new;
else
r_prev->narg = r_new;
t1 = copy_term(seq[i].t);
r_new->argval = t1;
r_prev = r_new;
}
return(t);
} /* seq_to_quant_term */
/*************
*
* struct term *seq_to_term(seq, start, end, m)
*
* seq is an array of terms/operators, and start and end are
* indexes into seq. This routine attempts to construct a term
* starting with start, ending with end, with precedence <= m.
* On success, the resulting term is an entirely new copy.
*
*************/
static struct term *seq_to_term(struct sequence_member *seq,
int start,
int end,
int m)
{
int i, n, type;
struct term *t1, *t2, *t3, *t;
struct rel *r1, *r2;
if (start == end) {
t = copy_term(seq[start].t);
return(t);
}
else {
/* Check if first is prefix op that applies to rest. */
if (seq[start].t->type == NAME) {
type = seq[start].unary_type;
n = seq[start].unary_prec;
t = seq[start].t;
if (type == FX && n <= m) {
t1 = seq_to_term(seq, start+1, end, n-1);
if (t1) {
t3 = get_term();
t3->type = COMPLEX;
t3->sym_num = str_to_sn(sn_to_str(t->sym_num), 1);
r1 = get_rel();
t3->farg = r1;
r1->argval = t1;
return(t3);
}
}
else if (type == FY && n <= m) {
t1 = seq_to_term(seq, start+1, end, n);
if (t1) {
t3 = get_term();
t3->type = COMPLEX;
t3->sym_num = str_to_sn(sn_to_str(t->sym_num), 1);
r1 = get_rel();
t3->farg = r1;
r1->argval = t1;
return(t3);
}
}
}
/* Check if last is postfix op that applies to all preceding. */
if (seq[end].t->type == NAME) {
type = seq[end].unary_type;
n = seq[end].unary_prec;
t = seq[end].t;
if (type == XF && n <= m) {
t1 = seq_to_term(seq, start, end-1, n-1);
if (t1) {
t3 = get_term();
t3->type = COMPLEX;
t3->sym_num = str_to_sn(sn_to_str(t->sym_num), 1);
r1 = get_rel();
t3->farg = r1;
r1->argval = t1;
return(t3);
}
}
else if (type == YF && n <= m) {
t1 = seq_to_term(seq, start, end-1, n);
if (t1) {
t3 = get_term();
t3->type = COMPLEX;
t3->sym_num = str_to_sn(sn_to_str(t->sym_num), 1);
r1 = get_rel();
t3->farg = r1;
r1->argval = t1;
return(t3);
}
}
}
/* Look for an infix operator. */
for (i = start+1; i <= end-1; i++) {
if (seq[i].t->type == NAME) {
type = seq[i].binary_type;
n = seq[i].binary_prec;
t = seq[i].t;
if (type == XFY && n <= m) {
t1 = seq_to_term(seq, start, i-1, n-1);
if (t1) {
t2 = seq_to_term(seq, i+1, end, n);
if (!t2)
zap_term(t1);
}
if (t1 && t2) {
t3 = get_term();
t3->type = COMPLEX;
t3->sym_num = str_to_sn(sn_to_str(t->sym_num), 2);
r1 = get_rel(); r2 = get_rel();
t3->farg = r1; r1->narg = r2;
r1->argval = t1; r2->argval = t2;
return(t3);
}
}
else if (type == YFX && n <= m) {
t1 = NULL;
t2 = seq_to_term(seq, i+1, end, n-1);
if (t2) {
t1 = seq_to_term(seq, start, i-1, n);
if (!t1)
zap_term(t2);
}
if (t1 && t2) {
t3 = get_term();
t3->type = COMPLEX;
t3->sym_num = str_to_sn(sn_to_str(t->sym_num), 2);
r1 = get_rel();
r2 = get_rel();
t3->farg = r1;
r1->narg = r2;
r1->argval = t1;
r2->argval = t2;
return(t3);
}
}
else if (type == XFX && n <= m) {
t1 = seq_to_term(seq, start, i-1, n-1);
t2 = NULL;
if (t1) {
t2 = seq_to_term(seq, i+1, end, n-1);
if (!t2)
zap_term(t1);
}
if (t1 && t2) {
t3 = get_term();
t3->type = COMPLEX;
t3->sym_num = str_to_sn(sn_to_str(t->sym_num), 2);
r1 = get_rel();
r2 = get_rel();
t3->farg = r1;
r1->narg = r2;
r1->argval = t1;
r2->argval = t2;
return(t3);
}
}
} /* name */
} /* loop looking for infix op to apply */
return(NULL);
}
} /* seq_to_term */
/*************
*
* struct term_ptr *str_to_args(buffer, position, name)
*
* name -- the functor.
*
* start: functor( a1 , a2 , a3 )
* ^
* end: functor( a1 , a2 , a3 )
* ^
*************/
static struct term *str_to_args(char *buf,
int *p,
char *name)
{
struct term *t, *t_sub;
struct rel *r1, *r2;
int i;
t = get_term();
t->type = COMPLEX;
r1 = NULL;
i = 0; /* count subterms to get arity */
while (buf[*p] != ')') {
i++;
t_sub = str_to_term(buf, p, 0);
if (t_sub == NULL)
return(NULL);
else if (buf[*p] != ',' && buf[*p] != ')') {
fprintf(stdout, "\nERROR, comma or ) expected:\n");
print_error(stdout, buf, *p);
return(NULL);
}
else {
r2 = get_rel();
r2->argval = t_sub;
if (r1 == NULL)
t->farg = r2;
else
r1->narg = r2;
r1 = r2;
if (buf[*p] == ',')
(*p)++; /* step past comma */
}
}
if (i == 0) {
fprintf(stdout, "\nERROR, functor has no arguments:\n");
print_error(stdout, buf, *p);
return(NULL);
}
t->sym_num = str_to_sn(name, i); /* functor */
return(t);
} /* str_to_args */
/*************
*
* struct term_ptr *str_to_list(buffer, position)
*
* start: [ a1 , a2 , a3 ]
* ^
* end: [ a1 , a2 , a3 ]
* ^
*************/
static struct term *str_to_list(char *buf,
int *p)
{
struct term *t_cons, *t_head, *t_tail, *t_return;
struct rel *r_head, *r_tail;
int go;
(*p)++; /* step past '[' */
if (buf[*p] == ']') { /* [] */
t_return = get_term();
t_return->type = NAME;
t_return->sym_num = str_to_sn("$nil", 0);
(*p)++; /* skip "]" */
return(t_return);
}
else { /* [h|t], [t1,...,tn], or [t1,...,tn|t] */
t_return = NULL; r_tail = NULL;
go = 1;
while (go) {
t_head = str_to_term(buf, p, 1);
if (t_head == NULL)
return(NULL); /* error */
t_cons = get_term();
if (r_tail == NULL)
t_return = t_cons;
else
r_tail->argval = t_cons;
t_cons->type = COMPLEX;
t_cons->sym_num = str_to_sn("$cons", 2);
r_head = get_rel();
t_cons->farg = r_head;
r_head->argval = t_head;
r_tail = get_rel();
r_head->narg = r_tail;
go = (buf[*p] == ',');
if (go)
(*p)++; /* step past ',' */
}
if (buf[*p] == ']') {
t_tail = get_term();
r_tail->argval = t_tail;
t_tail->type = NAME;
t_tail->sym_num = str_to_sn("$nil", 0);
(*p)++; /* step past ']' */
return(t_return);
}
else if (buf[*p] == '|') {
(*p)++; /* step past '|' */
t_tail = str_to_term(buf, p, 1);
if (buf[*p] != ']') {
fprintf(stdout, "\nERROR, ']' expected in list:\n");
print_error(stdout, buf, *p);
return(NULL);
}
r_tail->argval = t_tail;
(*p)++; /* step past ']' */
return(t_return);
}
else {
fprintf(stdout, "\nERROR, ], |, or comma expected in list:\n");
print_error(stdout, buf, *p);
return(NULL);
}
}
} /* str_to_list */
/*************
*
* int str_to_sequence(buffer, position, seq, in_list)
*
* Read a sequence of operators/terms---It will be parsed into
* a term later in str_to_term.
* After successful call, position is the delimeter following the term.
*
* Mutually recursive with str_to_term.
*
* If success, return the number of terms read.
*
* If a syntax error is found, print message and return(0).
*
*************/
static int str_to_sequence(char *buf,
int *p,
struct sequence_member *seq,
int in_list)
{
char name[MAX_NAME], c;
struct term *t;
int done, n, white;;
done = 0; n = 0;
while (!done) {
get_name(buf, p, name, in_list);
white = is_white(buf[*p]); /* f(a) vs. f (a) */
skip_white(buf, p);
if (name[0] == '\0' && buf[*p] != '[' && buf[*p] != '(' && buf[*p] != '{') {
fprintf(stdout, "\nERROR, name expected:\n");
print_error(stdout, buf, *p);
return(0);
}
else if (name[0] == '\0' && buf[*p] == '(') { /* (term) */
(*p)++; /* step past '(' */
t = str_to_term(buf, p, 0);
if (t == NULL)
return(0);
if (buf[*p] != ')') {
fprintf(stdout, "\nERROR, ')' expected:\n");
print_error(stdout, buf, *p);
return(0);
}
(*p)++; /* step past ')' */
}
else if (name[0] == '\0' && buf[*p] == '{') { /* {term} */
(*p)++; /* step past '{' */
t = str_to_term(buf, p, 0);
if (t == NULL)
return(0);
if (buf[*p] != '}') {
fprintf(stdout, "\nERROR, '}' expected:\n");
print_error(stdout, buf, *p);
return(0);
}
(*p)++; /* step past '}' */
}
else if (name[0] == '\0' && buf[*p] == '[') { /* list */
t = str_to_list(buf, p);
if (t == NULL)
return(0);
}
else if (name[0] != '\0' && !white && buf[*p] == '('){ /* f(args) */
(*p)++; /* step past '(' */
t = str_to_args(buf, p, name);
if (t == NULL)
return(0);
(*p)++; /* step past ')' */
}
else if (name[0] != '\0') { /* name */
t = get_term();
t->type = NAME;
/* If it's an operator, change arity later. */
t->sym_num = str_to_sn(name, 0);
}
else {
fprintf(stdout, "\nERROR, unrecognized error in term:\n");
print_error(stdout, buf, *p);
return(0);
}
/* We have a term t. */
if (n == MAX_COMPLEX) {
fprintf(stdout, "\nERROR, term too big:\n");
print_error(stdout, buf, *p);
return(0);
}
else {
fill_in_op_data(&seq[n], t);
n++;
}
skip_white(buf, p);
c = buf[*p];
done = (c == ',' || c == ')' || c == '}' || c == ']' ||
c == '.' || c == '\0' || (in_list && c == '|'));
}
return(n);
} /* str_to_sequence */
/*************
*
* struct term *str_to_term(buffer, position, in_list)
*
* Parse a string and build a term.
* Mutually recursive with str_to_sequence.
* After successful call, position is the delimeter following the term.
*
* If a syntax error is found, print message and return(NULL).
*
*************/
struct term *str_to_term(char *buf,
int *p,
int in_list)
{
struct sequence_member seq[MAX_COMPLEX];
struct term *t;
int n, i, save_pos;
save_pos = *p;
n = str_to_sequence(buf, p, seq, in_list);
if (n == 0)
return(NULL);
else if (seq[0].t->type == NAME && n > 2 &&
(str_ident(sn_to_str(seq[0].t->sym_num), "all") ||
str_ident(sn_to_str(seq[0].t->sym_num), "exists"))) {
t = seq_to_quant_term(seq, n);
if (!t) {
fprintf(stdout, "\nERROR in quantifier prefix starting here:\n");
print_error(stdout, buf, save_pos);
}
}
else {
t = seq_to_term(seq, 0, n-1, 1000);
if (!t) {
fprintf(stdout, "\nERROR, the %d terms/operators in the following sequence are OK, but they\ncould not be combined into a single term with special operators.\n", n);
for (i = 0; i < n; i++){
p_term(seq[i].t); printf(" ");
}
printf("\n");
fprintf(stdout, "The context of the bad sequence is:\n");
print_error(stdout, buf, save_pos);
}
}
for (i = 0; i < n; i++)
if (seq[i].t != NULL)
zap_term(seq[i].t);
return(t);
} /* str_to_term */
/*************
*
* int read_buf(file_ptr, buffer)
*
* Read characters into buffer until one of the following:
* 1. '.' is reached ('.' goes into the buffer)
* 2. EOF is reached: buf[0] = '\0' (an error occurs if
* any nonwhite space precedes EOF)
* 3. MAX_BUF characters have been read (an error occurs)
*
* If error occurs, return(0), else return(1).
*
*************/
int read_buf(FILE *fp,
char *buf)
{
int c, qc, i, j, ok, eof, eof_q, max, max_q;
ok = eof = eof_q = max = max_q = 0; /* stop conditions */
i = 0;
while (!ok && !eof && !eof_q && !max && !max_q) {
c = getc(fp);
if (c == '%') { /* comment--discard rest of line */
while (c != '\n' && c != EOF)
c = getc(fp);
}
if (c =='.')
ok = 1;
else if (c == EOF)
eof = 1;
else if (i == MAX_BUF-1)
max = 1;
else {
buf[i++] = c;
if (c == '\'' || c == '\"') {
qc = c;
c = getc(fp);
while (c != qc && c != EOF && i != MAX_BUF-1) {
buf[i++] = c;
c = getc(fp);
}
if (i == MAX_BUF-1)
max_q = 1;
else if (c == EOF)
eof_q = 1;
else
buf[i++] = c;
}
}
}
if (ok) {
buf[i++] = '.';
buf[i] = '\0';
return(1);
}
else if (eof) {
/* white space at end of file is OK */
j = 0;
buf[i] = '\0';
skip_white(buf, &j);
if (i != j) {
fprintf(stdout, "\nERROR, characters after last period: %s\n", buf);
buf[0] = '\0';
return(0);
}
else {
buf[0] = '\0';
return(1);
}
}
else if (eof_q) {
char s[500];
buf[i>100 ? 100 : i] = '\0';
sprintf(s, "read_buf, quoted string has no end:%s", buf);
abend(s);
}
else if (max) {
char s[500];
buf[i>100 ? 100 : i] = '\0';
sprintf(s, "read_buf, input string has more than %d characters, increase MAX_BUF", MAX_BUF);
abend(s);
}
else { /* max_q */
char s[500];
buf[i>100 ? 100 : i] = '\0';
sprintf(s, "read_buf, input string (which contains quote mark) has more than %d characters, increase MAX_BUF", MAX_BUF);
abend(s);
}
return(0); /* to quiet lint */
} /* read_buf */
/*************
*
* struct term *term_fixup(t)
*
* change !=(a,b) to -(=(a,b))
* change -(3) to -3 not recursive, -(-(3)) -> -(-3))
* change +(3) to +3 not recursive, +(+(3)) -> +(+3))
*
*************/
struct term *term_fixup(struct term *t)
{
struct rel *r, *r1;
struct term *t1;
int neg;
char *s, str[MAX_NAME];
long l;
if (t->type == COMPLEX) {
if (is_symbol(t, "!=", 2)) {
t1 = get_term(); t1->type = COMPLEX;
r1 = get_rel();
t1->farg = r1;
r1->argval = t;
t1->sym_num = str_to_sn("-", 1);
t->sym_num = str_to_sn("=", 2);
t = t1;
}
else if ((neg = is_symbol(t, "-", 1)) || is_symbol(t, "+", 1)) {
t1 = t->farg->argval;
s = sn_to_str(t1->sym_num);
if (t1->type == NAME && str_long(s, &l)) {
cat_str((neg ? "-" : "+"), s, str);
t1->sym_num = str_to_sn(str, 0);
free_rel(t->farg);
free_term(t);
t = t1;
}
}
for (r = t->farg; r; r = r->narg)
r->argval = term_fixup(r->argval);
}
return(t);
} /* term_fixup */
/*************
*
* struct term *term_fixup_2(t)
*
* change -(=(a,b)) to !=(a,b)
*
*************/
struct term *term_fixup_2(struct term *t)
{
struct term *t1;
struct rel *r;
if (is_symbol(t, "-", 1) && is_symbol(t->farg->argval, "=", 2)) {
t1 = t->farg->argval;
t1->sym_num = str_to_sn("!=", 2);
free_rel(t->farg);
free_term(t);
t = t1;
}
if (t->type == COMPLEX)
for (r = t->farg; r; r = r->narg)
r->argval = term_fixup_2(r->argval);
return(t);
} /* term_fixup_2 */
/*************
*
* struct term *read_term(file_ptr, retcd_ptr) --
*
* Read and return then next term.
* It is assumed that the next term in the file is terminated
* with a period. NULL is returned if EOF is reached first.
*
* If an error is found, return(0); else return(1).
*
*************/
struct term *read_term(FILE *fp,
int *rcp)
{
char buf[MAX_BUF+1]; /* one extra for \0 at end */
int p, rc;
struct term *t;
rc = read_buf(fp, buf);
if (rc == 0) { /* error */
*rcp = 0;
return(NULL);
}
else if (buf[0] == '\0') { /* ok. EOF */
*rcp = 1;
return(NULL);
}
else {
p = 0;
t = str_to_term(buf, &p, 0);
if (t == NULL) {
*rcp = 0;
return(NULL);
}
else {
skip_white(buf, &p);
if (buf[p] != '.') {
fprintf(stdout, "\nERROR, text after term:\n");
print_error(stdout, buf, p);
*rcp = 0;
return(NULL);
}
else {
t = term_fixup(t);
*rcp = 1;
return(t);
}
}
}
} /* read_term */
/*************
*
* merge_sort
*
*************/
void merge_sort(void **a,
void **w,
int start,
int end,
int (*comp_proc)(void *v1, void *v2))
{
int mid, i, i1, i2, e1, e2;
if (start < end) {
mid = (start+end)/2;
merge_sort(a, w, start, mid, comp_proc);
merge_sort(a, w, mid+1, end, comp_proc);
i1 = start; e1 = mid;
i2 = mid+1; e2 = end;
i = start;
while (i1 <= e1 && i2 <= e2) {
if ((*comp_proc)(a[i1], a[i2]) == LESS_THAN)
w[i++] = a[i1++];
else
w[i++] = a[i2++];
}
if (i2 > e2)
while (i1 <= e1)
w[i++] = a[i1++];
else
while (i2 <= e2)
w[i++] = a[i2++];
for (i = start; i <= end; i++)
a[i] = w[i];
}
} /* merge_sort */
/*************
*
* compare_for_auto_lex_order()
*
* First sort on arity: 0 < MAX_INT < ... < 3 < 2 < 1.
* Within arity, use strcmp function
*
*************/
int compare_for_auto_lex_order(void *d1,
void *d2)
{
struct sym_ent *p1, *p2;
int i;
p1 = (struct sym_ent *) d1;
p2 = (struct sym_ent *) d2;
if (p1->arity == p2->arity) {
i = strcmp(p1->name, p2->name);
if (i < 0)
return(LESS_THAN);
else if (i > 0)
return(GREATER_THAN);
else {
char s[500];
sprintf(s, "compare_for_auto_lex_order, strings the same: %s.", p1->name);
abend(s);
return(0); /* to quiet lint */
}
}
else if (p1->arity == 0)
return(LESS_THAN);
else if (p2->arity == 0)
return(GREATER_THAN);
else if (p1->arity < p2->arity)
return(GREATER_THAN);
else
return(LESS_THAN);
} /* compare_for_auto_lex_order */
/*************
*
* auto_lex_order()
*
* Order the symbols in the symbol table using the lex_val field.
*
*************/
void auto_lex_order(void)
{
int i, j, n;
struct sym_ent *p;
struct sym_ent **a, **w;
/* Find an upper limit on the number of symbols. */
n = new_sym_num(); /* don't use this for a sym_num */
/* There should be at most n-1 symbols. */
/* Allocate arrays for storing and for work. */
a = (struct sym_ent **) tp_alloc(n * (int) sizeof(struct sym_ent *));
w = (struct sym_ent **) tp_alloc(n * (int) sizeof(struct sym_ent *));
for (i = j = 0; i < SYM_TAB_SIZE; i++)
for (p = Sym_tab[i]; p; p = p->next)
a[j++] = p;
/* We find j symbols. */
#if 0
printf("\nauto_lex_order: new_sym_num=%d, count=%d.\n\n", n, j);
#endif
merge_sort((void **) a, (void **) w, 0, j-1, compare_for_auto_lex_order);
/* Symbols get lex vals 2, 4, 6, 8, ... . */
for (i = 0; i < j; i++) {
a[i]->lex_val = i*2 + 2;
#if 0
printf("%7s %d %d\n", a[i]->name, a[i]->arity, i);
#endif
}
} /* auto_lex_order */
./otter/is.c 0000744 0002044 0001012 00000030157 11120534446 011236 0 ustar beeson /*
* is.c -- This file contains routines for discrimination tree
* indexing for forward subsumption.
*
*/
#include <assert.h>
#include "header.h"
#include "is2.h" // for Beeson's is_retrieve2
/*************
*
* struct is_tree *insert_is_tree(t, is)
*
*************/
static struct is_tree *insert_is_tree(struct term *t,
struct is_tree *is)
{
struct rel *r;
struct is_tree *i1, *prev, *i3;
int varnum, sym;
if (t->type == VARIABLE) {
i1 = is->u.kids;
prev = NULL;
varnum = t->varnum;
while (i1 != NULL && i1->type == VARIABLE && (int) i1->lab < varnum) {
prev = i1;
i1 = i1->next;
}
if (i1 == NULL || i1->type != VARIABLE || i1->lab != varnum) {
i3 = get_is_tree();
i3->type = VARIABLE;
i3->lab = t->varnum;
i3->next = i1;
if (prev == NULL)
is->u.kids = i3;
else
prev->next = i3;
return(i3);
}
else /* found node */
return(i1);
}
else { /* NAME || COMPLEX */
i1 = is->u.kids;
prev = NULL;
/* arities fixed: handle both NAME and COMPLEX */
sym = t->sym_num;
while (i1 != NULL && i1->type == VARIABLE) { /* skip variables */
prev = i1;
i1 = i1->next;
}
while (i1 != NULL && (int) i1->lab < sym) {
prev = i1;
i1 = i1->next;
}
if (i1 == NULL || i1->lab != sym) {
i3 = get_is_tree();
i3->type = t->type;
i3->lab = sym;
i3->next = i1;
i1 = i3;
}
else
i3 = NULL; /* new node not required at this level */
if (t->type == COMPLEX && t->sym_num != Ignore_sym_num) {
r = t->farg;
while (r != NULL) {
i1 = insert_is_tree(r->argval, i1);
r = r->narg;
}
}
if (i3 != NULL) { /* link in new subtree (possibly a leaf) */
if (prev == NULL)
is->u.kids = i3;
else
prev->next = i3;
}
return(i1); /* i1 is leaf corresp. to end of input term */
}
} /* insert_is_tree */
/*************
*
* is_insert(t, root_is)
*
* Insert a term into the discrimination tree index for
* forward subsumption. (for finding more general terms)
*
*************/
void is_insert(struct term *t,
struct is_tree *root_is)
{
struct is_tree *i1;
struct term_ptr *tp;
i1 = insert_is_tree(t, root_is);
tp = get_term_ptr();
tp->term = t;
tp->next = i1->u.terms;
i1->u.terms = tp;
} /* is_insert */
/*************
*
* struct is_tree *end_term_is(t, is, path_p)
*
* Given a discrimination tree (or a subtree) and a term, return the
* node in the tree that corresponds to the last symbol in t (or NULL
* if the node doesn't exist). *path_p is a list that is extended by
* this routine. It is a list of pointers to the
* nodes in path from the parent of the returned node up to imd.
* (It is needed for deletions, because nodes do not have pointers to
* parents.)
*
*************/
static struct is_tree *end_term_is(struct term *t,
struct is_tree *is,
struct term_ptr **path_p)
{
struct rel *r;
struct is_tree *i1;
struct term_ptr *isp;
int varnum, sym;
/* add current node to the front of the path list. */
isp = get_term_ptr();
isp->term = (struct term *) is;
isp->next = *path_p;
*path_p = isp;
if (t->type == VARIABLE) {
i1 = is->u.kids;
varnum = t->varnum;
while (i1 != NULL && i1->type == VARIABLE && (int) i1->lab < varnum)
i1 = i1->next;
if (i1 == NULL || i1->type != VARIABLE || i1->lab != varnum)
return(NULL);
else /* found node */
return(i1);
}
else { /* NAME || COMPLEX */
i1 = is->u.kids;
sym = t->sym_num; /* arities fixed: handle both NAME and COMPLEX */
while (i1 != NULL && i1->type == VARIABLE) /* skip variables */
i1 = i1->next;
while (i1 != NULL && (int) i1->lab < sym)
i1 = i1->next;
if (i1 == NULL || i1->lab != sym)
return(NULL);
else {
if (t->type == NAME || t->sym_num == Ignore_sym_num)
return(i1);
else {
r = t->farg;
while (r != NULL && i1 != NULL) {
i1 = end_term_is(r->argval, i1, path_p);
r = r->narg;
}
return(i1);
}
}
}
} /* end_term_is */
/*************
*
* is_delete(t, root_is)
*
*************/
void is_delete(struct term *t,
struct is_tree *root_is)
{
struct is_tree *end, *i2, *i3, *parent;
struct term_ptr *tp1, *tp2;
struct term_ptr *isp1, *path;
/* First find the correct leaf. path is used to help with */
/* freeing nodes, because nodes don't have parent pointers. */
path = NULL;
end = end_term_is(t, root_is, &path);
if (end == NULL) {
fprintf(stdout,"The following term was not indexed properly:\n"); // Beeson 6.17.03
print_term_nl(stdout, t);
// abend("is_delete, can't find end."); commented out by Beeson 6.17.03
return; // Beeson 6.17.03
}
/* Free the pointer in the leaf-list */
tp1 = end->u.terms;
tp2 = NULL;
while(tp1 != NULL && tp1->term != t) {
tp2 = tp1;
tp1 = tp1->next;
}
if (tp1 == NULL) {
fprintf(stdout,"The following term was not indexed properly:\n"); // Beeson 6.24.03
print_term_nl(stdout, t);
// abend("is_delete, can't find term."); commented out by Beeson 6.24.03
return ; // Beeson 6.24.03
}
if (tp2 == NULL)
end->u.terms = tp1->next;
else
tp2->next = tp1->next;
free_term_ptr(tp1);
if (end->u.terms == NULL) {
/* free tree nodes from bottom up, using path to get parents */
end->u.kids = NULL; /* probably not necessary */
isp1 = path;
while (end->u.kids == NULL && end != root_is) {
parent = (struct is_tree *) isp1->term;
isp1 = isp1->next;
i2 = parent->u.kids;
i3 = NULL;
while (i2 != end) {
i3 = i2;
i2 = i2->next;
}
if (i3 == NULL)
parent->u.kids = i2->next;
else
i3->next = i2->next;
free_is_tree(i2);
end = parent;
}
}
/* free path list */
while (path != NULL) {
isp1 = path;
path = path->next;
free_term_ptr(isp1);
}
} /* is_delete */
/*************
*
* struct term *is_retrieve(term, subst, index_tree, position)
*
* Return the first or next list of terms that subsumes `term'.
* Also return the substitution. Return NULL if there are
* none or no more. All terms in the returned list of terms
* are identical.
*
* if (term != NULL)
* {This is the first call, so return the first, and also
* return a position for subsequent calls}
* else if (position != NULL)
* {return the next term, and update the position}
* else
* {there are no more terms that subsume}
*
* If you don't want the entire set of subsuming terms, then
* cancel the position with `free_is_pos_list(position)'.
*
*************/
struct term_ptr *is_retrieve(struct term *t,
struct context *subst,
struct is_tree *is,
struct is_pos **is_pos)
{
struct rel *rel_stack[MAX_FS_TERM_DEPTH];
struct is_tree *i1 = NULL;
struct is_pos *pos, *ip2;
int found, backup, varnum, j, reset, sym;
int top = 0;
if(Flags[LAMBDA_FLAG].val)
return is_retrieve2(t,subst,is,is_pos); // Beeson's version
if (t != NULL) { /* first call */
pos = NULL;
top = -1;
i1 = is->u.kids;
backup = 0;
}
else if (*is_pos != NULL) { /* continuation with more to try */
pos = *is_pos; /* must remember to set is_pos on return */
backup = 1;
}
else /* continuation with nothing more to try */
return(NULL);
while (1) { /* loop until a leaf is found or done with tree */
if (backup) {
if (pos == NULL)
return(NULL);
else { /* pop top of stack (most recent variable node)
and restore state */
top = pos->stack_pos;
for (j = 0; j <= top; j++)
rel_stack[j] = pos->rel_stack[j];
i1 = pos->is;
t = subst->terms[i1->lab];
if (pos->reset) /* undo variable binding */
subst->terms[i1->lab] = NULL;
i1 = i1->next;
ip2 = pos;
pos = pos->next;
free_is_pos(ip2);
}
}
/* at this point, i1 is the next node to try */
found = 0;
/* first try to match input term t with a variable node */
while (found == 0 && i1 != NULL && i1->type == VARIABLE) {
varnum = i1->lab;
if (subst->terms[varnum] == NULL) { /*if not bound, bind it */
subst->terms[varnum] = t;
subst->contexts[varnum] = NULL;
found = 1;
reset = 1;
}
else { /* bound variable, succeed iff identical */
found = term_ident(subst->terms[varnum], t);
reset = 0;
}
if (found) { /* save state */
ip2 = get_is_pos();
ip2->next = pos;
pos = ip2;
pos->is = i1;
pos->reset = reset;
for (j = 0; j <= top; j++)
pos->rel_stack[j] = rel_stack[j];
pos->stack_pos = top;
}
else /* try next variable */
i1 = i1->next;
}
backup = 0;
if (found == 0) { /* couldn't match t with (another) variable */
if (t->type == VARIABLE)
backup = 1; /* because we can't instantiate given term */
else { /* NAME or COMPLEX */
sym = t->sym_num;
while (i1 != NULL && (int) i1->lab < sym)
i1 = i1->next;
if (i1 == NULL || i1->lab != sym)
backup = 1;
else if (t->type == COMPLEX && t->sym_num != Ignore_sym_num) {
top++;
if (top >= MAX_FS_TERM_DEPTH)
abend("is_retrieve, increase MAX_FS_TERM_DEPTH.");
rel_stack[top] = t->farg; /* save pointer to subterms */
}
}
}
if (backup == 0) { /* get next term from rel_stack */
while (top >= 0 && rel_stack[top] == NULL)
top--;
if (top == -1) { /* found a term */
*is_pos = pos;
return(i1->u.terms);
}
else { /* pop a term and continue */
t = rel_stack[top]->argval;
rel_stack[top] = rel_stack[top]->narg;
i1 = i1->u.kids;
}
}
} /* end of while(1) loop */
} /* is_retrieve */
/*************
*
* struct term *fs_retrieve(t, c, is, fs_pos)
*
* Get the first or next term that subsumes t. (t != NULL)
* for first call, and (t == NULL) for subsequent calls.
*
* If you want to stop calls before a NULL is returned,
* call canc_fs_pos(fs_pos, context) to reclaim memory.
*
*************/
struct term *fs_retrieve(struct term *t,
struct context *subst,
struct is_tree *is,
struct fsub_pos **fs_pos)
{
struct term_ptr *tp;
struct is_pos *i_pos;
struct fsub_pos *f_pos;
if (t != NULL) { /* if first call */
tp = is_retrieve(t, subst, is, &i_pos);
if (tp == NULL)
return(NULL);
else {
f_pos = get_fsub_pos();
f_pos->pos = i_pos;
f_pos->terms = tp;
*fs_pos = f_pos;
return(tp->term);
}
}
else { /* subsequent call */
f_pos = *fs_pos;
tp = f_pos->terms->next;
if (tp != NULL) { /* if any more terms in current leaf */
f_pos->terms = tp;
return(tp->term);
}
else { /* try for another leaf */
tp = is_retrieve((struct term *) NULL, subst, is, &(f_pos->pos));
if (tp == NULL) {
free_fsub_pos(f_pos);
return(NULL);
}
else {
f_pos->terms = tp;
return(tp->term);
}
}
}
} /* fs_retrieve */
/*************
*
* canc_fs_pos(pos, subst)
*
*************/
void canc_fs_pos(struct fsub_pos *pos,
struct context *subst)
{
int i;
if (pos->pos != NULL) {
for (i = 0; i < MAX_VARS; i++)
subst->terms[i] = NULL;
}
free_is_pos_list(pos->pos);
free_fsub_pos(pos);
} /* canc_fs_pos */
/*************
*
* print_is_tree(fp, is)
*
* Display an index-subsumption tree.
*
*************/
void print_is_tree(FILE *fp,
struct is_tree *is)
{
fprintf(fp, "don't know how to print is tree %x\n", (unsigned) is);
} /* print_is_tree */
/*************
*
* p_is_tree(is)
*
*************/
void p_is_tree(struct is_tree *is)
{
print_is_tree(stdout, is);
} /* p_is_tree */
./otter/ivy.c 0000744 0002044 0001012 00000012743 11120534446 011433 0 ustar beeson /*
* ivy.c - part of the otter/ivy interface.
*
*/
#include "header.h"
#include "lisp.h"
#include "check.h"
static struct proof_object *Initial_proof_object = NULL;
/*************************************************************************/
static int bnode_to_natural(Bnode b)
{
if (!atom(b))
return -1;
else {
int i;
if (str_int(b->label, &i))
return (i < 0 ? -1 : i);
else
return -1;
}
} /* bnode_to_natural */
/*************************************************************************/
static struct term *bnode_to_otterterm(Bnode b,
char **varnames)
{
if (atom(b)) {
int i = 0;
char *str;
struct term *t = get_term();
t->type = VARIABLE;
t->sym_num = str_to_sn(b->label, 0);
str = sn_to_str(t->sym_num);
while (i < MAX_VARS && varnames[i] != NULL &&
varnames[i] != sn_to_str(t->sym_num))
i++;
if (i == MAX_VARS)
return NULL;
else {
if (varnames[i] == NULL)
varnames[i] = sn_to_str(t->sym_num);
t->varnum = i;
}
return t;
}
else if (length(b) == 1) {
struct term *t = get_term();
t->type = NAME;
t->sym_num = str_to_sn(car(b)->label, 0);
return t;
}
else {
struct rel *r1, *r2;
char *label = car(b)->label;
int arity = length(b) - 1;
struct term *t = get_term();
t->type = COMPLEX;
t->sym_num = str_to_sn(label, arity);
r2 = NULL;
for (b = cdr(b) ; !atom(b); b = cdr(b)) {
r1 = get_rel();
r1->argval = bnode_to_otterterm(b->car, varnames);
if (r2 == NULL)
t->farg = r1;
else
r2->narg = r1;
r2 = r1;
}
return t;
}
} /* bnode_to_otterterm */
/*************************************************************************/
/* This is different from is_symbol in that it works for variables. */
int special_is_symbol(struct term *t, char *str, int arity)
{
return(sn_to_arity(t->sym_num) == arity &&
str_ident(sn_to_str(t->sym_num), str));
} /* special_is_symbol */
/*************************************************************************/
void trans_logic_symbols(struct term *t)
{
if (special_is_symbol(t, "TRUE", 0)) {
t->sym_num = str_to_sn("$T", 0);
t->type = NAME;
}
else if (special_is_symbol(t, "FALSE", 0)) {
t->sym_num = str_to_sn("$F", 0);
t->type = NAME;
}
else if (is_symbol(t, "NOT", 1)) {
t->sym_num = str_to_sn("-", 1);
trans_logic_symbols(t->farg->argval);
}
else if (is_symbol(t, "OR", 2)) {
t->sym_num = str_to_sn("|", 2);
trans_logic_symbols(t->farg->argval);
trans_logic_symbols(t->farg->narg->argval);
}
} /* trans_logic_symbols */
/*************************************************************************/
static struct clause *bnode_to_clause(Bnode b)
{
struct term *t;
char *varnames[MAX_VARS];
int i;
for (i=0; i<MAX_VARS; i++)
varnames[i] = NULL;
t = bnode_to_otterterm(b, varnames);
if (t == NULL)
return NULL;
else {
struct clause *c;
trans_logic_symbols(t);
c = term_to_clause(t);
/* lit_t_f_reduce(c); don't do this, because of test in derive */
return c;
}
} /* bnode_to_clause */
/*************************************************************************/
struct proof_object *parse_initial_proof_object(FILE *fp)
{
struct proof_object *po = get_proof_object();
Bnode lisp_proof_object = parse_lisp(fp);
Bnode b;
Bnode lisp_step;
if (lisp_proof_object == NULL)
abend("parse_proof_object: parse_listp returns NULL");
if (!true_listp(lisp_proof_object))
abend("parse_proof_object: parse_listp nonlist");
for (b = lisp_proof_object; !nullp(b); b = b->cdr) {
struct proof_object_node *pn = connect_new_node(po);
Bnode e1, e2, e3;
char *label;
lisp_step = b->car;
if (length(lisp_step) < 3)
abend("parse_proof_object: step length < 3");
e1 = car(lisp_step);
e2 = cadr(lisp_step);
e3 = caddr(lisp_step);
pn->id = bnode_to_natural(e1);
if (length(e2) < 1 || !atom(car(e2)))
abend("parse_proof_object: bad justification (1)");
label = car(e2)->label;
if (str_ident(label, "INPUT"))
pn->rule = P_RULE_INPUT;
else if (str_ident(label, "EQ-AXIOM"))
pn->rule = P_RULE_EQ_AXIOM;
else
abend("parse_proof_object: bad justification (2)");
pn->c = bnode_to_clause(e3);
if (!pn->c)
abend("parse_proof_object: NULL clause");
} /* for each step */
return po;
} /* parse_proof_object */
/*************************************************************************/
struct list *init_proof_object(FILE *fin,
FILE *fout)
{
struct proof_object *obj;
init_proof_object_environment();
obj = parse_initial_proof_object(fin);
if (obj == NULL) {
fprintf(fout, "error parsing initial proof object\n");
return NULL;
}
else {
struct proof_object_node *pn;
struct list *lst = get_list();
print_proof_object(fout, obj);
for (pn = obj->first; pn != NULL; pn = pn->next)
append_cl(lst, cl_copy(pn->c)); /* this gets rid of variable names */
Initial_proof_object = obj; /* save it for construction of final version */
return lst;
}
} /* init_proof_object */
/*************************************************************************/
struct proof_object *retrieve_initial_proof_object(void)
{
return Initial_proof_object;
} /* retrieve_initial_proof_object */
./otter/linkhyp.c 0000744 0002044 0001012 00000000432 11120534446 012272 0 ustar beeson /*
* linkhyp.c -- linked hyperresolution
*
*/
#include "header.h"
/*************
*
* linked_hyper_res(giv_cl)
*
*************/
void linked_hyper_res(struct clause *giv_cl)
{
printf("linked hyper not implemented yet.\n");
} /* linked_hyper_res */
./otter/linkur.c 0000744 0002044 0001012 00000227251 11120534446 012132 0 ustar beeson /*
* linkur.c -- Linked hyperresolution inference rule.
*
*/
#include "header.h"
/*
* As modified by SKW Apr 10 90 and May 15 90,
* from "release 2" Otter with linking.
* Added routines: subsumable_unit, linked_unit_del.
* To see the changes, search for SKW.
*/
/* When I changed to new-style function prototypes (May 2000),
* I put all of these static declarations here, because the
* corresponding definitions aren't ordered nicely. Not all
* of these are necessary.
*/
static void construct_children_nodes(struct link_node *curr_node,
struct term *tp,
struct link_node **target,
char target_here);
static struct clause *subsumable_unit(char sign,
struct term *d);
static struct clause *linked_unit_del(char sign,
struct term *d);
static struct link_node *backward(struct link_node **tree,
struct link_node *node,
struct link_node **target,
int *nopen,
int *nres);
static struct int_ptr *build_parental_chain(struct link_node *node,
struct link_node *target);
static struct clause *build_ur_resolvent(struct link_node *target,
struct link_node *tree);
static BOOLEAN check_down_tree(struct link_node *node,
int my_depth);
static BOOLEAN check_up_tree(struct link_node *node,
int my_depth);
static struct term *first_unifiable(struct term *t,
struct fpa_index *index,
struct context *subst_t,
struct context *subst_ret,
struct fpa_tree **pos_ptr,
struct trail **tr_ptr,
struct link_node *curr_node,
struct link_node *target,
char *target_here,
int *hit_dp_count);
static struct link_node *forward(struct link_node *cn,
struct link_node *target);
static struct link_node *forward_from_resolved_tree(struct link_node *curr_node,
struct link_node **target,
int *nres,
int *nopen);
static void free_linked_node_tree(struct link_node *tree,
struct link_node **target);
static struct term *generate_resolvent(struct link_node *curr_node,
struct link_node *target,
char *target_here,
int *hit_dp_count);
static struct link_node *initialize_tree(struct clause *giv_cl);
static BOOLEAN is_in_ancestry(struct link_node *curr_node,
struct link_node *inf_tree);
static BOOLEAN keep_clause(struct link_node *node,
struct link_node **target,
char *target_here,
int *nopen);
static void linked_print_clause(struct clause *cp);
static void linked_print_link_node(struct link_node *lnp,
int lvl);
static void linked_print_link_node_tree(struct link_node *lnp,
int lvl);
static BOOLEAN more_targets_here(struct term *tp);
static struct term *next_unifiable(struct term *t,
struct context *subst_t,
struct context *subst_ret,
struct fpa_tree **pos_ptr,
struct trail **tr_ptr,
struct link_node *curr_node,
struct link_node *target,
char *target_here,
int *hit_dp_count);
static BOOLEAN poss_nuc_link(struct link_node *lnp);
static BOOLEAN pass_parms_check(struct link_node *curr_node,
int nres,
int nopen,
int *depth_count,
int *ded_count,
struct link_node *tar);
static BOOLEAN pass_target_depth_check(struct link_node *curr_node);
static BOOLEAN process_this_resolution(struct link_node *curr_node,
struct link_node *target,
struct term *tp,
char *target_here,
int *hit_dp_count);
static int term_ident_subst(struct term *t1,
struct context *c1,
struct term *t2,
struct context *c2);
static void write_down_tree(struct link_node *node,
int my_depth);
static void write_up_tree(struct link_node *node,
int my_depth);
static void write_target_distances(struct link_node *curr_node);
/************************************************************
*
* void construct_children_nodes(curr_node,tp, target, target_here)
* struct link_node *curr_node;
* struct term *tp;
* struct link_node **target;
* BOOLEAN target_here;
*
* It is assumed that the clause linked to tp may be added as children
* to the curr_node. This function writes the new depths in the inference
* tree. If target_here then re-writes the whole tree accordingly (the
* test for that was done in process_this_resolution()), otherwise it
* just writes the depths for the children nodes.
*
************************************************************/
static void construct_children_nodes(struct link_node *curr_node,
struct term *tp,
struct link_node **target,
char target_here)
{
struct link_node *lnp;
struct literal *lp;
if (Flags[LINKED_UR_TRACE].val == 1)
printf("constructing nodes for remaining lits:\n");
if (target_here && *target)
{
printf("ERROR: constructing children told target here with already target set\n");
exit(ABEND_EXIT);
} /* endif */
/* constructing first child node of curr_node */
if ((lnp = get_link_node()) == NULL)
{
printf("couldn't get link_node\n");
exit(ABEND_EXIT);
} /* endif */
curr_node->first_child = lnp;
lnp->parent = curr_node;
lnp->prev_sibling = NULL;
lnp->first = TRUE;
/* loop to find first literal other than the one */
/* that linked into this clause */
for (lp = (curr_node->current_clause)->first_lit;
lp && lp == tp->occ.lit; lp = lp->next_lit)
;
if (!lp)
{
printf("ERROR ... non UNIT clause looks UNIT\n");
exit(ABEND_EXIT);
} /* endif */
if (target_here && lp->target)
*target = lnp;
lnp->goal = lp->atom;
if ((lnp->subst = get_context()) == NULL)
{
printf("couldn't get context\n");
exit(ABEND_EXIT);
} /* endif */
(lnp->subst)->multiplier = lnp->subst->built_in_multiplier;
if (Flags[LINKED_UR_TRACE].val == 1)
{
if (!(((lnp->goal)->occ.lit)->sign))
printf("-");
print_term(stdout, lnp->goal);
printf(" from clause ");
linked_print_clause(((lnp->goal)->occ.lit)->container);
printf("\n");
} /* endif */
/* loop to construct link_node for */
/* remaining lits in new clause */
for (lp = lp->next_lit; lp; lp = lp->next_lit)
{
if (lp != tp->occ.lit)
{
if ((lnp->next_sibling = get_link_node()) == NULL)
{
printf("couldn't get link_node\n");
exit(ABEND_EXIT);
} /* endif */
(lnp->next_sibling)->prev_sibling = lnp;
lnp = lnp->next_sibling;
lnp->parent = curr_node;
lnp->first = TRUE;
if (target_here && lp->target && !(*target))
*target = lnp;
lnp->goal = lp->atom;
if ((lnp->subst = get_context()) == NULL)
{
printf("couldn't get context node\n");
exit(ABEND_EXIT);
} /* endif */
(lnp->subst)->multiplier = lnp->subst->built_in_multiplier;
if (Flags[LINKED_UR_TRACE].val == 1)
{
if (!(((lnp->goal)->occ.lit)->sign))
printf("-");
print_term(stdout, lnp->goal);
printf(" from clause ");
fflush(stdout);
linked_print_clause(((lnp->goal)->occ.lit)->container);
printf("\n");
} /* endif */
} /* endif */
} /* endfor */
lnp->next_sibling = NULL;
if (target_here && !(*target))
{
printf("ERROR: constructing children told target here and target not found here\n");
exit(ABEND_EXIT);
} /* endif */
/* loop to establish distances for the new clause */
for (lnp = (lnp->parent)->first_child; lnp; lnp = lnp->next_sibling)
{
if (target_here)
lnp->target_dist = -1;
else
{
/* target not in this clause */
if (*target)
/* target is elsewhere */
lnp->target_dist = (lnp->parent)->target_dist + 1;
} /* endif */
lnp->farthest_sat = (lnp->parent)->farthest_sat + 1;
lnp->back_up = UNDEFINED;
if (poss_nuc_link(lnp))
lnp->near_poss_nuc = 0;
else
{
if (poss_nuc_link(lnp->parent))
lnp->near_poss_nuc = 1;
else
{
if ((lnp->parent)->near_poss_nuc == UNDEFINED)
lnp->near_poss_nuc = UNDEFINED;
else
lnp->near_poss_nuc = (lnp->parent)->near_poss_nuc + 1;
} /* endif */
} /* endif */
} /* endfor */
if (target_here)
{
write_target_distances(curr_node);
}
} /* end construct_children_nodes() */
/*********************************************************************
*
* struct clause *subsumable_unit(sign,d)
*
* Attempt to find a unit clause that subsumes the (unsigned) literal
* (atom) d with sign "sign".
*
* SKW - Apr 11 90 - This entire routine added to do subsumable unit
* checking in linked resolution.
*
**********************************************************************/
static struct clause *subsumable_unit(char sign,
struct term *d)
{
int subsumed; /* flag set to 1 if literal is subsumed */
struct clause *c = NULL; /* c is a ptr to a (possible) subsuming cl */
struct term *c_atom, *d_atom; /* c_atom and d_atom are ptrs to */
/* atoms (unsigned literals) for */
/* literal c and clause d resp. */
struct context *s; /* a context is a substitution */
struct is_tree *is_db; /* This is the index that we use. */
/* This will be set either to */
/* Is_pos_lits (global variable indicating */
/* index for positive literals) or to */
/* Is_neg_lits (index for neg literals). */
struct fsub_pos *pos; /* Maintains a position in the sequence of */
/* subsuming literals. fsub position. */
/* Maintained from one call to the next of */
/* the indexing routine. */
/* BEGIN DEBUG SKW print out passed term (and possibly sign) */
/* printf("entering subsumable_unit, passed term follows\n"); */
/* print_term(stdout,d); printf("\n"); */
/* END DEBUG SKW */
subsumed = 0; /* initially flag says not subsumed */
s = get_context(); /* s is initially a null context, void subst */
/* The following code checks for subsumption of the passed literal "d"
* by a clause in the list or lists selected by option flags.
* If Flags[LINKED_SUB_UNIT_USABLE].val is 1,
* via set(linked_sub_unit_usable), then subsumption by Usable list
* clauses is checked.
* If Flags[LINKED_SUB_UNIT_SOS].val is 1,
* via set(linked_sub_unit_sos), then subsumption by Sos list
* clauses is checked.
* If BOTH flags are one, subsumption by both lists is checked.
* The necessary flags are set up in "cos.h" and in "options.c",
* in the standard manner used throughout Otter.
*/
/* The following code for subsumable unit assumes that the option
* "clear(for_sub_fpa)" is in effect, that is, that forward subsumption
* by FPA is not in use.
* In fact, forward subsumption by FPA has simply not been used
* in the recent past, so this assumption is not a limiting one.
*/
if (Flags[FOR_SUB_FPA].val == 0) { /* if `is' indexing */
/* d_lit = d; *//* this setting allows the code in "forward_subsume" */
d_atom = d; /* this setting allows the code in "forward_subsume" */
/* in "clause.c" to be copied in here. */
/* Is_pos_lits and Is_neg_lits are global variables */
is_db = sign ? Is_pos_lits : Is_neg_lits;
c_atom = fs_retrieve(d_atom, s, is_db, &pos);
/* &pos is position returned for subsequent calls. */
while (c_atom != NULL && subsumed == 0) {
c = c_atom->occ.lit->container;
/* want to get the clause that contains "c_atom". */
/* if c is a unit, in the right list (usable or sos or either),
* then set subsumed to 1.
*/
if (num_literals(c) == 1 &&
( (c->container == Usable
&& Flags[LINKED_SUB_UNIT_USABLE].val == 1)
|| (c->container == Sos
&& Flags[LINKED_SUB_UNIT_SOS].val == 1)))
subsumed = 1;
if (subsumed == 0)
c_atom = fs_retrieve((struct term *) NULL, s, is_db, &pos);
else {
/* clear_subst_1(tr); ** Apr 12 90 SKW */
/* ("tr" is not being used in this simple application
** of subsumption testing for unit clauses.
** We don't need to do additional unifies on additional
** literals. Therefore there is no need to keep a trail
** (tr) of what we did.
** Therefore we never initialized "tr" to NIL.
** Therefore we can't pass "tr" to clear_subst_1,
** and this is all right because we don't need to clear.
*/
canc_fs_pos(pos, s);
}
}
}
else
printf("FPA indexing not supported for linked res subsumable unit");
/* endif */
free_context(s);
/* BEGIN DEBUG SKW
** if (subsumed) {
** printf("exiting subsumable_unit, subsuming clause c follows\n");
** print_clause(stdout,c); printf("\n");
** }
** else
** printf("exiting subsumable_unit, not subsumed\n");
** END DEBUG SKW */
if (subsumed)
return(c);
else
return(NULL);
} /* end of subsumable_unit */
/*********************************************************************
*
* struct clause *linked_unit_del(sign,d)
*
* Attempt to find a unit clause that resolves the (unsigned) literal
* (atom) d with sign "sign", without instantiating "d".
*
* SKW - Apr 11 90 - This entire routine added to do unit deletion
* checking in linked resolution.
*
* This routine will not update the link_node data structure.
* This routine simply returns a pointer to a clause with sign opposite
* to the passed "sign". The clause can be used to unit-delete "d".
*
* If no unit deletion clause is found, a NULL pointer is returned.
*
* A literal L can be unit deleted if and only if -L
* (L with sign reversed) is subsumed by a unit clause C.
* If such a clause C is found, it can be used to resolve off L without
* instantiating L.
* Hence the use of the forward subsumption routine "fs_retrieve".
* The subsuming unit clause C, or "NULL" if none, is returned.
*
* Essentially the same subsumption logic is used as in "subsumable_unit".
*
**********************************************************************/
static struct clause *linked_unit_del(char sign,
struct term *d)
{
int subsumed; /* flag set to 1 if negation of
* literal is subsumed */
BOOLEAN print_ud_trace; /* Hard-code this to TRUE to print */
/* linked unit deletion trace msgs */
struct clause *c = NULL; /* c is a ptr to a (possible) subsuming cl */
struct term *c_atom, *d_atom; /* c_atom and d_atom are ptrs to */
/* atoms (unsigned literals) for */
/* clause c and literal d resp. */
struct context *s; /* a context is a substitution */
struct is_tree *is_db; /* This is the index that we use. */
/* This will be set either to */
/* Is_pos_lits (global variable indicating */
/* index for positive literals) or to */
/* Is_neg_lits (index for neg literals). */
struct fsub_pos *pos; /* Maintains a position in the sequence of */
/* subsuming literals. fsub position. */
/* Maintained from one call to the next of */
/* the indexing routine. */
print_ud_trace = FALSE; /* Turn off trace */
/* BEGIN DEBUG SKW print out passed term (and possibly sign) */
if (print_ud_trace)
{
printf("UD entering linked_unit_del, passed term follows\n");
printf("UD ");
print_term(stdout,d); printf("\n");
} /* endif */
/* END DEBUG SKW */
subsumed = 0; /* initially flag says not subsumed */
s = get_context();
/* s is initially a null context, void subst */
/* The following code checks for subsumption
* of the negation of the passed literal "d"
* by a unit clause in any list.
*/
/* The following code for unit deletion assumes that the option
* "clear(for_sub_fpa)" is in effect, that is, that forward subsumption
* by FPA is not in use.
* In fact, forward subsumption by FPA has simply not been used
* in the recent past, so this assumption is not a limiting one.
*/
if (Flags[FOR_SUB_FPA].val == 0) { /* if `is' indexing */
d_atom = d; /* this setting allows the code in "forward_subsume" */
/* in "clause.c" to be copied in here. */
/* Is_pos_lits and Is_neg_lits are global variables */
/* that point to indexes for positive literals and */
/* negative literals respectively. */
is_db = sign ? Is_neg_lits : Is_pos_lits ;
/* Note that if "sign" is positive, use NEGATIVE literal index,
* if "sign" is negative, use POSITIVE literal index,
* So that in fact a subsumer of the NEGATION
* of the passed literal is sought.
*/
c_atom = fs_retrieve(d_atom, s, is_db, &pos);
/* &pos is position returned for subsequent calls. */
while (c_atom != NULL && subsumed == 0) {
c = c_atom->occ.lit->container;
/* want to get the clause that contains "c_atom". */
/* if c is a unit,
* then set subsumed to 1.
*/
if (num_literals(c) == 1)
subsumed = 1;
if (subsumed == 0)
c_atom = fs_retrieve((struct term *) NULL, s, is_db, &pos);
else {
/* No need to clear_subst_1(tr); ** Apr 12 90 SKW */
/* ("tr" is not being used in this simple application
** of subsumption testing for unit clauses.
** We don't need to do additional unifies on additional
** literals. Therefore there is no need to keep a trail
** (tr) of what we did.
** Therefore we never initialized "tr" to NIL.
** Therefore we can't pass "tr" to clear_subst_1,
** and this is all right because we don't need to clear.)
*/
canc_fs_pos(pos, s);
}
}
}
else
printf("FPA indexing not supported for linked res linked_unit_del");
/* endif */
free_context(s);
/* BEGIN DEBUG SKW */
if (print_ud_trace)
{
if (subsumed)
{
printf("UD exiting linked_unit_del, subsuming clause c follows\n");
printf("UD ");
print_clause(stdout,c); printf("\n");
} /* endif */
else
printf("UD exiting linked_unit_del, not subsumed\n");
} /* endif */
/* END DEBUG SKW */
if (subsumed)
{
Stats[UNIT_DELETES]++;
return(c);
}
else
return(NULL);
} /* end of linked_unit_del */
/************************************************************
*
* struct link_node *backward(tree, node, target, nopen, nres)
* struct link_node **tree, *node, **target;
* int *nopen, *nres;
*
************************************************************/
static struct link_node *backward(struct link_node **tree,
struct link_node *node,
struct link_node **target,
int *nopen,
int *nres)
{
struct link_node *p, *start, *temp_p;
BOOLEAN left_most, target_here;
if (node->first_child)
{
printf("attempted to back up from a node with a child\n");
exit(ABEND_EXIT);
} /* endif */
clear_subst_1(node->tr);
node->first = TRUE;
node->current_clause = NULL;
/* At the time that you back up away from this node,
* all information as to how the node's literal was instantiated,
* and all information as to how this literal was resolved,
* must be reset to NULL, unknown, etc.
* In particular, unit deletion of the node no longer holds good.
*/
node->unit_deleted = FALSE;
if (node->goal_to_resolve)
{
zap_term(node->goal_to_resolve);
/* SKW This is where the instantiated goal_to_resolve */
/* is zapped (deleted from memory) when the backtracking process */
/* is done with it. */
node->goal_to_resolve = NULL;
} /* endif */
if (node->prev_sibling)
{
if (node->prev_sibling == *target)
{
if ((*target)->prev_sibling)
{
left_most = FALSE;
start = node;
}
else
{
left_most = TRUE;
start = *target;
} /* endif */
}
else
{
left_most = FALSE;
start = node;
} /* endif */
}
else
{
left_most = TRUE;
start = node;
} /* endif */
if (!left_most)
{
/* node has left sibling */
node->farthest_sat = (node->parent)->farthest_sat + 1;
p = start->prev_sibling;
if (p == *target)
p = p->prev_sibling;
while (p->first_child)
{
p = p->first_child;
/* loop to get the rightmost sibling at this level */
while (p->next_sibling)
p = p->next_sibling;
} /* endwhile */
if (p == *target)
/* backed up to the target ... must back up again */
p = backward(tree, p, target, nopen, nres);
else
{
*nopen = *nopen + 1;
*nres = *nres - 1;
p->current_clause = NULL;
} /* endif */
}
else
{
/* node is leftmost sibling ... if the target clause is in here */
/* an attempt must be made to re-position the target. if the */
/* target cannot be re-postioned and this is NOT a BOTH clause */
/* it is trashed. if the target is not in this clause then it */
/* is trashed. */
if (keep_clause(start, target, &target_here, nopen))
p = start;
else
{
/* node is leftmost sibling ... must */
/* remove himself and all his siblings. */
/* this simply means returning the nodes */
/* as the clear_subst have been done all */
/* along. */
p = start->parent;
/* removing nodes of deleted clause from open lit count */
if (target_here)
*nopen = *nopen - (num_literals(p->current_clause) - 2);
else
*nopen = *nopen - (num_literals(p->current_clause) - 1);
while (p->first_child)
{
temp_p = p->first_child;
p->first_child = temp_p->next_sibling;
free_context(temp_p->subst);
free_link_node(temp_p);
} /* endwhile */
if (p == *tree)
{
/* have removed all the nodes of the tree */
free_context(p->subst);
free_link_node(p);
p = NULL;
*tree = NULL;
*nopen = *nopen - 1;
}
else
{
/* p now points to a newly acquired open node */
*nres = *nres - 1;
*nopen = *nopen + 1;
p->current_clause = NULL;
} /* endif */
} /* endif */
} /* endif */
return p;
} /* end backward() */
/*************
*
* linked_ur_res(giv_cl)
*
*************/
void linked_ur_res(struct clause *giv_cl)
{
struct link_node *inf_tree, *curr_node, *target, *lnp;
struct term *tp, *temp_term;
int hit_ur_limit_count, open_lit_count, res_count, i;
int hit_ur_ded_count;
struct clause *resolvent, *unit_cl;
BOOLEAN target_here;
BOOLEAN subsumable_unit_here;
tp = NULL; /* to quite -Wall */
/* subsumable_unit_here is TRUE if the current
* literal "curr_node->goal_to_resolve"
* has been found to be a subsumable unit.
* Otherwise subsumable_unit_here is FALSE.
*/
/* only process given clauses that are unit */
if (num_literals(giv_cl) > 1)
return;
CLOCK_START(LINKED_UR_TIME);
if (Flags[LINKED_UR_TRACE].val == 1)
{
printf("********entering Linked UR\n");
print_linked_ur_mem_stats();
printf("***********\n");
} /* endif */
if ((inf_tree = initialize_tree(giv_cl)) == NULL)
{
printf("ERROR: unable to initialize linked UR inference tree\n");
exit(ABEND_EXIT);
} /* endif */
hit_ur_limit_count = hit_ur_ded_count = 0;
res_count = 0;
open_lit_count = 1;
if (Flags[LINKED_UR_TRACE].val == 1)
{
printf("********tree before BIG loop open lit %d nres %d\n",
open_lit_count, res_count);
linked_print_link_node_tree(inf_tree, 0);
printf("***********\n");
} /* endif */
/* BIG loop to process whole tree */
target = NULL;
curr_node = inf_tree->first_child;
while (curr_node)
{
/* assumed that curr_node is correctly positioned */
/* Print trace information if trace flag is turned on */
if (Flags[LINKED_UR_TRACE].val == 1)
{
printf("attempting to find clash for term ");
if (!(((curr_node->goal)->occ.lit)->sign))
printf("-");
fflush(stdout);
print_term(stdout, curr_node->goal);
fflush(stdout);
printf(" in clause ");
fflush(stdout);
linked_print_clause(((curr_node->goal)->occ.lit)->container);
printf(" first time = %c res_count = %d\n",
(curr_node->first ? 'T' : 'F'), res_count);
} /* endif */
/* Modifications by SKW Apr 10 90 and May 15 90 follow */
subsumable_unit_here = FALSE;
/* If the current node's literal has not been unit-deleted away,
* and the various parameters say OK to continue linking,
* find a first way or an additional way to resolve
* this node's literal.
*/
if ( ! (curr_node->unit_deleted)
&&
pass_parms_check(curr_node, res_count, open_lit_count,
&hit_ur_limit_count, &hit_ur_ded_count, target))
{
/* Apply:
** Do the apply here so that goal_to_resolve will be correctly
** set to the instantiated form of the current (unsigned) literal
** before "subsumable_unit" (which uses this instantiated term)
** is called.
*/
if (curr_node->first)
{
curr_node->goal_to_resolve =
apply(curr_node->goal, (curr_node->parent)->subst);
curr_node->unit_deleted = FALSE;
} /* endif */
/* Subsumable Unit Test:
** If this is the first time that this node of the linked
** inference tree is being examined (after all, we only need
** to check once whether the unit is subsumable)
** and no target has been chosen yet
** (subsumable unit is only applicable if there is just one
** open (unresolved) literal and it is NOT the target)
** and, finally, there is indeed exactly one open literal,
** then perform the subsumable unit test.
*/
if (curr_node->first && !target && open_lit_count == 1
&& res_count >= 1)
{
/* SKW DEBUG BEGIN - SHOW WHAT res_count IS */
/* printf("ready to test for calling subsumable_unit\n"); */
/* printf("res_count = %d\n",res_count); */
/* SKW DEBUG END */
if ((Flags[LINKED_SUB_UNIT_USABLE].val == 1 ||
Flags[LINKED_SUB_UNIT_SOS].val == 1) &&
subsumable_unit(curr_node->goal->occ.lit->sign,
curr_node->goal_to_resolve))
{
subsumable_unit_here = TRUE;
tp = NULL;
/* If the unit is indeed subsumable, set tp = NULL
** which essentially means a "FAIL" has occurred
** at this node, that is no linked resolvent can be
** completed when this node is involved.
**
** The sign of the literal is found by tracing the chain
** of pointers "curr_node->goal->occ.lit->sign".
** Here "goal" points to the UNINSTANTIATED and unsigned
** form of the literal to be resolved.
** The pointer "goal_to_resolve" points to the
** INSTANTIATED unsigned form of the literal to be
** resolved. That is, "goal_to_resolve" is
** "goal"/(current unifying substitution so far).
*/
}
}
/* The following nested "if" statement has the following effect.
* If a resolving clause can be found, point "tp" to
* the resolving unsigned literal (struct term) in that clause.
* Otherwise, set "tp" to NULL.
*/
if ( ! subsumable_unit_here)
{
/* goal_to_resolve is not subsumable */
/* So, test for unit deletion of goal_to_resolve */
/* Note that we only test for unit deletion if at least
* one resolution has occurred.
* That is, we don't test the unit "given clause" for
* unit deletion.
*/
if ((Flags[LINKED_UNIT_DEL].val) && (res_count >= 1)
&&
(unit_cl = linked_unit_del(curr_node->goal->occ.lit->sign,
curr_node->goal_to_resolve)))
{
/* unit deletion succeeded */
curr_node->unit_deleted = TRUE;
tp = unit_cl->first_lit->atom;
target_here = FALSE;
/* new resolving clause is a unit, and so
* does not contain the target
*/
}
else
tp = generate_resolvent(curr_node, target,
&target_here, &hit_ur_limit_count);
} /* endif */
} /* endif */
else
/* did not pass parms check */
tp = NULL;
/* At this point, "tp" is either a pointer to a clause, that will
* resolve the literal "curr_node->goal_to_resolve",
* or is "NULL" indicating that no resolving clause could be found.
*
* If "curr_node->unit_deleted" is TRUE, then the resolving clause
* is a unit, the resolution is a "unit deletion",
* and the resolution does not instantiate the literal
* "curr_node->goal_to_resolve".
* In this case there is no need to try any additional ways of
* resolving the literal.
*
* Otherwise ("curr_node->unit_deleted" is FALSE),
* other possible resolutions will need to be tried.
*/
if (tp)
{
/* found (another) resolvent */
if (Flags[LINKED_UR_TRACE].val == 1)
{
printf("clashed against term: ");
if (!((tp->occ.lit)->sign))
printf("-");
print_term(stdout, tp);
printf(" in clause ");
linked_print_clause((tp->occ.lit)->container);
printf("\n");
} /* endif */
/* this resolution may be added to the inference tree */
res_count ++;
open_lit_count --;
curr_node->current_clause = (tp->occ.lit)->container;
i = num_literals(curr_node->current_clause);
if (target_here)
open_lit_count = open_lit_count + (i - 2);
else
open_lit_count = open_lit_count + (i - 1);
if (i == 1)
/* new clause is UNIT */
curr_node->first_child = NULL;
else
{
/* new clause is non-UNIT */
construct_children_nodes(curr_node, tp,
&target, target_here);
} /* endif */
if ((lnp = forward(curr_node, target)) != NULL)
{
/* was able to move forward */
if (!(lnp->first))
{
printf("ERROR: moved forward to %x first = FALSE\n", (unsigned) lnp);
exit(ABEND_EXIT);
} /* endif */
curr_node = lnp;
/* was able to move forward to select new goal */
/* must check that new goal is not in ancestry */
if (is_in_ancestry(curr_node, inf_tree))
{
/* literal in curr_node is in ancestry */
/* attempting to resolve it away would */
/* start a loop. must back up. */
if (Flags[LINKED_UR_TRACE].val == 1)
{
printf("did not attempt to resolve ");
if (!(((curr_node->goal)->occ.lit)->sign))
printf("-");
fflush(stdout);
print_term(stdout, curr_node->goal);
printf(" ... appears in ancestry\n");
} /* endif */
curr_node = backward(&inf_tree, curr_node, &target,
&open_lit_count, &res_count);
}
else
{
/* literal in curr_node is not in ancestry */
/* and may be chosen as the next literal */
/* to be resolved away. */
/* have moved forward and there's no target */
/* this node's farthest_sat must be */
/* re-calculated as MAX(his farthest_sat, */
/* all left siblings' back_up distances) */
i = curr_node->farthest_sat;
for (lnp = (curr_node->parent)->first_child;
lnp && lnp != curr_node;
lnp = lnp->next_sibling)
{
if (lnp->back_up == UNDEFINED && lnp != target)
{
printf("ERROR: found non_target back_up < 0\n");
exit(ABEND_EXIT);
}
else
{
if (i < lnp->back_up)
i = lnp->back_up;
} /* endif */
} /* endfor */
if (!lnp)
{
printf("ERROR: left_sibling chain to NULL\n");
exit(ABEND_EXIT);
} /* endif */
curr_node->farthest_sat = i;
} /* endif */
}
else
{
/* resolved away whole tree */
if (Flags[LINKED_UR_TRACE].val == 1)
{
printf("***RESOLVED AWAY TREE curr_node at %x target at %x open lit %d nres %d\n",
(unsigned) curr_node, (unsigned) target, open_lit_count, res_count);
linked_print_link_node_tree(inf_tree, 0);
printf("***********\n");
printf("resolvent = ");
fflush(stdout);
if (target)
{
if (!(((target->goal)->occ.lit)->sign))
printf("-");
fflush(stdout);
temp_term = apply(target->goal,
(target->parent)->subst);
print_term(stdout, temp_term);
printf("\n");
zap_term(temp_term);
}
else
printf("[]\n");
} /* endif */
resolvent = build_ur_resolvent(target,
inf_tree->first_child);
Stats[CL_GENERATED]++;
Stats[LINKED_UR_RES_GEN]++;
CLOCK_STOP(LINKED_UR_TIME);
pre_process(resolvent, 0, Sos);
CLOCK_START(LINKED_UR_TIME);
curr_node = forward_from_resolved_tree(curr_node,
&target, &res_count, &open_lit_count);
} /* endif */
}
else
{
/* couldn't find anything (else) to unify */
/* or failed parms check */
if (Flags[LINKED_UR_TRACE].val == 1)
printf("-- FAIL --\n");
/* must back up from curr_node ... when */
/* trying this node again it will be */
/* the first time. */
curr_node = backward(&inf_tree, curr_node, &target,
&open_lit_count, &res_count);
} /* endif */
if (Flags[LINKED_UR_TRACE].val == 1)
{
printf("***tree end BIG loop curr_node %x tar %x open lit %d\n",
(unsigned) curr_node, (unsigned) target, open_lit_count);
linked_print_link_node_tree(inf_tree, 0);
printf("***********\n");
} /* endif */
} /* endwhile */
if (Flags[LINKED_UR_TRACE].val == 1)
{
printf("********tree leaving linked UR open lit %d nres %d\n",
open_lit_count, res_count);
linked_print_link_node_tree(inf_tree, 0);
printf("***********\n");
print_linked_ur_mem_stats();
printf("***********\n");
} /* endif */
if (hit_ur_limit_count)
printf("** HIT maximum linked UR depth %d times\n", hit_ur_limit_count);
if (hit_ur_ded_count)
printf("** HIT maximum linked UR deduction size %d times\n",
hit_ur_ded_count);
Stats[LINKED_UR_DEPTH_HITS] += hit_ur_limit_count;
Stats[LINKED_UR_DED_HITS] += hit_ur_ded_count;
CLOCK_STOP(LINKED_UR_TIME);
} /* end linked_ur_res() */
/************************************************************
*
* struct int_ptr *build_parental_chain(node, target)
* struct link_node *node, *target;
*
************************************************************/
static struct int_ptr *build_parental_chain(struct link_node *node,
struct link_node *target)
{
struct int_ptr *chain_head, *last_one, *tail, *unit_del_flag_node;
struct link_node *lnp;
chain_head = get_int_ptr();
chain_head->i = (((node->goal)->occ.lit)->container)->id;
chain_head->next = NULL;
last_one = chain_head;
for (lnp = node; lnp; lnp = lnp->next_sibling)
{
if (lnp->first_child)
tail = build_parental_chain(lnp->first_child, target);
else
{
if (lnp != target)
{
tail = get_int_ptr();
tail->i = (lnp->current_clause)->id;
if (lnp->unit_deleted)
{
unit_del_flag_node = get_int_ptr();
unit_del_flag_node->i = UNIT_DEL_RULE;
unit_del_flag_node->next = tail;
tail = unit_del_flag_node;
}
}
else
tail = NULL;
} /* endif */
last_one->next = tail;
while (last_one->next)
last_one = last_one->next;
} /* endfor */
return chain_head;
} /* end build_parental_chain() */
/************************************************************
*
* struct clause *build_ur_resolvent(target, tree)
* struct link_node *target, *tree;
*
************************************************************/
static struct clause *build_ur_resolvent(struct link_node *target,
struct link_node *tree)
{
struct clause *resolvent;
struct literal *from_lit, *to_lit;
resolvent = get_clause();
if (target)
{
/* linked ur generated a unit clause */
resolvent->first_lit = to_lit = get_literal();
from_lit = (target->goal)->occ.lit;
to_lit->container = resolvent;
to_lit->sign = from_lit->sign;
to_lit->atom = apply(target->goal, (target->parent)->subst);
(to_lit->atom)->occ.lit = to_lit;
(to_lit->atom)->varnum = (from_lit->atom)->varnum;
}
else
/* linked ur generated the empty clause */
resolvent->first_lit = NULL;
resolvent->parents = get_int_ptr();
(resolvent->parents)->i = LINKED_UR_RES_RULE;
(resolvent->parents)->next = build_parental_chain(tree, target);
return resolvent;
} /* end build_ur_resolvent() */
/************************************************************
*
* BOOLEAN check_down_tree(node, my_depth)
* struct link_node *node;
* int my_depth;
*
* This function assumes the target rests above node in the tree
* at a distance of my_depth.
*
* if (node)
* if (my_depth is OK)
* for (each of my left siblings SIB && still OK)
* OK = check_down_tree(SIB->first_child, my_depth+1)
* endfor
* else
* OK = FALSE
* endif
* else
* if (mydepth is OK)
* OK = TRUE
* else
* OK = FALSE
* endif
* endif
*
* return OK
*
************************************************************/
static BOOLEAN check_down_tree(struct link_node *node,
int my_depth)
{
BOOLEAN rc;
struct link_node *lnp;
if (my_depth <= Parms[MAX_UR_DEPTH].val)
{
rc = TRUE;
if (node)
{
/* I am not a SATELLITE with no link node */
for (lnp = node; rc && lnp; lnp = lnp->next_sibling)
rc = check_down_tree(lnp->first_child, my_depth+1);
} /* endif */
}
else
rc = FALSE;
return rc;
} /* end check_down_tree */
/************************************************************
*
* BOOLEAN check_up_tree(node, my_depth)
* struct link_node *node;
* int my_depth;
*
* This function assumes the target has been brought into node
* from below at a distance of my_depth.
*
* if (i am not the dummy node)
* if (my_depth is OK)
* OK = TRUE
* for (each of my siblings to the left && still OK)
* OK = check the depth of their children (my_depth+1)
* endfor
* if (still OK)
* OK = check_up_tree(leftmost sibling parent, my_depth+1)
* endif
* else
* OK = FALSE
* endif
* else
* OK = TRUE
* endif
*
* return OK
*
************************************************************/
static BOOLEAN check_up_tree(struct link_node *node,
int my_depth)
{
BOOLEAN rc;
struct link_node *lnp;
if (node->parent)
{
/* I am NOT the dummy node at the top of the inference tree */
if (my_depth <= Parms[MAX_UR_DEPTH].val)
{
/* this level clause is OK ... must check */
/* all the children of the siblings to my */
/* left (the ones to the right have not */
/* been processed yet) then go UP on my */
/* leftmost sibling. */
rc = TRUE;
lnp = node;
while (rc && lnp->prev_sibling)
{
lnp = lnp->prev_sibling;
rc = check_down_tree(lnp->first_child, my_depth+1);
} /* endwhile */
if (rc)
rc = check_up_tree(lnp->parent, my_depth+1);
}
else
rc = FALSE;
}
else
/* I am the dummy node at the top of the inference tree */
rc = TRUE;
return rc;
} /* end check_up_tree() */
/*************
*
* struct term *first_unifiable(t,index,subst_t,subst_ret,pos_ptr,tr_ptr,
* curr_node, target, target_here)
* struct term *t;
* struct fpa_head **index;
* struct context *subst_t, *subst_ret;
* struct fpa_tree **pos_ptr;
* struct trail **tr_ptr;
* struct link_node *curr_node, *target;
* BOOLEAN *target_here;
*
* This function finds the first term that can resolve away the literal
* pointed at by curr_node.
*
*************/
static struct term *first_unifiable(struct term *t,
struct fpa_index *index,
struct context *subst_t,
struct context *subst_ret,
struct fpa_tree **pos_ptr,
struct trail **tr_ptr,
struct link_node *curr_node,
struct link_node *target,
char *target_here,
int *hit_dp_count)
{
int var_nums[MAX_VARS], i;
/* curr_node->goal_to_resolve = apply(t, subst_t); ** SKW Apr 12 90 */
for (i = 0; i < MAX_VARS; i ++)
var_nums[i] = -1;
if (!(renum_vars_term(curr_node->goal_to_resolve, var_nums)))
{
printf("unable to renumber vas in fist_unifiable()\n");
exit(ABEND_EXIT);
} /* endif */
*pos_ptr = build_tree(curr_node->goal_to_resolve, UNIFY,
Parms[FPA_LITERALS].val, index);
return(next_unifiable(t, subst_t, subst_ret, pos_ptr, tr_ptr,
curr_node, target, target_here, hit_dp_count));
} /* first_unifiable */
/************************************************************
*
* struct link_node *forward(cn, target)
* struct link_node *cn, *target;
*
************************************************************/
static struct link_node *forward(struct link_node *cn,
struct link_node *target)
{
struct link_node *p, *lnp;
BOOLEAN done;
int max_back_up;
done = FALSE;
p = NULL; /* to quite -Wall */
if (cn->first_child)
{
/* has a first child */
if (cn->first_child != target)
{
/* first child is not the target */
p = cn->first_child;
done = TRUE;
}
else
{
/* has first child that is the target */
if ((cn->first_child)->next_sibling)
{
/* target has a next_sibling */
p = (cn->first_child)->next_sibling;
done = TRUE;
} /* endif */
} /* endif */
} /* endif */
if (!done)
{
/* cn picked off by SATELLITE */
cn->back_up = 0;
if (cn->next_sibling)
{
/* has a next sibling */
if (cn->next_sibling != target)
{
/* the next_sibling is not the target */
p = cn->next_sibling;
done = TRUE;
}
else
{
/* the next_sibling is the target */
if ((cn->next_sibling)->next_sibling)
{
/* the target has a next_sibling */
p = (cn->next_sibling)->next_sibling;
done = TRUE;
} /* endif */
} /* endif */
} /* endif */
} /* endif */
if (!done)
{
/* time to go back up in the tree */
/* must traverse up tree until I find a parent that has */
/* a sibling to the right that is NOT the target */
p = cn->parent;
while (!done && p)
{
/* must find the longest back_up value from */
/* all my children to establish my back_up */
for (max_back_up = -1, lnp = p->first_child;
lnp; lnp = lnp->next_sibling)
if (max_back_up < lnp->back_up)
max_back_up = lnp->back_up;
p->back_up = max_back_up + 1;
if (p->next_sibling)
{
/* has a next_sibling */
if (p->next_sibling != target)
{
/* the next sibling is NOT the target */
p = p->next_sibling;
done = TRUE;
}
else
{
/* the next_sibling is the target */
if ((p->next_sibling)->next_sibling)
{
/* the target has a next_sibling */
p = (p->next_sibling)->next_sibling;
done = TRUE;
}
else
{
/* the target does not have a next_sibling */
p = p->parent;
} /* endif */
} /* endif */
}
else
p = p->parent;
} /* endwhile */
} /* endif */
return p;
} /* end forward() */
/************************************************************
*
* struct link_node *forward_from_resolved_tree(curr_node, target, nres, nopen)
* struct link_node *curr_node, **target;
* int *nres, *nopen;
*
* The inference tree has been resolved away and curr_node points
* to the last node that was resolved away. There is a special case
* that must be considered. It is in fact possible for curr_node
* to have a first_child. This occurs when the target is in a
* two literal clause and that clause was just brought in as the
* child of curr_node.
*
* When this happens, the target must be removed and one of two
* things must occur:
* 1) The first_child is of type BOTH. The first child must be converted
* to a link. The first_child is then chosen as the curr_node first = T.
* 2) The first_child is of type NUCLEUS. It must be removed from the
* inference tree and the curr_node becomes the curr_node first = F.
*
************************************************************/
static struct link_node *forward_from_resolved_tree(struct link_node *curr_node,
struct link_node **target,
int *nres,
int *nopen)
{
struct link_node *lnp;
lnp = curr_node;
if (lnp->first_child)
{
/* the current node has a child ... better be the only */
/* sibling at that level and it better be the target */
if (lnp->first_child != *target)
{
printf("ERROR: forward failed, has first_child that's NOT tar\n");
exit(ABEND_EXIT);
}
else
{
/* this target node better not have any */
/* children or siblings */
if ((lnp->first_child)->next_sibling ||
(lnp->first_child)->first_child)
{
printf("ERROR: forward failed with target child (has sibs)\n");
exit(ABEND_EXIT);
}
else
{
/* the target must be cleared ... either */
/* tossing this nucleus or both is */
/* converted from a nuclues to a link. */
*target = NULL;
if ((lnp->current_clause)->type == BOTH)
{
/* bottom node is BOTH and must */
/* converted from a nucleus to */
/* a link. */
lnp = lnp->first_child;
*nopen = *nopen + 1;
}
else
{
/* bottom node is NUCLEUS and must be tossed */
free_linked_node_tree(lnp->first_child, target);
lnp->first_child = NULL;
*nres = *nres - 1;
*nopen = *nopen + 1;
lnp->current_clause = NULL;
} /* endif */
} /* endif */
} /* endif */
}
else
{
/* curr_node has no children */
*nres = *nres - 1;
*nopen = *nopen + 1;
lnp->current_clause = NULL;
} /* endif */
return lnp;
} /* end forward_from_resolved_tree() */
/************************************************************
*
* void free_linked_node_tree(tree, target)
* struct link_node *tree, **target;
*
************************************************************/
static void free_linked_node_tree(struct link_node *tree,
struct link_node **target)
{
if (tree)
{
free_linked_node_tree(tree->next_sibling, target);
free_linked_node_tree(tree->first_child, target);
if (tree == *target)
*target = NULL;
if (tree->subst)
free_context(tree->subst);
free_link_node(tree);
} /* endif */
} /* end free_linked_node_tree() */
/************************************************************
*
* struct term *generate_resolvent(curr_node, target, target_here)
* struct link_node *curr_node, *target;
* BOOLEAN *target_here;
*
* This function attempts to find the next term that can resolve against
* the goal term in the node pointed at by curr_node. If there are
* no more terms that resolve against this given term, the NULL pointer
* is returned.
*
************************************************************/
static struct term *generate_resolvent(struct link_node *curr_node,
struct link_node *target,
char *target_here,
int *hit_dp_count)
{
struct term *tp;
struct fpa_index *db;
if ((((curr_node->goal)->occ.lit)->sign))
db = Fpa_clash_neg_lits;
else
db = Fpa_clash_pos_lits;
if (curr_node->first)
{
curr_node->first = FALSE;
tp = first_unifiable(curr_node->goal, db, (curr_node->parent)->subst,
curr_node->subst, &(curr_node->unif_position),
&(curr_node->tr), curr_node, target, target_here,
hit_dp_count);
}
else
{
clear_subst_1(curr_node->tr);
tp = next_unifiable(curr_node->goal, (curr_node->parent)->subst,
curr_node->subst, &(curr_node->unif_position),
&(curr_node->tr), curr_node, target, target_here,
hit_dp_count);
} /* endif */
return tp;
} /* end generate_resolvent() */
/************************************************************
*
* struct link_node *initialize_tree(giv_cl)
* struct clause *giv_cl;
*
************************************************************/
static struct link_node *initialize_tree(struct clause *giv_cl)
{
struct link_node *tree, *given, *dummy_target;
dummy_target = NULL;
if ((tree = get_link_node()) != NULL)
{
/* initializing top dummy node */
tree->parent = NULL;
tree->next_sibling = NULL;
tree->prev_sibling = NULL;
tree->near_poss_nuc = UNDEFINED;
tree->farthest_sat = -2;
tree->target_dist = 0;
tree->back_up = UNDEFINED;
tree->goal = NULL;
tree->current_clause = giv_cl;
tree->tr = NULL;
tree->first = TRUE;
tree->unif_position = NULL;
if ((tree->subst = get_context()) != NULL)
(tree->subst)->multiplier = tree->subst->built_in_multiplier;
else
{
printf("ERROR: couldn't get context for dummy node\n");
free_linked_node_tree(tree, &dummy_target);
tree = NULL;
} /* endif */
}
else
printf("ERROR: couldn't get link node for dummy\n");
if (tree)
{
/* getting node that represents given clause */
if ((given = get_link_node()) != NULL)
{
/* initializing node that represents given clause */
given->parent = tree;
tree->first_child = given;
given->next_sibling = NULL;
given->prev_sibling = NULL;
given->near_poss_nuc = UNDEFINED;
given->farthest_sat = -1;
given->target_dist = 0;
given->back_up = UNDEFINED;
given->goal = (giv_cl->first_lit)->atom;
given->current_clause = NULL;
given->tr = NULL;
given->first = TRUE;
given->unif_position = NULL;
if ((given->subst = get_context()) != NULL)
(given->subst)->multiplier = given->subst->built_in_multiplier;
else
{
printf("ERROR: couldn't get context for given node\n");
free_linked_node_tree(tree, &dummy_target);
tree = NULL;
} /* endif */
}
else
{
printf("couldn't get given link_node\n");
free_linked_node_tree(tree, &dummy_target);
tree = NULL;
} /* endif */
} /* endif */
return tree;
} /* end initialize_tree() */
/************************************************************
*
* BOOLEAN is_in_ancestry(curr_node, inf_tree)
* struct link_node *curr_node, *inf_tree;
*
************************************************************/
static BOOLEAN is_in_ancestry(struct link_node *curr_node,
struct link_node *inf_tree)
{
struct link_node *lnp;
struct term *cand;
struct context *cand_subst;
BOOLEAN rc;
char sign;
sign = ((curr_node->goal)->occ.lit)->sign;
cand = curr_node->goal;
cand_subst = (curr_node->parent)->subst;
if (Flags[LINKED_UR_TRACE].val == 1)
{
printf("checking is_in_ancestry on lit ");
if (!sign)
printf("-");
fflush(stdout);
print_term(stdout, cand);
printf("\n");
} /* endif */
for (lnp = curr_node->parent, rc = FALSE; !rc && lnp != inf_tree;
lnp = lnp->parent)
rc = ( (sign == ((lnp->goal)->occ.lit)->sign)
&&
term_ident_subst(lnp->goal, (lnp->parent)->subst,
cand, cand_subst)
);
return rc;
} /* end is_in_ancestry() */
/************************************************************
*
* BOOLEAN keep_clause(node, target, target_here, nopen)
* struct link_node *node, **target;
* BOOLEAN *target_here;
* int *nopen;
*
* This function is called by backward() when the node that is
* being backed up from is the leftmost sibling. A decision must
* be made whether to keep the clause represented by this node and
* its siblings.
*
* if (target in this clause)
* if (there is another target candidate literal to the right)
* re-define the target as the next target literal candidate
* keep clause
* else
* clear target pointer (target = NULL)
* if (clause is of type BOTH)
* keep clause (BOTH from NUCLEUS to LINK)
* else
* don't keep clause
* endif
* endif
* else
* don't keep clause
* endif
*
************************************************************/
static BOOLEAN keep_clause(struct link_node *node,
struct link_node **target,
char *target_here,
int *nopen)
{
BOOLEAN keep, both_to_link;
struct link_node *temp_p;
if (*target)
{
/* the target has been established ... may be here */
/* loop to determine if target is in this clause */
for (temp_p = node;
temp_p && temp_p != *target;
temp_p = temp_p->next_sibling)
;
if (temp_p)
{
/* target is in this clause */
*target_here = TRUE;
both_to_link = FALSE;
/* loop to find another target in this clause */
for (temp_p = temp_p->next_sibling;
temp_p && !(((temp_p->goal)->occ.lit)->target);
temp_p = temp_p->next_sibling)
;
if (temp_p)
{
/* there is another target */
*target = temp_p;
keep = TRUE;
}
else
{
/* there are no other targets */
if (((((*target)->goal)->occ.lit)->container)->type == BOTH)
{
/* clause is of type BOTH and may */
/* now be treated as a LINK */
keep = TRUE;
both_to_link = TRUE;
}
else
/* clause is of type NUC with no more targets */
keep = FALSE;
*target = NULL;
} /* endif */
if (both_to_link)
*nopen = *nopen + 1;
}
else
{
/* target is not in this clause */
keep = FALSE;
*target_here = FALSE;
} /* endif */
}
else
{
/* the target has not been established anywhere */
keep = FALSE;
*target_here = FALSE;
} /* endif */
return keep;
} /* end keep_clause() */
/************************************************************
*
* void linked_print_clause(cp)
* struct clause *cp;
*
************************************************************/
static void linked_print_clause(struct clause *cp)
{
struct literal *lp;
printf("at %x >>", (unsigned) cp);
fflush(stdout);
switch (cp->type)
{
case NOT_SPECIFIED:
printf("NOT_SPECIFIED: ");
break;
case NUCLEUS:
printf("NUCLEUS: ");
break;
case LINK:
printf("LINK: ");
break;
case BOTH:
printf("BOTH: ");
break;
case SATELLITE:
printf("SATELLITE: ");
break;
default:
printf("** UNKNOWN **: ");
break;
} /* end switch() */
fflush(stdout);
for (lp = cp->first_lit; lp; lp = lp->next_lit)
{
if (lp->target)
printf("**");
fflush(stdout);
printf("-");
fflush(stdout);
print_term(stdout, lp->atom);
fflush(stdout);
if (lp->target)
printf("**");
fflush(stdout);
printf(" ");
fflush(stdout);
} /* endfor */
printf("<< ");
} /* end linked_print_clause() */
/************************************************************
*
* void linked_print_link_node(lnp, lvl)
* struct link_node *lnp;
* int lvl;
*
************************************************************/
static void linked_print_link_node(struct link_node *lnp,
int lvl)
{
int i;
for (i = 0; i < lvl; i ++)
printf(" ");
printf("-----start node at %x------\n", (unsigned) lnp);
for (i = 0; i < lvl; i ++)
printf(" ");
printf("parent = %x prev_sibling = %x next_sibling = %x first_child = %x\n",
(unsigned) lnp->parent, (unsigned) lnp->prev_sibling, (unsigned) lnp->next_sibling, (unsigned) lnp->first_child);
for (i = 0; i < lvl; i ++)
printf(" ");
printf("current_clause >> ");
if (lnp->current_clause)
linked_print_clause(lnp->current_clause);
else
printf("(NIL)");
printf(" <<\n");
for (i = 0; i < lvl; i ++)
printf(" ");
printf("first = %c unit_deleted = %c near_poss_nuc = %d farthest_sat = %d target_dist = %d back_up = %d\n",
(lnp->first ? 'T' : 'F'), (lnp->unit_deleted ? 'T' : 'F'),
lnp->near_poss_nuc, lnp->farthest_sat,
lnp->target_dist, lnp->back_up);
for (i = 0; i < lvl; i ++)
printf(" ");
printf("goal to resolve ");
if (lnp->goal_to_resolve)
{
if (!(((lnp->goal)->occ.lit)->sign))
printf("-");
print_term(stdout, lnp->goal_to_resolve);
}
else
printf("(NIL)");
printf(" ... from literal ");
if (lnp->goal)
{
if (!(((lnp->goal)->occ.lit)->sign))
printf("-");
print_term(stdout, lnp->goal);
}
else
printf("(NIL)");
printf("\n");
if (lnp->goal)
{
for (i = 0; i < lvl; i ++)
printf(" ");
printf("from clause ");
fflush(stdout);
linked_print_clause(((lnp->goal)->occ.lit)->container);
printf("\n");
} /* endif */
for (i = 0; i < lvl; i ++)
printf(" ");
printf("subst = %x subst->multiplier = %d tr = %x unif_position = %x\n",
(unsigned) lnp->subst, (lnp->subst)->multiplier, (unsigned) lnp->tr, (unsigned) lnp->unif_position);
for (i = 0; i < lvl; i ++)
printf(" ");
printf("-----end node at %x------\n", (unsigned) lnp);
} /* end linked_print_link_node() */
/************************************************************
*
* void linked_print_link_node_tree(lnp, lvl)
* struct link_node *lnp;
* int lvl;
*
************************************************************/
static void linked_print_link_node_tree(struct link_node *lnp,
int lvl)
{
struct link_node *l;
for (l = lnp; l; l = l->next_sibling)
{
linked_print_link_node(l, lvl);
linked_print_link_node_tree(l->first_child, lvl+1);
} /* endfor */
} /* end linked_print_link_node_tree() */
/************************************************************
*
* BOOLEAN more_targets_here(tp)
* struct term *tp;
*
* This function returns TRUE iff there exists a target literal in
* the clause that contains tp OTHER than the literal that
* contains tp.
*
************************************************************/
static BOOLEAN more_targets_here(struct term *tp)
{
BOOLEAN more;
struct literal *lp;
for (more = FALSE, lp = ((tp->occ.lit)->container)->first_lit;
!more && lp;
lp = lp->next_lit)
if (lp != (tp->occ.lit) && lp->target)
more = TRUE;
return more;
} /* end more_targets_here() */
/*************
*
* struct term *next_unifiable(t, subst_t, subst_ret, pos_ptr, tr_ptr,
* curr_node, target, target_here)
* struct term *t;
* struct context *subst_t, *subst_ret;
* struct fpa_tree **pos_ptr;
* struct trail **tr_ptr;
* struct link_node *curr_node, *target;
* BOOLEAN *target_here;
*
* This function finds a term that can be used to resolve away the node
* pointed at by curr_node.
*
*************/
static struct term *next_unifiable(struct term *t,
struct context *subst_t,
struct context *subst_ret,
struct fpa_tree **pos_ptr,
struct trail **tr_ptr,
struct link_node *curr_node,
struct link_node *target,
char *target_here,
int *hit_dp_count)
{
struct term *term_to_return;
int rc;
BOOLEAN try_find_another;
term_to_return = next_term(*pos_ptr, 0);
*tr_ptr = NULL;
/*
while (term_to_return != NULL &&
(!process_this_resolution(curr_node, target, term_to_return, target_here)
||
unify(t, subst_t, term_to_return, subst_ret, tr_ptr) == 0))
term_to_return = next_term(*pos_ptr, 0);
*/
if (term_to_return == NULL)
try_find_another = FALSE;
else
{
if (process_this_resolution(curr_node, target,
term_to_return, target_here, hit_dp_count))
{
rc = unify(t, subst_t, term_to_return, subst_ret, tr_ptr);
if (rc == 0)
{
try_find_another = TRUE;
}
else
{
try_find_another = FALSE;
} /* endif */
}
else
try_find_another = TRUE;
} /* endif */
while (try_find_another)
{
term_to_return = next_term(*pos_ptr, 0);
if (term_to_return == NULL)
try_find_another = FALSE;
else
{
if (process_this_resolution(curr_node, target,
term_to_return, target_here, hit_dp_count))
{
rc = unify(t, subst_t, term_to_return, subst_ret, tr_ptr);
if (rc == 0)
{
try_find_another = TRUE;
}
else
{
try_find_another = FALSE;
} /* endif */
}
else
try_find_another = TRUE;
} /* endif */
} /* endwhile */
return(term_to_return);
} /* next_unifiable */
/************************************************************
*
* BOOLEAN poss_nuc_link(lnp)
* struct link_node *lnp;
*
* This function tests the clause associated with the node pointed
* at by lnp. It tests whether this clause has the potential to
* bring in a NUCLEUS somewhere to the right of lnp. This is
* TRUE if lnp has a right sibling and the farthest satellite
* from lnp is < max link depth away.
*
************************************************************/
static BOOLEAN poss_nuc_link(struct link_node *lnp)
{
BOOLEAN rc;
if (lnp->next_sibling)
{
if (lnp->farthest_sat < Parms[MAX_UR_DEPTH].val)
rc = TRUE;
else
rc = FALSE;
}
else
rc = FALSE;
return rc;
} /* end poss_nuc_link() */
/************************************************************
*
* BOOLEAN pass_parms_check(curr_node, nres, nopen, depth_count, ded_count, tar)
* struct link_node *curr_node;
* int nres, nopen, *depth_count, *ded_count;
* struct link_node tar;
*
* Just about to resolve away the node pointed at by curr_node.
* Checking the parms set for linked UR deduction. Currently checks
* depth of tree and deduction size (number of resolutions).
*
************************************************************/
static BOOLEAN pass_parms_check(struct link_node *curr_node,
int nres,
int nopen,
int *depth_count,
int *ded_count,
struct link_node *tar)
{
BOOLEAN ok_to_resolve;
ok_to_resolve = TRUE;
/* check maximum linked UR depth */
if (tar)
{
/* a target has been established somewhere */
if (curr_node->target_dist >= Parms[MAX_UR_DEPTH].val)
{
ok_to_resolve = FALSE;
*depth_count = *depth_count + 1;
if (Flags[LINKED_UR_TRACE].val == 1)
printf("max ur depth hit # %d ", *depth_count);
}
}
else
{
/* a target has not been established yet */
if (curr_node->near_poss_nuc != UNDEFINED)
{
if (curr_node->near_poss_nuc >= Parms[MAX_UR_DEPTH].val)
{
ok_to_resolve = FALSE;
*depth_count = *depth_count + 1;
if (Flags[LINKED_UR_TRACE].val == 1)
printf("max ur depth hit # %d ", *depth_count);
} /* endif */
}
else
{
if (curr_node->farthest_sat >= Parms[MAX_UR_DEPTH].val)
{
ok_to_resolve = FALSE;
*depth_count = *depth_count + 1;
if (Flags[LINKED_UR_TRACE].val == 1)
printf("max ur depth hit # %d ", *depth_count);
} /* endif */
} /* endif */
} /* endif */
/* check maximum linked UR deduction size */
if (ok_to_resolve)
{
if ((nres + nopen) > Parms[MAX_UR_DED_SIZE].val)
/* SKW DEBUG COMMENT HERE IN pass_parms_check, */
/* SKW DEBUG COMMENT "nres + nopen" IS COMPARED TO MAX DEDUCT SIZE */
{
ok_to_resolve = FALSE;
*ded_count = *ded_count + 1;
if (Flags[LINKED_UR_TRACE].val == 1)
printf("max ur ded size hit # %d ", *ded_count);
} /* endif */
} /* endif */
return ok_to_resolve;
} /* end pass_parms_check() */
/************************************************************
*
* BOOLEAN pass_target_depth_check(curr_node)
* struct link_node *curr_node;
*
* A potential target has been brought in as a child of this curr_node.
* This function returns TRUE iff bringing in this target as a child to
* curr_node is consistent with the depth check relative to the existing
* inference tree.
*
************************************************************/
static BOOLEAN pass_target_depth_check(struct link_node *curr_node)
{
return (curr_node->farthest_sat < Parms[MAX_UR_DEPTH].val);
/*
return check_up_tree(curr_node, 0);
*/
} /* end pass_target_depth_check() */
/************************************************************
*
* int process_linked_tags(cp)
* struct clause *cp;
*
************************************************************/
int process_linked_tags(struct clause *cp)
{
struct literal *lp, *tag;
struct term *tp;
int errors, i, rc, num_lits, j;
struct rel *r;
if (cp->first_lit == NULL)
return(0);
/* first set target field to the default value */
for (lp = cp->first_lit, num_lits = 0; lp; lp = lp->next_lit, num_lits++)
lp->target = Flags[LINKED_TARGET_ALL].val;
tp = cp->first_lit->atom;
if (str_ident("$NUCLEUS", sn_to_str(tp->sym_num)))
cp->type = NUCLEUS;
else if (str_ident("$LINK", sn_to_str(tp->sym_num)))
cp->type = LINK;
else if (str_ident("$BOTH", sn_to_str(tp->sym_num)))
cp->type = BOTH;
else if (str_ident("$SATELLITE", sn_to_str(tp->sym_num)))
cp->type = SATELLITE;
else {
cp->type = SATELLITE;
return(0);
}
errors = 0;
if (tp->farg == NULL || tp->farg->narg != NULL || proper_list(tp->farg->argval) == 0) {
printf("ERROR, argument of link tag is not a list: ");
print_term_nl(stdout, tp);
errors++;
}
else {
/* remove tag literal */
tag = cp->first_lit;
cp->first_lit = tag->next_lit;
num_lits--;
/* process tag list */
for (r = tag->atom->farg;
r->argval->sym_num != Nil_sym_num;
r = r->argval->farg->narg) {
rc = str_int(sn_to_str(r->argval->farg->argval->sym_num), &i);
if (rc == 0 || i > num_lits || i < 1) {
printf("ERROR, list member has bad literal number: %s\n",
sn_to_str(r->argval->farg->argval->sym_num));
errors++;
}
else {
for (lp=cp->first_lit, j = 1; j != i; lp = lp->next_lit, j++)
; /* empty body */
lp->target = (Flags[LINKED_TARGET_ALL].val ? 0 : 1);
}
}
/* delete tag literal */
tag->atom->occ.lit = NULL;
zap_term(tag->atom);
free_literal(tag);
}
return(errors);
} /* end process_linked_tags() */
/************************************************************
*
* BOOLEAN process_this_resolution(curr_node, target, tp, target_here)
* struct link_node *curr_node, *target;
* struct term *tp;
* BOOLEAN *target_here
*
* The node pointed at by curr_node can be resolved away by the term
* pointed at by tp. This function primarily checks that constructing
* nodes for the remaining literals in the clause that holds tp doesn't
* violate any of the rules associated with the choice of the target ... i.e.
* bringing in a nucleus when the target is chosen, choosing the target
* here violates the depth check, etc.
*
* if (clause type is LINK)
* target_here = FALSE
* process = TRUE;
* else
* if (target has been chosen)
* target_here = FALSE
* if (clause type is NUCLEUS)
* process = FALSE
* else
* process = TRUE
* endif
* else
* if (clause type is NUCLEUS)
* if (candidate targets left in this clause)
* if (pass target depth check)
* target_here = TRUE
* process = TRUE
* else
* target_here = FALSE
* process = FASLE
* endif
* else
* target_here = FALSE
* process = FALSE
* endif
* else
* process = TRUE
* if (candidate targets left in this clause)
* if (pass target depth check)
* target_here = TRUE
* else
* target_here = FALSE
* endif
* else
* target_here = FALSE
* endif
* endif
* endif
* endif
*
* ------------------------------------------------------------------
* Here is an alternate logic. ### represents a boolean expression.
* ### iff bringing in this clause and attempting to resolve away its
* other literals will NOT violate the depth check nor the deduction size.
* Very much like conducting pass_parms_check() on the clause first.
*
* switch (tp type)
* case NUCLEUS:
* if (!(target has been chosen)
* && candidate targets left in this clause
* && pass target depth check)
* target_here = FALSE
* process = FALSE
* else
* target_here = FALSE
* process = FALSE
* endif
* case LINK:
* target_here = FALSE
* if (###)
* process = TRUE
* else
* process = FALSE
* endif
* case BOTH:
* if (!(target has been chosen) && pass target depth check)
* target_here = TRUE
* process = TRUE
* else
* target_here = FALSE
* if (###)
* process = TRUE
* else
* process = FALSE
* endif
* endif
* case SATELLITE:
* target_here = FALSE
* process = TRUE
* end switch
*
************************************************************/
static BOOLEAN process_this_resolution(struct link_node *curr_node,
struct link_node *target,
struct term *tp,
char *target_here,
int *hit_dp_count)
{
BOOLEAN process, temp;
if (((tp->occ.lit)->container)->type == LINK)
{
process = TRUE;
*target_here = FALSE;
}
else
{
if (target)
{
/* the target has been previously chosen */
*target_here = FALSE;
if (((tp->occ.lit)->container)->type == NUCLEUS)
{
/* clause type is NUCLEUS */
process = FALSE;
if (Flags[LINKED_UR_TRACE].val == 1)
printf("brought NUC is TRASHED .. already have tar\n");
}
else
/* clause type is BOTH */
process = TRUE;
}
else
{
/* the target has not been previously chosen */
if (((tp->occ.lit)->container)->type == NUCLEUS)
{
/* clause type is NUCLEUS */
if (more_targets_here(tp))
{
temp = pass_target_depth_check(curr_node);
if (temp)
{
*target_here = TRUE;
process = TRUE;
}
else
{
*target_here = FALSE;
process = FALSE;
*hit_dp_count = *hit_dp_count + 1;
if (Flags[LINKED_UR_TRACE].val == 1)
printf("NUC failed depth check TRASHED\n");
} /* endif */
}
else
{
/* NUCLEUS brought in on only target */
*target_here = FALSE;
process = FALSE;
if (Flags[LINKED_UR_TRACE].val == 1)
printf("NUC in on only tar TRASHED\n");
} /* endif */
}
else
{
/* clause type is BOTH */
process = TRUE;
if (more_targets_here(tp))
{
temp = pass_target_depth_check(curr_node);
if (temp)
*target_here = TRUE;
else
{
*target_here = FALSE;
*hit_dp_count = *hit_dp_count + 1;
} /* endif */
}
else
*target_here = FALSE;
} /* endif */
} /* endif */
} /* endif */
return process;
} /* end process_this_resolution() */
/*************
*
* int term_ident_subst(t1, c1, t2, c2)
*
* Is t1 under substitution c1 identical to t2 under substitution c2?
*
*************/
static int term_ident_subst(struct term *t1,
struct context *c1,
struct term *t2,
struct context *c2)
{
struct rel *r1, *r2;
int vn1, vn2;
/* dereference if variables */
while (t1->type == VARIABLE && c1->terms[t1->varnum] != NULL) {
vn1 = t1->varnum;
t1 = c1->terms[vn1];
c1 = c1->contexts[vn1];
}
while (t2->type == VARIABLE && c2->terms[t2->varnum] != NULL) {
vn2 = t2->varnum;
t2 = c2->terms[vn2];
c2 = c2->contexts[vn2];
}
if (t1->type == VARIABLE)
return(t2->type == VARIABLE && t1->varnum == t2->varnum && c1 == c2);
else if (t2->type == VARIABLE)
return(0);
else { /* neither term is a variable */
if (t1->sym_num != t2->sym_num)
return(0); /* fail because of symbol clash */
else { /* following handles both names and complex terms */
r1 = t1->farg;
r2 = t2->farg;
/* arities are the same, becuase sym_num's are the same */
while (r1 != NULL && term_ident_subst(r1->argval, c1, r2->argval, c2)) {
r1 = r1->narg;
r2 = r2->narg;
}
if (r1 == NULL)
return(1);
else
return(0);
}
}
} /* term_ident_subst */
/************************************************************
*
* void write_down_tree(node, my_depth)
* struct link_node *node;
* int my_depth;
*
* The target has been brought in somewhere above node in the
* inference tree. I must write my_depth into target_dist
* of all the nodes at my level and process the child of
* myself and all my siblings' children.
*
************************************************************/
static void write_down_tree(struct link_node *node,
int my_depth)
{
struct link_node *lnp;
if (node)
{
for (lnp = node; lnp; lnp = lnp->next_sibling)
{
lnp->target_dist = my_depth;
write_down_tree(lnp->first_child, my_depth+1);
} /* endfor */
} /* endif */
} /* write_down_tree */
/************************************************************
*
* void write_up_tree(node, my_depth)
* struct link_node *node;
* int my_depth;
*
* The target has been brought into a node below this one at
* a distance of my_depth. I must write my_depth into all the
* siblings' target_dist at this level, write all the depths
* of all the children of the siblings to my left, and go up
* the inference tree at the left_most sibling.
*
************************************************************/
static void write_up_tree(struct link_node *node,
int my_depth)
{
struct link_node *lnp;
if (node->parent)
{
/* I am not the dummy node at the top of the inference tree */
/* ... writing my_depth to myself and all to right */
for (lnp = node; lnp; lnp = lnp->next_sibling)
lnp->target_dist = my_depth;
/* writing my_depth to all my left siblings and */
/* writing depths to their children */
lnp = node;
while (lnp->prev_sibling)
{
lnp = lnp->prev_sibling;
lnp->target_dist = my_depth;
write_down_tree(lnp->first_child, my_depth+1);
} /* endwhile */
write_up_tree(lnp->parent, my_depth+1);
} /* endif */
} /* end write_up_tree() */
/************************************************************
*
* void write_target_distances(curr_node)
* struct link_node *curr_node;
*
* curr_node has resolved with a clause that has the target.
* The acquitistion of this target has passed all the depth
* and legality checks and now the entire inference tree
* must have all their target_dist updated.
*
************************************************************/
static void write_target_distances(struct link_node *curr_node)
{
write_up_tree(curr_node, 0);
} /* end write_target_distances() */
./otter/lisp.c 0000744 0002044 0001012 00000014502 11120534447 011567 0 ustar beeson #include "lisp.h"
#define MAX_WORD 100
static char Word[MAX_WORD];
static int Gets, Frees;
#if 0
NOTE: the purpose of the /**/ comments before the function
definitions is to prevent the prototype-making scripts from
making prototypes for the functions.
#endif
/*************************************************************************/
static BOOLEAN str_ident(char *s, char *t)
{
return (strcmp(s, t) == 0);
} /* str_ident */
/*************************************************************************/
static char *new_str_copy(char *str)
{
char *p = (void *) malloc((size_t) strlen(str)+1);
strcpy(p, str);
return p;
} /* new_str_copy */
/*************************************************************************/
static Bnode get_bnode(void)
{
Bnode p = (void *) malloc((size_t) sizeof(struct bnode));
Gets++;
p->car = NULL;
p->cdr = NULL;
p->label = NULL;
p->atom = TRUE;
return p;
} /* get_bnode */
/*************************************************************************/
static void free_bnode(Bnode p)
{
Frees++;
if (p->atom)
free(p->label);
free(p);
} /* get_bnode */
/*************************************************************************/
/**/ void zap_btree(Bnode p)
{
if (!p->atom) {
zap_btree(p->car);
zap_btree(p->cdr);
}
free_bnode(p);
} /* get_bnode */
/*************************************************************************/
/**/ BOOLEAN true_listp(Bnode p)
{
if (p->atom)
return str_ident(p->label, "nil");
else
return true_listp(p->cdr);
} /* true_listp */
/*************************************************************************/
/**/ void fprint_btree(FILE *fp, Bnode p)
{
if (p->atom)
fprintf(fp, "%s", p->label);
else if (true_listp(p)) {
Bnode p2;
fprintf(fp,"(");
for (p2 = p; p2->cdr != NULL; p2 = p2->cdr) {
fprint_btree(fp, p2->car);
if (p2->cdr->cdr)
fprintf(fp," ");
}
fprintf(fp,")");
}
else {
fprintf(fp,"(");
fprint_btree(fp, p->car);
fprintf(fp," . ");
fprint_btree(fp, p->cdr);
fprintf(fp,")");
}
} /* fprint_btree */
/*************************************************************************/
/**/ void p_btree(Bnode p)
{
fprint_btree(stdout, p);
printf("\n");
fflush(stdout);
} /* p_btree */
/*************************************************************************/
static BOOLEAN white_char(char c)
{
return (c == ' ' ||
c == '\t' || /* tab */
c == '\n' || /* newline */
c == '\v' || /* vertical tab */
c == '\r' || /* carriage return */
c == '\f'); /* form feed */
} /* white_char */
static BOOLEAN paren(char c)
{
return (c == '(' ||
c == ')');
} /* paren */
/*************************************************************************/
static int fill_word(FILE *fp)
{
int c;
int i = 0;
c = getc(fp);
while (c != EOF && white_char((char) c)) // cast added by Beeson, 7.23.02
c = getc(fp);
if (c != EOF) {
while (c != EOF && !white_char((char)c) && !paren((char)c)) { // casts added by Beeson, 7.23.02
Word[i] = c;
i++;
if (i == MAX_WORD) {
Word[i] = '\0';
fprintf(stderr, "fill_word, word too big: |%s|\n", Word);
exit(2);
}
c = getc(fp);
}
if (c == ')' || (i != 0 && c == '('))
ungetc(c, fp);
}
Word[i] = '\0';
return(c);
} /* fill_word */
/*************************************************************************/
/**/ BOOLEAN nullp(Bnode p)
{
return (p->atom && str_ident(p->label,"nil"));
} /* nullp */
static BOOLEAN dotp(Bnode p)
{
return (p->atom && str_ident(p->label,"."));
} /* nullp */
/*************************************************************************/
static void dot_trans (Bnode p)
{
Bnode curr = p;
Bnode prev = NULL;
while (!curr->atom) {
if (dotp(curr->car)) {
if (!curr->cdr->atom &&
nullp(curr->cdr->cdr) &&
prev != NULL &&
!dotp(curr->cdr->car)) {
prev->cdr = curr->cdr->car;
free_bnode(curr->cdr->cdr);
free_bnode(curr->cdr);
free_bnode(curr->car);
free_bnode(curr);
}
else {
fprintf(stderr, "dot_trans, bad dot notation\n");
exit(2);
}
}
prev = curr;
curr = curr->cdr;
}
} /* dot_trans */
/*************************************************************************/
/**/ Bnode parse_lisp(FILE *fp)
{
int c;
c = fill_word(fp);
if (!str_ident(Word, "")) {
Bnode p = get_bnode();
p->atom = TRUE;
p->label = new_str_copy(Word);
return p;
}
else if (c == ')' )
return NULL;
else if (c == '(') {
Bnode top = get_bnode();
Bnode curr = top;
Bnode p = parse_lisp(fp);
while (p != NULL) {
curr->atom = FALSE;
curr->car = p;
curr->cdr = get_bnode();
curr = curr->cdr;
p = parse_lisp(fp);
}
c = getc(fp); /* step past ')' */
curr->label = new_str_copy("nil");
curr->atom = TRUE;
dot_trans(top);
return top;
}
else
return NULL;
} /* parse_lisp */
/*************************************************************************/
/**/ int atom(Bnode p)
{ return p->atom; } /* atom */
/*************************************************************************/
/**/ Bnode car(Bnode p)
{ return p->car;} /* car */
/*************************************************************************/
/**/ Bnode cdr(Bnode p)
{ return p->cdr;} /* cdr */
/*************************************************************************/
/**/ Bnode cadr(Bnode p)
{ return p->cdr->car;} /* cadr */
/*************************************************************************/
/**/ Bnode caddr(Bnode p)
{ return p->cdr->cdr->car;} /* caddr */
/*************************************************************************/
/**/ int length(Bnode p)
{
return (atom(p) ? 0 : length(cdr(p)) + 1);
} /* length */
/*************************************************************************/
#ifdef SOLO
/**/ int main(int argc, char **argv)
{
Bnode p;
p = parse_lisp(stdin);
fprint_btree(stdout, p);
printf("length = %d\n", length(p));
zap_btree(p);
printf("Gets=%d, Frees=%d.\n", Gets, Frees);
} /* main */
#endif
./otter/lisp.h 0000744 0002044 0001012 00000001754 11120534447 011601 0 ustar beeson /*
This is a dirty little parser for LISP-like expressions. It is meant
to to parse expressions written by machine.
* Comments are not recognized.
* Almost any token is accepted as an atom.
* Dot expressions are ok.
* Extra whitespace is ok.
* If anything goes wrong, exit with a message goes to stderr.
*/
#include <stdio.h>
#include <string.h>
#include <stdlib.h> /* for malloc, free */
#if 1
#define BOOLEAN char
#define FALSE 0
#define TRUE 1
#else
typedef enum { FALSE=0, TRUE=1 } BOOL;
#endif
typedef struct bnode * Bnode;
struct bnode {
Bnode car;
Bnode cdr;
BOOLEAN atom;
char *label;
};
/* Prototypes from lisp.c */
void zap_btree(Bnode p);
BOOLEAN true_listp(Bnode p);
void fprint_btree(FILE *fp, Bnode p);
void p_btree(Bnode p);
BOOLEAN nullp(Bnode p);
Bnode parse_lisp(FILE *fp);
int atom(Bnode p);
Bnode car(Bnode p);
Bnode cdr(Bnode p);
Bnode cadr(Bnode p);
Bnode caddr(Bnode p);
int length(Bnode p);
./otter/lrpo.c 0000744 0002044 0001012 00000017216 11120534447 011601 0 ustar beeson /*
* lrpo.c -- Lexicograpphic recursive path ordering (RPO with status)
*
*/
#include "header.h"
/*************
*
* int sym_precedence(sym_num_1, sym_num_2)
*
* Return SAME_AS, GREATER_THAN, LESS_THAN, or NOT_COMPARABLE.
*
*************/
static int sym_precedence(int sym_num_1,
int sym_num_2)
{
int p1, p2, sn;
static int warning_given;
if (sym_num_1 == sym_num_2)
return(SAME_AS);
else {
p1 = sn_to_node(sym_num_1)->lex_val;
p2 = sn_to_node(sym_num_2)->lex_val;
if (p1 == MAX_INT || p2 == MAX_INT) {
if (!warning_given) {
sn = (p1 == MAX_INT ? sym_num_1 : sym_num_2);
fprintf(stderr, "%c\nWARNING: at least one symbol, %s, is not lexically comparable.\nIf you use a lex command, you should include all symbols that\nwill be compared. This warning will not be given again.\n", Bell, sn_to_str(sn));
warning_given = 1;
}
return(NOT_COMPARABLE);
}
else if (p1 > p2)
return(GREATER_THAN);
else if (p1 < p2)
return(LESS_THAN);
else
return(SAME_AS);
}
} /* sym_precedence */
/*************
*
* int lrpo_status(sym_num)
*
*************/
static int lrpo_status(int sym_num)
{
return(sn_to_node(sym_num)->lex_rpo_status);
} /* lrpo_status */
/*************
*
* int lrpo_lex(t1, t2) -- Is t1 > t2 ?
*
* t1 and t2 have same functor and the functor has lr status.
* (If a functor really has rl status, its args have already been
* reversed. This is true of all subterms of t1 and t2.)
*
*************/
static int lrpo_lex(struct term *t1,
struct term *t2)
{
struct rel *r1, *r2;
int rc;
/* First skip over any identical arguments. */
/* (Same number of args, because same functor.) */
for (r1 = t1->farg, r2 = t2->farg;
r1 && term_ident(r1->argval, r2->argval);
r1 = r1->narg, r2 = r2->narg) /* empty body */ ;
if (!r1)
rc = 0; /* t1 and t2 identical */
else if (lrpo(r1->argval, r2->argval)) {
/* return (t1 > each remaining arg of t2) */
for (r2 = r2->narg; r2 && lrpo(t1, r2->argval); r2 = r2->narg)
/* empty body */ ;
rc = (r2 == NULL);
}
else {
/* return (there is a remaining arg of t1 s.t. arg == t2 or arg > t2) */
rc = 0;
for (r1 = r1->narg; r1; r1 = r1->narg) {
if (term_ident(r1->argval, t2) || lrpo(r1->argval, t2))
rc = 1;
}
}
return(rc);
} /* lrpo_lex */
/*************
*
* int num_occurrences(t_arg, t) -- How many times does t_arg occur
* as an argument of t?
*
*************/
static int num_occurrences(struct term *t_arg,
struct term *t)
{
struct rel *r;
int i;
for (i = 0, r = t->farg; r; r = r->narg)
if (term_ident(r->argval, t_arg))
i++;
return(i);
} /* num_occurrences */
/*************
*
* struct term *set_multiset_diff(t1, t2)
*
* Construct the multiset difference, then return the set of that.
* Result must be deallocated by caller with zap_term.
*
* In other words, viewing a term as a multiset of its arguments,
* find the set of t1's arguments that have more occurrences in
* t1 than in t2.
*
*************/
static struct term *set_multiset_diff(struct term *t1,
struct term *t2)
{
struct term *t_result;
struct rel *prev, *curr, *r1, *r;
int i;
t_result = get_term();
prev = NULL;
i = 0;
for (r1 = t1->farg; r1; r1 = r1->narg) {
/* First check if a preceeding occurrence of this arg has */
/* already been done. */
for (r = t1->farg; r != r1 && term_ident(r->argval, r1->argval) == 0; r = r->narg)
/* empty body */ ;
if (r == r1 && num_occurrences(r1->argval, t1) > num_occurrences(r1->argval, t2)) {
i++;
curr = get_rel();
curr->argval = copy_term(r1->argval);
if (!prev)
t_result->farg = curr;
else
prev->narg = curr;
prev = curr;
}
}
t_result->type = (i == 0 ? NAME : COMPLEX) ;
/* note that no sym_num is assigned; this should be ok */
return(t_result);
} /* set_multiset_diff */
/*************
*
* int lrpo_multiset(t1, t2) -- Is t1 > t2 in the lrpo multiset ordering?
*
* t1 and t2 have functors with the same precedence.
*
* let n(a,t) be the number of occurrences of a (as an argument) in t.
*
* t1 >(multiset) t2 iff for each arg a2 of t2 with n(a2,t2) > n(a2,t1),
* there is an arg a1 of t1 such that n(a1,t1) > n(a1,t2), and a1>a2.
*
*************/
static int lrpo_multiset(struct term *t1,
struct term *t2)
{
struct term *s1, *s2;
struct rel *r1, *r2;
int ok;
s1 = set_multiset_diff(t1, t2); /* builds and returns a set */
s2 = set_multiset_diff(t2, t1); /* builds and returns a set */
/*
* return (s2 not empty and foreach arg a2 of s2
* there is an arg a1 of s1 such that lrpo(a1, a2)).
*/
if (s2->farg == NULL)
ok = 0;
else {
for (r2 = s2->farg, ok = 1; r2 && ok; r2 = r2->narg) {
for (r1 = s1->farg, ok = 0; r1 && !ok ; r1 = r1->narg)
ok = lrpo(r1->argval, r2->argval);
}
}
zap_term(s1);
zap_term(s2);
return(ok);
} /* lrpo_multiset */
/*************
*
* int lrpo(t1, t2) - Is t1 > t2 in the lexicographic recursive
* path ordering?
*
*************/
int lrpo(struct term *t1,
struct term *t2)
{
int p;
struct rel *r;
if (t1->type == VARIABLE)
/* varaiable never greater than anything */
return(0);
else if (t2->type == VARIABLE)
/* t1 > variable iff t1 properly contains that variable */
return(occurs_in(t2, t1));
else if (t1->sym_num == t2->sym_num &&
lrpo_status(t1->sym_num) == LRPO_LR_STATUS)
return(lrpo_lex(t1, t2));
else {
p = sym_precedence(t1->sym_num, t2->sym_num);
if (p == SAME_AS)
return(lrpo_multiset(t1,t2));
else if (p == GREATER_THAN) {
/* return (t1 > each arg of t2) */
for (r = t2->farg; r && lrpo(t1, r->argval); r = r->narg)
/* empty body */ ;
return(r == NULL);
}
else { /* LESS_THEN or NOT_COMPARABLE */
/* return (there is an arg of t1 s.t. arg == t2 or arg > t2) */
for (r = t1->farg; r; r = r->narg) {
if (term_ident(r->argval, t2) || lrpo(r->argval, t2))
return(1);
}
return(0);
}
}
} /* lrpo */
/*************
*
* int lrpo_greater(t1, t2) - Is t1 > t2 in the lexicographic
* recursive path ordering?
*
* Time this routine.
*
*************/
int lrpo_greater(struct term *t1,
struct term *t2)
{
int rc;
#if 0
CLOCK_START(LRPO_TIME);
rc = lrpo(t1,t2);
CLOCK_STOP(LRPO_TIME);
#else
rc = lrpo(t1,t2);
#endif
return(rc);
} /* lrpo_greater */
/*************
*
* order_equalities_lrpo(c)
*
* For each equality literal (pos or neg), flip args if the right
* side is heavier. After possible filp, if the left side is
* heavier, set the ORIENTED_EQ_BIT in the atom.
* If the atom is flipped, set SCRATCH_BIT.
*
*************/
void order_equalities_lrpo(struct clause *c)
{
struct rel *r1, *r2;
struct term *alpha, *beta;
struct literal *l;
for (l = c->first_lit; l; l = l->next_lit) {
if (eq_lit(l)) {
r1 = l->atom->farg;
r2 = r1->narg;
alpha = r1->argval;
beta = r2->argval;
if (lrpo_greater(alpha, beta))
SET_BIT(l->atom->bits, ORIENTED_EQ_BIT);
else if (lrpo_greater(beta, alpha)) {
r1->argval = beta;
r2->argval = alpha;
SET_BIT(l->atom->bits, SCRATCH_BIT);
SET_BIT(l->atom->bits, ORIENTED_EQ_BIT);
}
}
}
} /* order_equalities_lrpo */
./otter/macros.h 0000744 0002044 0001012 00000005456 11120534447 012121 0 ustar beeson /*
* macros.h -- This file contains some #define preprocessor macros
*
*/
/*************
*
* CPU_TIME(sec, usec) - It has been sec seconds + usec microseconds
* since the start of this process.
*
*************/
#if defined(TP_ABSOLUTELY_NO_CLOCKS) || defined(TP_NO_CLOCKS)
#define CPU_TIME(sec, usec) {sec = usec = 0;}
#else
#ifdef THINK_C /* Macintosh */
#define CPU_TIME(sec, usec) \
{ \
long ticks; \
ticks = clock(); \
sec = ticks / CLOCKS_PER_SEC; \
usec = (ticks % CLOCKS_PER_SEC) * (1000000 / CLOCKS_PER_SEC); \
} /* CPU_TIME */
#else
#ifdef TP_RUSAGE
#define CPU_TIME(sec, usec) \
{ \
struct rusage r; \
getrusage(RUSAGE_SELF, &r); \
sec = r.ru_utime.tv_sec; \
usec = r.ru_utime.tv_usec; \
} /* CPU_TIME */
#else
#define CPU_TIME(sec, usec) {sec = usec = 0;}
#endif
#endif
#endif
/*************
*
* CLOCK_START(clock_num) - Start or continue timing.
*
* If the clock is already running, a warning message is printed.
*
*************/
#if defined(TP_NO_CLOCKS) || defined(TP_ABSOLUTELY_NO_CLOCKS)
#define CLOCK_START(c) /* empty string */
#else
#define CLOCK_START(c) \
{ \
struct clock *cp; \
\
cp = &Clocks[c]; \
if (cp->curr_sec != -1) { \
fprintf(stderr, "WARNING, CLOCK_START: clock %d already on.\n", c); \
printf("WARNING, CLOCK_START: clock %d already on.\n", c); \
} \
else \
CPU_TIME(cp->curr_sec, cp->curr_usec) \
} /* CLOCK_START */
#endif
/*************
*
* CLOCK_STOP(clock_num) - Stop timing and add to accumulated total.
*
* If the clock not running, a warning message is printed.
*
*************/
#if defined(TP_NO_CLOCKS) || defined(TP_ABSOLUTELY_NO_CLOCKS)
#define CLOCK_STOP(c) /* empty string */
#else
#define CLOCK_STOP(c) \
{ \
long sec, usec; \
struct clock *cp; \
\
cp = &Clocks[c]; \
if (cp->curr_sec == -1) { \
fprintf(stderr, "WARNING, CLOCK_STOP: clock %d already off.\n", c); \
printf("WARNING, CLOCK_STOP: clock %d already off.\n", c); \
} \
else { \
CPU_TIME(sec, usec) \
cp->accum_sec += sec - cp->curr_sec; \
cp->accum_usec += usec - cp->curr_usec; \
cp->curr_sec = -1; \
cp->curr_usec = -1; \
} \
} /* CLOCK_STOP */
#endif
/*************
*
* SET_BIT, CLEAR_BIT, BIT.
*
*************/
/* SCRATCH_BIT is by several operations to temporarily mark terms.
* When using it, make sure that no other operation is using it, and
* make sure to clear it when done. */
#define SET_BIT(bits, flag) (bits = bits | flag)
#define CLEAR_BIT(bits, flag) (bits = bits & ~flag)
#define TP_BIT(bits, flag) (bits & flag)
/* for terms: */
#define SCRATCH_BIT 01
#define ORIENTED_EQ_BIT 02
/* for clauses: */
#define SCRATCH_BIT 01
./otter/main.c 0000744 0002044 0001012 00000013344 11120534450 011541 0 ustar beeson /* Otter 3.2
*
* William McCune
* Mathematics and Computer Science Division
* Argonne National Laboratory
* Argonne, IL 60439
* U.S.A.
*
* E-mail: mccune@mcs.anl.gov
* Web: http://www.mcs.anl.gov/~mccune
* http://www.mcs.anl.gov/AR/otter
*/
#define OTTER_VERSION "3.2"
#define OTTER_DATE "August 2001"
#define OTTER_LAMBDA_VERSION "1.4"
#define OTTER_LAMBDA_DATE "July 2006"
#define IN_MAIN /* so that global vars in header.h will not be external */
#include "header.h"
#ifdef SCOTT
#include "called_by_otter.h" /* SCOTT protos seen by OTTER */
#endif
/**/ int main(int argc, char **argv)
{
struct clause *giv_cl;
int errors, status, level, first_of_next_level;
char *str;
FILE *xlog_fp = NULL;
non_portable_init(argc, argv);
#ifdef SCOTT
print_scott_banner(argc, argv);
#else
print_banner(argc, argv);
#endif
init();
read_all_input(argc, argv);
errors = Stats[INPUT_ERRORS];
if (errors != 0) {
fprintf(stderr, "\n%d input errors were found.%c\n\n", errors, Bell);
printf("%d input errors were found.\n", errors);
exit(INPUT_ERROR_EXIT);
}
else {
status = check_stop();
if (status == KEEP_SEARCHING) {
if (splitting() && Parms[SPLIT_GIVEN].val == 0)
always_split(); /* does not return */
giv_cl = extract_given_clause();
}
else
giv_cl = NULL;
level = 0;
first_of_next_level = 0;
if (Flags[LOG_FOR_X_SHOW].val)
xlog_fp = init_log_for_x_show();
/* --------------------- MAIN LOOP STARTS HERE --------------------- */
printf("\n=========== start of search ===========\n"); fflush(stdout);
while (giv_cl != NULL && status == KEEP_SEARCHING) {
if (Flags[SOS_QUEUE].val && giv_cl->id >= first_of_next_level) {
level++;
first_of_next_level = next_cl_num();
printf("\nStarting on level %d, last kept clause of level %d is %d.\n\n", level, level-1, first_of_next_level-1);
fprintf(stderr, "\n%cStarting on level %d, last kept clause of level %d is %d.\n\n", Bell, level, level-1, first_of_next_level-1);
#ifdef SCOTT
scott_queue_to_level(level);
#endif
}
#ifdef SCOTT
if (Parms[STATS_LEVEL].val == -2)
output_stats(stdout, Parms[STATS_LEVEL].val);
#endif
if (Flags[LOG_FOR_X_SHOW].val)
log_for_x_show(xlog_fp);
Stats[CL_GIVEN]++;
#ifdef SCOTT
/* useful info that we output with proof clauses */
giv_cl->given = Stats[CL_GIVEN];
#endif
if (Flags[PRINT_GIVEN].val) {
printf("\ngiven clause #%ld: ", Stats[CL_GIVEN]);
printf("(wt=%d) ", giv_cl->pick_weight);
print_clause(stdout, giv_cl); fflush(stdout);
}
#if defined(DOS_GCC) || defined(THINK_C)
/* if DOS or Macintosh, so user knows something is happening */
fprintf(stderr, ".");
if (Stats[CL_GIVEN] % 50 == 0)
fprintf(stderr, " %ld clauses given.\n", Stats[CL_GIVEN]);
#endif
index_lits_clash(giv_cl);
append_cl(Usable, giv_cl);
if (splitting())
possible_given_split(giv_cl);
infer_and_process(giv_cl);
if (Parms[INTERRUPT_GIVEN].val > 0 &&
Stats[CL_GIVEN] % Parms[INTERRUPT_GIVEN].val == 0) {
fprintf(stderr, "\n%c%ld clauses have been given.\n", Bell, Stats[CL_GIVEN]);
interact();
}
status = check_stop();
#ifdef SCOTT
status = check_max_pick_wt(giv_cl);
#endif
if (status == KEEP_SEARCHING) {
if (Parms[CHANGE_LIMIT_AFTER].val == Stats[CL_GIVEN]) {
int new_limit;
new_limit = Parms[NEW_MAX_WEIGHT].val;
Parms[MAX_WEIGHT].val = new_limit;
printf("\nreducing weight limit to %d.\n", new_limit);
}
if (splitting())
possible_split(); /* parent does not return if successful */
giv_cl = extract_given_clause();
}
if (status == KEEP_SEARCHING && giv_cl && Parms[REPORT].val > 0)
report();
} /* end of main loop */
/* --------------------- MAIN LOOP ENDS HERE --------------------- */
/* print the reason the search ended */
if (status == KEEP_SEARCHING) {
if (splitting() && current_case() != NULL)
exit_with_possible_model(); /* this call does not return here */
status = SOS_EMPTY_EXIT;
fprintf(stderr, "\n%cSearch stopped because sos empty.\n\n", Bell);
printf("\nSearch stopped because sos empty.\n");
}
else {
switch (status) {
#ifdef SCOTT
case MAX_PICK_WT_EXIT: str = "max_pick_weight"; break;
#endif
case MAX_GIVEN_EXIT: str = "max_given"; break;
case MAX_GEN_EXIT: str = "max_gen"; break;
case MAX_KEPT_EXIT: str = "max_kept"; break;
case MAX_SECONDS_EXIT: str = "max_seconds"; break;
default: str = "???"; break;
}
fprintf(stderr, "\n%cSearch stopped by %s option.\n\n", Bell, str);
printf("\nSearch stopped by %s option.\n", str);
}
cleanup();
exit(status);
}
} /* main */
/*************
*
* void print_banner(argc, argv)
*
*************/
void print_banner(int argc,
char **argv)
{
int i;
int pid = my_process_id();
printf("----- Otter-lambda %s %s -----\n", OTTER_LAMBDA_VERSION, OTTER_LAMBDA_DATE);
printf("----- Based on Otter %s %s-----\n", OTTER_VERSION, OTTER_DATE);
/* printf("The process was started by %s on %s,\n%s", // commented out by Beeson 7.2.06
username(), hostname(), get_time()); */
printf("The command was \"");
for(i = 0; i < argc; i++)
printf("%s%s", argv[i], (i < argc-1 ? " " : ""));
printf("\".");
if (pid != 0)
printf(" The process ID is %d.\n\n", pid);
else
printf("\n\n");
} /* print_banner */
./otter/Makefile 0000744 0002044 0001012 00000012163 11026756616 012126 0 ustar beeson #############################################################################
#
# Makefile for building Otter 3.1. There is no configuration script
# or higher-level make. Edit this file to configure compilation of
# Otter. There are three things you may need to change:
#
# DFLAGS - to control conditional compilation to enable/disable things
# CC - to specify the C compiler (usually cc or gcc)
# CFLAGS - to specify optimization, debugging, and profiling
#
# This should work as is for recent versions of Linux.
#
# To compile otter, "make" and cross your fingers!
# The binary will be left in this directory. There is no man page.
#
# !!!NOTE!!! On Solaris, you'll probably want to add -DTP_NO_CLOCKS
# to the DFLAGS line. If you don't, Otter might run VERY slowly.
#
#############################################################################
#############################################################################
#
# The DFLAGS symbol, defined after this section of comments, controls
# conditional compilation; it enables or disables various features.
#
# Enable features:
#
# -DTP_NAMES will get username, hostname.
# Don't use if you get errors about gethostname, getuid, getpwuid.
# -DTP_SIGNAL will cause some signals to be caught.
# Don't use if you get errors about signal, SIGINT, SIGSEGV.
# -DTP_FORK will allow interactive forks and case splitting.
# Don't use if you get errors about fork, wait.
# -DTP_RUSAGE for calls to getrusage() (user time, system time).
# Don't use if you get errors about rusage, getrusage, RUSAGE_SELF.
# For HP-UX, you might need -DHP_UX to use getrusage().
#
# Disable features:
#
# -DTP_NO_CLOCKS disables most timing---this can save a lot of system
# CPU time, because many operations are timed.
# This should definitely be used on FreeBSD (2.1.0), which seems
# to have a REALLY SLOW getrusage() system call.
# -DTP_ABSOLUTELY_NO_CLOCKS disables all of the timing.
# Use this as a last resort for timing or clock errrors.
#
# The full set of features:
#
# DFLAGS = -DTP_NAMES -DTP_SIGNAL -DTP_FORK -DTP_RUSAGE
#
###############
#
# Here are some notes about which features work on various OSs:
#
# Solaris (SunOS 5.7) - has a very slow getrusage() system call, so use
#
# DFLAGS = -DTP_NAMES -DTP_SIGNAL -DTP_FORK -DTP_RUSAGE -DTP_NO_CLOCKS
#
# HP-UX A.09.01 (snake) needs HP_UX to be defined (for getrusage macro):
#
# DFLAGS = -DHP_UX -DTP_NAMES -DTP_SIGNAL -DTP_FORK -DTP_RUSAGE
#
# MS Windows - see nonport.c, see DOS_GCC in the source.
#
# Macintosh - ???? - see macutils.c, see nonport.c, see THINK_C in the source
#
###############
# OK, here is where to define the DFLAGS:
DFLAGS = -DTP_NAMES -DTP_SIGNAL -DTP_FORK -DTP_RUSAGE
#############################################################################
#############################################################################
#
# Specify the C compiler. I recommend gcc (GNU C Compiler) if you have it.
# In many Linux environments, cc is just a symlink to gcc.
CC = gcc
#############################################################################
#
# Specify the compiler flags; include DFLAGS (above) -- Pick one of these
#
# optimized
CFLAGS = -O $(DFLAGS)
#
# check for strict ANSI conformance with Solaris cc:
#
# CFLAGS = -Xc $(DFLAGS)
#
# various checks for gcc:
#
# CFLAGS = -ansi -pedantic -Wall $(DFLAGS)
# CFLAGS = -Wtraditional -Wpointer-arith -Wcast-qual -Wcast-align $(DFLAGS)
# CFLAGS = -Wconversion -Wstrict-prototypes -Wmissing-prototypes -Wmissing-declarations -Wredundant-decls -Wnested-externs $(DFLAGS)
#
# save symbols for debuggers
# CFLAGS = -g $(DFLAGS)
#
# optimized, debugging
# CFLAGS = -O -g $(DFLAGS)
#
# gprof profiling
# CFLAGS = -pg -O $(DFLAGS)
#
#############################################################################
FILES = av.c io.c share.c fpa.c clocks.c unify.c demod.c weight.c imd.c is.c clause.c options.c resolve.c index.c paramod.c formula.c process.c misc.c lrpo.c linkur.c linkhyp.c foreign.c geometry.c hot.c nonport.c check.c hints.c attrib.c case.c lisp.c ivy.c pickdiff.c overbeek.c
OBJECTS = av.o io.o share.o fpa.o clocks.o unify.o demod.o weight.o imd.o is.o clause.o options.o resolve.o index.o paramod.o formula.o process.o misc.o lrpo.o linkur.o linkhyp.o foreign.o geometry.o hot.o nonport.o check.o hints.o attrib.o case.o lisp.o ivy.o pickdiff.o overbeek.o
#############################################################################
otter: main.o $(OBJECTS)
$(CC) $(CFLAGS) main.o $(OBJECTS) -o otter
otterlib: main.o $(OBJECTS)
clean:
/bin/rm -f *.o
realclean:
/bin/rm -f *.o otter ../examples/*/*.out examples/Run_all.out[0-9]*
/bin/rm -f *~ ../*~ */*~ ../documents/*.{aux,dvi,log,bbl,blg}
prototypes:
/bin/csh make-prototypes main.c $(FILES)
lint:
lint $(DFLAGS) main.c $(FILES)
main.o $(OBJECTS): header.h
main.o $(OBJECTS): types.h
main.o $(OBJECTS): macros.h
main.o $(OBJECTS): cos.h
main.o $(OBJECTS): proto.h
foreign.o: foreign.h
lisp.o: lisp.h
./otter/Makefile.solaris 0000744 0002044 0001012 00000012201 11120534450 013553 0 ustar beeson #############################################################################
#
# Makefile for building Otter 3.1. There is no configuration script
# or higher-level make. Edit this file to configure compilation of
# Otter. There are three things you may need to change:
#
# DFLAGS - to control conditional compilation to enable/disable things
# CC - to specify the C compiler (usually cc or gcc)
# CFLAGS - to specify optimization, debugging, and profiling
#
# This should work as is for recent versions of Linux.
#
# To compile otter, "make" and cross your fingers!
# The binary will be left in this directory. There is no man page.
#
# !!!NOTE!!! On Solaris, you'll probably want to add -DTP_NO_CLOCKS
# to the DFLAGS line. If you don't, Otter might run VERY slowly.
#
#############################################################################
#############################################################################
#
# The DFLAGS symbol, defined after this section of comments, controls
# conditional compilation; it enables or disables various features.
#
# Enable features:
#
# -DTP_NAMES will get username, hostname.
# Don't use if you get errors about gethostname, getuid, getpwuid.
# -DTP_SIGNAL will cause some signals to be caught.
# Don't use if you get errors about signal, SIGINT, SIGSEGV.
# -DTP_FORK will allow interactive forks and case splitting.
# Don't use if you get errors about fork, wait.
# -DTP_RUSAGE for calls to getrusage() (user time, system time).
# Don't use if you get errors about rusage, getrusage, RUSAGE_SELF.
# For HP-UX, you might need -DHP_UX to use getrusage().
#
# Disable features:
#
# -DTP_NO_CLOCKS disables most timing---this can save a lot of system
# CPU time, because many operations are timed.
# This should definitely be used on FreeBSD (2.1.0), which seems
# to have a REALLY SLOW getrusage() system call.
# -DTP_ABSOLUTELY_NO_CLOCKS disables all of the timing.
# Use this as a last resort for timing or clock errrors.
#
# The full set of features:
#
# DFLAGS = -DTP_NAMES -DTP_SIGNAL -DTP_FORK -DTP_RUSAGE
#
###############
#
# Here are some notes about which features work on various OSs:
#
# Solaris (SunOS 5.7) - has a very slow getrusage() system call, so use
#
# DFLAGS = -DTP_NAMES -DTP_SIGNAL -DTP_FORK -DTP_RUSAGE -DTP_NO_CLOCKS
#
# HP-UX A.09.01 (snake) needs HP_UX to be defined (for getrusage macro):
#
# DFLAGS = -DHP_UX -DTP_NAMES -DTP_SIGNAL -DTP_FORK -DTP_RUSAGE
#
# MS Windows - see nonport.c, see DOS_GCC in the source.
#
# Macintosh - ???? - see macutils.c, see nonport.c, see THINK_C in the source
#
###############
# OK, here is where to define the DFLAGS:
DFLAGS = -DTP_NAMES -DTP_SIGNAL -DTP_FORK -DTP_RUSAGE -DTP_NO_CLOCKS
#############################################################################
#############################################################################
#
# Specify the C compiler. I recommend gcc (GNU C Compiler) if you have it.
# In many Linux environments, cc is just a symlink to gcc.
CC = cc
#############################################################################
#
# Specify the compiler flags; include DFLAGS (above) -- Pick one of these
#
# optimized
CFLAGS = -O $(DFLAGS)
#
# check for strict ANSI conformance with Solaris cc:
#
# CFLAGS = -Xc $(DFLAGS)
#
# various checks for gcc:
#
# CFLAGS = -ansi -pedantic -Wall $(DFLAGS)
# CFLAGS = -Wtraditional -Wpointer-arith -Wcast-qual -Wcast-align $(DFLAGS)
# CFLAGS = -Wconversion -Wstrict-prototypes -Wmissing-prototypes -Wmissing-declarations -Wredundant-decls -Wnested-externs $(DFLAGS)
#
# save symbols for debuggers
# CFLAGS = -g $(DFLAGS)
#
# optimized, debugging
# CFLAGS = -O -g $(DFLAGS)
#
# gprof profiling
# CFLAGS = -pg -O $(DFLAGS)
#
#############################################################################
FILES = av.c io.c share.c fpa.c clocks.c unify.c demod.c weight.c imd.c is.c clause.c options.c resolve.c index.c paramod.c formula.c process.c misc.c lrpo.c linkur.c linkhyp.c foreign.c geometry.c hot.c nonport.c check.c hints.c attrib.c case.c lisp.c ivy.c pickdiff.c overbeek.c
OBJECTS = av.o io.o share.o fpa.o clocks.o unify.o demod.o weight.o imd.o is.o clause.o options.o resolve.o index.o paramod.o formula.o process.o misc.o lrpo.o linkur.o linkhyp.o foreign.o geometry.o hot.o nonport.o check.o hints.o attrib.o case.o lisp.o ivy.o pickdiff.o overbeek.o
#############################################################################
otter: main.o $(OBJECTS)
$(CC) $(CFLAGS) main.o $(OBJECTS) -o otter
otterlib: main.o $(OBJECTS)
clean:
/bin/rm -f *.o
realclean:
/bin/rm -f *.o otter ../examples/*/*.out examples/Run_all.out[0-9]*
/bin/rm -f *~ ../*~ */*~ ../documents/*.{aux,dvi,log,bbl,blg}
prototypes:
/bin/csh make-prototypes main.c $(FILES)
lint:
lint $(DFLAGS) main.c $(FILES)
main.o $(OBJECTS): header.h
main.o $(OBJECTS): types.h
main.o $(OBJECTS): macros.h
main.o $(OBJECTS): cos.h
main.o $(OBJECTS): proto.h
foreign.o: foreign.h
lisp.o: lisp.h
./otter/make-prototypes 0000744 0002044 0001012 00000000561 11026756616 013553 0 ustar beeson #
/bin/mv proto.h proto.h~
echo "/* proto.h made " > proto.h
date >> proto.h
echo "*/" >> proto.h
foreach i ($argv)
echo "" >> proto.h
echo "/* $i */" >> proto.h
echo "" >> proto.h
awk -f awk.prototypes < $i | sed -f sed.prototypes >> proto.h
end
./otter/misc.c 0000744 0002044 0001012 00000224411 11120534450 011547 0 ustar beeson /*
* misc.c -- Miscellaneous routines.
*
*/
#include "header.h"
#include "bterms.h" // for set_vars2
#ifdef SCOTT
#include "called_by_otter.h"
#endif
/*************
*
* init() -- initialize global variables
*
*************/
void init(void)
{
Stats[INIT_WALL_SECONDS] = wall_seconds();
clock_init();
init_options();
init_attributes();
#ifdef SCOTT
scott_clock_init();
init_scott_options();
init_distributions();
#endif
Null_output = fopen("/dev/null", "w");
Bell = '\007';
built_in_symbols();
init_special_ops();
declare_user_functions();
strcpy(Float_format, "%.12f");
Is_pos_lits = get_is_tree(); /* index for forward subsumption */
Is_neg_lits = get_is_tree(); /* index for forward subsumption */
Demod_imd = get_imd_tree(); /* index for demodulation */
Fpa_pos_lits = alloc_fpa_index();
Fpa_neg_lits = alloc_fpa_index();
Fpa_clash_pos_lits= alloc_fpa_index();
Fpa_clash_neg_lits= alloc_fpa_index();
Fpa_clash_terms = alloc_fpa_index();
Fpa_alphas = alloc_fpa_index();
Fpa_back_demod = alloc_fpa_index();
} /* init */
/*************
*
* abend
*
*************/
void abend(char *str)
{
output_stats(stdout, 3);
fprintf(stderr, "\n%c********** ABNORMAL END **********\n\n", Bell);
fprintf(stderr, "********** %s\n", str);
fprintf(stdout, "\n********** ABNORMAL END **********\n\n");
fprintf(stdout, "********** %s\n", str);
exit(ABEND_EXIT);
} /* abend */
/*************
*
* read_a_file()
*
*************/
void read_a_file(FILE *in_fp,
FILE *out_fp)
{
struct list *l;
struct term *t, *t1;
struct clause *c;
int rc, error, list_errors, i, j;
struct formula_ptr *formp;
char *s;
t = read_term(in_fp, &rc);
while (t || rc == 0) {
error = 0;
if (!t)
error = 1;
else if (t->type != COMPLEX)
error = 1;
else if (str_ident("include", sn_to_str(t->sym_num))) {
t1 = t->farg->argval;
if (t1->type == COMPLEX || t->farg->narg) {
fprintf(out_fp, "ERROR, bad argument to include: ");
print_term_nl(out_fp, t);
Stats[INPUT_ERRORS]++;
}
else {
char fn[MAX_NAME];
FILE *local_in_fp;
s = sn_to_str(t1->sym_num);
/* If filename is quoted, get rid of the quotes. */
if (s[0] == '\"' || s[0] == '\'') {
strcpy(fn, s+1);
fn[strlen(fn)-1] = '\0';
}
else
strcpy(fn, s);
local_in_fp = fopen(fn, "r");
if (local_in_fp == NULL) {
fprintf(out_fp, "ERROR, cannot open file %s.\n", fn);
Stats[INPUT_ERRORS]++;
}
else {
print_term_nl(out_fp, t);
if (Flags[ECHO_INCLUDED_FILES].val)
{
fprintf(out_fp, "------- start included file %s-------\n", fn);
read_a_file(local_in_fp, out_fp);
fprintf(out_fp, "------- end included file %s-------\n", fn);
}
else
read_a_file(local_in_fp, Null_output);
fclose(local_in_fp);
}
}
}
else if (str_ident("set", sn_to_str(t->sym_num))) {
i = change_flag(out_fp, t, 1);
if (i != -1) {
print_term_nl(out_fp, t);
#ifdef SCOTT
/* Eurgghh! This is real flaky ... but it works:-) */
if (i > 1000) {
dependent_scott_flags(out_fp, i-1000);
}
else {
dependent_flags(out_fp, i);
}
#else
dependent_flags(out_fp, i);
#endif
}
}
else if (str_ident("clear", sn_to_str(t->sym_num))) {
i = change_flag(out_fp, t, 0);
if (i != -1) {
print_term_nl(out_fp, t);
#ifdef SCOTT
if (i > 1000) {
dependent_scott_flags(out_fp, i-1000);
}
else {
dependent_flags(out_fp, i);
}
#else
dependent_flags(out_fp, i);
#endif
}
}
else if (str_ident("assign", sn_to_str(t->sym_num))) {
i = change_parm(out_fp, t);
if (i != -1) {
print_term_nl(out_fp, t);
#ifdef SCOTT
if (i > 1000) {
dependent_scott_tparms(out_fp, i - 1000);
}
else if (i > 2000) {
dependent_scott_fparms(out_fp, i - 2000);
}
else {
dependent_parms(out_fp, i);
}
#else
dependent_parms(out_fp, i);
#endif
}
}
else if (str_ident("list", sn_to_str(t->sym_num))) {
t1 = t->farg->argval;
if (t1->type == COMPLEX || t->farg->narg) {
fprintf(out_fp, "ERROR, bad argument to list: ");
print_term_nl(out_fp, t);
Stats[INPUT_ERRORS]++;
}
else if (str_ident("usable", sn_to_str(t1->sym_num)) ||
str_ident("axioms", sn_to_str(t1->sym_num))) {
if (str_ident("axioms", sn_to_str(t1->sym_num)))
fprintf(stderr, "NOTICE: Please change 'axioms' to 'usable'.\n");
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
l = read_cl_list(in_fp, &list_errors);
if (list_errors != 0)
Stats[INPUT_ERRORS] += list_errors;
else if (Flags[PROCESS_INPUT].val == 0) {
c = l->first_cl;
while (c) {
Stats[INPUT_ERRORS] += process_linked_tags(c);
cl_integrate(c);
c = c->next_cl;
}
}
print_cl_list(out_fp, l);
append_lists(Usable,l);
}
else if (str_ident("sos", sn_to_str(t1->sym_num))) {
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
l = read_cl_list(in_fp, &list_errors);
if (list_errors != 0)
Stats[INPUT_ERRORS] += list_errors;
else if (Flags[PROCESS_INPUT].val == 0) {
c = l->first_cl;
while (c) {
cl_integrate(c);
c = c->next_cl;
}
}
print_cl_list(out_fp, l);
append_lists(Sos,l);
}
#ifdef SCOTT
else if (str_ident("input_first", sn_to_str(t1->sym_num))) {
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
l = read_cl_list(in_fp, &list_errors);
if (list_errors != 0)
Stats[INPUT_ERRORS] += list_errors;
else if (Flags[PROCESS_INPUT].val == 0) {
c = l->first_cl;
while (c) {
cl_integrate(c);
c = c->next_cl;
}
}
print_cl_list(out_fp, l);
append_lists(First,l);
}
#endif
else if (str_ident("demodulators", sn_to_str(t1->sym_num))) {
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
l = read_cl_list(in_fp, &list_errors);
if (list_errors != 0)
Stats[INPUT_ERRORS] += list_errors;
c = l->first_cl;
while (c) {
cl_integrate(c);
c = c->next_cl;
}
print_cl_list(out_fp, l);
append_lists(Demodulators,l);
}
else if (str_ident("types", sn_to_str(t1->sym_num))) { // Beeson 5.06.04 down to next comment
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
l = read_cl_list(in_fp, &list_errors);
if (list_errors != 0)
Stats[INPUT_ERRORS] += list_errors;
c = l->first_cl;
while (c) {
cl_integrate(c);
c = c->next_cl;
} // end Beeson 5.06.04
print_cl_list(out_fp, l);
append_lists(Types,l);
}
else if (str_ident("passive", sn_to_str(t1->sym_num))) {
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
l = read_cl_list(in_fp, &list_errors);
if (list_errors != 0)
Stats[INPUT_ERRORS] += list_errors;
c = l->first_cl;
/* always integrate, because never pre_processed */
while (c) {
cl_integrate(c);
c = c->next_cl;
}
print_cl_list(out_fp, l);
append_lists(Passive,l);
}
else if (str_ident("hot", sn_to_str(t1->sym_num))) {
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
l = read_cl_list(in_fp, &list_errors);
if (list_errors != 0)
Stats[INPUT_ERRORS] += list_errors;
c = l->first_cl;
/* always integrate, because never pre_processed */
while (c) {
hot_cl_integrate(c);
c = c->next_cl;
}
print_cl_list(out_fp, l);
append_lists(Hot,l);
}
else if (str_ident("hints", sn_to_str(t1->sym_num))) {
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
l = read_cl_list(in_fp, &list_errors);
if (list_errors != 0)
Stats[INPUT_ERRORS] += list_errors;
/* always integrate, because never pre_processed */
for (c = l->first_cl; c; c = c->next_cl)
cl_integrate(c);
print_hints_cl_list(out_fp, l);
append_lists(Hints,l);
}
else if (str_ident("mace_constraints", sn_to_str(t1->sym_num))) {
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
l = read_cl_list(in_fp, &list_errors);
if (list_errors != 0)
Stats[INPUT_ERRORS] += list_errors;
/* don't integrate */
print_cl_list(out_fp, l);
append_lists(Mace_constraints,l);
}
else {
if (str_ident("axioms", sn_to_str(t1->sym_num)))
fprintf(stderr, "Name of axioms list is now 'usable'.\n");
fprintf(out_fp, "ERROR, unknown list: ");
print_term_nl(out_fp, t);
l = read_cl_list(in_fp, &list_errors);
print_cl_list(out_fp, l);
Stats[INPUT_ERRORS]++;
}
}
else if (str_ident("formula_list", sn_to_str(t->sym_num))) {
t1 = t->farg->argval;
if (t1->type == COMPLEX || t->farg->narg) {
fprintf(out_fp, "ERROR, bad argument to list: ");
print_term_nl(out_fp, t);
Stats[INPUT_ERRORS]++;
}
else if (str_ident("usable", sn_to_str(t1->sym_num)) ||
str_ident("axioms", sn_to_str(t1->sym_num))) {
if (str_ident("axioms", sn_to_str(t1->sym_num)))
fprintf(stderr, "NOTICE: Please change 'axioms' to 'usable'.\n");
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
formp = read_formula_list(in_fp, &list_errors);
print_formula_list(out_fp,formp);
if (list_errors != 0)
Stats[INPUT_ERRORS] += list_errors;
else {
CLOCK_START(CLAUSIFY_TIME);
l = clausify_formula_list(formp);
CLOCK_STOP(CLAUSIFY_TIME);
if (Flags[PROCESS_INPUT].val == 0) {
c = l->first_cl;
while (c) {
cl_integrate(c);
c = c->next_cl;
}
}
fprintf(out_fp, "\n-------> usable clausifies to:\n\nlist(usable).\n");
print_cl_list(out_fp, l);
append_lists(Usable,l);
}
}
#ifdef SCOTT
else if (str_ident("input_first", sn_to_str(t1->sym_num))) {
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
formp = read_formula_list(in_fp, &list_errors);
print_formula_list(out_fp,formp);
if (list_errors != 0)
Stats[INPUT_ERRORS] += list_errors;
else {
CLOCK_START(CLAUSIFY_TIME)
l = clausify_formula_list(formp);
CLOCK_STOP(CLAUSIFY_TIME)
if (Flags[PROCESS_INPUT].val == 0) {
c = l->first_cl;
while (c) {
cl_integrate(c);
c = c->next_cl;
}
}
fprintf(out_fp, "\n-------> input_first clausifies to:\n\nlist(input_first).\n");
print_cl_list(out_fp, l);
append_lists(First,l);
}
}
#endif
else if (str_ident("sos", sn_to_str(t1->sym_num))) {
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
formp = read_formula_list(in_fp, &list_errors);
print_formula_list(out_fp,formp);
if (list_errors != 0)
Stats[INPUT_ERRORS] += list_errors;
else {
CLOCK_START(CLAUSIFY_TIME);
l = clausify_formula_list(formp);
CLOCK_STOP(CLAUSIFY_TIME);
if (Flags[PROCESS_INPUT].val == 0) {
c = l->first_cl;
while (c) {
cl_integrate(c);
c = c->next_cl;
}
}
fprintf(out_fp, "\n-------> sos clausifies to:\n\nlist(sos).\n");
print_cl_list(out_fp, l);
append_lists(Sos,l);
}
}
else if (str_ident("passive", sn_to_str(t1->sym_num))) {
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
formp = read_formula_list(in_fp, &list_errors);
print_formula_list(out_fp,formp);
if (list_errors != 0)
Stats[INPUT_ERRORS] += list_errors;
else {
CLOCK_START(CLAUSIFY_TIME);
l = clausify_formula_list(formp);
CLOCK_STOP(CLAUSIFY_TIME);
c = l->first_cl;
/* always integrate, because never pre_processed */
while (c) {
cl_integrate(c);
c = c->next_cl;
}
fprintf(out_fp, "\n-------> passive clausifies to:\n\nlist(passive).\n");
print_cl_list(out_fp, l);
append_lists(Passive,l);
}
}
else if (str_ident("hints", sn_to_str(t1->sym_num))) {
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
formp = read_formula_list(in_fp, &list_errors);
print_formula_list(out_fp,formp);
if (list_errors != 0)
Stats[INPUT_ERRORS] += list_errors;
else {
CLOCK_START(CLAUSIFY_TIME);
l = clausify_formula_list(formp);
CLOCK_STOP(CLAUSIFY_TIME);
c = l->first_cl;
/* always integrate, because never pre_processed */
while (c) {
cl_integrate(c);
c = c->next_cl;
}
fprintf(out_fp, "\n-------> hints clausifies to:\n\nlist(passive).\n");
print_cl_list(out_fp, l);
append_lists(Hints,l);
}
}
else if (str_ident("hot", sn_to_str(t1->sym_num))) {
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
formp = read_formula_list(in_fp, &list_errors);
print_formula_list(out_fp,formp);
if (list_errors != 0)
Stats[INPUT_ERRORS] += list_errors;
else {
CLOCK_START(CLAUSIFY_TIME);
l = clausify_formula_list(formp);
CLOCK_STOP(CLAUSIFY_TIME);
c = l->first_cl;
/* always integrate, because never pre_processed */
while (c) {
hot_cl_integrate(c);
c = c->next_cl;
}
fprintf(out_fp, "\n-------> hot list clausifies to:\n\nlist(hot).\n");
print_cl_list(out_fp, l);
append_lists(Hot,l);
}
}
else {
if (str_ident("axioms", sn_to_str(t1->sym_num)))
fprintf(stderr, "Name of axioms list is now 'usable'.\n");
fprintf(out_fp, "ERROR, unknown formula_list: ");
print_term_nl(out_fp, t);
l = read_cl_list(in_fp, &list_errors);
print_cl_list(out_fp, l);
Stats[INPUT_ERRORS]++;
}
}
else if (str_ident("weight_list", sn_to_str(t->sym_num))) {
t1 = t->farg->argval;
if (t1->type != NAME || t->farg->narg) {
fprintf(out_fp, "ERROR, bad argument to Weight_list: ");
print_term_nl(out_fp, t);
Stats[INPUT_ERRORS]++;
}
else if (str_ident("purge_gen", sn_to_str(t1->sym_num))) {
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
if (Weight_purge_gen) {
fprintf(out_fp, "----> ERROR, already have purge weight list.\n");
Stats[INPUT_ERRORS] ++;
}
Weight_purge_gen = read_wt_list(in_fp, &list_errors);
if (list_errors != 0)
Stats[INPUT_ERRORS] += list_errors;
Weight_purge_gen_index = get_is_tree();
set_wt_list(Weight_purge_gen, Weight_purge_gen_index, &list_errors);
if (list_errors != 0)
Stats[INPUT_ERRORS] += list_errors;
print_list(out_fp, Weight_purge_gen);
}
else if (str_ident("pick_given", sn_to_str(t1->sym_num))) {
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
if (Weight_pick_given) {
fprintf(out_fp, "----> ERROR, already have pick weight list.\n");
Stats[INPUT_ERRORS] ++;
}
Weight_pick_given = read_wt_list(in_fp, &list_errors);
if (list_errors != 0)
Stats[INPUT_ERRORS] += list_errors;
Weight_pick_given_index = get_is_tree();
set_wt_list(Weight_pick_given, Weight_pick_given_index, &list_errors);
if (list_errors != 0)
Stats[INPUT_ERRORS] += list_errors;
print_list(out_fp, Weight_pick_given);
}
else if (str_ident("pick_and_purge", sn_to_str(t1->sym_num))) {
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
if (Weight_pick_given || Weight_purge_gen) {
fprintf(out_fp, "----> ERROR, already have pick weight list or purge weight list.\n");
Stats[INPUT_ERRORS] ++;
}
Weight_pick_given = Weight_purge_gen = read_wt_list(in_fp, &list_errors);
if (list_errors != 0)
Stats[INPUT_ERRORS] += list_errors;
Weight_pick_given_index = Weight_purge_gen_index = get_is_tree();
set_wt_list(Weight_pick_given, Weight_pick_given_index, &list_errors);
if (list_errors != 0)
Stats[INPUT_ERRORS] += list_errors;
print_list(out_fp, Weight_pick_given);
}
else if (str_ident("terms", sn_to_str(t1->sym_num))) {
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
if (Weight_terms) {
fprintf(out_fp, "----> ERROR, already have term weight list.\n");
Stats[INPUT_ERRORS] ++;
}
Weight_terms = read_wt_list(in_fp, &list_errors);
if (list_errors != 0)
Stats[INPUT_ERRORS] += list_errors;
Weight_terms_index = get_is_tree();
set_wt_list(Weight_terms, Weight_terms_index, &list_errors);
if (list_errors != 0)
Stats[INPUT_ERRORS] += list_errors;
print_list(out_fp, Weight_terms);
}
else {
fprintf(out_fp, "ERROR, unknown Weight_list: ");
print_term_nl(out_fp, t);
Weight_pick_given = read_wt_list(in_fp, &list_errors);
print_list(out_fp, Weight_pick_given);
Stats[INPUT_ERRORS]++;
}
}
else if (str_ident("lex", sn_to_str(t->sym_num))) {
if (t->farg == NULL || t->farg->narg || proper_list(t->farg->argval) == 0) {
fprintf(out_fp, "ERROR, argument of lex term is not a list: ");
print_term_nl(out_fp, t);
Stats[INPUT_ERRORS]++;
}
else {
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
set_lex_vals(t);
Internal_flags[LEX_VALS_SET] = 1;
}
}
else if (str_ident("lrpo_multiset_status", sn_to_str(t->sym_num))) {
if (t->farg == NULL || t->farg->narg || proper_list(t->farg->argval) == 0) {
fprintf(out_fp, "ERROR, argument of lrpo_status term is not a list: ");
print_term_nl(out_fp, t);
Stats[INPUT_ERRORS]++;
}
else {
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
set_lrpo_status(t, LRPO_MULTISET_STATUS);
}
}
else if (str_ident("lrpo_lr_status", sn_to_str(t->sym_num))) {
fprintf(out_fp, "\nERROR, the command lrpo_lr_status no longer exists.\n");
fprintf(stderr, "\nERROR, the command lrpo_lr_status no longer exists.\n");
fprintf(stderr, "Symbols have lr status by default. The command\n");
fprintf(stderr, "lrpo_multiset_status gives symbols multiset status.\n");
Stats[INPUT_ERRORS]++;
}
else if (str_ident("skolem", sn_to_str(t->sym_num))) {
if (t->farg == NULL || t->farg->narg || proper_list(t->farg->argval) == 0) {
fprintf(out_fp, "ERROR, argument of skolem term is not a list: ");
print_term_nl(out_fp, t);
Stats[INPUT_ERRORS]++;
}
else {
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
set_skolem(t);
}
}
else if (str_ident("overbeek_terms", sn_to_str(t->sym_num))) {
if (t->farg == NULL || t->farg->narg || proper_list(t->farg->argval) == 0) {
fprintf(out_fp, "ERROR, argument of overbeek_terms is not a list: ");
print_term_nl(out_fp, t);
Stats[INPUT_ERRORS]++;
}
else {
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
Overbeek_terms = copy_term(t->farg->argval);
set_vars(Overbeek_terms);
}
}
else if (str_ident("split_atoms", sn_to_str(t->sym_num))) {
if (t->farg == NULL || t->farg->narg || proper_list(t->farg->argval) == 0) {
fprintf(out_fp, "ERROR, argument of split_atoms is not a list: ");
print_term_nl(out_fp, t);
Stats[INPUT_ERRORS]++;
}
else {
Split_atoms = copy_term(t->farg->argval);
set_vars(Split_atoms);
if (!ground(Split_atoms)) {
fprintf(out_fp, "ERROR, split_atoms must be gound: ");
print_term_nl(out_fp, t);
Stats[INPUT_ERRORS]++;
}
else {
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
}
}
}
else if (str_ident("special_unary", sn_to_str(t->sym_num))) {
if (t->farg == NULL || t->farg->narg || proper_list(t->farg->argval) == 0) {
fprintf(out_fp, "ERROR, argument of special_unary term is not a list: ");
print_term_nl(out_fp, t);
Stats[INPUT_ERRORS]++;
}
else {
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
set_special_unary(t);
Internal_flags[SPECIAL_UNARY_PRESENT] = 1;
}
}
else if (str_ident("op", sn_to_str(t->sym_num))) {
print_term_nl(out_fp, t);
if (!process_op_command(t))
Stats[INPUT_ERRORS]++;
}
else if (str_ident("float_format", sn_to_str(t->sym_num))) {
if (t->farg == NULL || t->farg->narg) {
fprintf(out_fp, "ERROR, float_format term must have one argument.\n");
print_term_nl(out_fp, t);
Stats[INPUT_ERRORS]++;
}
else {
print_term_nl(out_fp, t);
s = sn_to_str(t->farg->argval->sym_num);
/* Assume it's well formed. Remove quotes. */
i = strlen(s);
for (j = 1; j < i-1 ; j++)
Float_format[j-1] = s[j];
Float_format[i-2] = '\0';
}
}
else if (str_ident("make_evaluable", sn_to_str(t->sym_num))) {
if (sn_to_arity(t->sym_num) != 2) {
fprintf(out_fp, "ERROR, make_evaluable term must have two arguments:\n");
print_term_nl(out_fp, t);
Stats[INPUT_ERRORS]++;
}
else {
int i1, i2;
struct sym_ent *p1, *p2;
i1 = t->farg->argval->sym_num; i2 = t->farg->narg->argval->sym_num;
p1 = sn_to_node(i1); p2 = sn_to_node(i2);
if (p2->eval_code < 1) {
fprintf(out_fp, "ERROR, second arg is not evaluable:\n");
print_term_nl(out_fp, t);
Stats[INPUT_ERRORS]++;
}
else if (p1->arity != p2->arity) {
fprintf(out_fp, "ERROR, args have different arities:\n");
print_term_nl(out_fp, t);
Stats[INPUT_ERRORS]++;
}
else {
print_term_nl(out_fp, t);
p1->eval_code = p2->eval_code;
}
}
}
else if (str_ident("initial_proof_object", sn_to_str(t->sym_num))) {
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
l = init_proof_object(in_fp, out_fp);
if (l == NULL)
Stats[INPUT_ERRORS]++;
else {
if (Flags[PROCESS_INPUT].val == 0) {
c = l->first_cl;
while (c) {
Stats[INPUT_ERRORS] += process_linked_tags(c);
cl_integrate(c);
c = c->next_cl;
}
}
print_cl_list(out_fp, l);
append_lists(Usable,l);
}
} /* initial_proof_object */
else if (str_ident("overbeek_world", sn_to_str(t->sym_num))) {
int errors = 0;
struct term_ptr *p1, *p2;
fprintf(out_fp, "\n");
print_term_nl(out_fp, t);
p1 = read_list(in_fp, &errors, 0); /* don't integrate */
if (errors > 0)
abend("overbeek_world: term errors");
for (p2 = p1; p2; p2 = p2->next) {
int ok = set_vars(p2->term);
if (!ok)
abend("overbeek_world: too many variables");
renumber_vars_term(p2->term);
zap_variable_names(p2->term);
overbeek_insert(p2->term);
print_term_nl(out_fp, p2->term);
}
fprintf(out_fp, "end_of_list.\n");
#if 0
check_overbeek_world();
#endif
} /* overbeek_world */
else
error = 1;
if (error) {
Stats[INPUT_ERRORS]++;
if (t) {
fprintf(out_fp, "ERROR, command not found: ");
print_term_nl(out_fp, t);
}
}
if (t)
zap_term(t);
t = read_term(in_fp, &rc);
}
} /* read_a_file */
/*************
*
* sos_argument()
*
*************/
void sos_argument(int argc,
char **argv)
{ int nvars; // Beeson 10.6.02
if (argc < 2) {
fprintf(stdout, "ERROR, sos_arg set, but no argument found.\n");
Stats[INPUT_ERRORS]++;
}
else {
char *buf = argv[1];
struct term *t;
int p = 0;
t = str_to_term(buf, &p, 0);
if (t == NULL) {
Stats[INPUT_ERRORS]++;
}
else {
skip_white(buf, &p);
if (buf[p] == '.')
p++;
skip_white(buf, &p);
if (buf[p] != '\0') {
fprintf(stdout, "\nERROR, characters after term:\n");
print_error(stdout, buf, p);
Stats[INPUT_ERRORS]++;
}
else {
t = term_fixup(t);
if (!set_vars2(t,&nvars)) { // Beeson changed to set_vars2 10.6.02
fprintf(stdout, "\nERROR, clause contains too many variables:\n");
print_term(stdout, t); printf(".\n\n");
zap_term(t);
Stats[INPUT_ERRORS]++;
}
else if (contains_skolem_symbol(t)) {
fprintf(stdout, "\nERROR, input clause contains Skolem symbol:\n");
print_term(stdout, t); printf(".\n\n");
zap_term(t);
Stats[INPUT_ERRORS]++;
}
else {
struct clause *c = term_to_clause(t);
c->next_var = nvars;
zap_term(t);
if (c == NULL)
Stats[INPUT_ERRORS]++;
if (Flags[PROCESS_INPUT].val == 0) {
cl_integrate(c);
}
fprintf(stdout, "\nlist(sos).\n");
print_clause(stdout, c);
fprintf(stdout, "end_of_list.\n");
append_cl(Sos, c);
Stats[SOS_SIZE]++;
}
}
}
}
} /* sos_argument */
/*************
*
* read_all_input()
*
*************/
void read_all_input(int argc,
char **argv)
{
struct list *l;
struct clause *c, *c2;
FILE *in_fp, *out_fp;
Usable = get_list();
Sos = get_list();
Demodulators = get_list();
Passive = get_list();
Hot = get_list();
Hints = get_list();
Mace_constraints = get_list();
Types = get_list(); // Beeson 5.06.04
#ifdef SCOTT
First = get_list();
#endif
if(argc > 1) // Beeson 7.24.02
{ in_fp = fopen(argv[1],"r");
if(in_fp == NULL)
{ printf("File not found. Is it in the right folder and spelled correctly?");
exit(1);
}
}
else
in_fp = stdin;
out_fp = stdout;
CLOCK_START(INPUT_TIME);
read_a_file(in_fp, out_fp);
CLOCK_STOP(INPUT_TIME);
if (Flags[SOS_ARG].val)
sos_argument(argc, argv);
if (Stats[INPUT_ERRORS] == 0) {
if (!Internal_flags[LEX_VALS_SET])
auto_lex_order();
if (Flags[AUTO2].val)
automatic_2_settings();
else if (Flags[AUTO1].val)
automatic_1_settings();
#ifdef SCOTT
else if (get_auto3_flag())
automatic_3_settings();
/*----------------------------------------------------------------.
| Note: (1) This may move clauses around, so should occur before |
| PROCESS_INPUT (2) Requires inference rules to be set so must be |
| after automatic_3_settings() |
`----------------------------------------------------------------*/
if (get_semantic_guidance_flag()) init_semantics(argc, argv);
#endif
check_options();
/* process demodulators */
for (c = Demodulators->first_cl; c; c = c->next_cl) {
if (check_input_demod(c)) {
if (!Flags[DEMOD_LINEAR].val)
imd_insert(c, Demod_imd);
}
else {
Stats[INPUT_ERRORS]++;
printf("ERROR, bad demodulator: ");
print_clause(stdout, c);
}
}
/* Index passive list; don't pre_process, even if flag is set. */
for (c = Passive->first_cl; c; c = c->next_cl)
index_lits_all(c);
/* Index hot list. */
if (Hot->first_cl) {
init_hot();
for (c = Hot->first_cl; c; c = c->next_cl)
hot_index_clause(c);
}
/* Compile hints. */
for (c = Hints->first_cl; c; c = c->next_cl)
process_hint_attributes(c);
/* Process input if flag is set. */
if (Flags[PROCESS_INPUT].val) {
CLOCK_START(PROCESS_INPUT_TIME);
printf("\n------------> process usable:\n");
l = Usable;
Usable = get_list();
Stats[USABLE_SIZE] = 0;
c = l->first_cl;
while (c) {
c2 = c;
c = c->next_cl;
cl_clear_vars(c2); /* destroy input variable names */
pre_process(c2, 1, Usable);
}
free_list(l);
c2 = NULL;
post_proc_all((struct clause *) NULL, 1, Usable);
printf("\n------------> process sos:\n");
l = Sos;
Sos = get_list();
Stats[SOS_SIZE] = 0;
c = l->first_cl;
while (c) {
c2 = c;
c = c->next_cl;
cl_clear_vars(c2); /* destroy input variable names */
pre_process(c2, 1, Sos);
}
free_list(l);
c2 = NULL;
post_proc_all((struct clause *) NULL, 1, Sos);
#ifdef SCOTT
printf("\n------------> process input_first:\n");
l = First;
First = get_list();
c = l->first_cl;
while (c) {
c2 = c;
c = c->next_cl;
cl_clear_vars(c2); /* destroy input variable names */
pre_process(c2, 1, First);
}
free_list(l);
c2 = NULL;
post_proc_all((struct clause *) NULL, 1, First);
#endif
CLOCK_STOP(PROCESS_INPUT_TIME);
}
else { /* index usable and sos (not passive) */
for (c = Usable->first_cl; c; c = c->next_cl) {
index_lits_clash(c);
index_lits_all(c);
#ifdef SCOTT
/* so that weight statistics are set properly */
CLOCK_START(WEIGH_CL_TIME);
c->pick_weight = weight_cl(c, Weight_pick_given_index);
CLOCK_STOP(WEIGH_CL_TIME);
adjust_weight_with_hints(c);
#endif
}
#ifdef SCOTT
for (c = Sos->first_cl; c; c = c->next_cl) {
index_lits_all(c);
CLOCK_START(WEIGH_CL_TIME);
c->pick_weight = weight_cl(c, Weight_pick_given_index);
CLOCK_STOP(WEIGH_CL_TIME);
adjust_weight_with_hints(c);
}
#else
for (c = Sos->first_cl; c; c = c->next_cl)
index_lits_all(c);
#endif
#ifdef SCOTT
for (c = First->first_cl; c; c = c->next_cl) {
index_lits_all(c);
CLOCK_START(WEIGH_CL_TIME);
c->pick_weight = weight_cl(c, Weight_pick_given_index);
CLOCK_STOP(WEIGH_CL_TIME);
}
#endif
}
#ifdef SCOTT
// fix up SCOTT data-structures after process input
if (get_semantic_guidance_flag()){
init_clause_space();
init_partitions();
}
#endif
c = Sos->first_cl;
for (c = Sos->first_cl; c; c = c->next_cl) {
if (Flags[INPUT_SOS_FIRST].val)
c->pick_weight = -MAX_INT;
else {
c->pick_weight = weight_cl(c, Weight_pick_given_index);
adjust_weight_with_hints(c);
}
}
}
printf("\n======= end of input processing =======\n"); fflush(stdout);
Max_input_id = next_cl_num() - 1;
fflush(stdout);
} /* read_all_input */
/*************
*
* set_lex_vals(t)
*
* t is a lex term with a list as its one and only argument.
* Set lexical values of the members to 1, 2, 3, ... .
*
*************/
void set_lex_vals(struct term *t)
{
struct rel *r;
int i;
struct sym_ent *p;
/* Symbols get lex vals 2, 4, 6, 8, ... . */
for ( r = t->farg, i = 0;
r->argval->sym_num != Nil_sym_num;
r = r->argval->farg->narg, i++) {
p = sn_to_node(r->argval->farg->argval->sym_num);
p->lex_val = i*2 + 2;
}
} /* set_lex_vals */
/*************
*
* set_lrpo_status(t, val) -
* t is a lex term with a list as its one and only argument.
* Set lrpo_status values of the members to 1.
*
*************/
void set_lrpo_status(struct term *t,
int val)
{
struct rel *r;
struct sym_ent *p;
for (r = t->farg; r->argval->sym_num != Nil_sym_num; r = r->argval->farg->narg) {
p = sn_to_node(r->argval->farg->argval->sym_num);
p->lex_rpo_status = val;
}
} /* set_lrpo_status */
/*************
*
* set_special_unary(t)
*
* t is a lex term with a list as its one and only argument.
* Set special_unary values of the members to 1.
*
*************/
void set_special_unary(struct term *t)
{
struct rel *r;
struct sym_ent *p;
for (r = t->farg; r->argval->sym_num != Nil_sym_num; r = r->argval->farg->narg) {
p = sn_to_node(r->argval->farg->argval->sym_num);
p->special_unary = 1;
}
} /* set_special_unary */
/*************
*
* set_skolem(t)
*
* t is a lex term with a list as its one and only argument.
* Set the major function symbol (including constants) of each member of the
* list to be a skolem symbol. (This is called only when skolem symbols
* are not created by skolemization by OTTER.)
*
*************/
void set_skolem(struct term *t)
{
struct rel *r;
struct sym_ent *p;
for (r = t->farg; r->argval->sym_num != Nil_sym_num; r = r->argval->farg->narg) {
p = sn_to_node(r->argval->farg->argval->sym_num);
p->skolem = 1;
}
} /* set_skolem */
/*************
*
* free_all_mem()
*
*************/
void free_all_mem(void)
{
struct clause *c;
c = find_last_cl(Usable);
while (c) {
rem_from_list(c);
un_index_lits_clash(c);
un_index_lits_all(c);
cl_del_int(c);
c = find_last_cl(Usable);
}
free_list(Usable);
Usable = NULL;
c = find_last_cl(Sos);
while (c) {
rem_from_list(c);
un_index_lits_all(c);
cl_del_int(c);
c = find_last_cl(Sos);
}
free_list(Sos);
Sos = NULL;
#ifdef SCOTT
c = find_last_cl(First);
while (c) {
rem_from_list(c);
un_index_lits_all(c);
cl_del_int(c);
c = find_last_cl(First);
}
free_list(First);
First = NULL;
#endif
c = find_last_cl(Passive);
while (c) {
rem_from_list(c);
un_index_lits_all(c);
cl_del_int(c);
c = find_last_cl(Passive);
}
free_list(Passive);
Passive = NULL;
c = find_last_cl(Demodulators);
while (c) {
rem_from_list(c);
if (Flags[DEMOD_LINEAR].val == 0) /* if imd indexing */
imd_delete(c, Demod_imd);
cl_del_int(c);
c = find_last_cl(Demodulators);
}
free_list(Demodulators);
Demodulators = NULL;
free_imd_tree(Demod_imd);
/* Weight_purge_gen and Weight_pick_given might point to the same list */
if (Weight_purge_gen) {
weight_index_delete(Weight_purge_gen_index);
zap_list(Weight_purge_gen);
if (Weight_purge_gen == Weight_pick_given) {
Weight_pick_given = NULL;
Weight_pick_given_index = NULL;
}
Weight_purge_gen = NULL;
Weight_purge_gen_index = NULL;
}
if (Weight_pick_given) {
weight_index_delete(Weight_pick_given_index);
zap_list(Weight_pick_given);
Weight_pick_given = NULL;
Weight_pick_given_index = NULL;
}
if (Weight_terms) {
weight_index_delete(Weight_terms_index);
zap_list(Weight_terms);
Weight_terms = NULL;
Weight_terms_index = NULL;
}
free_is_tree(Is_pos_lits);
free_is_tree(Is_neg_lits);
Is_pos_lits = Is_neg_lits = NULL;
del_hidden_clauses();
free_sym_tab();
} /* free_all_mem */
/*************
*
* output_stats(fp, level) -- print memory, clause, and time stats
*
*************/
void output_stats(FILE *fp,
int level)
{
if (level >= 4)
print_options(fp);
if (level >= 3)
print_mem(fp);
if (level >= 2) {
print_stats(fp);
print_times(fp);
}
else if (level == 1) {
print_stats_brief(fp);
print_times_brief(fp);
}
#ifdef SCOTT
output_scott_stats(fp,level);
#endif
#if 1
if (level >= 3) {
int i, j;
fprintf(fp, "\nForward subsumption counts, subsumer:number_subsumed.\n");
for (i = 0; i < 10; i++) {
for (j = 1; j < 10; j++)
fprintf(fp, "%2d:%-4d ", 10*i+j, Subsume_count[10*i+j]);
if (i < 9) /* don't do 100 */
fprintf(fp, "%2d:%-4d\n", 10*i+10, Subsume_count[10*i+10]);
else
fprintf(fp, "\n");
}
fprintf(fp, "All others: %d.\n", Subsume_count[0]);
}
#endif
} /* output_stats */
/*************
*
* print_stats(fp)
*
*************/
void print_stats(FILE *fp)
{
if (splitting())
fprintf(fp, "\n------- statistics (process %d) -------\n", my_process_id());
else
fprintf(fp, "\n-------------- statistics -------------\n");
#if 0
fprintf(fp, "clauses input %7ld\n", Stats[CL_INPUT]);
#endif
fprintf(fp, "clauses given %7ld\n", Stats[CL_GIVEN]);
fprintf(fp, "clauses generated %7ld\n", Stats[CL_GENERATED]);
if (Hot->first_cl)
fprintf(fp, " (hot clauses generated)%7ld\n", Stats[HOT_GENERATED]);
if (Flags[BINARY_RES].val)
fprintf(fp, " binary_res generated %7ld\n", Stats[BINARY_RES_GEN]);
if (Flags[HYPER_RES].val)
fprintf(fp, " hyper_res generated %7ld\n", Stats[HYPER_RES_GEN]);
if (Flags[NEG_HYPER_RES].val)
fprintf(fp, " neg_hyper_res generated%7ld\n", Stats[NEG_HYPER_RES_GEN]);
if (Flags[PARA_FROM].val)
fprintf(fp, " para_from generated %7ld\n", Stats[PARA_FROM_GEN]);
if (Flags[PARA_INTO].val)
fprintf(fp, " para_into generated %7ld\n", Stats[PARA_INTO_GEN]);
if (Flags[FACTOR].val)
fprintf(fp, " factors generated %7ld\n", Stats[FACTOR_GEN]);
if (Flags[GEOMETRIC_RULE].val)
fprintf(fp, " gL rule generated %7ld\n", Stats[GEO_GEN]);
if (Flags[DEMOD_INF].val)
fprintf(fp, " demod_inf generated %7ld\n", Stats[DEMOD_INF_GEN]);
if (Flags[UR_RES].val)
fprintf(fp, " ur_res generated %7ld\n", Stats[UR_RES_GEN]);
if (Flags[LINKED_UR_RES].val)
fprintf(fp, " linked_ur_res generated%7ld\n", Stats[LINKED_UR_RES_GEN]);
if (Flags[BACK_UNIT_DELETION].val)
fprintf(fp, " back unit del. gen. %7ld\n", Stats[BACK_UNIT_DEL_GEN]);
#ifdef SCOTT
if (get_sem_res_flag())
fprintf(fp, " sem_res generated %7ld\n", get_sem_res_gen_val());
#endif
fprintf(fp, "demod & eval rewrites %7ld\n", Stats[REWRITES]);
fprintf(fp, "clauses wt,lit,sk delete %7ld\n", Stats[CL_WT_DELETE]);
fprintf(fp, "tautologies deleted %7ld\n", Stats[CL_TAUTOLOGY]);
fprintf(fp, "clauses forward subsumed %7ld\n", Stats[CL_FOR_SUB]);
if (Flags[ANCESTOR_SUBSUME].val)
fprintf(fp, "cl not subsumed due to ancestor_subsume %7ld\n", Stats[CL_NOT_ANC_SUBSUMED]);
fprintf(fp, " (subsumed by sos) %7ld\n", Stats[FOR_SUB_SOS]);
fprintf(fp, "unit deletions %7ld\n", Stats[UNIT_DELETES]);
fprintf(fp, "factor simplifications %7ld\n", Stats[FACTOR_SIMPLIFICATIONS]);
fprintf(fp, "clauses kept %7ld\n", Stats[CL_KEPT]);
if (Hot->first_cl)
fprintf(fp, " (hot clauses kept) %7ld\n", Stats[HOT_KEPT]);
fprintf(fp, "new demodulators %7ld\n", Stats[NEW_DEMODS]);
fprintf(fp, "empty clauses %7ld\n", Stats[EMPTY_CLAUSES]);
fprintf(fp, "clauses back demodulated %7ld\n", Stats[CL_BACK_DEMOD]);
fprintf(fp, "clauses back subsumed %7ld\n", Stats[CL_BACK_SUB]);
fprintf(fp, "usable size %7ld\n", Stats[USABLE_SIZE]);
fprintf(fp, "sos size %7ld\n", Stats[SOS_SIZE]);
fprintf(fp, "demodulators size %7ld\n", Stats[DEMODULATORS_SIZE]);
fprintf(fp, "passive size %7ld\n", Stats[PASSIVE_SIZE]);
fprintf(fp, "hot size %7ld\n", Stats[HOT_SIZE]);
fprintf(fp, "Kbytes malloced %7ld\n", Stats[K_MALLOCED]);
if (Flags[LINKED_UR_RES].val) {
fprintf(fp, "linked UR depth hits %7ld\n", Stats[LINKED_UR_DEPTH_HITS]);
fprintf(fp, "linked UR deduct hits %7ld\n", Stats[LINKED_UR_DED_HITS]);
}
/* The following are output only if not 0. */
/* They aren't errors, but they are anomalies. */
if (Stats[CL_VAR_DELETES] != 0)
fprintf(fp, "cl deletes, too many vars %7ld\n", Stats[CL_VAR_DELETES]);
if (Stats[FPA_OVERLOADS] != 0)
fprintf(fp, "fpa argument overloads %7ld\n", Stats[FPA_OVERLOADS]);
if (Stats[FPA_UNDERLOADS] != 0)
fprintf(fp, "fpa argument underloads %7ld\n", Stats[FPA_UNDERLOADS]);
if (Stats[DEMOD_LIMITS] != 0)
fprintf(fp, "demodulations stopped by limit %7ld\n", Stats[DEMOD_LIMITS]);
} /* print_stats */
/*************
*
* print_stats_brief(fp)
*
*************/
void print_stats_brief(FILE *fp)
{
if (splitting())
fprintf(fp, "\n------- statistics (process %d) -------\n", my_process_id());
else
fprintf(fp, "\n-------------- statistics -------------\n");
fprintf(fp, "clauses given %7ld\n", Stats[CL_GIVEN]);
fprintf(fp, "clauses generated %7ld\n", Stats[CL_GENERATED]);
if (Hot && Hot->first_cl)
fprintf(fp, " (hot clauses generated)%7ld\n", Stats[HOT_GENERATED]);
fprintf(fp, "clauses kept %7ld\n", Stats[CL_KEPT]);
if (Hot && Hot->first_cl)
fprintf(fp, " (hot clauses kept)%7ld\n", Stats[HOT_KEPT]);
fprintf(fp, "clauses forward subsumed %7ld\n", Stats[CL_FOR_SUB]);
fprintf(fp, "clauses back subsumed %7ld\n", Stats[CL_BACK_SUB]);
fprintf(fp, "Kbytes malloced %7ld\n", Stats[K_MALLOCED]);
} /* print_stats_brief */
/*************
*
* p_stats()
*
*************/
void p_stats(void)
{
print_stats(stdout);
} /* p_stats */
/*************
*
* print_times(fp)
*
*************/
void print_times(FILE *fp)
{
long t, min, hr;
fprintf(fp, "\n----------- times (seconds) -----------\n");
t = run_time();
fprintf(fp, "user CPU time %10.2f ", t / 1000.);
t = t / 1000; hr = t / 3600; t = t % 3600; min = t / 60; t = t % 60;
fprintf(fp, " (%ld hr, %ld min, %ld sec)\n", hr, min, t);
t = system_time();
fprintf(fp, "system CPU time %10.2f ", t / 1000.);
t = t / 1000; hr = t / 3600; t = t % 3600; min = t / 60; t = t % 60;
fprintf(fp, " (%ld hr, %ld min, %ld sec)\n", hr, min, t);
t = wall_seconds() - Stats[INIT_WALL_SECONDS];
fprintf(fp, "wall-clock time %7ld ", t);
hr = t / 3600; t = t % 3600; min = t / 60; t = t % 60;
fprintf(fp, " (%ld hr, %ld min, %ld sec)\n", hr, min, t);
fprintf(fp, "input time %10.2f\n", clock_val(INPUT_TIME) / 1000.);
fprintf(fp, " clausify time %10.2f\n", clock_val(CLAUSIFY_TIME) / 1000.);
if (Flags[PROCESS_INPUT].val)
fprintf(fp, " process input %10.2f\n", clock_val(PROCESS_INPUT_TIME) / 1000.);
fprintf(fp, "pick given time %10.2f\n", clock_val(PICK_GIVEN_TIME) / 1000.);
if (Flags[BINARY_RES].val)
fprintf(fp, "binary_res time %10.2f\n", clock_val(BINARY_TIME) / 1000.);
if (Flags[HYPER_RES].val)
fprintf(fp, "hyper_res time %10.2f\n", clock_val(HYPER_TIME) / 1000.);
if (Flags[NEG_HYPER_RES].val)
fprintf(fp, "neg_hyper_res time%9.2f\n", clock_val(NEG_HYPER_TIME) / 1000.);
if (Flags[UR_RES].val)
fprintf(fp, "ur_res time %10.2f\n", clock_val(UR_TIME) / 1000.);
if (Flags[PARA_INTO].val)
fprintf(fp, "para_into time %10.2f\n", clock_val(PARA_INTO_TIME) / 1000.);
if (Flags[PARA_FROM].val)
fprintf(fp, "para_from time %10.2f\n", clock_val(PARA_FROM_TIME) / 1000.);
if (Flags[LINKED_UR_RES].val)
fprintf(fp, "linked_ur time %10.2f\n", clock_val(LINKED_UR_TIME) / 1000.);
if (Flags[BACK_UNIT_DELETION].val)
fprintf(fp, "back unit del time%9.2f\n", clock_val(BACK_UNIT_DEL_TIME) / 1000.);
fprintf(fp, "pre_process time %10.2f\n", clock_val(PRE_PROC_TIME) / 1000.);
fprintf(fp, " renumber time %10.2f\n", clock_val(RENUMBER_TIME) / 1000.);
fprintf(fp, " demod time %10.2f\n", clock_val(DEMOD_TIME) / 1000.);
fprintf(fp, " order equalities%9.2f\n", clock_val(ORDER_EQ_TIME) / 1000.);
fprintf(fp, " unit deleletion%10.2f\n", clock_val(UNIT_DEL_TIME) / 1000.);
fprintf(fp, " factor simplify%10.2f\n", clock_val(FACTOR_SIMP_TIME) / 1000.);
fprintf(fp, " weigh cl time %10.2f\n", clock_val(WEIGH_CL_TIME) / 1000.);
fprintf(fp, " hints keep time%10.2f\n", clock_val(HINTS_KEEP_TIME) / 1000.);
fprintf(fp, " sort lits time %10.2f\n", clock_val(SORT_LITS_TIME) / 1000.);
fprintf(fp, " forward subsume%10.2f\n", clock_val(FOR_SUB_TIME) / 1000.);
fprintf(fp, " delete cl time %10.2f\n", clock_val(DEL_CL_TIME) / 1000.);
fprintf(fp, " keep cl time %10.2f\n", clock_val(KEEP_CL_TIME) / 1000.);
fprintf(fp, " hints time %10.2f\n", clock_val(HINTS_TIME) / 1000.);
fprintf(fp, " print_cl time %10.2f\n", clock_val(PRINT_CL_TIME) / 1000.);
fprintf(fp, " conflict time %10.2f\n", clock_val(CONFLICT_TIME) / 1000.);
fprintf(fp, " new demod time %10.2f\n", clock_val(NEW_DEMOD_TIME) / 1000.);
fprintf(fp, "post_process time%10.2f\n", clock_val(POST_PROC_TIME) / 1000.);
fprintf(fp, " back demod time%10.2f\n", clock_val(BACK_DEMOD_TIME) / 1000.);
fprintf(fp, " back subsume %10.2f\n", clock_val(BACK_SUB_TIME) / 1000.);
fprintf(fp, " factor time %10.2f\n", clock_val(FACTOR_TIME) / 1000.);
if (Hot->first_cl)
fprintf(fp, " hot list time %10.2f\n", clock_val(HOT_TIME) / 1000.);
fprintf(fp, " unindex time %10.2f\n", clock_val(UN_INDEX_TIME) / 1000.);
#ifdef SCOTT
fprintf(fp, "sem_guide time %10.2f\n", get_sem_guide_time_val() / 1000.);
fprintf(fp, "sem_dev time %10.2f\n", get_sem_dev_time_val() / 1000.);
#endif
} /* print_times */
/*************
*
* print_times_brief(fp)
*
*************/
void print_times_brief(FILE *fp)
{
long t, min, hr;
fprintf(fp, "\n----------- times (seconds) -----------\n");
t = run_time();
fprintf(fp, "user CPU time %10.2f ", t / 1000.);
t = t / 1000; hr = t / 3600; t = t % 3600; min = t / 60; t = t % 60;
fprintf(fp, " (%ld hr, %ld min, %ld sec)\n", hr, min, t);
t = system_time();
fprintf(fp, "system CPU time %10.2f ", t / 1000.);
t = t / 1000; hr = t / 3600; t = t % 3600; min = t / 60; t = t % 60;
fprintf(fp, " (%ld hr, %ld min, %ld sec)\n", hr, min, t);
t = wall_seconds() - Stats[INIT_WALL_SECONDS];
fprintf(fp, "wall-clock time %7ld ", t);
hr = t / 3600; t = t % 3600; min = t / 60; t = t % 60;
fprintf(fp, " (%ld hr, %ld min, %ld sec)\n", hr, min, t);
if (Flags[BINARY_RES].val)
fprintf(fp, "binary_res time %10.2f\n", clock_val(BINARY_TIME) / 1000.);
if (Flags[HYPER_RES].val)
fprintf(fp, "hyper_res time %10.2f\n", clock_val(HYPER_TIME) / 1000.);
if (Flags[NEG_HYPER_RES].val)
fprintf(fp, "neg_hyper time %10.2f\n", clock_val(NEG_HYPER_TIME) / 1000.);
if (Flags[UR_RES].val)
fprintf(fp, "UR_res time %10.2f\n", clock_val(UR_TIME) / 1000.);
if (Flags[PARA_INTO].val)
fprintf(fp, "para_into time %10.2f\n", clock_val(PARA_INTO_TIME) / 1000.);
if (Flags[PARA_FROM].val)
fprintf(fp, "para_from time %10.2f\n", clock_val(PARA_FROM_TIME) / 1000.);
if (Flags[LINKED_UR_RES].val)
fprintf(fp, "linked_ur time %10.2f\n", clock_val(LINKED_UR_TIME) / 1000.);
fprintf(fp, "for_sub time %10.2f\n", clock_val(FOR_SUB_TIME) / 1000.);
fprintf(fp, "back_sub time %10.2f\n", clock_val(BACK_SUB_TIME) / 1000.);
fprintf(fp, "conflict time %10.2f\n", clock_val(CONFLICT_TIME) / 1000.);
if ((Demodulators && Demodulators->first_cl) || Internal_flags[DOLLAR_PRESENT])
fprintf(fp, "demod time %10.2f\n", clock_val(DEMOD_TIME) / 1000.);
if (Hot && Hot->first_cl)
fprintf(fp, " hot list time %10.2f\n", clock_val(HOT_TIME) / 1000.);
#ifdef SCOTT
fprintf(fp, "sem guide time %10.2f\n", get_sem_guide_time_val() / 1000.);
fprintf(fp, "sem dev time %10.2f\n", get_sem_dev_time_val() / 1000.);
#endif
} /* print_times_brief */
/*************
*
* p_times()
*
*************/
void p_times(void)
{
print_times(stdout);
} /* p_times */
/*************
*
* append_lists(l1, l2) -- append l2 to l1 and free the header node l2
*
*************/
void append_lists(struct list *l1,
struct list *l2)
{
struct clause *c;
int i;
if (l1->last_cl) /* if l1 not empty */
l1->last_cl->next_cl = l2->first_cl;
else
l1->first_cl = l2->first_cl;
if (l2->first_cl) { /* if l2 not empty */
l2->first_cl->prev_cl = l1->last_cl;
l1->last_cl = l2->last_cl;
}
for (c = l2->first_cl, i = 0; c; c = c->next_cl, i++)
c->container = l1;
if (l1 == Usable)
Stats[USABLE_SIZE] += i;
else if (l1 == Sos)
Stats[SOS_SIZE] += i;
else if (l1 == Demodulators)
Stats[DEMODULATORS_SIZE] += i;
else if (l1 == Passive)
Stats[PASSIVE_SIZE] += i;
else if (l1 == Hot)
Stats[HOT_SIZE] += i;
#ifdef SCOTT
else if (l1 == First)
Stats[SOS_SIZE] += i;
#endif
if (l2 == Usable)
Stats[USABLE_SIZE] -= i;
else if (l2 == Sos)
Stats[SOS_SIZE] -= i;
else if (l2 == Demodulators)
Stats[DEMODULATORS_SIZE] -= i;
else if (l2 == Passive)
Stats[PASSIVE_SIZE] -= i;
else if (l2 == Hot)
Stats[HOT_SIZE] -= i;
#ifdef SCOTT
else if (l2 == First)
Stats[SOS_SIZE] -= i;
#endif
free_list(l2);
} /* append_lists */
/*************
*
* struct term *copy_term(term) -- Return a copy of the term.
*
* The bits field is not copied.
* except for SECOND_ORDER_BIT, which is copied (Beeson)
*
*************/
struct term *copy_term(struct term *t)
{
struct rel *r, *r2, *r3;
struct term *t2;
if(t == NULL)
{ printf("\ncopy_term received a NULL argument\n"); // Beeson 10.13
return NULL;
}
t2 = get_term();
t2->type = t->type;
t2->sym_num = t->sym_num;
t2->varnum = t->varnum;
if (t->type != COMPLEX)
return(t2);
else {
r3 = NULL;
r = t->farg;
while (r) {
r2 = get_rel();
if (r3 == NULL)
t2->farg = r2;
else
r3->narg = r2;
r2->argval = copy_term(r->argval);
r3 = r2;
r = r->narg;
}
return(t2);
}
} /* copy_term */
/*************
*
* int biggest_var(term) -- return largest variable number (-1 if none)
*
*************/
int biggest_var(struct term *t)
{
struct rel *r;
int i, j;
if (t->type == VARIABLE)
return(t->varnum);
else if (t->type == NAME)
return(-1);
else {
r = t->farg;
i = -1;
while (r) {
j = biggest_var(r->argval);
if (j > i)
i = j;
r = r->narg;
}
return(i);
}
} /* biggest_var */
/*************
*
* int biggest_var_clause(c) -- return largest variable number (-1 if none)
*
*************/
int biggest_var_clause(struct clause *c)
{
struct literal *lit;
int i, max;
max = -1;
for (lit = c->first_lit; lit; lit = lit->next_lit) {
i = biggest_var(lit->atom);
max = (i > max ? i : max);
}
return(max);
} /* biggest_var_clause */
/*************
*
* int ground_clause(c)
*
*************/
int ground_clause(struct clause *c)
{
return(biggest_var_clause(c) == -1);
} /* ground_var_clause */
/*************
*
* zap_list(term_ptr) -- Free a list of nonintegrated terms.
*
*************/
void zap_list(struct term_ptr *p)
{
struct term_ptr *q;
while (p) {
zap_term(p->term);
q = p;
p = p->next;
free_term_ptr(q);
}
} /* zap_list */
/*************
*
* int occurs_in(t1, t2) -- Does t1 occur in t2?
*
* term_ident is used to check identity.
*
*************/
int occurs_in(struct term *t1,
struct term *t2)
{
struct rel *r;
if (term_ident(t1, t2))
return(1);
else if (t2->type != COMPLEX)
return(0);
else {
r = t2->farg;
while (r && occurs_in(t1, r->argval) == 0)
r = r->narg;
return(r != NULL);
}
} /* occurs_in */
/*************
*
* occurrences(s, t)
*
* How many occurrences of s are there in t.
*
*************/
int occurrences(struct term *s,
struct term *t)
{
if (term_ident(s, t))
return(1);
else if (t->type != COMPLEX)
return(0);
else {
struct rel *r;
int count;
for (r = t->farg, count = 0; r; r = r->narg)
count += occurrences(s, r->argval);
return(count);
}
} /* occurrences */
/*************
*
* int sn_occur(sn, t)
*
* Is sn the sym_num of t or any subterms of t?
*
*************/
int sn_occur(int sn,
struct term *t)
{
struct rel *r;
int occurs;
if (t->type != COMPLEX)
return(t->sym_num == sn);
else if (t->sym_num == sn)
return(1);
else {
occurs = 0;
r = t->farg;
while (r && occurs == 0) {
occurs = sn_occur(sn, r->argval);
r = r->narg;
}
return(occurs);
}
} /* sn_occur */
/*************
*
* is is_atom(t) -- Is t an atom?
*
* A term is an atom iff it is not a variable and varnum != 0.
* (The varnum field of an atom gives its type---equality, answer, evaluable, etc.)
*
*************/
int is_atom(struct term *t)
{
return(t->type != VARIABLE && t->varnum != 0);
} /* is_atom */
/*************
*
* int id_nested_skolems(t)
*
* Does t or any of its subterms have the identical_nested_skolems property?
*
*************/
static int id_nested_skolems(struct term *t)
{
struct rel *r;
int occurs;
if (t->type != COMPLEX)
return(0);
else {
occurs = 0;
if (is_skolem(t->sym_num)) {
r = t->farg;
while (r && occurs == 0) {
occurs = sn_occur(t->sym_num, r->argval);
r = r->narg;
}
}
if (occurs)
return(1);
else {
occurs = 0;
r = t->farg;
while (r && occurs == 0) {
occurs = id_nested_skolems(r->argval);
r = r->narg;
}
return(occurs);
}
}
} /* id_nested_skolems */
/*************
*
* int ident_nested_skolems(c)
*
* Do any of the terms in clause c have the
* identical_nested_skolems property?
*
*************/
int ident_nested_skolems(struct clause *c)
{
struct literal *l;
int occurs;
l = c->first_lit;
occurs = 0;
while (l && occurs == 0) {
occurs = id_nested_skolems(l->atom);
l = l->next_lit;
}
return(occurs);
} /* ident_nested_skolems */
/*************
*
* int ground(t) -- is a term ground?
*
*************/
int ground(struct term *t)
{
struct rel *r;
int ok;
if (t->type == NAME)
return(1);
else if (t->type == VARIABLE)
return(0);
else { /* COMPLEX */
ok = 1;
for (r = t->farg; r && ok; r = r->narg)
ok = ground(r->argval);
return(ok);
}
} /* ground */
/*************
*
* void cleanup()
*
*************/
void cleanup(void)
{
printf("\n============ end of search ============\n");
if (Flags[PRINT_LISTS_AT_END].val) {
printf("\nlist(usable).\n"); print_cl_list(stdout, Usable);
printf("\nlist(sos).\n"); print_cl_list(stdout, Sos);
if (Demodulators) {
printf("\nlist(demodulators).\n");
print_cl_list(stdout, Demodulators);
}
printf("\n");
}
if (Flags[FREE_ALL_MEM].val)
free_all_mem();
output_stats(stdout, Parms[STATS_LEVEL].val);
if (Stats[EMPTY_CLAUSES] > 0 &&
(!splitting() || current_case() == NULL))
printf("\nThat finishes the proof of the theorem.\n");
printf("\nProcess %d finished %s", my_process_id(), get_time());
} /* cleanup */
/*************
*
* int check_stop() -- Should the search be terminated?
*
* return:
* KEEP_SEARCHING if we should not stop;
* MAX_GIVEN_EXIT if we should stop because of max_given option;
* MAX_SECONDS_EXIT if we should stop because of max_seconds option;
* MAX_GEN_EXIT if we should stop because of max_gen option;
* MAX_KEPT_EXIT if we should stop because of max_kept option.
*
*************/
int check_stop(void)
{
long given, seconds, gen, kept;
int max_given, max_seconds, max_gen, max_kept;
given = Stats[CL_GIVEN];
gen = Stats[CL_GENERATED];
kept = Stats[CL_KEPT];
if (splitting())
seconds = wall_seconds() - Stats[INIT_WALL_SECONDS];
else
seconds = run_time() / 1000;
max_given = Parms[MAX_GIVEN].val;
max_seconds = Parms[MAX_SECONDS].val;
max_gen = Parms[MAX_GEN].val;
max_kept = Parms[MAX_KEPT].val;
if (max_given != -1 && given >= max_given)
return(MAX_GIVEN_EXIT);
else if(max_seconds != -1 && seconds >= max_seconds)
return(MAX_SECONDS_EXIT);
else if (max_gen != -1 && gen >= max_gen)
return(MAX_GEN_EXIT);
else if (max_kept != -1 && kept >= max_kept)
return(MAX_KEPT_EXIT);
else
return(KEEP_SEARCHING);
} /* check_stop */
/*************
*
* report() -- possibly report statistics and times
*
*************/
void report(void)
{
static int next_report;
double runtime; // changed from 'float' by Beeson 7.23.02
if (next_report == 0)
next_report = Parms[REPORT].val;
runtime = run_time() / 1000.;
if (runtime >= next_report) {
printf("\n----- report at %9.2f seconds ----- %s", runtime, get_time());
output_stats(stdout, Parms[STATS_LEVEL].val);
fprintf(stderr, "%cA report (%.2f seconds) has been sent to the output file.\n", Bell, runtime);
while (runtime >= next_report)
next_report += Parms[REPORT].val;
}
} /* report */
/*************
*
* void control_memory()
*
*************/
void control_memory(void)
{
static int next_control_point = 0;
int sos_distribution[500];
int i, j, wt, n, control, size;
struct clause *c;
j = total_mem();
if (Parms[MAX_MEM].val != 0 && j*3 > Parms[MAX_MEM].val) {
if (!next_control_point)
control = 1;
else if (next_control_point == Stats[CL_GIVEN])
control = 1;
else
control = 0;
}
else
control = 0;
if (control) {
next_control_point = Stats[CL_GIVEN] + 20;
for (i = 0; i < 500; i++)
sos_distribution[i] = 0;
for (c = Sos->first_cl, size = 0; c; c = c->next_cl, size++) {
if (c->pick_weight < 0)
wt = 0;
else if (c->pick_weight >= 500)
wt = 499;
else
wt = c->pick_weight;
sos_distribution[wt]++;
}
i = 0; n = 0;
while (i < 500 && n*20 <= size) {
n += sos_distribution[i];
i++;
}
i--;
/* reset weight limit to i */
if (i < Parms[MAX_WEIGHT].val || Parms[MAX_WEIGHT].val == 0) {
Parms[MAX_WEIGHT].val = i;
fprintf(stderr, "%c\n\nResetting weight limit to %d.\n\n", Bell, i);
printf("\nResetting weight limit to %d.\n\n", i);
printf("sos_size=%d\n", size);
fflush(stdout);
#if 0
printf("weight: number of sos clauses with that weight\n");
for (j = 0; j < 100; j++)
printf("%d: %d\n", j, sos_distribution[j]);
#endif
}
}
} /* control_memory */
/*************
*
* proof_message(c) - print a message to stderr
*
* If clause c has any (probably answer) literals, print c.
*
*************/
static void proof_message(struct clause *c)
{
char *user = username();
long i = run_time(); /* i is milliseconds */
if (Stats[EMPTY_CLAUSES] == 1)
fprintf(stderr, "\n");
if (splitting() && current_case() != NULL) {
fprintf(stderr, "%c--- refuted case ", Bell);
print_case(stderr);
}
else if (i > 10000) {
/* If more than 10 seconds, print excitedly. (Now that's real AI!) */
fprintf(stderr, "%c-- HEY %s, WE HAVE A PROOF!! -- ", Bell, user);
}
else
fprintf(stderr, "%c-------- PROOF -------- ", Bell);
if (c->first_lit)
print_clause(stderr, c);
else
fprintf(stderr, "\n");
} /* proof_message */
/*************
*
* print_proof(fp, c)
*
*************/
void print_proof(FILE *fp,
struct clause *c)
{
struct clause_ptr *cp1, *cp2, *cp3;
struct int_ptr *ip1, *ip2;
int length, level;
#ifdef SCOTT
int givens;
#endif
cp1 = NULL;
level = get_ancestors(c, &cp1, &ip1);
#ifdef SCOTT
for (length = 0, givens = 0, cp2 = cp1; cp2; cp2 = cp2->next){
if (cp2->c->given) givens++;
if (cp2->c->parents && cp2->c->parents->i != NEW_DEMOD_RULE) {
length++;
}
}
#else
for (length = 0, cp2 = cp1; cp2; cp2 = cp2->next)
if (cp2->c->parents && cp2->c->parents->i != NEW_DEMOD_RULE) {
length++;
}
#endif
proof_message(c); /* to stderr */
fprintf(fp, "Length of proof is %d.", length-1);
fprintf(fp, " Level of proof is %d.", level-1);
#ifdef SCOTT
fprintf(fp, "\nNumber of given clauses in proof is %d.", givens);
#endif
if (splitting()) {
struct int_ptr *p = current_case();
if (p != NULL) {
fprintf(fp, " Case ");
print_case(fp);
}
}
if (Flags[PROOF_WEIGHT].val)
fprintf(fp, " Weight of proof is %d.", prf_weight(c));
fprintf(fp, "\n\n---------------- PROOF ----------------\n\n");
cp2 = cp1;
while (cp2) {
cp3 = cp2->next;
if (cp3 && cp3->c->parents &&
cp3->c->parents->i == NEW_DEMOD_RULE &&
cp3->c->parents->next->i == cp2->c->id) {
#ifdef SCOTT
fprintf(fp,"%d: ", cp2->c->given);
fprintf(fp,"(wt=%d) ", cp2->c->pick_weight);
#endif
/* skip over dynamic demodulator copy */
fprintf(fp, "%d,", cp3->c->id);
print_clause(fp, cp2->c);
cp2 = cp3->next;
}
else {
#ifdef SCOTT
fprintf(fp,"%d: ", cp2->c->given);
fprintf(fp,"(wt=%d) ", cp2->c->pick_weight);
#endif
print_clause(fp, cp2->c);
cp2 = cp2->next;
}
}
fprintf(fp, "\n------------ end of proof -------------\n\n");
fflush(fp);
while (cp1 != NULL) {
cp2 = cp1; cp1 = cp1->next; free_clause_ptr(cp2);
ip2 = ip1; ip1 = ip1->next; free_int_ptr(ip2);
}
} /* print_proof */
/*************
*
* struct clause *check_for_proof(c)
*
* Check for EMPTY CLAUSE proof and UNIT CONFLICT proof.
*
*************/
struct clause *check_for_proof(struct clause *c)
{
struct clause *e;
struct clause_ptr *cp1, *cp2;
int number_of_lits;
e = NULL;
number_of_lits = num_literals(c);
if (number_of_lits == 0) {
printf("\n-----> EMPTY CLAUSE at %6.2f sec ----> ",
run_time() / 1000.);
print_clause(stdout, c);
printf("\n");
#ifndef SCOTT
Stats[CL_KEPT]--; /* don't count empty clauses */
/* pre_process has already KEPT it */
rem_from_list(c); /* with SCOTT we append clause AFTER check_for_proof() */
#endif
hide_clause(c);
Stats[EMPTY_CLAUSES]++;
e = c;
if (Flags[PRINT_PROOFS].val)
print_proof(stdout, e);
if (Flags[BUILD_PROOF_OBJECT].val)
build_proof_object(e);
}
else if (number_of_lits == 1
#ifdef SCOTT
/* for investigation the effect sof Unit Conflict */
&& get_unit_conflict_flag()
#endif
) {
cp1 = unit_conflict(c);
while (cp1) { /* empty clause from unit conflict */
e = cp1->c;
cp2 = cp1->next;
free_clause_ptr(cp1);
cp1 = cp2;
cl_integrate(e);
printf("\n----> UNIT CONFLICT at %6.2f sec ----> ",
run_time() / 1000.);
print_clause(stdout, e);
printf("\n");
hide_clause(e);
if (Flags[PRINT_PROOFS].val)
print_proof(stdout, e);
if (Flags[BUILD_PROOF_OBJECT].val)
build_proof_object(e);
}
}
return(e); /* NULL if no proof was found */
} /* check_for_proof */
/*************
*
* int proper_list(t)
*
* Is term t a proper list
*
*************/
int proper_list(struct term *t)
{
if (t->type == VARIABLE)
return(0);
else if (t->type == NAME)
return(t->sym_num == str_to_sn("$nil", 0));
else if (t->sym_num != str_to_sn("$cons", 2))
return(0);
else
return(proper_list(t->farg->narg->argval));
} /* proper_list */
/*************
*
* move_clauses()
*
* Move clauses satisfying given routine from one list to another.
*
*************/
void move_clauses(int (*clause_proc)(struct clause *c),
struct list *source,
struct list *destination)
{
struct clause *c1, *c2;
c1 = source->first_cl;
while (c1) {
c2 = c1->next_cl;
if ((*clause_proc)(c1)) {
rem_from_list(c1);
append_cl(destination, c1);
}
c1 = c2;
}
} /* move_clauses */
/*************
*
* copy_int_ptr_list()
*
* Copy and return a list of pointers to integers.
*
*************/
struct int_ptr *copy_int_ptr_list(struct int_ptr *p)
{
struct int_ptr *p0, *p1, *p2;
p0 = NULL; p1 = NULL;
for ( ; p; p = p->next) {
p2 = get_int_ptr();
p2->i = p->i;
if (p1)
p1->next = p2;
else
p0 = p2;
p1 = p2;
}
return(p0);
} /* copy_int_ptr_list */
/*************
*
* int_list_length()
*
*************/
int int_list_length(struct int_ptr *p)
{
int i;
for (i = 0; p != NULL; i++, p = p->next);
return i;
} /* int_list_length */
/*************
*
* automatic_1_settings()
*
* Original version (Otter 3.0.4)
*
* Do a very simple syntactic analysis of the clauses and decide on
* a simple strategy. Print a message about the strategy.
*
*************/
void automatic_1_settings(void)
{
if (Passive->first_cl)
abend("Passive list not accepted in auto1 mode.");
else if (Demodulators->first_cl)
abend("Demodulators list not accepted in auto1 mode.");
else if (Weight_pick_given || Weight_purge_gen || Weight_terms)
abend("Weight lists not accepted in auto1 mode.");
else {
struct clause *c;
int propositional, horn, equality, max_lits, i, symmetry;
if (Sos->first_cl) {
printf("WARNING: Sos list not accepted in auto1 mode:\n");
printf(" sos clauses are being moved to usable list.\n");
append_lists(Usable, Sos);
Sos = get_list();
}
/* Find out some basic properties. */
/* All input clauses are in Usable; move to Sos. */
for (c=Usable->first_cl, propositional=1; c&&propositional; c=c->next_cl)
propositional = propositional_clause(c);
for (c=Usable->first_cl, horn = 1; c && horn; c=c->next_cl)
horn = horn_clause(c);
for (c=Usable->first_cl, equality = 0; c && !equality; c=c->next_cl)
equality = equality_clause(c);
for (c=Usable->first_cl, symmetry = 0; c && !symmetry; c=c->next_cl)
symmetry = symmetry_clause(c);
for (c=Usable->first_cl, max_lits = 0; c; c=c->next_cl) {
i = num_literals(c);
max_lits = (i > max_lits ? i : max_lits);
}
printf("\nSCAN INPUT: prop=%d, horn=%d, equality=%d, symmetry=%d, max_lits=%d.\n",
propositional, horn, equality, symmetry, max_lits);
if (propositional) {
printf("\nThe clause set is propositional; the strategy will be\n");
printf("ordered hyperresolution with the propositional\n");
printf("optimizations, with satellites in sos and nuclei in usable.\n\n");
auto_change_flag(stdout, HYPER_RES, 1);
auto_change_flag(stdout, PROPOSITIONAL, 1);
move_clauses(pos_clause, Usable, Sos);
}
else if (equality && max_lits == 1) {
printf("\nAll clauses are units, and equality is present; the\n");
printf("strategy will be Knuth-Bendix with positive clauses in sos.\n\n");
auto_change_flag(stdout, KNUTH_BENDIX, 1);
for (c = Usable->first_cl; c && pos_clause(c); c = c->next_cl);
if (!c) {
printf("\nThere is no negative clause, so all clause lists will\n");
printf("be printed at the end of the search.\n\n");
auto_change_flag(stdout, PRINT_LISTS_AT_END, 1);
}
move_clauses(pos_clause, Usable, Sos);
}
else if (!horn && !equality) {
printf("\nThis is a non-Horn set without equality. The strategy will\n");
printf("be ordered hyper_res, unit deletion, and factoring, with\n");
printf("satellites in sos and with nuclei in usable.\n\n");
auto_change_flag(stdout, HYPER_RES, 1);
auto_change_flag(stdout, FACTOR, 1);
auto_change_flag(stdout, UNIT_DELETION, 1);
move_clauses(pos_clause, Usable, Sos);
}
else if (horn && !equality) {
printf("\nThis is a Horn set without equality. The strategy will\n");
printf("be hyperresolution, with satellites in sos and nuclei\n");
printf("in usable.\n\n");
auto_change_flag(stdout, HYPER_RES, 1);
auto_change_flag(stdout, ORDER_HYPER, 0);
move_clauses(pos_clause, Usable, Sos);
}
else if (!horn && equality) {
printf("\nThis ia a non-Horn set with equality. The strategy will be\n");
printf("Knuth-Bendix, ordered hyper_res, factoring, and unit\n");
printf("deletion, with positive clauses in sos and nonpositive\n");
printf("clauses in usable.\n\n");
auto_change_flag(stdout, KNUTH_BENDIX, 1);
auto_change_flag(stdout, HYPER_RES, 1);
auto_change_flag(stdout, UNIT_DELETION, 1);
auto_change_flag(stdout, FACTOR, 1);
if (symmetry) {
printf("\nThere is a clause for symmetry of equality, so it is\n");
printf("assumed that equality is fully axiomatized; therefore,\n");
printf("paramodulation is disabled.\n\n");
auto_change_flag(stdout, PARA_FROM, 0);
auto_change_flag(stdout, PARA_INTO, 0);
}
move_clauses(pos_clause, Usable, Sos);
}
else if (horn && equality) {
printf("\nThis is a Horn set with equality. The strategy will be\n");
printf("Knuth-Bendix and hyper_res, with positive clauses in\n");
printf("sos and nonpositive clauses in usable.\n\n");
auto_change_flag(stdout, KNUTH_BENDIX, 1);
auto_change_flag(stdout, HYPER_RES, 1);
auto_change_flag(stdout, ORDER_HYPER, 0);
if (symmetry) {
printf("\nThere is a clause for symmetry of equality is, so it is\n");
printf("assumed that equality is fully axiomatized; therefore,\n");
printf("paramodulation is disabled.\n\n");
auto_change_flag(stdout, PARA_FROM, 0);
auto_change_flag(stdout, PARA_INTO, 0);
}
move_clauses(pos_clause, Usable, Sos);
}
}
} /* automatic_1_settings */
/*************
*
* sos_has_pos_nonground()
*
*************/
int sos_has_pos_nonground(void)
{
struct clause *c;
for (c = Sos->first_cl; c; c = c->next_cl) {
if (pos_clause(c) && !ground_clause(c))
return(1);
}
#ifdef SCOTT
for (c = First->first_cl; c; c = c->next_cl) {
if (pos_clause(c) && !ground_clause(c))
return(1);
}
#endif
return (0);
} /* sos_has_pos_nonground */
/*************
*
* automatic_2_settings()
*
* Revised version (Otter 3.0.5)
*
* Do a very simple syntactic analysis of the clauses and decide on
* a simple strategy. Print a message about the strategy.
*
* This version accepts input sos clauses. Also, input usable clauses
* can be moved to sos. See below.
*
*************/
void automatic_2_settings(void)
{
if (Passive->first_cl)
abend("Passive list not accepted in auto2 mode.");
else if (Demodulators->first_cl)
abend("Demodulators list not accepted in auto2 mode.");
else if (Weight_pick_given || Weight_purge_gen || Weight_terms)
abend("Weight lists not accepted in auto2 mode.");
else {
struct clause *c;
int propositional, horn, equality, max_lits, i, symmetry;
if (sos_has_pos_nonground())
printf("Sos has positive nonground clause; therefore it is not changed.\n");
else {
printf("\nEvery positive clause in sos is ground (or sos is empty);\n");
printf("therefore we move all positive usable clauses to sos.\n");
move_clauses(pos_clause, Usable, Sos);
}
/* Find out some basic properties. */
for (c=Usable->first_cl, propositional=1; c&&propositional; c=c->next_cl)
propositional = propositional_clause(c);
for (c=Sos->first_cl; c&&propositional; c=c->next_cl)
propositional = propositional_clause(c);
for (c=Usable->first_cl, horn = 1; c && horn; c=c->next_cl)
horn = horn_clause(c);
for (c=Sos->first_cl; c && horn; c=c->next_cl)
horn = horn_clause(c);
for (c=Usable->first_cl, equality = 0; c && !equality; c=c->next_cl)
equality = equality_clause(c);
for (c=Sos->first_cl; c && !equality; c=c->next_cl)
equality = equality_clause(c);
for (c=Usable->first_cl, symmetry = 0; c && !symmetry; c=c->next_cl)
symmetry = symmetry_clause(c);
for (c=Sos->first_cl; c && !symmetry; c=c->next_cl)
symmetry = symmetry_clause(c);
for (c=Usable->first_cl, max_lits = 0; c; c=c->next_cl) {
i = num_literals(c);
max_lits = (i > max_lits ? i : max_lits);
}
for (c=Sos->first_cl; c; c=c->next_cl) {
i = num_literals(c);
max_lits = (i > max_lits ? i : max_lits);
}
printf("\nProperties of input clauses: prop=%d, horn=%d, equality=%d, symmetry=%d, max_lits=%d.\n\n",
propositional, horn, equality, symmetry, max_lits);
if (propositional) {
printf("\nAll clauses are propositional; therefore we set the\n");
printf("propositional flag and use ordered hyperresolution.\n");
auto_change_flag(stdout, PROPOSITIONAL, 1);
auto_change_flag(stdout, HYPER_RES, 1);
}
else {
/* nonpropositional */
if (max_lits == 1) {
printf("Setting pick_given_ratio to 2, because all clauses are units.\n");
auto_change_parm(stdout, PICK_GIVEN_RATIO, 2);
}
else {
/* Nonunit */
printf("Setting hyper_res, because there are nonunits.\n");
auto_change_flag(stdout, HYPER_RES, 1);
if (equality || !horn) {
printf("Setting ur_res, because this is a nonunit set containing\n");
printf("either equality literals or non-Horn clauses.\n");
auto_change_flag(stdout, UR_RES, 1);
}
if (horn) {
printf("Clearing order_hyper, because all clauses are Horn.\n");
auto_change_flag(stdout, ORDER_HYPER, 0);
}
else {
/* Non-Horn */
printf("Setting factor and unit_deletion, because there are non-Horn clauses.\n");
auto_change_flag(stdout, FACTOR, 1);
auto_change_flag(stdout, UNIT_DELETION, 1);
}
}
if (equality) {
printf("Equality is present, so we set the knuth_bendix flag.\n");
auto_change_flag(stdout, KNUTH_BENDIX, 1);
if (max_lits > 1) {
printf("As an incomplete heuristic, we paramodulate with units only.\n");
auto_change_flag(stdout, PARA_FROM_UNITS_ONLY, 1);
auto_change_flag(stdout, PARA_INTO_UNITS_ONLY, 1);
}
if (symmetry) {
printf("There is a clause for symmetry of equality, so it is\n");
printf("assumed that equality is fully axiomatized; therefore,\n");
printf("paramodulation is disabled.\n\n");
auto_change_flag(stdout, PARA_FROM, 0);
auto_change_flag(stdout, PARA_INTO, 0);
}
}
}
}
} /* automatic_2_settings */
/*************
*
* log_for_x_show()
*
* Print some statistics to a file. This is intended to be used by
* some other program that displays statistics about the search in real time.
*
*************/
void log_for_x_show(FILE *fp)
{
fprintf(fp, "given %ld\n", Stats[CL_GIVEN]);
fprintf(fp, "generated %ld\n", Stats[CL_GENERATED]);
fprintf(fp, "kept %ld\n", Stats[CL_KEPT]);
fprintf(fp, "usable %ld\n", Stats[USABLE_SIZE]);
fprintf(fp, "sos %ld\n", Stats[SOS_SIZE]);
fprintf(fp, "demods %ld\n", Stats[DEMODULATORS_SIZE]);
fprintf(fp, "passive %ld\n", Stats[PASSIVE_SIZE]);
fprintf(fp, "hot %ld\n", Stats[HOT_SIZE]);
fprintf(fp, "kbytes %ld\n", Stats[K_MALLOCED]);
fprintf(fp, "wall-time %.2f\n", (double) wall_seconds() - Stats[INIT_WALL_SECONDS]);
fprintf(fp, "user-time %.2f\n", run_time() / 1000.);
fprintf(fp, "sys-time %.2f\n", system_time() / 1000.);
fflush(fp);
} /* log_for_x_show */
/*************
*
* int same_structure(t1, t2)
*
* Similar to lex_order_vars, except that variables are identical.
*
*************/
int same_structure(struct term *t1,
struct term *t2)
{
struct rel *r1, *r2;
int i;
if (t1->type == VARIABLE)
return(t2->type == VARIABLE);
else if (t2->type == VARIABLE)
return(0);
else if (t1->sym_num == t2->sym_num) {
r1 = t1->farg;
r2 = t2->farg;
i = 1;
while (r1 && (i = same_structure(r1->argval,r2->argval))) {
r1 = r1->narg;
r2 = r2->narg;
}
return(i);
}
else
return(0);
} /* same_structure */
/*************
*
* void zap_variable_names(t);
*
*************/
void zap_variable_names(struct term *t)
{
if (t->type == VARIABLE)
t->sym_num = 0;
else if (t->type == COMPLEX) {
struct rel *r;
for (r = t->farg; r != NULL; r = r->narg)
zap_variable_names(r->argval);
}
} /* zap_variable_names */
./otter/nonport.c 0000744 0002044 0001012 00000021743 11120534450 012316 0 ustar beeson /* 7.24.02 Beeson modified hostname and username for Windows
/*
* nonport.c -- nonportable features; see unix makefile.
*
*/
#include "header.h"
#ifdef SCOTT
#include "called_by_otter.h" /* SCOTT protos seen by OTTER */
#endif
#ifdef TP_SIGNAL /* for call to signal() */
# include <signal.h>
#endif
#ifdef TP_FORK /* for calls to fork() and wait() */
# include <sys/types.h>
# include <sys/wait.h>
# include <unistd.h>
#endif
#ifdef TP_NAMES /* for calls to getpwuid() and gethostname() */
# include <sys/types.h>
# include <pwd.h>
# include <unistd.h>
#endif
#ifdef THINK_C /* Macintosh */
# include <console.h> /* for call to ccommand() */
#endif
/*************
*
* non_portable_init()
*
*************/
void non_portable_init(int argc,
char **argv)
{
#ifdef TP_SIGNAL
signal(SIGINT, sig_handler);
signal(SIGSEGV, sig_handler);
signal(SIGUSR1, sig_handler);
#endif
#ifdef THINK_C /* Macintosh */
AdjustStack();
SetCreator();
argc = ccommand(&argv);
#endif
} /* non_portable_init */
#ifdef TP_SIGNAL
/*************
*
* sig_handler()
*
*************/
void sig_handler(int condition)
{
if (condition == SIGSEGV) {
char message[] =
"\nSEGMENTATION FAULT!! This is probably caused by a\n"
"bug in Otter. Please send copy of the input file to\n"
"otter@mcs.anl.gov, let us know what version of Otter you are\n"
"using, and send any other info that might be useful.\n\n";
output_stats(stdout, Parms[STATS_LEVEL].val);
fprintf(stdout, "%s", message);
fprintf(stderr, "%s%c", message, Bell);
printf("\nThe job finished %s", get_time());
exit(SEGV_EXIT);
}
else if (condition == SIGINT) {
signal(SIGINT, sig_handler); /* for subsequent interrupts */
interact();
#ifdef SCOTT
/* why use semantic guidance if your're gonna do it by hand anyway? */
if (get_semantic_guidance_flag()) exit(SIGINT);
#endif
}
else if (condition == SIGUSR1) {
output_stats(stdout, Parms[STATS_LEVEL].val);
printf("\nOtter killed by SIGUSR1 signal.\n");
fprintf(stderr, "\nOtter killed by SIGUSR1 signal.\n");
exit(USR1_EXIT);
}
else {
char s[100];
sprintf(s, "sig_handler, cannot handle signal %d.\n", condition);
abend(s);
}
} /* sig_handler */
#endif /* TP_SIGNAL */
/*************
*
* username()
*
*************/
char *username(void)
{
#ifdef THINK_C
return("Macintosh user");
#else
#ifdef DOS_GCC
return("DOS user");
#else
#ifdef _WIN32
return "Windows user";
#else
#ifdef TP_NAMES
/* cuserid is not on some machines;
* getlogin doesn't always work if user is not logged in;
* getlogin broken on Linux. Following seems to be ok.
*/
struct passwd *p;
p = getpwuid(getuid());
return(p ? p->pw_name : "???");
#else
return("???");
#endif
#endif
#endif
#endif
} /* username */
/*************
*
* hostname()
*
*************/
char *hostname(void)
{
static char host[64];
#ifdef THINK_C
strcpy(host, "a Macintosh");
#else
#ifdef DOS_GCC
strcpy(host, "DOS");
#else
#ifdef TP_NAMES
if (gethostname(host, 64) != 0)
strcpy(host, "???");
#else
#ifdef _WIN32
strcpy(host,"Windows");
#else
strcpy(host, "???");
#endif
#endif
#endif
#endif
return(host);
} /* hostname */
/*************
*
* void interact()
*
* This routine provides some primitive interaction with the user.
*
*************/
void interact(void)
{
FILE *fin, *fout;
struct term *t;
int rc, go_back;
char *help_string;
static int fork_level = 0;
if (!Flags[SIGINT_INTERACT].val) {
fprintf(stderr, "\n%cSearch stopped by SIGINT.\n\n", Bell);
fprintf(stdout, "\nSearch stopped by SIGINT.\n");
exit(INTERACTIVE_EXIT);
}
fin = fopen("/dev/tty", "r");
fout = fopen("/dev/tty", "w");
help_string = "Commands are help, kill, continue, set(_), clear(_), assign(_,_),\n usable, sos, demodulators, passive, stats, fork, and options.\n All commands end with a period.\n";
if (!fin || !fout) {
printf("interaction failure: cannot find tty.\n");
fprintf(stderr, "interaction failure: cannot find tty.\n");
}
else {
printf("\n--- Begin interaction (level %d) ---\n\n", fork_level);
fprintf(fout, "\n--- Begin interaction (level %d) ---\n\n", fork_level);
fprintf(fout, "Type `help.' for the list of commands.\n> ");
fflush(fout);
t = read_term(fin, &rc);
go_back = 0;
while (!go_back) {
if (!t) {
if (rc == 1) {
fprintf(fout, " Received end-of-file character.\n");
go_back = 1;
}
else
fprintf(fout, " Malformed term.\n");
}
else if (t->type == NAME) {
if (str_ident("help", sn_to_str(t->sym_num))) {
fprintf(fout, "%s", help_string);
}
else if (str_ident("fork", sn_to_str(t->sym_num))) {
#ifdef TP_FORK
int fork_status;
fflush(stdout); fflush(fout);
fork_status = fork();
if (fork_status < 0) {
fprintf(fout, "%c\nFork failed.\n", Bell);
printf("\nFork failed.\n");
}
else if (fork_status == 0) { /* child process */
fork_level++;
fprintf(fout, "\nLevel %d process started and running (waiting for commands);\nlevel %d process will resume when %d finishes.\n", fork_level, fork_level-1, fork_level);
printf("\nLevel %d process started and running.\n", fork_level);
}
else { /* parent process */
#ifdef TP_SIGNAL
/* Ignore interrupt while waiting. This is necessary
* because interrupting a child also interrupts
* the parent.
*/
signal(SIGINT, SIG_IGN);
#endif
wait(0); /* for child process to finish */
#ifdef TP_SIGNAL
signal(SIGINT, sig_handler);
#endif
printf("\n--- Continue interaction at level %d ---\n\n",
fork_level);
fprintf(fout, "\n--- Continue interaction at level %d ---\n\n", fork_level);
fflush(fout);
}
#else /* TP_FORK not defined */
fprintf(fout,"The fork operation is not available, because"
" TP_FORK was not defined during compilation.\n");
#endif
}
else if (str_ident("stats", sn_to_str(t->sym_num))) {
output_stats(fout, Parms[STATS_LEVEL].val);
output_stats(stdout, Parms[STATS_LEVEL].val);
fflush(stdout);
}
else if (str_ident("kill", sn_to_str(t->sym_num))) {
printf("\nkilled level %d search during interaction.\n", fork_level);
fprintf(fout, "killed level %d search during interaction.\n", fork_level);
fprintf(fout, " ok.\n");
fclose(fin);
fclose(fout);
cleanup();
exit(INTERACTIVE_EXIT);
}
else if (str_ident("continue", sn_to_str(t->sym_num))) {
fprintf(fout, " ok.");
go_back = 1;
}
else if (str_ident("sos", sn_to_str(t->sym_num))) {
struct clause *c;
for (c = Sos->first_cl; c; c = c->next_cl)
print_clause(fout, c);
}
else if (str_ident("usable", sn_to_str(t->sym_num))) {
struct clause *c;
for (c = Usable->first_cl; c; c = c->next_cl)
print_clause(fout, c);
}
else if (str_ident("demodulators", sn_to_str(t->sym_num))) {
struct clause *c;
for (c = Demodulators->first_cl; c; c = c->next_cl)
print_clause(fout, c);
}
else if (str_ident("passive", sn_to_str(t->sym_num))) {
struct clause *c;
for (c = Passive->first_cl; c; c = c->next_cl)
print_clause(fout, c);
}
else if (str_ident("options", sn_to_str(t->sym_num))) {
print_options(stdout);
print_options(fout);
}
else if (str_ident("symbols", sn_to_str(t->sym_num))) {
print_syms(stdout);
print_syms(fout);
}
else
fprintf(fout, " command not understood.\n");
}
else if (str_ident("set", sn_to_str(t->sym_num))) {
if (change_flag(fout, t, 1)) {
print_term(stdout, t); printf(".\n");
}
}
else if (str_ident("clear", sn_to_str(t->sym_num))) {
if (change_flag(fout, t, 0)) {
print_term(stdout, t); printf(".\n");
}
}
else if (str_ident("assign", sn_to_str(t->sym_num))) {
if (change_parm(fout, t)) {
print_term(stdout, t); printf(".\n");
}
}
else
fprintf(fout, " Command not understood.\n");
if (t)
zap_term(t);
if (!go_back) {
fprintf(fout, " ok.\n> ");
fflush(fout);
t = read_term(fin, &rc);
}
}
printf("\n--- End interaction, continue search at level %d ---\n\n", fork_level);
fprintf(fout,"\n--- End interaction, continue search at level %d ---\n", fork_level);
fclose(fin);
fclose(fout);
fflush(stdout);
}
} /* interact */
/*************
*
* init_log_for_x_show()
*
*************/
FILE *init_log_for_x_show(void)
{
char s[20];
int ppid = 0;
#ifdef TP_NAMES
ppid = getppid(); /* parent PID */
#endif
sprintf(s, "Xlog_%d", ppid);
return(fopen(s, "w"));
} /* init_log_for_x_show */
/*************
*
* my_process_id()
*
*************/
int my_process_id(void)
{
#ifdef TP_FORK
return getpid();
#else
return 0;
#endif
} /* my_process_id */
./otter/options.c 0000744 0002044 0001012 00000103357 11120534451 012315 0 ustar beeson /*
* options.c -- Routines to manage flags and parameters.
*
*/
#include "header.h"
#ifdef SCOTT
#include "called_by_otter.h" /* SCOTT protos seen by OTTER */
#endif
/*************
*
* init_options()
*
*************/
void init_options(void)
{
int i;
for (i = 0; i < MAX_FLAGS; i++)
Flags[i].name = "";
for (i = 0; i < MAX_PARMS; i++)
Parms[i].name = "";
/* flags are boolean valued options */
Flags[BINARY_RES].name = "binary_res";
Flags[BINARY_RES].val = 0;
Flags[HYPER_RES].name = "hyper_res";
Flags[HYPER_RES].val = 0;
Flags[NEG_HYPER_RES].name = "neg_hyper_res";
Flags[NEG_HYPER_RES].val = 0;
Flags[UR_RES].name = "ur_res";
Flags[UR_RES].val = 0;
Flags[PARA_FROM].name = "para_from";
Flags[PARA_FROM].val = 0;
Flags[PARA_INTO].name = "para_into";
Flags[PARA_INTO].val = 0;
Flags[PARA_FROM_LEFT].name = "para_from_left";
Flags[PARA_FROM_LEFT].val = 1;
Flags[PARA_FROM_RIGHT].name = "para_from_right";
Flags[PARA_FROM_RIGHT].val = 1;
Flags[PARA_FROM_VARS].name = "para_from_vars";
Flags[PARA_FROM_VARS].val = 0;
Flags[PARA_INTO_VARS].name = "para_into_vars";
Flags[PARA_INTO_VARS].val = 0;
Flags[PARA_INTO_LEFT].name = "para_into_left";
Flags[PARA_INTO_LEFT].val = 1;
Flags[PARA_INTO_RIGHT].name = "para_into_right";
Flags[PARA_INTO_RIGHT].val = 1;
Flags[PARA_ONES_RULE].name = "para_ones_rule";
Flags[PARA_ONES_RULE].val = 0;
Flags[PARA_ALL].name = "para_all";
Flags[PARA_ALL].val = 0;
Flags[DEMOD_INF].name = "demod_inf";
Flags[DEMOD_INF].val = 0;
Flags[DEMOD_LINEAR].name = "demod_linear";
Flags[DEMOD_LINEAR].val = 0;
Flags[VERY_VERBOSE].name = "very_verbose";
Flags[VERY_VERBOSE].val = 0;
Flags[FOR_SUB_FPA].name = "for_sub_fpa";
Flags[FOR_SUB_FPA].val = 0;
Flags[FOR_SUB].name = "for_sub";
Flags[FOR_SUB].val = 1;
Flags[BACK_SUB].name = "back_sub";
Flags[BACK_SUB].val = 1;
Flags[FREE_ALL_MEM].name = "free_all_mem";
Flags[FREE_ALL_MEM].val = 0;
Flags[NO_FAPL].name = "no_fapl";
Flags[NO_FAPL].val = 0;
Flags[NO_FANL].name = "no_fanl";
Flags[NO_FANL].val = 0;
Flags[FACTOR].name = "factor";
Flags[FACTOR].val = 0;
Flags[PRINT_KEPT].name = "print_kept";
Flags[PRINT_KEPT].val = 1;
Flags[DEMOD_HISTORY].name = "demod_history";
Flags[DEMOD_HISTORY].val = 1;
Flags[UNIT_DELETION].name = "unit_deletion";
Flags[UNIT_DELETION].val = 0;
Flags[SORT_LITERALS].name = "sort_literals";
Flags[SORT_LITERALS].val = 0;
Flags[PRINT_GIVEN].name = "print_given";
Flags[PRINT_GIVEN].val = 1;
Flags[PRINT_BACK_SUB].name = "print_back_sub";
Flags[PRINT_BACK_SUB].val = 1;
Flags[CHECK_ARITY].name = "check_arity";
Flags[CHECK_ARITY].val = 1;
Flags[SOS_QUEUE].name = "sos_queue";
Flags[SOS_QUEUE].val = 0;
Flags[ATOM_WT_MAX_ARGS].name = "atom_wt_max_args";
Flags[ATOM_WT_MAX_ARGS].val = 0;
Flags[TERM_WT_MAX_ARGS].name = "term_wt_max_args";
Flags[TERM_WT_MAX_ARGS].val = 0;
Flags[PRINT_LISTS_AT_END].name = "print_lists_at_end";
Flags[PRINT_LISTS_AT_END].val = 0;
Flags[ORDER_EQ].name = "order_eq";
Flags[ORDER_EQ].val = 0;
Flags[DYNAMIC_DEMOD].name = "dynamic_demod";
Flags[DYNAMIC_DEMOD].val = 0;
Flags[BACK_DEMOD].name = "back_demod";
Flags[BACK_DEMOD].val = 0;
Flags[PRINT_NEW_DEMOD].name = "print_new_demod";
Flags[PRINT_NEW_DEMOD].val = 1;
Flags[PRINT_BACK_DEMOD].name = "print_back_demod";
Flags[PRINT_BACK_DEMOD].val = 1;
Flags[DEMOD_OUT_IN].name = "demod_out_in";
Flags[DEMOD_OUT_IN].val = 0;
Flags[PROCESS_INPUT].name = "process_input";
Flags[PROCESS_INPUT].val = 0;
Flags[SIMPLIFY_FOL].name = "simplify_fol";
Flags[SIMPLIFY_FOL].val = 1;
Flags[KNUTH_BENDIX].name = "knuth_bendix";
Flags[KNUTH_BENDIX].val = 0;
Flags[PRINT_PROOFS].name = "print_proofs";
Flags[PRINT_PROOFS].val = 1;
Flags[SYMBOL_ELIM].name = "symbol_elim";
Flags[SYMBOL_ELIM].val = 0;
Flags[LEX_ORDER_VARS].name = "lex_order_vars";
Flags[LEX_ORDER_VARS].val = 0;
Flags[DYNAMIC_DEMOD_ALL].name = "dynamic_demod_all";
Flags[DYNAMIC_DEMOD_ALL].val = 0;
Flags[DELETE_IDENTICAL_NESTED_SKOLEM].name = "delete_identical_nested_skolem";
Flags[DELETE_IDENTICAL_NESTED_SKOLEM].val = 0;
Flags[PARA_FROM_UNITS_ONLY].name = "para_from_units_only";
Flags[PARA_FROM_UNITS_ONLY].val = 0;
Flags[PARA_INTO_UNITS_ONLY].name = "para_into_units_only";
Flags[PARA_INTO_UNITS_ONLY].val = 0;
Flags[REALLY_DELETE_CLAUSES].name = "really_delete_clauses";
Flags[REALLY_DELETE_CLAUSES].val = 0;
Flags[LRPO].name = "lrpo";
Flags[LRPO].val = 0;
Flags[PROLOG_STYLE_VARIABLES].name = "prolog_style_variables";
Flags[PROLOG_STYLE_VARIABLES].val = 0;
Flags[LAMBDA_FLAG].name = "lambda"; // Beeson 8.1.02, changed to "lambda" 5.6.04
Flags[LAMBDA_FLAG].val = 0; // Beeson 8.1.02
Flags[TYPES_FLAG].name = "types"; // Beeson 5.10.04
Flags[TYPES_FLAG].val = 0; // Beeson 5.10.04
Flags[CASES_FLAG].name = "cases"; // Beeson 7.23.03
Flags[CASES_FLAG].val = 0; // Beeson 7.23.03
Flags[INDUCTION_FLAG].name = "induction"; // Beeson 7.23.03
Flags[INDUCTION_FLAG].val = 0; // Beeson 7.23.03
Flags[BIGNUM_FLAG].name = "bignums"; // Beeson 10.21.03
Flags[BIGNUM_FLAG].val = 0; // Beeson 10.21.03
Flags[SIMPLIFY_FLAG].name = "simplify"; // Beeson 10.21.03
Flags[SIMPLIFY_FLAG].val = 0; // Beeson 10.21.03
Flags[SIMPLIFYRULE_FLAG].name = "simplify_rule"; // Beeson 7.22.05
Flags[SIMPLIFYRULE_FLAG].val = 0; // Beeson 7.22.05
Flags[SOLVE_FLAG].name = "solve"; // Beeson 11.01.03
Flags[SOLVE_FLAG].val = 0; // Beeson 11.01.03
Flags[TYPESAFE_FLAG].name = "typesafe"; // Beeson 7.29.05
Flags[TYPESAFE_FLAG].val = 0; // Beeson 7.29.05
Flags[SOS_STACK].name = "sos_stack";
Flags[SOS_STACK].val = 0;
Flags[DYNAMIC_DEMOD_LEX_DEP].name = "dynamic_demod_lex_dep";
Flags[DYNAMIC_DEMOD_LEX_DEP].val = 0;
Flags[PROG_SYNTHESIS].name = "prog_synthesis";
Flags[PROG_SYNTHESIS].val = 0;
Flags[ANCESTOR_SUBSUME].name = "ancestor_subsume";
Flags[ANCESTOR_SUBSUME].val = 0;
Flags[INPUT_SOS_FIRST].name = "input_sos_first";
Flags[INPUT_SOS_FIRST].val = 0;
Flags[LINKED_UR_RES].name = "linked_ur_res";
Flags[LINKED_UR_RES].val = 0;
Flags[LINKED_UR_TRACE].name = "linked_ur_trace";
Flags[LINKED_UR_TRACE].val = 0;
Flags[PARA_SKIP_SKOLEM].name = "para_skip_skolem";
Flags[PARA_SKIP_SKOLEM].val = 0;
Flags[INDEX_FOR_BACK_DEMOD].name = "index_for_back_demod";
Flags[INDEX_FOR_BACK_DEMOD].val = 1;
Flags[LINKED_SUB_UNIT_USABLE].name = "linked_sub_unit_usable";
Flags[LINKED_SUB_UNIT_USABLE].val = 0;
Flags[LINKED_SUB_UNIT_SOS].name = "linked_sub_unit_sos";
Flags[LINKED_SUB_UNIT_SOS].val = 0;
Flags[LINKED_UNIT_DEL].name = "linked_unit_del";
Flags[LINKED_UNIT_DEL].val = 0;
Flags[LINKED_TARGET_ALL].name = "linked_target_all";
Flags[LINKED_TARGET_ALL].val = 0;
Flags[LINKED_HYPER_RES].name = "linked_hyper_res";
Flags[LINKED_HYPER_RES].val = 0;
Flags[CONTROL_MEMORY].name = "control_memory";
Flags[CONTROL_MEMORY].val = 0;
Flags[ORDER_HISTORY].name = "order_history";
Flags[ORDER_HISTORY].val = 0;
Flags[DISPLAY_TERMS].name = "display_terms";
Flags[DISPLAY_TERMS].val = 0;
Flags[GEOMETRIC_RULE].name = "geometric_rule";
Flags[GEOMETRIC_RULE].val = 0;
Flags[GEOMETRIC_REWRITE_BEFORE].name = "geometric_rewrite_before";
Flags[GEOMETRIC_REWRITE_BEFORE].val = 0;
Flags[GEOMETRIC_REWRITE_AFTER].name = "geometric_rewrite_after";
Flags[GEOMETRIC_REWRITE_AFTER].val = 0;
Flags[PRETTY_PRINT].name = "pretty_print";
Flags[PRETTY_PRINT].val = 0;
Flags[INPUT_SEQUENT].name = "input_sequent";
Flags[INPUT_SEQUENT].val = 0;
Flags[OUTPUT_SEQUENT].name = "output_sequent";
Flags[OUTPUT_SEQUENT].val = 0;
Flags[ECHO_INCLUDED_FILES].name = "echo_included_files";
Flags[ECHO_INCLUDED_FILES].val = 1;
Flags[INTERACTIVE_GIVEN].name = "interactive_given";
Flags[INTERACTIVE_GIVEN].val = 0;
Flags[DETAILED_HISTORY].name = "detailed_history";
Flags[DETAILED_HISTORY].val = 1;
Flags[ORDER_HYPER].name = "order_hyper";
Flags[ORDER_HYPER].val = 1;
Flags[PROPOSITIONAL].name = "propositional";
Flags[PROPOSITIONAL].val = 0;
Flags[AUTO].name = "auto";
Flags[AUTO].val = 0;
Flags[AUTO1].name = "auto1";
Flags[AUTO1].val = 0;
Flags[AUTO2].name = "auto2";
Flags[AUTO2].val = 0;
Flags[EQ_UNITS_BOTH_WAYS].name = "eq_units_both_ways";
Flags[EQ_UNITS_BOTH_WAYS].val = 0;
Flags[BIRD_PRINT].name = "bird_print";
Flags[BIRD_PRINT].val = 0;
Flags[BUILD_PROOF_OBJECT].name = "build_proof_object";
Flags[BUILD_PROOF_OBJECT].val = 0;
Flags[BUILD_PROOF_OBJECT_2].name = "build_proof_object_2";
Flags[BUILD_PROOF_OBJECT_2].val = 0;
Flags[LOG_FOR_X_SHOW].name = "log_for_x_show";
Flags[LOG_FOR_X_SHOW].val = 0;
Flags[FORMULA_HISTORY].name = "formula_history";
Flags[FORMULA_HISTORY].val = 0;
Flags[KEEP_HINT_SUBSUMERS].name = "keep_hint_subsumers";
Flags[KEEP_HINT_SUBSUMERS].val = 0;
Flags[KEEP_HINT_EQUIVALENTS].name = "keep_hint_equivalents";
Flags[KEEP_HINT_EQUIVALENTS].val = 0;
Flags[PROOF_WEIGHT].name = "proof_weight";
Flags[PROOF_WEIGHT].val = 0;
Flags[HYPER_SYMMETRY_KLUDGE].name = "hyper_symmetry_kludge";
Flags[HYPER_SYMMETRY_KLUDGE].val = 0;
Flags[GL_DEMOD].name = "gl_demod";
Flags[GL_DEMOD].val = 0;
Flags[DP_INT_DOMAIN].name = "dp_int_domain";
Flags[DP_INT_DOMAIN].val = 1;
Flags[DISCARD_NON_ORIENTABLE_EQ].name = "discard_non_orientable_eq";
Flags[DISCARD_NON_ORIENTABLE_EQ].val = 0;
Flags[DISCARD_XX_RESOLVABLE].name = "discard_xx_resolvable";
Flags[DISCARD_XX_RESOLVABLE].val = 0;
Flags[TPTP_EQ].name = "tptp_eq";
Flags[TPTP_EQ].val = 0;
Flags[BELL].name = "bell";
Flags[BELL].val = 1; /* Do not set default to 0 */
Flags[BACK_UNIT_DELETION].name = "back_unit_deletion";
Flags[BACK_UNIT_DELETION].val = 0;
Flags[SPLIT_CLAUSE].name = "split_clause";
Flags[SPLIT_CLAUSE].val = 0;
Flags[SPLIT_POS].name = "split_pos";
Flags[SPLIT_POS].val = 0;
Flags[SPLIT_NEG].name = "split_neg";
Flags[SPLIT_NEG].val = 0;
Flags[SPLIT_NONHORN].name = "split_nonhorn";
Flags[SPLIT_NONHORN].val = 0;
Flags[SPLIT_MIN_MAX].name = "split_min_max";
Flags[SPLIT_MIN_MAX].val = 0;
Flags[SPLIT_ATOM].name = "split_atom";
Flags[SPLIT_ATOM].val = 0;
Flags[SPLIT_POPULAR].name = "split_popular";
Flags[SPLIT_POPULAR].val = 0;
Flags[SPLIT_WHEN_GIVEN].name = "split_when_given";
Flags[SPLIT_WHEN_GIVEN].val = 0;
Flags[UNIT_RES].name = "unit_res";
Flags[UNIT_RES].val = 0;
Flags[SIGINT_INTERACT].name = "sigint_interact";
Flags[SIGINT_INTERACT].val = 1;
Flags[UR_LAST].name = "ur_last";
Flags[UR_LAST].val = 0;
Flags[LITERALS_WEIGH_ONE].name = "literals_weigh_one";
Flags[LITERALS_WEIGH_ONE].val = 0;
Flags[PICK_DIFF_SIM].name = "pick_diff_sim";
Flags[PICK_DIFF_SIM].val = 0;
Flags[PICK_RANDOM_LIGHTEST].name = "pick_random_lightest";
Flags[PICK_RANDOM_LIGHTEST].val = 0;
Flags[PICK_LAST_LIGHTEST].name = "pick_last_lightest";
Flags[PICK_LAST_LIGHTEST].val = 0;
Flags[PICK_MID_LIGHTEST].name = "pick_mid_lightest";
Flags[PICK_MID_LIGHTEST].val = 0;
Flags[SOS_ARG].name = "sos_arg";
Flags[SOS_ARG].val = 0;
Flags[FOR_SUB_EQUIVALENTS_ONLY].name = "for_sub_equivalents_only";
Flags[FOR_SUB_EQUIVALENTS_ONLY].val = 0;
/* parms are integer valued options */
Parms[FPA_LITERALS].name = "fpa_literals";
Parms[FPA_LITERALS].val = 8;
Parms[FPA_LITERALS].min = 0;
Parms[FPA_LITERALS].max = 100; /* check MAX_PATH before increasing */
Parms[FPA_TERMS].name = "fpa_terms";
Parms[FPA_TERMS].val = 8;
Parms[FPA_TERMS].min = 0;
Parms[FPA_TERMS].max = 100; /* check MAX_PATH before increasing */
Parms[DEMOD_LIMIT].name = "demod_limit";
Parms[DEMOD_LIMIT].val = 1000;
Parms[DEMOD_LIMIT].min = -1;
Parms[DEMOD_LIMIT].max = MAX_INT;
Parms[MAX_WEIGHT].name = "max_weight";
Parms[MAX_WEIGHT].val = MAX_INT;
Parms[MAX_WEIGHT].min = -MAX_INT;
Parms[MAX_WEIGHT].max = MAX_INT;
Parms[MAX_GIVEN].name = "max_given";
Parms[MAX_GIVEN].val = -1;
Parms[MAX_GIVEN].min = -1;
Parms[MAX_GIVEN].max = MAX_INT;
Parms[MAX_SECONDS].name = "max_seconds";
Parms[MAX_SECONDS].val = -1;
Parms[MAX_SECONDS].min = -1;
Parms[MAX_SECONDS].max = MAX_INT;
Parms[NEG_WEIGHT].name = "neg_weight";
Parms[NEG_WEIGHT].val = 0;
Parms[NEG_WEIGHT].min = -MAX_INT;
Parms[NEG_WEIGHT].max = MAX_INT;
Parms[MAX_KEPT].name = "max_kept";
Parms[MAX_KEPT].val = -1;
Parms[MAX_KEPT].min = -1;
Parms[MAX_KEPT].max = MAX_INT;
Parms[MAX_GEN].name = "max_gen";
Parms[MAX_GEN].val = -1;
Parms[MAX_GEN].min = -1;
Parms[MAX_GEN].max = MAX_INT;
Parms[MAX_MEM].name = "max_mem";
Parms[MAX_MEM].val = -1;
Parms[MAX_MEM].min = -1;
Parms[MAX_MEM].max = MAX_INT;
Parms[MAX_LITERALS].name = "max_literals";
Parms[MAX_LITERALS].val = -1;
Parms[MAX_LITERALS].min = -1;
Parms[MAX_LITERALS].max = MAX_INT;
Parms[REPORT].name = "report";
Parms[REPORT].val = -1;
Parms[REPORT].min = -1;
Parms[REPORT].max = MAX_INT;
Parms[MAX_PROOFS].name = "max_proofs";
Parms[MAX_PROOFS].val = 1;
Parms[MAX_PROOFS].min = -1;
Parms[MAX_PROOFS].max = MAX_INT;
Parms[STATS_LEVEL].name = "stats_level";
Parms[STATS_LEVEL].val = 2;
Parms[STATS_LEVEL].min = 0;
Parms[STATS_LEVEL].max = 4;
#ifdef SCOTT
/* negetaive values for "nonlinear" alternatives */
Parms[STATS_LEVEL].min = -2;
#endif
Parms[MAX_UR_DEPTH].name = "max_ur_depth";
Parms[MAX_UR_DEPTH].val = 5;
Parms[MAX_UR_DEPTH].min = 0;
Parms[MAX_UR_DEPTH].max = 100;
Parms[MAX_UR_DED_SIZE].name = "max_ur_deduction_size";
Parms[MAX_UR_DED_SIZE].val = 20;
Parms[MAX_UR_DED_SIZE].min = 0;
Parms[MAX_UR_DED_SIZE].max = 100;
Parms[MAX_DISTINCT_VARS].name = "max_distinct_vars";
Parms[MAX_DISTINCT_VARS].val = -1;
Parms[MAX_DISTINCT_VARS].min = -1;
Parms[MAX_DISTINCT_VARS].max = MAX_INT;
Parms[MAX_BINDING_DEPTH].name = "max_binding_depth";
Parms[MAX_BINDING_DEPTH].val = -1;
Parms[MAX_BINDING_DEPTH].min = -1;
Parms[MAX_BINDING_DEPTH].max = MAX_INT;
Parms[PICK_GIVEN_RATIO].name = "pick_given_ratio";
Parms[PICK_GIVEN_RATIO].val = -1;
Parms[PICK_GIVEN_RATIO].min = -1;
Parms[PICK_GIVEN_RATIO].max = MAX_INT;
Parms[CHANGE_LIMIT_AFTER].name = "change_limit_after";
Parms[CHANGE_LIMIT_AFTER].val = 0;
Parms[CHANGE_LIMIT_AFTER].min = 0;
Parms[CHANGE_LIMIT_AFTER].max = MAX_INT;
Parms[NEW_MAX_WEIGHT].name = "new_max_weight";
Parms[NEW_MAX_WEIGHT].val = MAX_INT;
Parms[NEW_MAX_WEIGHT].min = -MAX_INT;
Parms[NEW_MAX_WEIGHT].max = MAX_INT;
Parms[GEO_GIVEN_RATIO].name = "geo_given_ratio";
Parms[GEO_GIVEN_RATIO].val = 1;
Parms[GEO_GIVEN_RATIO].min = -1;
Parms[GEO_GIVEN_RATIO].max = MAX_INT;
Parms[PRETTY_PRINT_INDENT].name = "pretty_print_indent";
Parms[PRETTY_PRINT_INDENT].val = 4;
Parms[PRETTY_PRINT_INDENT].min = 0;
Parms[PRETTY_PRINT_INDENT].max = 16;
Parms[MIN_BIT_WIDTH].name = "min_bit_width";
Parms[MIN_BIT_WIDTH].val = sizeof(unsigned long) * CHAR_BIT;
Parms[MIN_BIT_WIDTH].min = 1;
Parms[MIN_BIT_WIDTH].max = sizeof(unsigned long) * CHAR_BIT;
Parms[INTERRUPT_GIVEN].name = "interrupt_given";
Parms[INTERRUPT_GIVEN].val = -1;
Parms[INTERRUPT_GIVEN].min = -1;
Parms[INTERRUPT_GIVEN].max = MAX_INT;
Parms[HEAT].name = "heat";
Parms[HEAT].val = 1;
Parms[HEAT].min = 0;
Parms[HEAT].max = 100;
Parms[DYNAMIC_HEAT_WEIGHT].name = "dynamic_heat_weight";
Parms[DYNAMIC_HEAT_WEIGHT].val = -MAX_INT;
Parms[DYNAMIC_HEAT_WEIGHT].min = -MAX_INT;
Parms[DYNAMIC_HEAT_WEIGHT].max = MAX_INT;
Parms[MAX_ANSWERS].name = "max_answers";
Parms[MAX_ANSWERS].val = -1;
Parms[MAX_ANSWERS].min = -1;
Parms[MAX_ANSWERS].max = MAX_INT;
Parms[DEBUG_FIRST].name = "debug_first";
Parms[DEBUG_FIRST].val = 0;
Parms[DEBUG_FIRST].min = 0;
Parms[DEBUG_FIRST].max = MAX_INT;
Parms[DEBUG_LAST].name = "debug_last";
Parms[DEBUG_LAST].val = -1;
Parms[DEBUG_LAST].min = -1;
Parms[DEBUG_LAST].max = MAX_INT;
Parms[FSUB_HINT_ADD_WT].name = "fsub_hint_add_wt";
Parms[FSUB_HINT_ADD_WT].val = 0;
Parms[FSUB_HINT_ADD_WT].min = -MAX_INT;
Parms[FSUB_HINT_ADD_WT].max = MAX_INT;
Parms[BSUB_HINT_ADD_WT].name = "bsub_hint_add_wt";
Parms[BSUB_HINT_ADD_WT].val = 0;
Parms[BSUB_HINT_ADD_WT].min = -MAX_INT;
Parms[BSUB_HINT_ADD_WT].max = MAX_INT;
Parms[EQUIV_HINT_ADD_WT].name = "equiv_hint_add_wt";
Parms[EQUIV_HINT_ADD_WT].val = 0;
Parms[EQUIV_HINT_ADD_WT].min = -MAX_INT;
Parms[EQUIV_HINT_ADD_WT].max = MAX_INT;
Parms[FSUB_HINT_WT].name = "fsub_hint_wt";
Parms[FSUB_HINT_WT].val = MAX_INT;
Parms[FSUB_HINT_WT].min = -MAX_INT;
Parms[FSUB_HINT_WT].max = MAX_INT;
Parms[BSUB_HINT_WT].name = "bsub_hint_wt";
Parms[BSUB_HINT_WT].val = MAX_INT;
Parms[BSUB_HINT_WT].min = -MAX_INT;
Parms[BSUB_HINT_WT].max = MAX_INT;
Parms[EQUIV_HINT_WT].name = "equiv_hint_wt";
Parms[EQUIV_HINT_WT].val = MAX_INT;
Parms[EQUIV_HINT_WT].min = -MAX_INT;
Parms[EQUIV_HINT_WT].max = MAX_INT;
Parms[VERBOSE_DEMOD_SKIP].name = "verbose_demod_skip";
Parms[VERBOSE_DEMOD_SKIP].val = 0;
Parms[VERBOSE_DEMOD_SKIP].min = 0;
Parms[VERBOSE_DEMOD_SKIP].max = MAX_INT;
Parms[DYNAMIC_DEMOD_DEPTH].name = "dynamic_demod_depth";
Parms[DYNAMIC_DEMOD_DEPTH].val = -1;
Parms[DYNAMIC_DEMOD_DEPTH].min = -1;
Parms[DYNAMIC_DEMOD_DEPTH].max = MAX_INT;
Parms[DYNAMIC_DEMOD_RHS].name = "dynamic_demod_rhs";
Parms[DYNAMIC_DEMOD_RHS].val = 1;
Parms[DYNAMIC_DEMOD_RHS].min = -MAX_INT;
Parms[DYNAMIC_DEMOD_RHS].max = MAX_INT;
Parms[AGE_FACTOR].name = "age_factor";
Parms[AGE_FACTOR].val = 0;
Parms[AGE_FACTOR].min = -MAX_INT;
Parms[AGE_FACTOR].max = MAX_INT;
Parms[DISTINCT_VARS_FACTOR].name = "distinct_vars_factor";
Parms[DISTINCT_VARS_FACTOR].val = 0;
Parms[DISTINCT_VARS_FACTOR].min = -MAX_INT;
Parms[DISTINCT_VARS_FACTOR].max = MAX_INT;
Parms[NEW_SYMBOL_LEX_POSITION].name = "new_symbol_lex_position";
Parms[NEW_SYMBOL_LEX_POSITION].val = MAX_INT / 2;
Parms[NEW_SYMBOL_LEX_POSITION].min = 1;
Parms[NEW_SYMBOL_LEX_POSITION].max = MAX_INT / 2;
Parms[WARN_MEM].name = "warn_mem";
Parms[WARN_MEM].val = -1;
Parms[WARN_MEM].min = -1;
Parms[WARN_MEM].max = MAX_INT;
Parms[WARN_MEM_MAX_WEIGHT].name = "warn_mem_max_weight";
Parms[WARN_MEM_MAX_WEIGHT].val = MAX_INT;
Parms[WARN_MEM_MAX_WEIGHT].min = -MAX_INT;
Parms[WARN_MEM_MAX_WEIGHT].max = MAX_INT;
Parms[SPLIT_SECONDS].name = "split_seconds";
Parms[SPLIT_SECONDS].val = -1;
Parms[SPLIT_SECONDS].min = -1;
Parms[SPLIT_SECONDS].max = MAX_INT;
Parms[SPLIT_GIVEN].name = "split_given";
Parms[SPLIT_GIVEN].val = 5;
Parms[SPLIT_GIVEN].min = -1;
Parms[SPLIT_GIVEN].max = MAX_INT;
Parms[SPLIT_DEPTH].name = "split_depth";
Parms[SPLIT_DEPTH].val = max_split_depth();
Parms[SPLIT_DEPTH].min = 1;
Parms[SPLIT_DEPTH].max = max_split_depth();
Parms[PICK_DIFF].name = "pick_diff";
Parms[PICK_DIFF].val = -1;
Parms[PICK_DIFF].min = -1;
Parms[PICK_DIFF].max = MAX_INT;
Parms[PICK_DIFF_RANGE].name = "pick_diff_range";
Parms[PICK_DIFF_RANGE].val = 0;
Parms[PICK_DIFF_RANGE].min = 0;
Parms[PICK_DIFF_RANGE].max = MAX_INT;
Parms[MAX_UNIFIERS].name = "max_unifiers"; // Beeson 5.20.04
Parms[MAX_UNIFIERS].val = 1;
Parms[MAX_UNIFIERS].min = 1;
Parms[MAX_UNIFIERS].max = 256;
} /* init_options */
/*************
*
* print_options(fp)
*
*************/
void print_options(FILE *fp)
{
int i, j;
fprintf(fp, "\n--------------- options ---------------\n");
j = 0;
for (i = 0; i < MAX_FLAGS; i++) /* print set flags */
if (Flags[i].name[0] != '\0') {
fprintf(fp, "%s", Flags[i].val ? "set(" : "clear(");
fprintf(fp, "%s). ", Flags[i].name);
j++;
if (j % 3 == 0)
fprintf(fp, "\n");
}
fprintf(fp, "\n\n");
j = 0;
for (i = 0; i < MAX_PARMS; i++) /* print parms */
if (Parms[i].name[0] != '\0') {
fprintf(fp, "assign(");
fprintf(fp, "%s, %d). ", Parms[i].name, Parms[i].val);
j++;
if (j % 3 == 0)
fprintf(fp, "\n");
}
fprintf(fp, "\n");
#ifdef SCOTT
print_scott_options(fp);
#endif
} /* print_options */
/*************
*
* p_options()
*
*************/
void p_options(void)
{
print_options(stdout);
} /* p_options */
/*************
*
* auto_change_flag()
*
*************/
void auto_change_flag(FILE *fp,
int index,
int val)
{
if (Flags[index].val != val) {
fprintf(fp, " dependent: %s(%s).\n",
val ? "set" : "clear", Flags[index].name);
Flags[index].val = val;
dependent_flags(fp, index);
}
} /* auto_change_flag */
/*************
*
* void dependent_flags(FILE *fp, int index)
*
* Flag[index] has just been changed. Change any flags or parms that
* depend on it. Write actions to *fp.
*
* Mutually recursive with auto_change_flag and auto_change_parm.
*
*************/
void dependent_flags(FILE *fp,
int index)
{
/* This part handles flags that have just been set. */
if (Flags[index].val) {
switch (index) {
case KNUTH_BENDIX:
auto_change_flag(fp, PARA_FROM, 1);
auto_change_flag(fp, PARA_INTO, 1);
auto_change_flag(fp, PARA_FROM_LEFT, 1);
auto_change_flag(fp, PARA_FROM_RIGHT, 0);
auto_change_flag(fp, PARA_INTO_LEFT, 1);
auto_change_flag(fp, PARA_INTO_RIGHT, 0);
auto_change_flag(fp, PARA_FROM_VARS, 1);
auto_change_flag(fp, EQ_UNITS_BOTH_WAYS, 1);
auto_change_flag(fp, DYNAMIC_DEMOD_ALL, 1);
auto_change_flag(fp, BACK_DEMOD, 1);
auto_change_flag(fp, PROCESS_INPUT, 1);
auto_change_flag(fp, LRPO, 1);
break;
case BACK_DEMOD:
auto_change_flag(fp, DYNAMIC_DEMOD, 1);
break;
case DYNAMIC_DEMOD_ALL:
auto_change_flag(fp, DYNAMIC_DEMOD, 1);
break;
case DYNAMIC_DEMOD:
auto_change_flag(fp, ORDER_EQ, 1);
break;
case BINARY_RES:
auto_change_flag(fp, FACTOR, 1);
auto_change_flag(fp, UNIT_DELETION, 1);
break;
case VERY_VERBOSE:
auto_change_flag(fp, PRINT_KEPT, 1);
break;
case PARA_ALL:
auto_change_flag(fp, DETAILED_HISTORY, 0);
break;
case PROPOSITIONAL:
auto_change_flag(fp, SORT_LITERALS, 1);
auto_change_flag(fp, PROCESS_INPUT, 1);
break;
case AUTO1: /* original auto mode (version 3.0.4) */
auto_change_flag(fp, PROCESS_INPUT, 1);
auto_change_flag(fp, PRINT_KEPT, 0);
auto_change_flag(fp, PRINT_NEW_DEMOD, 0);
auto_change_flag(fp, PRINT_BACK_DEMOD, 0);
auto_change_flag(fp, PRINT_BACK_SUB, 0);
auto_change_flag(fp, CONTROL_MEMORY, 1);
auto_change_parm(fp, MAX_MEM, 12000);
auto_change_parm(fp, PICK_GIVEN_RATIO, 4);
auto_change_parm(fp, STATS_LEVEL, 1);
auto_change_parm(fp, MAX_SECONDS, 10800);
/* other options are set after clauses are read */
break;
case AUTO2: /* revised auto mode (version 3.0.5) */
auto_change_flag(fp, PROCESS_INPUT, 1);
auto_change_flag(fp, PRINT_KEPT, 0);
auto_change_flag(fp, PRINT_NEW_DEMOD, 0);
auto_change_flag(fp, PRINT_BACK_DEMOD, 0);
auto_change_flag(fp, PRINT_BACK_SUB, 0);
auto_change_flag(fp, CONTROL_MEMORY, 1);
auto_change_parm(fp, MAX_MEM, 20000);
auto_change_parm(fp, PICK_GIVEN_RATIO, 4);
auto_change_parm(fp, STATS_LEVEL, 1);
auto_change_parm(fp, MAX_SECONDS, 10800);
/* other options are set after clauses are read */
break;
case AUTO: /* selects current auto mode */
auto_change_flag(fp, AUTO1, 1);
break;
case BUILD_PROOF_OBJECT:
auto_change_flag(fp, ORDER_HISTORY, 1);
auto_change_flag(fp, DETAILED_HISTORY, 1);
break;
case SPLIT_CLAUSE:
case SPLIT_ATOM:
case SPLIT_WHEN_GIVEN:
auto_change_flag(fp, BACK_UNIT_DELETION, 1);
auto_change_parm(fp, REPORT, -1);
break;
case BACK_UNIT_DELETION:
auto_change_flag(fp, UNIT_DELETION, 1);
break;
case BUILD_PROOF_OBJECT_2:
auto_change_flag(fp, BUILD_PROOF_OBJECT, 1);
break;
}
}
/* This part handles flags that have just been cleared. */
if (!Flags[index].val) {
switch (index) {
}
}
/* This part handles flags that have just been cleared. */
} /* dependent_flags */
/*************
*
* auto_change_parm()
*
*************/
void auto_change_parm(FILE *fp,
int index,
int val)
{
if (Parms[index].val != val) {
fprintf(fp, " dependent: assign(%s, %d).\n",
Parms[index].name, val);
Parms[index].val = val;
dependent_parms(fp, index);
}
} /* auto_change_parm */
/*************
*
* void dependent_parms(FILE *fp, int index)
*
* Parms[index] has just been changed. Change any flags or parms that
* depend on it. Write actions to *fp.
*
* Mutually recursive with auto_change_flag and auto_change_parm.
*
* This routine may be empty.
*
*************/
void dependent_parms(FILE *fp,
int index)
{
switch (index) {
}
} /* dependent_parms */
/*************
*
* int change_flag(fp, term, set)
*
* Assume term is COMPLEX, with either `set' or `clear' as functor.
*
* If success, return index of flag, if fail, return -1.
* Warning and error messages go to file fp.
*
*************/
int change_flag(FILE *fp,
struct term *t,
int set)
{
char *flag_name;
int index, found;
if (t->farg == NULL || t->farg->narg != NULL ||
t->farg->argval->type == COMPLEX) {
fprintf(fp, "ERROR: ");
print_term(fp, t);
fprintf(fp, " must have one simple argument.\n");
Stats[INPUT_ERRORS]++;
return(-1);
}
else {
flag_name = sn_to_str(t->farg->argval->sym_num);
#ifdef SCOTT
/* might be a SCOTT flag */
index = change_scott_flag(fp, t, flag_name, set);
if (index > -2) return(index);
#endif
found = 0;
index = 0;
while (index < MAX_FLAGS && !found)
if (str_ident(flag_name, Flags[index].name))
found = 1;
else
index++;
if (!found) {
fprintf(fp, "ERROR: ");
print_term(fp, t);
fprintf(fp, " flag name not found.\n");
Stats[INPUT_ERRORS]++;
if (str_ident(flag_name, "lex_rpo"))
fprintf(stderr, "\nERROR, flag `lex_rpo\' has been changed to `lrpo\'.\n");
else if (str_ident(flag_name, "print_level"))
fprintf(stderr, "\nERROR, flag `print_level\' no longer exists.\n");
else if (str_ident(flag_name, "new_functions"))
fprintf(stderr, "\nERROR, flag `new_functions\' no longer exists.\n");
else if (str_ident(flag_name, "bird_print"))
fprintf(stderr, "\nERROR, flag `bird_print\' no longer exists.\n");
return(-1);
}
else if (Flags[index].val == set) {
fprintf(fp, "WARNING: ");
print_term(fp, t);
if (set)
fprintf(fp, " flag already set.\n");
else
fprintf(fp, " flag already clear.\n");
return(index);
}
else {
Flags[index].val = set;
if (index == BELL)
Bell = set ? '\007' : '\000';
return(index);
}
}
} /* change_flag */
/*************
*
* int change_parm(fp, term)
*
* Assume term is COMPLEX, with either `assign' as functor.
*
* If success, return index of parm, if fail, return -1.
* Warning and error messages go to file fp.
*
*************/
int change_parm(FILE *fp,
struct term *t)
{
char *parm_name, *int_name;
int index, found, new_val, rc;
if (t->farg == NULL || t->farg->narg == NULL ||
t->farg->narg->narg != NULL ||
t->farg->argval->type == COMPLEX ||
t->farg->narg->argval->type == COMPLEX) {
fprintf(fp, "ERROR: ");
print_term(fp, t);
fprintf(fp, " must have two simple arguments.\n");
Stats[INPUT_ERRORS]++;
return(-1);
}
else {
parm_name = sn_to_str(t->farg->argval->sym_num);
#ifdef SCOTT
index = change_scott_parm(fp, t, parm_name);
if (index > -2) return(index);
#endif
found = 0;
index = 0;
while (index < MAX_PARMS && !found)
if (str_ident(parm_name, Parms[index].name))
found = 1;
else
index++;
if (!found) {
fprintf(fp, "ERROR: ");
print_term(fp, t);
fprintf(fp, " parameter name not found.\n");
Stats[INPUT_ERRORS]++;
if (str_ident(parm_name, "reduce_weight_limit")) {
fprintf(stderr, "\nERROR, parameter `reduce_weight_limit\' has been changed to\n");
fprintf(stderr, "the pair `change_limit_after\' and `new_max_weight\'.\n");
}
return(-1);
}
else {
int_name = sn_to_str(t->farg->narg->argval->sym_num);
rc = str_int(int_name, &new_val);
if (rc == 0) {
fprintf(fp, "ERROR: ");
print_term(fp, t);
fprintf(fp, " second argument must be integer.\n");
Stats[INPUT_ERRORS]++;
return(-1);
}
else if (new_val < Parms[index].min || new_val > Parms[index].max) {
fprintf(fp, "ERROR: ");
print_term(fp, t);
fprintf(fp, " integer must be in range [%d,%d].\n",
Parms[index].min, Parms[index].max);
Stats[INPUT_ERRORS]++;
return(-1);
}
else if (new_val == Parms[index].val) {
fprintf(fp, "WARNING: ");
print_term(fp, t);
fprintf(fp, " already has that value.\n");
return(index);
}
else {
Parms[index].val = new_val;
return(index);
}
}
}
} /* change_parm */
/*************
*
* check_options() -- check for inconsistent or odd settings
*
* If a bad combination of settings is found, either a warning
* message is printed, or an ABEND occurs.
*
*************/
void check_options(void)
{
if (Flags[BINARY_RES].val == 0 &&
Flags[HYPER_RES].val == 0 &&
Flags[NEG_HYPER_RES].val == 0 &&
Flags[UR_RES].val == 0 &&
Flags[PARA_FROM].val == 0 &&
Flags[PARA_INTO].val == 0 &&
Flags[DEMOD_INF].val == 0 &&
Flags[GEOMETRIC_RULE].val == 0 &&
Flags[LINKED_UR_RES].val == 0
#ifdef SCOTT
&& get_sem_res_flag() == 0
#endif
)
fprintf(stderr, "\nWARNING: no inference rules are set.\n");
if (Flags[PARA_FROM].val &&
Flags[PARA_FROM_RIGHT].val == 0 && Flags[PARA_FROM_LEFT].val == 0) {
fprintf(stderr, "\nWARNING: PARA_FROM is set, but PARA_FROM_LEFT and\nPARA_FROM_RIGHT are both clear.\n");
}
if (Flags[PARA_INTO].val &&
Flags[PARA_FROM_RIGHT].val == 0 && Flags[PARA_FROM_LEFT].val == 0) {
fprintf(stderr, "\nWARNING: PARA_INTO is set, but PARA_FROM_LEFT and\n");
fprintf(stderr, "PARA_FROM_RIGHT are both clear.\n");
}
if (Flags[PARA_FROM].val == 0 && Flags[PARA_INTO].val == 0 && Flags[PARA_ONES_RULE].val)
fprintf(stderr, "\nWARNING: PARA_FROM, PARA_INTO rules are clear, but PARA_ONES_RULE is set.\n");
if (Flags[NO_FAPL].val && Flags[HYPER_RES].val == 0)
fprintf(stderr, "\nWARNING: NO_FAPL is set, but HYPER_RES is clear.\n");
if (Flags[NO_FAPL].val && Flags[FOR_SUB_FPA].val)
fprintf(stderr, "\nWARNING: NO_FAPL and FOR_SUB_FPA are both set.\n");
if (Flags[NO_FAPL].val && Flags[BACK_SUB].val)
fprintf(stderr, "\nWARNING: NO_FAPL and BACK_SUB are both set.\n");
if (Flags[KNUTH_BENDIX].val && Flags[LRPO].val == 0)
fprintf(stderr, "\nWARNING: KNUTH_BENDIX is set and LRPO is clear.\n");
if (Parms[DEMOD_LIMIT].val == 0)
fprintf(stderr, "\nWARNING: demod_limit=0; set it to -1 for no limit.\n");
if (Parms[MAX_LITERALS].val == 0)
fprintf(stderr, "\nWARNING: max_literals=0; set it to -1 for no limit.\n");
if (Parms[MAX_PROOFS].val == 0)
fprintf(stderr, "\nWARNING: max_proofs=0; set it to -1 for no limit.\n");
/* selecting the given clause */
if (Flags[INTERACTIVE_GIVEN].val) {
if ( (Parms[PICK_GIVEN_RATIO].val != -1) ||
(Flags[SOS_STACK].val) ||
(Flags[SOS_QUEUE].val) ) {
fprintf(stderr,"WARNING: INTERACTIVE_GIVEN has highest precedence\n");
fprintf(stderr," for picking given clause.\n");
}
}
if (Parms[PICK_GIVEN_RATIO].val != -1) {
if (Flags[SOS_STACK].val)
fprintf(stderr,"\nWARNING: SOS_STACK has priority over PICK_GIVEN_RATIO.\n");
else if (Flags[SOS_QUEUE].val)
fprintf(stderr,"\nWARNING: SOS_QUEUE has priority over PICK_GIVEN_RATIO.\n");
}
if (Flags[SOS_STACK].val && Flags[SOS_QUEUE].val)
fprintf(stderr, "\nWARNING, SOS_QUEUE has priority over SOS_STACK.\n");
if (Flags[SOS_STACK].val && Flags[INPUT_SOS_FIRST].val)
fprintf(stderr, "\nWARNING, INPUT_SOS_FIRST ignored, because SOS_STACK is set.\n");
if (Flags[PARA_ALL].val && Flags[DETAILED_HISTORY].val)
fprintf(stderr, "\nWARNING, detailed paramod history is ignored when para_all is set.\n");
if ((Flags[SPLIT_CLAUSE].val ||
Flags[SPLIT_ATOM].val ||
Flags[SPLIT_WHEN_GIVEN].val)
&& Parms[MAX_SECONDS].val != -1)
fprintf(stderr, "\nWARNING, with splitting, max_seconds is checked against the wall clock.\n");
/* BV(970327) */
if (Flags[KEEP_HINT_SUBSUMERS].val && Flags[KEEP_HINT_EQUIVALENTS].val)
fprintf(stderr, "\nWARNING, keep_hint_subsumers is ignored when keep_hint_equivalents is set.\n");
#ifdef SCOTT
if ((get_semantic_guidance_flag() || get_dsc_flag()) &&
Flags[REALLY_DELETE_CLAUSES].val) {
fprintf(stderr, "\nWARNING, this may cause a segmentation violation ");
fprintf(stderr, "if elements from the semantic base are ever deleted.\n");
}
#endif
} /* check_options */
./otter/overbeek.c 0000744 0002044 0001012 00000012463 11120534451 012421 0 ustar beeson /*
overbeek.c -- experimental weighting method, Feb 2001.
To use this feature, input a list of weight/term pairs like this.
overbeek_world(junk).
0 # P(e(e(x,y),e(e(x,z),e(z,y)))).
0 # P(e(e(e(x,y),z),e(z,e(e(x,u),e(u,y))))).
0 # P(e(e(e(x,y),e(y,z)),e(e(x,u),e(u,z)))).
0 # P(e(e(e(x,x),y),e(y,e(z,z)))).
0 # P(e(e(e(x,x),e(y,y)),e(z,z))).
0 # P(e(x,x)).
0 # P(e(e(x,y),e(y,x))).
0 # P(e(e(e(x,y),z),e(z,e(y,x)))).
0 # P(e(e(e(x,y),e(y,z)),e(x,z))).
0 # P(e(e(x,y),e(e(z,y),e(x,z)))).
end_of_list.
Variable renumbering/renaming is applied to each term
before it is inserted into the hash table.
The ordinary term weighting routine, weight(t), first
calls overbeek_weight(t) below to try to (exact) match
a renumberd copy of t with one of the overbeek_world terms.
If nothing matches, the ordinary weighting method is applied.
Here's an example input file:
%
% Equivalential calculus (EC): YQF -> YQL (both are single axioms)
%
set(hyper_res).
assign(max_weight, 0).
list(usable).
-P(e(x,y)) | -P(x) | P(y). % condensed detachment
-P(e(e(a,b),e(e(c,b),e(a,c)))). % YQL
end_of_list.
list(sos).
P(e(e(x,y),e(e(x,z),e(z,y)))). % YQF
end_of_list.
overbeek_world(junk).
0 # P(e(e(x,y),e(e(x,z),e(z,y)))).
0 # P(e(e(e(x,y),z),e(z,e(e(x,u),e(u,y))))).
0 # P(e(e(e(x,y),e(y,z)),e(e(x,u),e(u,z)))).
0 # P(e(e(e(x,x),y),e(y,e(z,z)))).
0 # P(e(e(e(x,x),e(y,y)),e(z,z))).
0 # P(e(x,x)).
0 # P(e(e(x,y),e(y,x))).
0 # P(e(e(e(x,y),z),e(z,e(y,x)))).
0 # P(e(e(e(x,y),e(y,z)),e(x,z))).
0 # P(e(e(x,y),e(e(z,y),e(x,z)))).
end_of_list.
*/
#include "header.h"
#define OVERBEEK_WORLD_SIZE 25000 /* size of hash table */
/*************
*
* hash_term2(term)
*
* Return a hash value of a term: just a word of bits.
*
*************/
static unsigned hash_term2(struct term *t)
{
unsigned hashval = 0;
if (t->type == NAME)
hashval = t->sym_num;
else if (t->type == VARIABLE)
hashval = t->varnum;
else { /* complex */
struct rel *r;
hashval = t->sym_num;
for (r = t->farg; r != NULL; r = r->narg) {
hashval <<= 1; /* shift left */
hashval ^= hash_term2(r->argval); /* exclusive or */
}
}
return(hashval);
} /* hash_term2 */
/*************
*
* void overbeek_insert()
*
*************/
void overbeek_insert(struct term *t)
{
int i;
/* If this is the first call, allocate a hash table. */
if (Overbeek_world == NULL) {
int i;
Overbeek_world = (void *) malloc((size_t) (OVERBEEK_WORLD_SIZE * sizeof(void *)));
for (i = 0; i < OVERBEEK_WORLD_SIZE; i++)
Overbeek_world[i] = NULL;
}
if (!is_symbol(t, "#", 2))
abend("overbeek_insert, bad term");
else if (!str_int(sn_to_str(t->farg->argval->sym_num), &i))
abend("overbeek_insert, bad weight in term");
else {
int hashval = abs(hash_term2(t->farg->narg->argval) % OVERBEEK_WORLD_SIZE);
struct term_ptr *p = get_term_ptr();
p->term = t;
p->next = Overbeek_world[hashval];
Overbeek_world[hashval] = p;
}
} /* overbeek_insert */
/*************
*
* int overbeek_weight()
*
*************/
int overbeek_weight(struct term *t, int *ip)
{
if (Overbeek_world == NULL)
return 0;
else {
int hashval;
struct term_ptr *p;
int found = 0;
struct term *copy = copy_term(t);
renumber_vars_term(copy);
hashval = abs(hash_term2(copy) % OVERBEEK_WORLD_SIZE);
for (p = Overbeek_world[hashval]; p && !found; p = p->next) {
if (term_ident(copy, p->term->farg->narg->argval)) {
int rc;
found = 1;
rc = str_int(sn_to_str(p->term->farg->argval->sym_num), ip);
}
}
zap_term(copy);
return found;
}
} /* overbeek_weight */
/*************
*
* void print_overbeek_world()
*
*************/
void print_overbeek_world(void)
{
if (Overbeek_world == NULL)
printf("There is no Overbeek World to print!\n");
else {
int i;
int terms = 0;
int excess = 0;
int max = 0;
printf("\nstart of Overbeek_world\n\n");
for (i = 0; i < OVERBEEK_WORLD_SIZE; i++) {
if (Overbeek_world[i]) {
int n = 0;
struct term_ptr *p;
printf("%d:\n", i);
excess--;
for (p = Overbeek_world[i]; p; p = p->next) {
terms++;
excess++;
n++;
printf(" ");
p_term(p->term);
}
max = (n > max ? n : max);
}
}
printf("\nend of Overbeek_world, terms=%d, overflow=%d, max_overflow=%d.\n\n",terms, excess, max);
}
} /* print_overbeek_world */
/*************
*
* void check_overbeek_world()
*
*************/
void check_overbeek_world(void)
{
if (Overbeek_world == NULL)
printf("There is no Overbeek World to check!\n");
else {
int i;
for (i = 0; i < OVERBEEK_WORLD_SIZE; i++) {
if (Overbeek_world[i]) {
struct term_ptr *p;
for (p = Overbeek_world[i]; p; p = p->next) {
int wt1, wt2, rc;
struct term *t = p->term->farg->narg->argval;
rc = str_int(sn_to_str(p->term->farg->argval->sym_num), &wt1);
if (overbeek_weight(t, &wt2)) {
if (wt1 != wt2) {
printf("check_overbeek_world, wrong weight: %d %d ", wt1, wt2);
p_term(t);
}
}
else {
printf("check_overbeek_world, term not found: ");
p_term(t);
}
}
}
}
}
} /* check_overbeek_world */
./otter/paramod.c 0000744 0002044 0001012 00000042441 11120534451 012241 0 ustar beeson /*
* paramod.c -- Paramodulation inference rules.
*
*/
#include "header.h"
#include "beta.h" // Beeson 8.10.03
#include "unify2.h" // Beeson 8.13.03
#include "bsym.h" // Beeson 7.1.05
#include "fsubsto.h" // Beeson 7.1.05
// #define DIAGNOSTICS // to see diagnostic printout
/*************
*
* struct term *apply_substitute(t, into_term, into_subst, beta, from_subst)
*
* This routine is similar to apply, except that when it reaches the into
* term, the appropriate instance of beta is returned.
*
*************/
static struct term *apply_substitute(struct term *t,
struct term *into_term,
struct context *into_subst,
struct term *beta,
struct context *from_subst,
int *pos_vec,
int *pi)
{
struct term *t2;
struct rel *r1, *r2, *r3;
if (t == into_term)
return(apply(beta, from_subst));
else if (t->type != COMPLEX) {
if (Flags[PARA_ALL].val == 0) {
print_term_nl(stdout, t);
abend("apply_substitute, term not COMPLEX.");
}
return(apply(t, into_subst));
}
else {
int i;
t2 = get_term();
t2->type = COMPLEX;
t2->sym_num = t->sym_num;
r3 = NULL;
for(r1 = t->farg, i = 1; r1; r1 = r1->narg, i++) {
r2 = get_rel();
if (r3 == NULL)
t2->farg = r2;
else
r3->narg = r2;
/* if we are on the path to the into term || PARA_ALL */
if (r1->path || Flags[PARA_ALL].val) {
if (*pi == MAX_FS_TERM_DEPTH)
abend("apply_substitute: term too deep.");
pos_vec[*pi] = i;
(*pi)++;
r2->argval = apply_substitute(r1->argval, into_term,
into_subst, beta, from_subst,
pos_vec, pi);
}
else
r2->argval = apply(r1->argval, into_subst);
r3 = r2;
}
return(t2);
}
} /* apply_substitute */
/*************
*
* struct clause *build_bin_para(alpha, from_subst, into_term, into_lit, into_subst)
*
* Construct a binary paramodulant.
*
*************/
static struct clause *build_bin_para(struct term *alpha,
struct context *from_subst,
struct term *into_term,
struct literal *into_lit,
struct context *into_subst,
int *pos_vec,
int *pi)
{
struct clause *paramodulant;
struct literal *lit, *new, *prev;
struct term *from_atom, *beta;
struct int_ptr *ip0, *ip1, *ip2;
int i;
paramodulant = get_clause();
prev = NULL;
from_atom = alpha->occ.rel->argof; /* find beta */
if (from_atom->farg->argval == alpha)
beta = from_atom->farg->narg->argval; /* beta is second arg */
else
beta = from_atom->farg->argval; /* beta is first arg */
*pi = 1;
/* go through literals of into clause */
for (lit = into_lit->container->first_lit, i = 1; lit; lit = lit->next_lit, i++) {
new = get_literal();
new->container = paramodulant;
if (prev == NULL)
paramodulant->first_lit = new;
else
prev->next_lit = new;
prev = new;
new->sign = lit->sign;
if (lit == into_lit || Flags[PARA_ALL].val) {
pos_vec[0] = i;
new->atom = apply_substitute(lit->atom, into_term, into_subst,
beta, from_subst, pos_vec, pi);
}
else
new->atom = apply(lit->atom, into_subst);
new->atom->occ.lit = new;
new->atom->varnum = lit->atom->varnum; /* copy type of atom */
}
/* go through literals of from clause */
for (lit = from_atom->occ.lit->container->first_lit; lit; lit = lit->next_lit) {
if (lit->atom != from_atom) { /* omit instance of from literal */
new = get_literal();
new->container = paramodulant;
if (paramodulant->first_lit == NULL)
paramodulant->first_lit = new;
else
prev->next_lit = new;
prev = new;
new->sign = lit->sign;
new->atom = apply(lit->atom, from_subst);
new->atom->occ.lit = new;
new->atom->varnum = lit->atom->varnum; /* copy type of atom */
}
}
ip0 = get_int_ptr(); /* rule and parents: to be filled in by caller */
ip1 = get_int_ptr();
ip2 = get_int_ptr();
ip0->next = ip1;
ip1->next = ip2;
paramodulant->parents = ip0;
return(paramodulant);
} /* build_bin_para */
/*************
*
* insert_detailed_para_history()
*
*************/
static void insert_detailed_para_history(struct int_ptr *ip_from,
struct int_ptr *ip_into,
struct term *alpha,
int *pos_vec,
int pos_vec_size)
{
struct int_ptr *ip2, *ip3, *ip4;
int i;
/* Insert position of into term */
ip2 = get_int_ptr();
ip2->i = LIST_RULE - pos_vec_size;
ip4 = ip_into->next;
ip_into->next = ip2;
for (i = 0; i < pos_vec_size; i++) {
ip3 = get_int_ptr();
ip3->i = pos_vec[i];
ip2->next = ip3;
ip2 = ip3;
}
ip2->next = ip4;
/* Insert position of alpha. */
ip2 = get_int_ptr();
ip3 = get_int_ptr();
ip4 = get_int_ptr();
ip2->next = ip3;
ip3->next = ip4;
ip2->i = LIST_RULE - 2;
ip3->i = literal_number(alpha->occ.rel->argof->occ.lit);
ip4->i = (alpha->occ.rel->argof->farg->argval == alpha ? 1 : 2);
ip4->next = ip_from->next;
ip_from->next = ip2;
} /* insert_detailed_para_history */
/*************
*
* para_from_up(t, into_term, into_subst, alpha, from_subst)
*
* We are paramodulating from the given clause, and a clashable into term
* has been found. This routine recursively goes through the clashable
* superterms of the into term.
*
*************/
static void para_from_up(struct term *t,
struct term *into_term,
struct context *into_subst,
struct term *alpha,
struct context *from_subst)
{
struct clause *paramodulant, *from_parent;
struct rel *r;
struct int_ptr *ip;
int pos_vec[MAX_FS_TERM_DEPTH];
int pos_vec_size;
from_parent = alpha->occ.rel->argof->occ.lit->container;
if (t->type == COMPLEX && t->varnum != 0) { /* it's an atom */
if (Flags[PARA_INTO_UNITS_ONLY].val == 0 ||
unit_clause(t->occ.lit->container)) {
paramodulant = build_bin_para(alpha, from_subst, into_term,
t->occ.lit, into_subst,
pos_vec, &pos_vec_size);
if(Flags[LAMBDA_FLAG].val && !check_lambdas(paramodulant)) // Beeson 8.13.03
return; // Beeson 8.13.03
/* fill in derivation info */
ip = paramodulant->parents;
ip->i = PARA_FROM_RULE;
ip->next->i = from_parent->id;
ip->next->next->i = t->occ.lit->container->id;
if (Flags[DETAILED_HISTORY].val) {
insert_detailed_para_history(ip->next, ip->next->next, alpha,
pos_vec, pos_vec_size);
}
Stats[CL_GENERATED]++;
Stats[PARA_FROM_GEN]++;
if (heat_is_on())
paramodulant->heat_level = from_parent->heat_level + 1;
CLOCK_STOP(PARA_FROM_TIME);
pre_process(paramodulant, 0, Sos);
CLOCK_START(PARA_FROM_TIME);
}
}
else {
r = t->occ.rel;
while (r != NULL) {
if (r->clashable) {
r->path = 1; /* mark path from into_term up to atom */
para_from_up(r->argof, into_term, into_subst, alpha, from_subst);
r->path = 0; /* remove mark */
}
r = r->nocc;
}
}
} /* para_from_up */
/*************
*
* para_from_alpha(alpha)
*
* We are paramodulating from the given clause. This routine
* paramodulates from an alpha.
*
*************/
static void para_from_alpha(struct term *alpha)
{
struct context *into_subst, *from_subst;
struct term *into_term;
struct fpa_tree *ut;
struct trail *tr;
into_subst = get_context();
into_subst->multiplier = 0;
if(Flags[LAMBDA_FLAG].val) // Beeson 8.11.03
{ struct clause *ccl = getContainingClause(alpha); // Beeson 8.11.03
from_subst = get_context2(ccl,1); // Beeson 8.11.03
} // Beeson 8.11.03
else // Beeson 8.11.03
from_subst = get_context();
from_subst->multiplier = 1;
if (alpha->type == VARIABLE && Flags[PARA_FROM_VARS].val == 0)
; /* do nothing */
else {
if (alpha->type == VARIABLE)
ut = build_for_all(Fpa_clash_terms); /* get all terms in index */
else
ut = build_tree(alpha, UNIFY, Parms[FPA_TERMS].val,
Fpa_clash_terms);
for(into_term = next_term(ut, 0);into_term;into_term = next_term(ut, 0))
{ // Beeson rewrote while-loop as for-loop, 7.29.05
tr = NULL;
if(Flags[LAMBDA_FLAG].val) // Beeson 8.10.03
{ if(into_term->sym_num == AP
// && into_term->farg->argval->type == VARIABLE && // commented out Beeson 3.24.06
// into_subst->terms[into_term->farg->argval->varnum] == NULL // commented out Beeson 3.24.06
)
continue; // Don't paramodulate into Ap(X,w) terms // or into Ap terms of any kind
prepare_context(into_term,into_subst, from_subst->next_var); // Beeson 8.10.03
}
if (unify(into_term, into_subst, alpha, from_subst, &tr)) {
para_from_up(into_term, into_term, into_subst, alpha, from_subst);
clear_subst_1(tr);
}
}
}
free_context(into_subst);
free_context(from_subst);
} /* para_from_alpha */
/*************
*
* para_from(giv_cl) -- binary paramodulation from the given clause
*
* Paramodulants are given to the routine pre_process.
*
*************/
void para_from(struct clause *giv_cl)
{
struct literal *from_lit;
struct term *atom;
CLOCK_START(PARA_FROM_TIME);
if (!Flags[PARA_FROM_UNITS_ONLY].val || unit_clause(giv_cl)) {
// Beeson rewrote while-loop as a for-loop 7.29.05
for(from_lit = giv_cl->first_lit;from_lit;from_lit = from_lit->next_lit)
{
atom = from_lit->atom;
if(!pos_eq_lit(from_lit))
continue;
if(Flags[LAMBDA_FLAG].val) // Beeson 7.28.05
{ // don't paramodulate from a literal with an Ap term on either side
// whose first arg is a variable
struct term *alpha = atom->farg->argval;
if(alpha->sym_num == AP && alpha->farg->argval->type == VARIABLE)
continue; // don't paramodulate from Ap(X,..)
alpha = atom->farg->narg->argval;
if(alpha->sym_num == AP && alpha->farg->argval->type == VARIABLE)
continue; // don't paramodulate from Ap(X,..)
}
if (!term_ident(atom->farg->argval, atom->farg->narg->argval))
{ if (Flags[PARA_FROM_LEFT].val)
para_from_alpha(atom->farg->argval);
if (Flags[PARA_FROM_RIGHT].val)
para_from_alpha(atom->farg->narg->argval);
}
}
}
CLOCK_STOP(PARA_FROM_TIME);
} /* para_from */
/*************
*
* para_into_terms(t, into_lit, from_subst, into_subst)
*
* We are paramodulating into the given clause. This routine recursively
* goes through the clashable subterms of the given literal.
*
*************/
/* Beeson changed the from_subst parameter to a double pointer,
so that from_subst can be freed and re-allocated in this function,
and the final free_subst from the calling function will free the
last-allocated from_subst. */
static void para_into_terms(struct term *into_term,
struct literal *into_lit,
struct context **from_subst, // Beeson 4.1.04
struct context *into_subst)
{
struct term *alpha;
struct trail *tr;
struct fpa_tree *ut;
struct clause *paramodulant;
struct rel *r;
struct int_ptr *ip;
int pos_vec[MAX_FS_TERM_DEPTH];
int pos_vec_size;
int save_next_var=0, oldflag=0; // Beeson 6.30.05
int block_subterms = 0;
if (into_term->type == COMPLEX) {
if(Flags[LAMBDA_FLAG].val && Flags[INDUCTION_FLAG].val &&
blocking_functor(into_term->sym_num) // Beeson 7.1.05
)
block_subterms = 1; // don't paramodulate into Skolem terms during inductive proofs
if(Flags[LAMBDA_FLAG].val && into_term->sym_num == AP && // Beeson 7.29.05
into_term->farg->argval->type == VARIABLE && // Beeson 7.29.05
into_subst->terms[into_term->farg->argval->varnum] == NULL // Beeson 7.29.05
)
return; // don't paramodulate into Ap(X,w) or any subterms! // Beeson 7.29.05
r = into_term->farg;
if(! block_subterms) //Beeson 12.5.05
{ while (r != NULL)
{ if (r->clashable)
{ r->path = 1; /* mark path to into term */
para_into_terms(r->argval, into_lit, from_subst, into_subst);
r->path = 0; /* remove mark */
}
r = r->narg;
}
}
}
/* no need to check if variable and `no para into vars' */
/* because the clashability flag handles it */
#ifdef DIAGNOSTICS
fprintf(stdout, "Attempting paramodulation into:\n "); // DEBUG
print_term_nl(stdout,into_term); // DEBUG
#endif
if (into_term->type == VARIABLE)
ut = build_for_all(Fpa_alphas); /* get all terms in index */
else
ut = build_tree(into_term, UNIFY, Parms[FPA_TERMS].val, Fpa_alphas);
if(Flags[LAMBDA_FLAG].val) // Beeson 7.5.05
{ oldflag = Flags[LAMBDA_FLAG].val; // Beeson 6.30.05
Flags[LAMBDA_FLAG].val = 2; // Beeson 6.30.05
}
for(alpha = next_term(ut, 0);alpha != NULL; alpha = next_term(ut,0))
{ tr = NULL;
if(Flags[LAMBDA_FLAG].val) // Beeson 8.10.03
{ struct clause *c; // Beeson 3.30.04
int m; // Beeson 3.30.04
if(alpha->sym_num==AP) // Beeson 7.1.05
{ if(alpha->farg->argval->type == VARIABLE)
continue; // don't paramodulate from Ap(X,..)
}
#ifdef DIAGNOSTICS
fprintf(stdout, "From: "); print_term_nl(stdout,alpha); // DEBUG
#endif
c = getContainingClause(alpha); // Beeson 3.30.04
m = (*from_subst)->multiplier; // Beeson 3.30.04
free_context(*from_subst); // Beeson 3.30.04
*from_subst = get_context2(c,m); // Beeson 3.30.04
(*from_subst)->next_var = max_vars(getContainingClause(into_term),alpha); // Beeson 8.14.03
save_next_var = into_subst->next_var; // Beeson 6.30.05
}
if (unify(into_term, into_subst, alpha, *from_subst, &tr)) {
paramodulant = build_bin_para(alpha, *from_subst, into_term,
into_lit, into_subst,
pos_vec, &pos_vec_size);
/* fill in derivation info */
ip = paramodulant->parents;
ip->i = PARA_INTO_RULE;
ip->next->i = into_lit->container->id;
ip->next->next->i = alpha->occ.rel->argof->occ.lit->container->id;
if (Flags[DETAILED_HISTORY].val) {
insert_detailed_para_history(ip->next->next, ip->next, alpha,
pos_vec, pos_vec_size);
}
clear_subst_1(tr);
Stats[CL_GENERATED]++;
Stats[PARA_INTO_GEN]++;
if (heat_is_on())
paramodulant->heat_level = into_lit->container->heat_level + 1;
CLOCK_STOP(PARA_INTO_TIME);
pre_process(paramodulant, 0, Sos);
CLOCK_START(PARA_INTO_TIME);
} // close if unify
}
if(Flags[LAMBDA_FLAG].val == 2) // Beeson 6.30.05
{ Flags[LAMBDA_FLAG].val = oldflag; // Beeson 6.30.05
into_subst->next_var = save_next_var; // Beeson 6.30.06
}
} /* para_into_terms */
/*************
*
* para_into(giv_cl) -- binary paramodulation into the given clause
*
* Paramodulants are given to the routine pre_process.
*
*************/
void para_into(struct clause *giv_cl)
{
struct literal *into_lit;
struct context *into_subst, *from_subst;
struct rel *r;
CLOCK_START(PARA_INTO_TIME);
if (!Flags[PARA_INTO_UNITS_ONLY].val || unit_clause(giv_cl)) {
/* Substitutions are allocated here instead of in */
/* para_into_terms to save procedure calls. */
if(Flags[LAMBDA_FLAG].val) // Beeson
{ into_subst = get_context2(giv_cl,0);
}
else
{ into_subst = get_context();
into_subst->multiplier = 0;
}
from_subst = get_context();
from_subst->multiplier = 1;
into_lit = giv_cl->first_lit;
while (into_lit != NULL) {
if (into_lit->atom->varnum != ANSWER) { /* if not answer literal */
for( r = into_lit->atom->farg; r; r=r->narg)
// Beeson rewrote while-loop as for-loop 7.29.05
{ struct term *alpha = r->argval;
if(alpha->sym_num == AP &&
alpha->farg->argval->type == VARIABLE &&
into_subst->terms[alpha->farg->argval->sym_num] == NULL
) // Beeson 7.29.05
continue; // don't paramodulate into Ap(X,..)
if (r->clashable) {
r->path = 1; /* mark path to into term */
para_into_terms(r->argval, into_lit, &from_subst, into_subst);
r->path = 0; /* remove mark */
}
}
}
into_lit = into_lit->next_lit;
}
free_context(into_subst);
free_context(from_subst);
}
CLOCK_STOP(PARA_INTO_TIME);
} /* para_into */
./otter/pickdiff.c 0000744 0002044 0001012 00000021725 11120534451 012377 0 ustar beeson #include "header.h"
/*************
*
* copy_rels() - copy a list of rel nodes and the associated pointers.
*
*************/
static struct rel *copy_rels(struct rel *a)
{
if (a == NULL)
return NULL;
else {
struct rel *r = get_rel();
r->argval = a->argval;
r->narg = copy_rels(a->narg);
return r;
}
} /* copy_rels */
/*************
*
* zap_rels() - free a list of rel nodes (but not the terms they point to)
*
*************/
static void zap_rels(struct rel *r)
{
if (r != NULL) {
struct rel *a = r->narg;
free_rel(r);
zap_rels(a);
}
} /* zap_rels */
/*************
*
* remove1() - remove (and free) a rel node from a list
*
*************/
static struct rel *remove1(struct term *x, struct rel *a)
{
if (a == NULL)
return NULL;
else if (x == a->argval) {
struct rel *r = a->narg;
free_rel(a);
return r;
}
else {
a->narg = remove1(x, a->narg);
return a;
}
} /* remove1 */
/*************
*
* add_vecs() - Add two vectors, creating a new vector. The old vectors
* are freed.
*
*************/
static struct int_ptr *add_vecs(struct int_ptr *v1, struct int_ptr *v2)
{
if (v1 == NULL)
return v2;
else if (v2 == NULL)
return v1;
else {
struct int_ptr *v3 = get_int_ptr();
v3->i = v1->i + v2->i;
v3->next = add_vecs(v1->next, v2->next);
free_int_ptr(v1);
free_int_ptr(v2);
return v3;
}
} /* add_vecs */
/*************
*
* le_vecs(v1, v2) - is vector v1 <= vector v2?
*
*************/
static int le_vecs(struct int_ptr *v1, struct int_ptr *v2)
{
if (v1 == NULL)
return 1;
else if (v2 == NULL)
return 0;
else if (v1->i < v2->i)
return 1;
else if (v1->i > v2->i)
return 0;
else
return le_vecs(v1->next, v2->next);
} /* le_vecs */
static struct int_ptr *diff(struct term *s, struct term *r);
/*************
*
* diff_lists() - mutually recursive with diff()
*
*************/
static struct int_ptr *diff_lists(struct rel *a1, struct rel *a2)
{
if (a1 == NULL && a2 == NULL) {
struct int_ptr *v = get_int_ptr();
v->i = 0;
return v;
}
else if (a1 == NULL || a2 == NULL) {
struct int_ptr *v = get_int_ptr();
v->i = 1;
return v;
}
else {
return add_vecs(diff(a1->argval, a2->argval),
diff_lists(a1->narg, a2->narg));
}
} /* diff_lists */
/*************
*
* diff() - return a vector representing the difference between two terms.
*
* This version does not try to minimize differences by permuting arguments.
*
*************/
static struct int_ptr *diff(struct term *s, struct term *r)
{
if (s->type == VARIABLE && r->type == VARIABLE) {
struct int_ptr *v = get_int_ptr();
v->i = 0;
return v;
}
else if (s->type == VARIABLE || r->type == VARIABLE ||
s->sym_num != r->sym_num) {
struct int_ptr *v = get_int_ptr();
v->i = 1;
return v;
}
else {
struct int_ptr *v = get_int_ptr();
v->i = 0;
v->next = diff_lists(s->farg, r->farg);
return v;
}
} /* diff */
static struct int_ptr *diff2(struct term *s, struct term *r);
/*************
*
* min_diff(+x, +a, -m) - mutually recursive with diff2 and diff2_lists
*
* Given term x and list of terms a, find the member of a that is
* most similar to x. Set m to that member, and return the
* difference vector.
*
*************/
static struct int_ptr *min_diff(struct term *x, struct rel *a, struct term **m)
{
if (a == NULL) {
struct int_ptr *v = get_int_ptr();
v->i = 1000;
*m = NULL;
return v;
}
else {
struct int_ptr *v1 = diff2(x, a->argval);
struct term *t;
struct int_ptr *v2 = min_diff(x, a->narg, &t);
if (le_vecs(v1, v2)) {
*m = a->argval;
zap_int_ptr_list(v2);
return v1;
}
else {
*m = t;
zap_int_ptr_list(v1);
return v2;
}
}
} /* min_diff */
/*************
*
* diff2_lists(a1, a2) - mutually recursive with diff2 and min_diff
*
* The nodes of a2 are freed.
*
*************/
static struct int_ptr *diff2_lists(struct rel *a1, struct rel *a2)
{
if (a1 == NULL && a2 == NULL) {
struct int_ptr *v = get_int_ptr();
v->i = 0;
zap_rels(a2);
return v;
}
else if (a1 == NULL) {
struct int_ptr *v = get_int_ptr();
v->i = 1;
return v;
}
else {
struct term *mint;
struct int_ptr *minv = min_diff(a1->argval, a2, &mint);
struct int_ptr *v = diff2_lists(a1->narg, remove1(mint, a2));
return add_vecs(minv, v);
}
} /* diff2_lists */
/*************
*
* diff2() - return a vector representing the difference between two terms.
*
* This version tries to minimize differences by permuting arguments.
*
*************/
static struct int_ptr *diff2(struct term *s, struct term *r)
{
if (s->type == VARIABLE && r->type == VARIABLE) {
struct int_ptr *v = get_int_ptr();
v->i = 0;
return v;
}
else if (s->type == VARIABLE || r->type == VARIABLE ||
s->sym_num != r->sym_num) {
struct int_ptr *v = get_int_ptr();
v->i = 1;
return v;
}
else {
struct int_ptr *v = get_int_ptr();
v->i = 0;
v->next = diff2_lists(s->farg, copy_rels(r->farg));
return v;
}
} /* diff2 */
/*************
*
* cldiff() - return a vector representing the difference between two clauses.
*
* This version applies to just the first literals, and ignores the sign.
*
*************/
struct int_ptr *cldiff(struct clause *c, struct clause *d)
{
if (c->first_lit == NULL || d->first_lit == NULL ||
c->first_lit->sign != d->first_lit->sign) {
struct int_ptr *v = get_int_ptr();
v->i = 1;
return v;
}
else if (Parms[PICK_DIFF].val == 1)
return diff(c->first_lit->atom, d->first_lit->atom);
else if (Parms[PICK_DIFF].val == 2)
return diff2(c->first_lit->atom, d->first_lit->atom);
else {
abend("cldiff, bad PICK_DIFF");
return NULL;
}
} /* cldiff */
/*************
*
* get_ci_of_wt_range()
*
*************/
static struct ci_ptr *get_ci_of_wt_range(struct clause *c,
int min, int max)
{
if (c == NULL)
return NULL;
else if (c->pick_weight >= min && c->pick_weight <= max) {
struct ci_ptr *p = get_ci_ptr();
p->c = c;
p->next = get_ci_of_wt_range(c->next_cl, min, max);
return p;
}
else
return get_ci_of_wt_range(c->next_cl, min, max);
} /* get_ci_of_wt_range */
/*************
*
* print_int_ptr(p) -- print a list intgers, to stdout, with a newline.
*
*************/
void print_int_ptr(FILE *fp, struct int_ptr *p)
{
fprintf(fp, "<");
for (; p != NULL; p = p->next)
fprintf(fp, "%d%s", p->i, p->next ? "," : "");
fprintf(fp, ">");
} /* print_int_ptr */
/*************
*
* p_int_ptr(p) -- print a list intgers, to stdout, with a newline.
*
*************/
void p_int_ptr(struct int_ptr *p)
{
print_int_ptr(stdout, p);
printf("\n");
} /* p_int_ptr */
/*************
*
* zap_ci_ptr_list(p)
*
* Free the nodes and the vectors, but not the clauses.
*
*************/
void zap_ci_ptr_list(struct ci_ptr *p)
{
if (p == NULL)
return;
else {
zap_ci_ptr_list(p->next);
zap_int_ptr_list(p->v);
free_ci_ptr(p);
}
} /* zap_ci_ptr_list */
/*************
*
* find_pickdiff_cl()
*
*************/
struct clause *find_pickdiff_cl(struct list *sos, struct list *usable)
{
struct clause *c = find_lightest_cl(sos);
if (c == NULL)
return NULL;
else {
int min = c->pick_weight;
int max = min + Parms[PICK_DIFF_RANGE].val;
struct ci_ptr *s = get_ci_of_wt_range(sos->first_cl, min, max);
struct ci_ptr *u = get_ci_of_wt_range(usable->first_cl, min, max);
struct ci_ptr *p1, *p2;
struct int_ptr *v;
/* Find the member of s that is "most different" from members of u. */
for (p1 = s; p1 != NULL; p1 = p1->next) {
#if 0
printf("\nSos clause: "); p_clause(p1->c);
#endif
p1->v = NULL;
for (p2 = u; p2 != NULL; p2 = p2->next) {
v = cldiff(p1->c, p2->c);
#if 0
printf(" Usable clause: "); print_int_ptr(stdout, v);
print_clause(stdout, p2->c);
#endif
p1->v = add_vecs(p1->v, v);
}
#if 0
printf("Total difference: "); p_int_ptr(p1->v);
#endif
}
/* Now, get the Sos clause with the greatest (least?) total difference. */
/* We know that Sos (therefore s) is not empty. */
v = s->v; c = s->c;
for (p1 = s->next; p1 != NULL; p1 = p1->next) {
int better;
if (Flags[PICK_DIFF_SIM].val)
better = !le_vecs(v, p1->v); /* looking for least diff */
else
better = !le_vecs(p1->v, v); /* looking for most diff */
if (better) {
v = p1->v;
c = p1->c;
}
}
zap_ci_ptr_list(s);
zap_ci_ptr_list(u);
return c;
}
} /* find_pickdiff_cl */
./otter/process.c 0000744 0002044 0001012 00000060722 11120534452 012277 0 ustar beeson /*
* process.c -- Routines to handle the processing of generated clauses.
*
*/
#include "header.h"
#include "unify2.h" // Beeson
#include "simplify.h" // Beeson
#define CD_ONLY
#ifdef SCOTT
#include "called_by_otter.h"
#endif
/*************
*
* post_process(c, input, lst) -- finish processing a clause
*
* The clause has already been integrated, indexed, appended to
* Sos. This routine does back subsumption,
* and possibly generates more clauses (factoring, back demod, hot
* lists, etc.). Any newly generated and kept clauses will be
* appended to lst and will wait their turn to be post_processed.
*
*************/
static void post_process(struct clause *c,
int input,
struct list *lst)
{
struct clause *d, *e;
struct clause_ptr *cp1, *cp2;
struct literal *lit;
#if 0
printf("Starting post: "); p_clause(c);
#endif
if (Flags[EQ_UNITS_BOTH_WAYS].val && unit_clause(c)) {
/*
* Generate a flipped copy if
* 1. it's a (pos or neg) eq unit, and
* 2. either
* a. order_eq is clear, or
* b. order_eq is set, and it couldn't be oriented.
*/
lit = ith_literal(c, 1);
if (eq_lit(lit) &&
(!Flags[ORDER_EQ].val ||
!TP_BIT(lit->atom->bits, ORIENTED_EQ_BIT))) {
struct term *t;
struct clause *c2;
struct int_ptr *ip1, *ip2, *ip3, *ip4, *ip5;
c2 = cl_copy(c);
ip1 = get_int_ptr(); ip1->i = COPY_RULE; c2->parents = ip1;
ip2 = get_int_ptr(); ip2->i = c->id; ip1->next = ip2;
ip3 = get_int_ptr(); ip3->i = FLIP_EQ_RULE; ip2->next = ip3;
ip4 = get_int_ptr(); ip4->i = LIST_RULE-1; ip3->next = ip4;
ip5 = get_int_ptr(); ip5->i = 1; ip4->next = ip5;
lit = ith_literal(c2, 1);
t = lit->atom->farg->argval;
lit->atom->farg->argval = lit->atom->farg->narg->argval;
lit->atom->farg->narg->argval = t;
CLOCK_STOP(POST_PROC_TIME);
pre_process(c2, input, lst);
CLOCK_START(POST_PROC_TIME);
}
}
if (Flags[BACK_DEMOD].val && unit_clause(c)) {
struct term *atom;
atom = ith_literal(c,1)->atom;
if (c->first_lit && TP_BIT(atom->bits, SCRATCH_BIT)) {
/* c was made into a new demodulator */
CLEAR_BIT(atom->bits, SCRATCH_BIT);
d = cl_find(c->id + 1); /* demod id is 1 more than clause id */
if (Flags[PRINT_BACK_DEMOD].val || input)
printf(">>>> Starting back demodulation with %d.\n", d->id);
CLOCK_START(BACK_DEMOD_TIME);
back_demod(d, c, input, lst);
CLOCK_STOP(BACK_DEMOD_TIME);
}
}
if (Flags[BACK_SUB].val) {
CLOCK_START(BACK_SUB_TIME);
cp1 = back_subsume(c);
CLOCK_STOP(BACK_SUB_TIME);
while (cp1 != NULL) {
e = cp1->c;
if (e->container != Passive) {
Stats[CL_BACK_SUB]++;
if (Flags[PRINT_BACK_SUB].val || input)
printf("%d back subsumes %d.\n", c->id, e->id);
CLOCK_START(UN_INDEX_TIME);
un_index_lits_all(e);
if (e->container == Usable)
un_index_lits_clash(e);
CLOCK_STOP(UN_INDEX_TIME);
rem_from_list(e);
#ifdef SCOTT
scott_delete_from_base(e);
#endif
hide_clause(e);
}
cp2 = cp1;
cp1 = cp1->next;
free_clause_ptr(cp2);
}
}
if (Flags[FACTOR].val) {
CLOCK_START(FACTOR_TIME);
all_factors(c, lst);
CLOCK_STOP(FACTOR_TIME);
}
if (Flags[GL_DEMOD].val) {
gl_demod(c, lst);
}
if (Hot->first_cl && !input) {
/* Don't hot-list input clauses. */
CLOCK_STOP(POST_PROC_TIME);
hot_inference(c);
CLOCK_START(POST_PROC_TIME);
}
if (Flags[BACK_UNIT_DELETION].val && unit_clause(c)) {
if (Flags[PRINT_BACK_DEMOD].val || input)
printf(">>>> Starting back unit deletion with %d.\n", c->id);
CLOCK_START(BACK_UNIT_DEL_TIME);
back_unit_deletion(c, input);
CLOCK_STOP(BACK_UNIT_DEL_TIME);
}
} /* post_process */
/*************
*
* post_proc_all(lst_pos, input, lst)
*
*************/
void post_proc_all(struct clause *lst_pos,
int input,
struct list *lst)
{
struct clause *c;
CLOCK_START(POST_PROC_TIME);
if (lst_pos == NULL)
c = lst->first_cl;
else
c = lst_pos->next_cl;
while (c != NULL) {
struct clause *d;
post_process(c, input, lst); /* this may alter c->next_cl */
d = c;
c = c->next_cl;
#if 1
if (TP_BIT(d->bits, SCRATCH_BIT)) {
CLEAR_BIT(d->bits, SCRATCH_BIT);
rem_from_list(d);
index_lits_clash(d);
append_cl(Usable, d);
/* printf("Clause %d moved to Usable.\n", d->id); */
}
#endif
/* following moved from end of infer_and_process 19 Jan 90 */
if (Flags[REALLY_DELETE_CLAUSES].val)
/* clauses hidden by back demod, back subsumption */
/* also empty clauses are hidden */
del_hidden_clauses();
}
CLOCK_STOP(POST_PROC_TIME);
} /* post_proc_all */
/*************
*
* given_clause_ok(id)
*
*************/
static int given_clause_ok(int id)
{
struct clause *c;
c = cl_find(id);
if (c)
return(c->container != NULL);
else
return(0);
} /* given_clause_ok */
/*************
*
* infer_and_process(giv_cl)
*
* The inference rules append kept clauses to Sos. After each
* inference rule is finished, the newly kept clauses are
* `post_process'ed (back subsump, back demod, etc.).
*
*************/
void infer_and_process(struct clause *giv_cl)
{
struct clause *c, *sos_pos;
struct int_ptr *ip;
int given_id;
if (Flags[CONTROL_MEMORY].val) {
#ifdef SCOTT
scott_control_memory();
#else
control_memory();
#endif
}
if (Parms[WARN_MEM].val != -1 && total_mem() > Parms[WARN_MEM].val) {
int i = Parms[WARN_MEM_MAX_WEIGHT].val;
if (Parms[MAX_WEIGHT].val != i) {
Parms[MAX_WEIGHT].val = i;
fprintf(stderr,"\nMemory warning: resetting max_weight to %d.\n\n",i);
fprintf(stdout,"\nMemory warning: resetting max_weight to %d.\n\n",i);
fflush(stdout);
}
}
given_id = giv_cl->id;
#ifndef NOMATHXPERT
if( // Beeson 11.6.03 and 7.22.05
(Flags[SIMPLIFY_FLAG].val && giv_cl->parents == NULL) // an input clause
|| Flags[SIMPLIFYRULE_FLAG].val // Beeson 7.22.05
) // Beeson 11.6.03
{ struct clause *simp = Simplify(giv_cl); // Beeson 11.6.03
if(simp) // Beeson 11.6.03
{ int save[2];
save[0] = Flags[SIMPLIFY_FLAG].val;
save[1] = Flags[SIMPLIFYRULE_FLAG].val;
sos_pos = Sos->last_cl; // Beeson 11.6.03
Flags[SIMPLIFY_FLAG].val = 0; // Beeson 11.6.03
Flags[SIMPLIFYRULE_FLAG].val = 0;
pre_process(simp,0,Sos); // Beeson 11.6.03
Flags[SIMPLIFY_FLAG].val = save[0];
Flags[SIMPLIFYRULE_FLAG].val = save[1];
post_proc_all(sos_pos, 0, Sos); // Beeson 11.6.03
} // Beeson 11.6.03
} // Beeson 11.6.03
#endif
if(Flags[LAMBDA_FLAG].val) // Beeson--following 6 lines
{ /* from -or(x,y), infer two clauses -x and -y. */
/* from and(x,y), infer two clauses x and y. */
sos_pos = Sos->last_cl;
split_or(giv_cl); /* appends the new clauses to sos. */
split_and(giv_cl);
split_not_or(giv_cl);
split_not_and(giv_cl);
post_proc_all(sos_pos,0,Sos);
}
if (Flags[BINARY_RES].val && given_clause_ok(given_id)) {
sos_pos = Sos->last_cl; /* Save position of last clauses in Sos. */
bin_res(giv_cl); /* Inf rule appends newly kept clauses to Sos. */
/* Now post_process new clauses in Sos. */
/* (Post_process may append even more clauses to Sos. Do them all.) */
/* (ROO does not do this.) */
post_proc_all(sos_pos, 0, Sos);
}
/* For subsequent inference rules, check that the given clause */
/* has not back demodulated or back subsumed. */
if (Flags[HYPER_RES].val && given_clause_ok(given_id)) {
sos_pos = Sos->last_cl;
hyper_res(giv_cl);
post_proc_all(sos_pos, 0, Sos);
}
if (Flags[NEG_HYPER_RES].val && given_clause_ok(given_id)) {
sos_pos = Sos->last_cl;
neg_hyper_res(giv_cl);
post_proc_all(sos_pos, 0, Sos);
}
if (Flags[UR_RES].val && given_clause_ok(given_id)) {
sos_pos = Sos->last_cl;
ur_res(giv_cl);
post_proc_all(sos_pos, 0, Sos);
}
#ifdef SCOTT
if (get_sem_res_flag() && given_clause_ok(given_id)) {
sos_pos = Sos->last_cl;
sem_res(giv_cl);
post_proc_all(sos_pos, 0, Sos);
}
#endif
if (Flags[PARA_INTO].val && given_clause_ok(given_id)) {
sos_pos = Sos->last_cl;
para_into(giv_cl);
post_proc_all(sos_pos, 0, Sos);
}
if (Flags[PARA_FROM].val && given_clause_ok(given_id)) {
sos_pos = Sos->last_cl;
para_from(giv_cl);
post_proc_all(sos_pos, 0, Sos);
}
if (Flags[LINKED_UR_RES].val && given_clause_ok(given_id)) {
sos_pos = Sos->last_cl;
linked_ur_res(giv_cl);
post_proc_all(sos_pos, 0, Sos);
}
if (Flags[LINKED_HYPER_RES].val && given_clause_ok(given_id)) {
sos_pos = Sos->last_cl;
linked_hyper_res(giv_cl);
post_proc_all(sos_pos, 0, Sos);
}
if (Flags[DEMOD_INF].val && given_clause_ok(given_id)) {
sos_pos = Sos->last_cl;
c = cl_copy(giv_cl);
ip = get_int_ptr();
ip->i = giv_cl->id;
c->parents = ip;
Stats[CL_GENERATED]++;
Stats[DEMOD_INF_GEN]++;
pre_process(c, 0, Sos);
post_proc_all(sos_pos, 0, Sos);
}
if (Flags[GEOMETRIC_RULE].val && given_clause_ok(given_id)) {
sos_pos = Sos->last_cl;
geometry_rule_unif(giv_cl);
post_proc_all(sos_pos, 0, Sos);
}
} /* infer_and_process */
/*************
*
* int proc_gen(c, input)
*
* This is the main processing applied to generated clauses.
*
* If (input), c is an input clause, and some tests should not be performed.
*
* This routine takes a generated clause and (* means optional):
*
* renumber variables
* * print the clause
* * gL rewriting
* demodulate, including $evaluation
* * gL rewriting
* handle evaluable literals
* * order equalities
* * unit_deletion
* * factor-simplify
* merge identical literals
* * max literals test (if not input)
* * max_distinct_vars check (if not input)
* tautology check
* * max weight test (if not input)
* * delete_identical_nested_skolems (if not input)
* * sort literals
* * forward subsumption
* renumber variables (again)
*
* Return 0 if clause should be deleted.
*
*************/
int proc_gen(struct clause *c,
int input)
{
struct clause *e;
int wt, i;
#ifdef SCOTT
/*-----------------------------------------------------------------.
| Dynamic Semantic Constraint: |
| |
| -- discard clause if all its parents have a model |
| |
| Recall the following... |
| |
| The justification list of a clause (c->parents) is a list of |
| integers. Usually, negative integers represent inference rules, |
| and positive integers are the IDs of parent clauses. Exception: |
| LIST_RULE is a large negative integer. If a member is <= |
| LIST_RULE, then a list of length (LIST_RULE-member) follows (and |
| typically represents a position in a clause). |
`-----------------------------------------------------------------*/
if (!input && get_dsc_flag()) {
struct int_ptr *parent;
boolean bad_parents = true;
int length, position;
for (parent = c->parents; parent ; parent = parent->next) {
if (parent->i <= LIST_RULE) { /* skip over any position lists */
length = LIST_RULE-parent->i;
for (position=0; position < length; position++, parent=parent->next) ;
}
if (parent->i < 0) continue ; /* skip inference rules */
e = cl_find(parent->i);
if (!in_constraint_set(e)) {
bad_parents = false;
break;
}
}
if (bad_parents)
return(0);
}
#endif
/* Renumbering variables: Some of the processing requires variables
to be in range (< MAX_VARS), so we renumber first. Any of the
processing that might introduce variables out of range should
renumber again. Some processing can remove or reorder variables,
so we renumber again at the end. Renumbering can be slow, so
this could be improved.
*/
CLOCK_START(RENUMBER_TIME);
if (renumber_vars(c) == 0) {
Stats[CL_VAR_DELETES]++;
CLOCK_STOP(RENUMBER_TIME);
return(0);
}
CLOCK_STOP(RENUMBER_TIME);
if (Flags[VERY_VERBOSE].val) {
printf("\n ");
CLOCK_START(PRINT_CL_TIME);
print_clause(stdout, c);
CLOCK_STOP(PRINT_CL_TIME);
}
if (Flags[GEOMETRIC_REWRITE_BEFORE].val)
i = geo_rewrite(c);
if ((Demodulators->first_cl ||
Internal_flags[DOLLAR_PRESENT] ||
Flags[LAMBDA_FLAG].val // Beeson 8.5.02
) &&
!Flags[GL_DEMOD].val) {
CLOCK_START(DEMOD_TIME);
demod_cl(c);
CLOCK_STOP(DEMOD_TIME);
if (Flags[VERY_VERBOSE].val) {
printf(" after demodulation: ");
CLOCK_START(PRINT_CL_TIME);
print_clause(stdout, c);
CLOCK_STOP(PRINT_CL_TIME);
}
/* If demodulation introduced new variables, the clause was renumbered,
so all vars are still < MAX_VARS. However, they might no longer
be in order.
*/
}
if (Flags[GEOMETRIC_REWRITE_AFTER].val)
i = geo_rewrite(c);
#ifndef NOMATHXPERT
if (Flags[SIMPLIFY_FLAG].val && !Flags[SIMPLIFYRULE_FLAG].val) // Beeson 11.1.03
/* set(simplifyrule) overrides set(simplify); if simplifyrule is set we don't
use simplification as we use demodulators */
{ int err = SimplifyInPlace(c); //Beeson 11.4.03
if(!err)
demod_cl(c); // Beeson 7.5.05. Demod AGAIN after simplification
}
if (Flags[SOLVE_FLAG].val) //Beeson 11.1.03
SolveInPlace(c); //Beeson 11.4.03
#endif
/* False lits of c may be deleted even if test fails. */
if (Internal_flags[DOLLAR_PRESENT] && lit_t_f_reduce(c)) {
Stats[CL_TAUTOLOGY]++;
return(0);
}
if (Flags[ORDER_EQ].val) {
CLOCK_START(ORDER_EQ_TIME);
if (Flags[LRPO].val)
order_equalities_lrpo(c);
else
order_equalities(c);
CLOCK_STOP(ORDER_EQ_TIME);
if (!input &&
Flags[DISCARD_NON_ORIENTABLE_EQ].val &&
unit_clause(c) &&
num_literals_including_answers(c) == 1 &&
pos_eq_lit(ith_literal(c, 1)) &&
!TP_BIT(ith_literal(c, 1)->atom->bits, ORIENTED_EQ_BIT))
return(0);
}
if (Flags[UNIT_DELETION].val && num_literals(c) > 1) {
CLOCK_START(UNIT_DEL_TIME);
i = unit_del(c);
CLOCK_STOP(UNIT_DEL_TIME);
}
if (Flags[FACTOR].val) {
CLOCK_START(FACTOR_SIMP_TIME);
i = factor_simplify(c);
CLOCK_STOP(FACTOR_SIMP_TIME);
Stats[FACTOR_SIMPLIFICATIONS] += i;
}
/* I had to move cl_merge() after factor_simplify, because
* build_proof_object() wants cl_merge() to be the last operation.
*/
cl_merge(c);
if (!input && Parms[MAX_LITERALS].val != -1) {
if (num_literals(c) > Parms[MAX_LITERALS].val) {
Stats[CL_WT_DELETE]++;
return(0);
}
}
if (!input && Parms[MAX_ANSWERS].val != -1) {
if (num_answers(c) > Parms[MAX_ANSWERS].val) {
Stats[CL_WT_DELETE]++;
return(0);
}
}
if(!input && Parms[MAX_BINDING_DEPTH].val != -1 && // Beeson 5.27.05
Flags[LAMBDA_FLAG].val &&
binding_depth(c) > Parms[MAX_BINDING_DEPTH].val
)
{ Stats[CL_WT_DELETE]++;
return 0;
}
if (!input && Parms[MAX_DISTINCT_VARS].val != -1) {
if(Flags[LAMBDA_FLAG].val){ // Beeson 3.30.04
if( distinct_free_vars(c) > Parms[MAX_DISTINCT_VARS].val){ // Beeson 3.30.04
Stats[CL_WT_DELETE]++; // Beeson 3.30.04
return(0); // Beeson 3.30.04
}
}
else if(distinct_vars(c) > Parms[MAX_DISTINCT_VARS].val){
Stats[CL_WT_DELETE]++;
return(0);
}
}
if (!input && Flags[DISCARD_XX_RESOLVABLE].val && xx_resolvable(c)) {
Stats[CL_WT_DELETE]++;
return(0);
}
if (tautology(c)) {
Stats[CL_TAUTOLOGY]++;
return(0);
}
if (!input && Parms[MAX_WEIGHT].val != MAX_INT) {
CLOCK_START(WEIGH_CL_TIME);
wt = weight_cl(c, Weight_purge_gen_index);
CLOCK_STOP(WEIGH_CL_TIME);
if (wt > Parms[MAX_WEIGHT].val) {
/* Do not delete if it hint_keep_test() says to keep it. */
if (hint_keep_test(c)) {
if (Flags[VERY_VERBOSE].val)
printf(" keeping clause because it matches a hint.\n");
}
else {
if (Flags[VERY_VERBOSE].val)
printf(" deleted because weight=%d.\n", wt);
Stats[CL_WT_DELETE]++;
return(0);
}
}
}
if (!input && Flags[DELETE_IDENTICAL_NESTED_SKOLEM].val) {
if (ident_nested_skolems(c)) {
Stats[CL_WT_DELETE]++;
return(0);
}
}
if (Flags[SORT_LITERALS].val) {
CLOCK_START(SORT_LITS_TIME);
if (sort_lits(c) && input) {
/* If an input clause is changed by sorting, make a note in
the justification.
*/
struct int_ptr *p;
struct int_ptr *ip = get_int_ptr();
ip->i = PROPOSITIONAL_RULE;
p = c->parents;
if (p == NULL)
c->parents = ip;
else {
while (p->next)
p = p->next;
p->next = ip;
}
}
CLOCK_STOP(SORT_LITS_TIME);
}
if (Flags[ORDER_EQ].val) {
/* For each eq literal that has been flipped, add an entry to
* the history. To make sense, this has to be done after sort_lits.
*/
struct int_ptr *ip1, *ip2, *ip3;
struct literal *lit;
int i;
for(lit = c->first_lit, i = 1; lit; lit = lit->next_lit, i++) {
if (TP_BIT(lit->atom->bits, SCRATCH_BIT)) {
CLEAR_BIT(lit->atom->bits, SCRATCH_BIT);
ip1 = get_int_ptr(); ip1->i = FLIP_EQ_RULE;
ip2 = get_int_ptr(); ip2->i = LIST_RULE-1; ip1->next = ip2;
ip3 = get_int_ptr(); ip3->i = i; ip2->next = ip3;
if (c->parents) {
for (ip3 = c->parents; ip3->next; ip3 = ip3->next);
ip3->next = ip1;
}
else
c->parents = ip1;
}
}
}
if (Flags[FOR_SUB].val) {
CLOCK_START(FOR_SUB_TIME);
e = forward_subsume(c);
CLOCK_STOP(FOR_SUB_TIME);
if (e) {
if (Flags[VERY_VERBOSE].val)
printf(" Subsumed by %d.\n", e->id);
else if (input) {
printf(" Following clause subsumed by %d during input processing: ", e->id);
print_clause(stdout, c);
}
Stats[CL_FOR_SUB]++;
if (e->container == Sos)
Stats[FOR_SUB_SOS]++;
if (e->id < 100)
Subsume_count[e->id]++;
else
Subsume_count[0]++;
return(0);
}
}
CLOCK_START(RENUMBER_TIME);
if (renumber_vars(c) == 0) {
Stats[CL_VAR_DELETES]++;
CLOCK_STOP(RENUMBER_TIME);
return(0);
}
CLOCK_STOP(RENUMBER_TIME);
return(1);
} /* proc_gen */
/*************
*
* pre_process(c, input, lst)
*
*************/
void pre_process(struct clause *c,
int input,
struct list *lst)
{
int i;
struct clause *e, *original_input;
CLOCK_START(PRE_PROC_TIME);
if (heat_is_on()) /* if c was generated by hot inference */
Stats[HOT_GENERATED]++;
if (!c->parents)
original_input = cl_copy(c);
else
original_input = NULL;
i = proc_gen(c, input);
if (!i) {
CLOCK_START(DEL_CL_TIME);
#ifdef SCOTT
scott_delete_from_base(c);
#endif
cl_del_non(c);
if (original_input)
cl_del_non(original_input);
CLOCK_STOP(DEL_CL_TIME);
CLOCK_STOP(PRE_PROC_TIME);
return;
}
if (original_input && c->parents) {
/* When input clauses are changed (demod, unit_del, factor_simp,
* sort_lits) during pre_process, we keep the original so that proofs
* make sense (in particular, so that proof_objects make sense).
*/
struct int_ptr *ip1, *ip2;
cl_integrate(original_input);
hide_clause(original_input);
ip1 = get_int_ptr();
ip2 = get_int_ptr();
ip1->i = COPY_RULE;
ip2->i = original_input->id;
ip1->next = ip2;
ip2->next = c->parents;
c->parents = ip1;
}
CLOCK_START(KEEP_CL_TIME);
cl_integrate(c);
index_lits_all(c);
if (lst == Usable)
index_lits_clash(c);
#ifdef SCOTT
if (c->pick_weight)
abort_scott("Clauses gets weight twice. This is a bug.\n");
#endif
#ifndef SCOTT /* do this after for scott */
append_cl(lst, c);
#endif
c->pick_weight = weight_cl(c, Weight_pick_given_index);
adjust_weight_with_hints(c);
if (Parms[AGE_FACTOR].val != 0)
c->pick_weight += (Stats[CL_GIVEN] / Parms[AGE_FACTOR].val);
if (Parms[DISTINCT_VARS_FACTOR].val != 0)
c->pick_weight += distinct_vars(c) * Parms[DISTINCT_VARS_FACTOR].val;
Stats[CL_KEPT]++;
if (c->heat_level > 0)
Stats[HOT_KEPT]++;
CLOCK_STOP(KEEP_CL_TIME);
if (input || Flags[PRINT_KEPT].val) {
printf("** KEPT (pick-wt=%d): ", c->pick_weight);
CLOCK_START(PRINT_CL_TIME);
print_clause(stdout, c);
CLOCK_STOP(PRINT_CL_TIME);
}
if (Flags[DYNAMIC_DEMOD].val &&
unit_clause(c) &&
num_literals_including_answers(c) == 1 &&
pos_eq_lit(ith_literal(c, 1))) {
int demod_flag;
CLOCK_START(NEW_DEMOD_TIME);
demod_flag = dynamic_demodulator(c);
if (demod_flag != 0) {
/* make sure there are no calls to cl_integrate between
* KEEP and here, because new_demod ID must be one more
* than KEPT copy. In particular, check_for_proof. */
struct clause *d;
d = new_demod(c, demod_flag);
if (Flags[PRINT_NEW_DEMOD].val || input) {
printf("---> New Demodulator: ");
if (demod_flag == 2)
printf("(lex-dependent) ");
print_clause(stdout, d);
}
}
CLOCK_STOP(NEW_DEMOD_TIME);
}
CLOCK_START(CONFLICT_TIME);
e = check_for_proof(c);
CLOCK_STOP(CONFLICT_TIME);
if (Parms[MAX_PROOFS].val != -1 &&
Stats[EMPTY_CLAUSES] >= Parms[MAX_PROOFS].val) {
if (!splitting() || current_case() == NULL) {
fprintf(stderr, "\n%cSearch stopped by max_proofs option.\n\n", Bell);
printf("\nSearch stopped by max_proofs option.\n");
cleanup();
}
else {
/* This is a case. */
if (!Flags[REALLY_DELETE_CLAUSES].val) {
/* Send assumptions used for refutation to the parent. */
assumps_to_parent(e);
}
output_stats(stdout, Parms[STATS_LEVEL].val);
printf("\nProcess %d finished %s", my_process_id(), get_time());
}
exit(PROOF_EXIT);
}
#ifdef SCOTT
/*----------------------------------------------------------------------.
| Add semantic weight to inferred clause. Need to do before clause |
| appended so that partition info is correct. This can take some time, |
| so it has been moved to after check_for_proof() |
`----------------------------------------------------------------------*/
if (!input && get_semantic_guidance_flag()) add_semantic_wt(c);
if (num_literals(c)) { /* empty clauses are hidden */
if (!input
&& lst == Sos /* only shuffle SOS */
&& get_shuffle_sos_flag() /* we want to shuffle */
&& !First->first_cl /* dont shuffle if input first is empty */
&& (e = find_random_cl(Sos))) /* and we can */
insert_after_cl(e,c); /* Place inferred clause randomly in SOS.*/
else
append_cl(lst, c);
}
#endif
if (!input && c->pick_weight <= Parms[DYNAMIC_HEAT_WEIGHT].val)
hot_dynamic(c); /* add to the hot list */
CLOCK_STOP(PRE_PROC_TIME);
} /* pre_process */
./otter/proto.h 0000744 0002044 0001012 00000066535 11120534452 012001 0 ustar beeson /* proto.h made
Tuesday, May 08, 02:40:38 PM 2001 (CDT)
*/
/* main.c */
void print_banner(int argc,
char **argv);
/* av.c */
int **tp_alloc(int n);
struct term *get_term(void);
void free_term(struct term *p);
struct rel *get_rel(void);
void free_rel(struct rel *p);
struct sym_ent *get_sym_ent(void);
void free_sym_ent(struct sym_ent *p);
struct term_ptr *get_term_ptr(void);
void free_term_ptr(struct term_ptr *p);
struct formula_ptr_2 *get_formula_ptr_2(void);
void free_formula_ptr_2(struct formula_ptr_2 *p);
struct fpa_tree *get_fpa_tree(void);
void free_fpa_tree(struct fpa_tree *p);
struct fpa_head *get_fpa_head(void);
void free_fpa_head(struct fpa_head *p);
struct context *get_context(void);
void free_context(struct context *p);
struct trail *get_trail(void);
void free_trail(struct trail *p);
struct imd_tree *get_imd_tree(void);
void free_imd_tree(struct imd_tree *p);
struct imd_pos *get_imd_pos(void);
void free_imd_pos(struct imd_pos *p);
struct is_tree *get_is_tree(void);
void free_is_tree(struct is_tree *p);
struct is_pos *get_is_pos(void);
void free_is_pos(struct is_pos *p);
struct fsub_pos *get_fsub_pos(void);
void free_fsub_pos(struct fsub_pos *p);
struct literal *get_literal(void);
void free_literal(struct literal *p);
struct clause *get_clause(void);
void free_clause(struct clause *p);
struct list *get_list(void);
void free_list(struct list *p);
struct clash_nd *get_clash_nd(void);
void free_clash_nd(struct clash_nd *p);
struct clause_ptr *get_clause_ptr(void);
void free_clause_ptr(struct clause_ptr *p);
struct ci_ptr *get_ci_ptr(void);
void free_ci_ptr(struct ci_ptr *p);
struct int_ptr *get_int_ptr(void);
void free_int_ptr(struct int_ptr *p);
struct ans_lit_node *get_ans_lit_node(void);
void free_ans_lit_node(struct ans_lit_node *p);
struct formula_box *get_formula_box(void);
void free_formula_box(struct formula_box *p);
struct formula *get_formula(void);
void free_formula(struct formula *p);
struct formula_ptr *get_formula_ptr(void);
void free_formula_ptr(struct formula_ptr *p);
struct cl_attribute *get_cl_attribute(void);
void free_cl_attribute(struct cl_attribute *p);
struct link_node *get_link_node(void);
void free_link_node(struct link_node *p);
void free_imd_pos_list(struct imd_pos *p);
void free_is_pos_list(struct is_pos *p);
void print_mem(FILE *fp);
void print_mem_brief(FILE *fp);
int total_mem(void);
int total_mem_calls(void);
void print_linked_ur_mem_stats(void);
/* io.c */
int str_double(char *s,
double *dp);
void double_str(double d,
char *s);
int str_int(char *s,
int *np);
void int_str(int i,
char *s);
int str_long(char *s,
long int *np);
int bits_ulong(char *s,
long unsigned int *np);
void long_str(long int i,
char *s);
void ulong_bits(long unsigned int i,
char *s);
void cat_str(char *s1,
char *s2,
char *s3);
int str_ident(char *s,
char *t);
void reverse(char *s);
struct sym_ent *insert_sym(char *s,
int arity);
int str_to_sn(char *str,
int arity);
void print_syms(FILE *fp);
void p_syms(void);
char *sn_to_str(int sym_num);
int sn_to_arity(int sym_num);
struct sym_ent *sn_to_node(int sym_num);
int sn_to_ec(int sym_num);
struct sym_ent *sym_tab_member(char *str,
int arity);
int in_sym_tab(char *s);
void free_sym_tab(void);
int is_symbol(struct term *t,
char *str,
int arity);
void mark_as_skolem(int sym_num);
int is_skolem(int sym_num);
int initial_str(char *s,
char *t);
int set_vars(struct term *t);
int set_vars_term(struct term *t,
char **varnames);
int var_name(char *s);
struct term_ptr *read_list(FILE *fp,
int *ep,
int integrate);
void print_list(FILE *fp,
struct term_ptr *p);
void bird_print(FILE *fp,
struct term *t);
void write_term(FILE *fp,
struct term *t,
int n,
int *prev);
void display_term(FILE *fp,
struct term *t);
void print_term(FILE *fp,
struct term *t);
void p_term(struct term *t);
void d_term(struct term *t);
void print_term_nl(FILE *fp,
struct term *t);
int print_term_length(struct term *t);
void pretty_print_term(FILE *fp,
struct term *t,
int indents);
void print_variable(FILE *fp,
struct term *t);
void built_in_symbols(void);
int declare_op(int prec,
int type,
char *str);
void init_special_ops(void);
int process_op_command(struct term *t);
void skip_white(char *buf,
int *p);
int name_sym(char *s);
void print_error(FILE *fp,
char *buf,
int pos);
struct term *str_to_term(char *buf,
int *p,
int in_list);
int read_buf(FILE *fp,
char *buf);
struct term *term_fixup(struct term *t);
struct term *term_fixup_2(struct term *t);
struct term *read_term(FILE *fp,
int *rcp);
void merge_sort(void **a,
void **w,
int start,
int end,
int (*comp_proc)(void *v1, void *v2));
int compare_for_auto_lex_order(void *d1,
void *d2);
void auto_lex_order(void);
/* share.c */
struct term *integrate_term(struct term *t);
void disintegrate_term(struct term *t);
void set_up_pointers(struct term *t);
void zap_term(struct term *t);
void print_term_tab(FILE *fp);
void p_term_tab(void);
void test_terms(FILE *fp);
struct term_ptr *all_instances(struct term *atom);
struct term_ptr *all_instances_fpa(struct term *atom);
void bd_kludge_insert(struct term *t);
void bd_kludge_delete(struct term *t);
/* fpa.c */
struct fpa_index *alloc_fpa_index(void);
void fpa_insert(struct term *t,
int level,
struct fpa_index *index);
void fpa_delete(struct term *t,
int level,
struct fpa_index *index);
struct fpa_tree *build_tree(struct term *t,
int u_type,
int bound,
struct fpa_index *index);
struct term *next_term(struct fpa_tree *n,
int max);
struct fpa_tree *build_for_all(struct fpa_index *index);
void zap_prop_tree(struct fpa_tree *n);
void print_fpa_tab(FILE *fp,
struct fpa_index *index);
void p_fpa_tab(struct fpa_index *index);
void print_prop_tree(FILE *fp,
struct fpa_tree *n,
int level);
void p_prop_tree(struct fpa_tree *n);
void print_path(FILE *fp,
int *path);
void p_path(int *path);
int new_sym_num(void);
/* clocks.c */
void clock_init(void);
long clock_val(int c);
void clock_reset(int c);
char *get_time(void);
long system_time(void);
long run_time(void);
long wall_seconds(void);
/* unify.c */
int occur_check(int vn,
struct context *vc,
struct term *t,
struct context *c);
int unify(struct term *t1,
struct context *c1,
struct term *t2,
struct context *c2,
struct trail **trp);
int unify_no_occur_check(struct term *t1,
struct context *c1,
struct term *t2,
struct context *c2,
struct trail **trp);
int otter_match(struct term *t1,
struct context *c1,
struct term *t2,
struct trail **trp);
struct term *apply(struct term *t,
struct context *c);
int term_ident(struct term *t1,
struct term *t2);
void clear_subst_2(struct trail *t1,
struct trail *t2);
void clear_subst_1(struct trail *t1);
void print_subst(FILE *fp,
struct context *c);
void p_subst(struct context *c);
void print_trail(FILE *fp,
struct trail *t);
/* demod.c */
struct term *convenient_demod(struct term *t);
void zap_term_special(struct term *t);
struct term *apply_demod(struct term *t,
struct context *c,
int *pf);
void demod_cl(struct clause *c);
void back_demod(struct clause *d,
struct clause *c,
int input,
struct list *lst);
int lit_t_f_reduce(struct clause *c);
int check_input_demod(struct clause *c);
int dynamic_demodulator(struct clause *c);
struct clause *new_demod(struct clause *c,
int demod_flag);
/* weight.c */
struct term_ptr *read_wt_list(FILE *fp,
int *ep);
int noncomplexifying(struct context *c);
int overbeek_match(struct term *t);
int weight(struct term *t,
struct is_tree *wt_index);
int wt_match(struct term *t,
struct term *template,
int *wtp,
struct is_tree *wt_index);
void set_wt_list(struct term_ptr *wt_list,
struct is_tree *wt_index,
int *ep);
void weight_index_delete(struct is_tree *wt_index);
int lex_order(struct term *t1,
struct term *t2);
int lex_order_vars(struct term *t1,
struct term *t2);
int lex_check(struct term *t1,
struct term *t2);
int var_subset(struct term *t1,
struct term *t2);
void order_equalities(struct clause *c);
int term_ident_x_vars(struct term *t1,
struct term *t2);
/* imd.c */
void imd_insert(struct clause *demod,
struct imd_tree *imd);
void imd_delete(struct clause *demod,
struct imd_tree *root_imd);
struct term *contract_imd(struct term *t_in,
int *demods,
struct context *subst,
int *demod_id_p);
void print_imd_tree(FILE *fp,
struct imd_tree *imd,
int level);
void p_imd_tree(struct imd_tree *imd);
/* is.c */
void is_insert(struct term *t,
struct is_tree *root_is);
void is_delete(struct term *t,
struct is_tree *root_is);
struct term_ptr *is_retrieve(struct term *t,
struct context *subst,
struct is_tree *is,
struct is_pos **is_pos);
struct term *fs_retrieve(struct term *t,
struct context *subst,
struct is_tree *is,
struct fsub_pos **fs_pos);
void canc_fs_pos(struct fsub_pos *pos,
struct context *subst);
void print_is_tree(FILE *fp,
struct is_tree *is);
void p_is_tree(struct is_tree *is);
/* clause.c */
void reset_clause_counter(void);
int next_cl_num(void);
void assign_cl_id(struct clause *c);
void hot_cl_integrate(struct clause *c);
void cl_integrate(struct clause *c);
void cl_del_int(struct clause *c);
void cl_del_non(struct clause *c);
void cl_int_chk(struct clause *c);
struct term *clause_to_term(struct clause *c);
struct clause *term_to_clause(struct term *t);
struct clause *read_sequent_clause(FILE *fp,
int *rcp);
struct clause *read_clause(FILE *fp,
int *rcp);
struct list *read_cl_list(FILE *fp,
int *ep);
int set_vars_cl(struct clause *cl);
void print_sequent_clause(FILE *fp,
struct clause *c);
void print_clause(FILE *fp,
struct clause *cl);
void p_clause(struct clause *cl);
void print_cl_list(FILE *fp,
struct list *lst);
void cl_merge(struct clause *c);
int tautology(struct clause *c);
int prf_weight(struct clause *c);
int proof_length(struct clause *c);
int subsume(struct clause *c,
struct clause *d);
int map_rest(struct clause *c,
struct clause *d,
struct context *s,
struct trail **trp);
int anc_subsume(struct clause *c,
struct clause *d);
struct clause *for_sub_prop(struct clause *d);
struct clause *forward_subsume(struct clause *d);
struct clause_ptr *back_subsume(struct clause *c);
struct clause_ptr *unit_conflict(struct clause *c);
int propositional_clause(struct clause *c);
int xx_resolvable(struct clause *c);
int pos_clause(struct clause *c);
int answer_lit(struct literal *lit);
int pos_eq_lit(struct literal *lit);
int neg_eq_lit(struct literal *lit);
int eq_lit(struct literal *lit);
int neg_clause(struct clause *c);
int num_literals(struct clause *c);
int num_answers(struct clause *c);
int num_literals_including_answers(struct clause *c);
int literal_number(struct literal *lit);
int unit_clause(struct clause *c);
int horn_clause(struct clause *c);
int equality_clause(struct clause *c);
int symmetry_clause(struct clause *c);
struct literal *ith_literal(struct clause *c,
int n);
void append_cl(struct list *l,
struct clause *c);
void prepend_cl(struct list *l,
struct clause *c);
void insert_before_cl(struct clause *c,
struct clause *c_new);
void insert_after_cl(struct clause *c,
struct clause *c_new);
void rem_from_list(struct clause *c);
void insert_clause(struct clause *c,
struct clause_ptr **cpp);
int max_literal_weight(struct clause *c,
struct is_tree *wt_index);
int weight_cl(struct clause *c,
struct is_tree *wt_index);
void hide_clause(struct clause *c);
void del_hidden_clauses(void);
struct clause *cl_copy(struct clause *c);
int clause_ident(struct clause *c1,
struct clause *c2);
void remove_var_syms(struct term *t);
void cl_insert_tab(struct clause *c);
void cl_delete_tab(struct clause *c);
struct clause *cl_find(int id);
int lit_compare(struct literal *l1,
struct literal *l2);
int ordered_sub_clause(struct clause *c1,
struct clause *c2);
int sub_clause(struct clause *c1,
struct clause *c2);
int sort_lits(struct clause *c);
void all_cont_cl(struct term *t,
struct clause_ptr **cpp);
void zap_cl_list(struct list *lst);
int is_eq(int sym_num);
void mark_literal(struct literal *lit);
int get_ancestors(struct clause *c,
struct clause_ptr **cpp,
struct int_ptr **ipp);
int renumber_vars_term(struct term *t);
int renumber_vars(struct clause *c);
int renum_vars_term(struct term *t,
int *varnums);
void clear_var_names(struct term *t);
void cl_clear_vars(struct clause *c);
int distinct_vars(struct clause *c);
struct clause *find_first_cl(struct list *l);
struct clause *find_last_cl(struct list *l);
struct clause *find_random_cl(struct list *l);
struct clause_ptr *get_clauses_of_wt_range(struct clause *c,
int min, int max);
int clause_ptr_list_size(struct clause_ptr *p);
struct clause *nth_clause(struct clause_ptr *p, int n);
void zap_clause_ptr_list(struct clause_ptr *p);
struct clause *find_random_lightest_cl(struct list *l);
struct clause *find_mid_lightest_cl(struct list *l);
struct clause *find_lightest_cl(struct list *l);
struct clause *find_lightest_geo_child(struct list *l);
struct clause *find_interactive_cl(void);
struct clause *find_given_clause(void);
struct clause *extract_given_clause(void);
int unit_del(struct clause *c);
void back_unit_deletion(struct clause *c,
int input);
/* options.c */
void init_options(void);
void print_options(FILE *fp);
void p_options(void);
void auto_change_flag(FILE *fp,
int index,
int val);
void dependent_flags(FILE *fp,
int index);
void auto_change_parm(FILE *fp,
int index,
int val);
void dependent_parms(FILE *fp,
int index);
int change_flag(FILE *fp,
struct term *t,
int set);
int change_parm(FILE *fp,
struct term *t);
void check_options(void);
/* resolve.c */
int maximal_lit(struct literal *l1);
void hyper_res(struct clause *giv_cl);
void neg_hyper_res(struct clause *giv_cl);
void ur_res(struct clause *giv_cl);
int one_unary_answer(struct clause *c);
struct term *build_term(int sn,
struct term *arg1,
struct term *arg2,
struct term *arg3);
void combine_answers(struct clause *res,
struct term *a1,
struct context *s1,
struct term *a2,
struct context *s2);
struct clause *build_bin_res(struct term *a1,
struct context *s1,
struct term *a2,
struct context *s2);
struct clause *apply_clause(struct clause *c,
struct context *s);
void bin_res(struct clause *giv_cl);
struct clause *first_or_next_factor(struct clause *c,
struct literal **l1p,
struct literal **l2p);
void all_factors(struct clause *c,
struct list *lst);
int factor_simplify(struct clause *c);
/* index.c */
void index_lits_all(struct clause *c);
void un_index_lits_all(struct clause *c);
void index_lits_clash(struct clause *c);
void un_index_lits_clash(struct clause *c);
/* paramod.c */
void para_from(struct clause *giv_cl);
void para_into(struct clause *giv_cl);
/* formula.c */
void print_formula(FILE *fp,
struct formula *f);
void p_formula(struct formula *f);
struct term *formula_to_term(struct formula *f);
struct formula *term_to_formula(struct term *t);
struct formula *read_formula(FILE *fp,
int *rcp);
struct formula_ptr *read_formula_list(FILE *fp,
int *ep);
void print_formula_list(FILE *fp,
struct formula_ptr *p);
struct formula *copy_formula(struct formula *f);
void zap_formula(struct formula *f);
struct formula *negate_formula(struct formula *f);
struct formula *nnf(struct formula *f);
struct formula *skolemize(struct formula *f);
struct formula *anti_skolemize(struct formula *f);
void subst_free_formula(struct term *var,
struct formula *f,
struct term *sk);
void gen_sk_sym(struct term *t);
int skolem_symbol(int sn);
int contains_skolem_symbol(struct term *t);
int new_var_name(void);
int new_functor_name(int arity);
void unique_all(struct formula *f);
struct formula *zap_quant(struct formula *f);
void flatten_top(struct formula *f);
struct formula *cnf(struct formula *f);
struct formula *dnf(struct formula *f);
void rename_syms_formula(struct formula *f,
struct formula *fr);
void subst_sn_term(int old_sn,
struct term *t,
int new_sn,
int type);
void subst_sn_formula(int old_sn,
struct formula *f,
int new_sn,
int type);
int gen_subsume_prop(struct formula *c,
struct formula *d);
struct formula *subsume_conj(struct formula *c);
struct formula *subsume_disj(struct formula *c);
int formula_ident(struct formula *f,
struct formula *g);
void conflict_tautology(struct formula *f);
void ts_and_fs(struct formula *f);
struct list *clausify(struct formula *f);
struct list *clausify_formula_list(struct formula_ptr *fp);
struct formula *negation_inward(struct formula *f);
struct formula *expand_imp(struct formula *f);
struct formula *iff_to_conj(struct formula *f);
struct formula *iff_to_disj(struct formula *f);
struct formula *nnf_cnf(struct formula *f);
struct formula *nnf_dnf(struct formula *f);
struct formula *nnf_skolemize(struct formula *f);
struct formula *clausify_formed(struct formula *f);
void rms_conflict_tautology(struct formula *f);
struct formula *rms_subsume_conj(struct formula *c);
struct formula *rms_subsume_disj(struct formula *c);
int free_occurrence(struct term *v,
struct formula *f);
struct formula *rms_distribute_quants(struct formula *f_quant);
struct formula *rms_push_free(struct formula *f);
struct formula *rms_quantifiers(struct formula *f);
struct formula *rms(struct formula *f);
struct formula *renumber_unique(struct formula *f,
int *vnum_p);
int gen_subsume_rec(struct formula *c,
struct context *cs,
struct formula *d,
struct context *ds,
struct trail **tr_p);
int gen_subsume(struct formula *c,
struct formula *d);
int gen_conflict(struct formula *c,
struct formula *d);
int gen_tautology(struct formula *c,
struct formula *d);
struct formula *rms_cnf(struct formula *f);
struct formula *rms_dnf(struct formula *f);
struct formula *distribute_quantifier(struct formula *f);
/* process.c */
void post_proc_all(struct clause *lst_pos,
int input,
struct list *lst);
void infer_and_process(struct clause *giv_cl);
int proc_gen(struct clause *c,
int input);
void pre_process(struct clause *c,
int input,
struct list *lst);
/* misc.c */
void init(void);
void abend(char *str);
void read_a_file(FILE *in_fp,
FILE *out_fp);
void sos_argument(int argc,
char **argv);
void read_all_input(int argc,
char **argv);
void set_lex_vals(struct term *t);
void set_lrpo_status(struct term *t,
int val);
void set_special_unary(struct term *t);
void set_skolem(struct term *t);
void free_all_mem(void);
void output_stats(FILE *fp,
int level);
void print_stats(FILE *fp);
void print_stats_brief(FILE *fp);
void p_stats(void);
void print_times(FILE *fp);
void print_times_brief(FILE *fp);
void p_times(void);
void append_lists(struct list *l1,
struct list *l2);
struct term *copy_term(struct term *t);
int biggest_var(struct term *t);
int biggest_var_clause(struct clause *c);
int ground_clause(struct clause *c);
void zap_list(struct term_ptr *p);
int occurs_in(struct term *t1,
struct term *t2);
int occurrences(struct term *s,
struct term *t);
int sn_occur(int sn,
struct term *t);
int is_atom(struct term *t);
int ident_nested_skolems(struct clause *c);
int ground(struct term *t);
void cleanup(void);
int check_stop(void);
void report(void);
void control_memory(void);
void print_proof(FILE *fp,
struct clause *c);
struct clause *check_for_proof(struct clause *c);
int proper_list(struct term *t);
void move_clauses(int (*clause_proc)(struct clause *c),
struct list *source,
struct list *destination);
struct int_ptr *copy_int_ptr_list(struct int_ptr *p);
int int_list_length(struct int_ptr *p);
void automatic_1_settings(void);
int sos_has_pos_nonground(void);
void automatic_2_settings(void);
void log_for_x_show(FILE *fp);
int same_structure(struct term *t1,
struct term *t2);
void zap_variable_names(struct term *t);
/* lrpo.c */
int lrpo(struct term *t1,
struct term *t2);
int lrpo_greater(struct term *t1,
struct term *t2);
void order_equalities_lrpo(struct clause *c);
/* linkur.c */
void linked_ur_res(struct clause *giv_cl);
int process_linked_tags(struct clause *cp);
/* linkhyp.c */
void linked_hyper_res(struct clause *giv_cl);
/* foreign.c */
long foo(long int l,
double d,
char *s);
long user_test_long(long int l,
double d,
int b,
char *s,
struct term *t);
double user_test_double(long int l,
double d,
int b,
char *s,
struct term *t);
int user_test_bool(long int l,
double d,
int b,
char *s,
struct term *t);
char *user_test_string(long int l,
double d,
int b,
char *s,
struct term *t);
struct term *user_test_term(long int l,
double d,
int b,
char *s,
struct term *t);
void declare_user_functions(void);
int get_args_for_user_function(struct term *t,
int op_code,
long int *long_args,
double *double_args,
int *bool_args,
char **string_args,
struct term **term_args);
struct term *long_to_term(long int i);
struct term *double_to_term(double d);
struct term *bool_to_term(int i);
struct term *string_to_term(char *s);
struct term *evaluate_user_function(struct term *t,
int op_code);
/* geometry.c */
int geo_rewrite(struct clause *c);
void geometry_rule_unif(struct clause *giv_cl);
int child_of_geometry(struct clause *c);
void gl_demod(struct clause *c,
struct list *lst);
/* hot.c */
void init_hot(void);
int heat_is_on(void);
void switch_to_hot_index(void);
void switch_to_ordinary_index(void);
void hot_index_clause(struct clause *c);
void hot_dynamic(struct clause *c);
void hot_mark_clash_cl(struct clause *c,
int mark);
void hot_inference(struct clause *new_cl);
/* nonport.c */
void non_portable_init(int argc,
char **argv);
void sig_handler(int condition);
char *username(void);
char *hostname(void);
void interact(void);
FILE *init_log_for_x_show(void);
int my_process_id(void);
/* check.c */
struct gen_node *get_gen_node(void);
struct proof_object *get_proof_object(void);
struct proof_object_node *get_proof_object_node(void);
struct int_ptr *copy_ip_segment(struct int_ptr *ip,
int n);
void print_int_list(FILE *fp,
struct int_ptr *ip);
void p_int_list(struct int_ptr *ip);
int trivial_subst(struct context *c);
struct proof_object_node *connect_new_node(struct proof_object *new_proof);
void print_term_s(FILE *fp,
struct term *t);
void p_term_s(struct term *t);
void print_clause_s(FILE *fp,
struct clause *c);
void p_clause_s(struct clause *c);
void print_clause_s2(FILE *fp,
struct clause *c);
void p_clause_s2(struct clause *c);
void print_proof_object_node(FILE *fp,
struct proof_object_node *pn);
void p_proof_object_node(struct proof_object_node *pn);
void print_proof_object(FILE *fp,
struct proof_object *po);
void p_proof_object(struct proof_object *po);
struct clause *cl_copy_delete_literal(struct clause *c,
int n);
int variant(struct term *t1,
struct context *c1,
struct term *t2,
struct context *c2,
struct trail **trp,
int flip);
struct int_ptr *match_clauses(struct clause *c1,
struct clause *c2);
struct clause *cl_append(struct clause *c1,
struct clause *c2);
struct clause *identity_resolve(struct clause *c1,
int i1,
struct clause *c2,
int i2);
void renumber_vars_subst(struct clause *c,
struct term **terms);
int finish_translating(struct clause *c,
struct int_ptr *rest_of_history,
struct proof_object_node *current,
struct proof_object *new_proof);
int ipx(struct int_ptr *ip,
int n);
struct proof_object_node *find_match2(struct clause *c,
struct proof_object *obj,
struct term **vars);
int contains_answer_literal(struct clause *c);
int contains_rule(struct clause *c,
int rule);
void zap_int_ptr_list(struct int_ptr *p);
struct int_ptr *trans_2_pos(int id,
struct int_ptr *pos);
void type_2_trans(struct proof_object *po);
void build_proof_object(struct clause *c);
void init_proof_object_environment(void);
/* hints.c */
void process_hint_attributes(struct clause *c);
void print_hint_clause(FILE *fp,
struct clause *c);
void p_hint_clause(struct clause *c);
void print_hints_cl_list(FILE *fp,
struct list *lst);
void p_hints_cl_list(struct list *lst);
void adjust_weight_with_hints(struct clause *c);
int hint_keep_test(struct clause *c);
/* attrib.c */
void init_attributes(void);
int get_attribute_index(char *s);
int attribute_type(int name);
struct cl_attribute *get_attribute(struct clause *c,
int name);
void set_attribute(struct clause *c,
int name,
void *val_ptr);
void delete_attributes(struct clause *c);
struct cl_attribute *term_to_attributes(struct term *t);
void print_attributes(FILE *fp,
struct cl_attribute *a);
/* case.c */
int splitting(void);
int max_split_depth(void);
int splitable_literal(struct clause *c,
struct literal *l);
int splitable_clause(struct clause *c);
struct clause *compare_splitable_clauses(struct clause *c,
struct clause *d);
void print_case(FILE *fp);
void p_case(void);
void print_case_n(FILE *fp,
int n);
void p_case_n(int n);
void p_assumption_depths(char assumptions[]);
struct int_ptr *current_case(void);
void add_subcase(int i);
int case_depth(void);
struct clause *find_clause_to_split(void);
struct term *find_atom_to_split(void);
int prover_forks(int n,
int *ip,
char assumptions[]);
int split_clause(struct clause *giv_cl);
int split_atom(void);
void possible_split(void);
void always_split(void);
void possible_given_split(struct clause *c);
void assumps_to_parent(struct clause *e);
void exit_with_possible_model(void);
/* lisp.c */
/* ivy.c */
int special_is_symbol(struct term *t, char *str, int arity);
void trans_logic_symbols(struct term *t);
struct proof_object *parse_initial_proof_object(FILE *fp);
struct list *init_proof_object(FILE *fin,
FILE *fout);
struct proof_object *retrieve_initial_proof_object(void);
/* pickdiff.c */
struct int_ptr *cldiff(struct clause *c, struct clause *d);
void print_int_ptr(FILE *fp, struct int_ptr *p);
void p_int_ptr(struct int_ptr *p);
void zap_ci_ptr_list(struct ci_ptr *p);
struct clause *find_pickdiff_cl(struct list *sos, struct list *usable);
/* overbeek.c */
void overbeek_insert(struct term *t);
int overbeek_weight(struct term *t, int *ip);
void print_overbeek_world(void);
void check_overbeek_world(void);
./otter/resolve.c 0000744 0002044 0001012 00000140532 11120534452 012276 0 ustar beeson /*
* resolve.c -- Resolution inference rules.
*
*/
#include <assert.h>
#include "header.h"
#include "bsym.h" // Beeson's files
#include "beta.h"
#include "bterms.h"
#include "unify2.h" // max_vars
/*************
*
* struct clause *build_hyper(clash,nuc_subst,nuc_lits,nuc,
* giv_subst,giv_lits,giv_sat,nuc_pos,sat_indexes)
*
* This routine constructs a hyperresolvent or UR-resolvent.
*
*************/
static struct clause *build_hyper(struct clash_nd *cla,
struct context *nuc_subst,
struct literal *nuc_lits,
struct clause *nuc,
struct context *giv_subst,
struct literal *giv_lits,
struct clause *giv_sat,
int nuc_pos,
int sat_indexes)
{
struct clause *res, *sat;
struct literal *lit, *new, *prev;
struct clash_nd *c;
struct int_ptr *ip1, *ip2, *ip3, *ip4;
int i, j;
int n = 0;
res = get_clause();
ip1 = get_int_ptr(); /* to be filled in by caller with name of inference rule */
res->parents = ip1;
/* If given clause is satellite, add number to parent list. */
ip3 = NULL;
if (giv_sat) {
ip2 = get_int_ptr();
ip2->i = giv_sat->id;
if (Flags[ORDER_HISTORY].val && nuc_pos != 0)
/* insert later in correct position */
ip3 = ip2;
else {
ip1->next = ip2;
ip1 = ip2;
}
}
ip2 = get_int_ptr();
ip2->i = nuc->id;
ip1->next = ip2;
lit = giv_lits;
prev = NULL;
while (lit != NULL) {
new = get_literal();
new->container = res;
if (prev == NULL)
res->first_lit = new;
else
prev->next_lit = new;
prev = new;
new->sign = lit->sign;
new->atom = apply(lit->atom, giv_subst);
new->atom->occ.lit = new;
new->atom->varnum = lit->atom->varnum; /* copy type of atom */
lit = lit->next_lit;
}
lit = nuc_lits;
while (lit != NULL) {
new = get_literal();
new->container = res;
if (res->first_lit == NULL)
res->first_lit = new;
else
prev->next_lit = new;
prev = new;
new->sign = lit->sign;
new->atom = apply(lit->atom, nuc_subst);
new->atom->occ.lit = new;
new->atom->varnum = lit->atom->varnum; /* copy type of atom */
lit = lit->next_lit;
}
c = cla;
i = 1;
while (c != NULL) {
if (ip3 && i == nuc_pos) {
/* insert given clause (which is satellite) number here */
ip2->next = ip3;
ip2 = ip3;
}
ip1 = get_int_ptr();
ip2->next = ip1;
ip2 = ip1;
if (c->evaluable)
ip1->i = EVAL_RULE;
else {
sat = c->found_atom->occ.lit->container;
lit = sat->first_lit;
j = 0;
while (lit != NULL) {
j++;
if (lit->atom != c->found_atom) {
new = get_literal();
new->container = res;
if (res->first_lit == NULL)
res->first_lit = new;
else
prev->next_lit = new;
prev = new;
new->sign = lit->sign;
new->atom = apply(lit->atom, c->subst);
new->atom->occ.lit = new;
new->atom->varnum = lit->atom->varnum; /* type of atom */
}
else
n = j;
lit = lit->next_lit;
}
ip1->i = sat->id;
if (sat_indexes) {
ip1 = get_int_ptr();
ip4 = get_int_ptr();
ip1->next = ip4;
ip2->next = ip1;
ip1->i = LIST_RULE-1;
ip4->i = n;
ip2 = ip4;
}
}
i++;
c = c->next;
}
if (ip3 && i == nuc_pos) {
/* insert given clause (which is satellite) number here */
ip2->next = ip3;
ip2 = ip3;
}
if (ip3 && sat_indexes) {
struct literal *l1, *l2;
ip1 = get_int_ptr();
ip4 = get_int_ptr();
ip1->next = ip4;
ip4->next = ip3->next;
ip3->next = ip1;
ip1->i = LIST_RULE-1;
/* Need index of clashed literal in given clause (which is satellite). */
l1 = giv_sat->first_lit;
l2 = giv_lits;
i = 1;
while (l2 && l1->sign == l2->sign && l1->atom == l2->atom) {
l1 = l1->next_lit; l2 = l2->next_lit; i++;
}
ip4->i = i;
}
return(res);
} /* build_hyper */
/*************
*
* maximal_lit()
*
* true iff no predicate symbol in clause has a higher lex val.
*
*************/
int maximal_lit(struct literal *l1)
{
struct literal *l2;
int i1;
i1 = sn_to_node(l1->atom->sym_num)->lex_val;
for (l2 = l1->container->first_lit; l2; l2 = l2->next_lit) {
if (l2 != l1 && l2->atom->varnum != ANSWER) {
if (l2->sign > l1->sign)
return(0);
else if (l2->sign == l1->sign &&
sn_to_node(l2->atom->sym_num)->lex_val > i1)
return(0);
}
}
return(1);
} /* maximal_lit */
/*************
*
* clash(c_start, nuc_subst, nuc_lits, nuc, giv_subst, giv_lits, giv_sat,
* sat_proc, inf_clock, nuc_pos)
*
* This routine is called by both hyper and UR to clash away the
* marked literals of the given nucleus, and append kept resolvents
* to Sos.
*
* c_start: Start of the clash_structure list. There is one node
* for each literal that is to be clashed away.
* nuc_subst: Substitution for the nucleus.
* nuc_lits: Non-clashed literals of the nucleus.
* nuc: The nucleus.
* giv_subst: If the given clause is a satellite, then this is its
* substitution; else NULL.
* giv_lits: If the given clause is a satellite, then these are its
* non-clashed literals; else NULL.
* giv_sat: If the given clause is a satellite, then this is it;
* else NULL.
* sat_proc: procedure to identify (other) satellites: `pos_clause'
* for hyper, `unit_clause' for UR.
* inf_clock: Clock (HYPER_TIME or UR_TIME) to be turned off during
* call to `pre_process'.
* nuc_pos: If not 0, giv cl is sat, and nuc_pos gives position
* of "missing" clash node. To construct history.
* ur_box: if not 0, UR is rule, and this is the index of the boxed literal.
*
*************/
static void clash(struct clash_nd *c_start,
struct context *nuc_subst,
struct literal *nuc_lits,
struct clause *nuc,
struct context *giv_subst,
struct literal *giv_lits,
struct clause *giv_sat,
int (*sat_proc)(struct clause *c),
int inf_clock,
int nuc_pos,
int ur_box)
{
struct clash_nd *c;
struct clash_nd *c_end = NULL;
int found, backup, fpa_depth, sign;
struct term *f_atom, *nuc_atom_instance;
struct trail *tr;
struct clause *res;
char *s;
int save_nextvar, save_nextvar2, save_nextvar3; // Beeson 4.05.04
save_nextvar2 = nuc_subst->next_var; // Beeson 5.04.04
save_nextvar3 = giv_subst? giv_subst->next_var : 0;
fpa_depth = Parms[FPA_LITERALS].val;
c = NULL;
backup = 0;
while (1) { /* return from within loop */
if (backup == 0) {
if (c_start == NULL || (c != NULL && c->next == NULL)) {
/* clash is complete */
res = build_hyper(c_start, nuc_subst, nuc_lits, nuc,
giv_subst, giv_lits, giv_sat, nuc_pos,
(inf_clock == HYPER_TIME || inf_clock == NEG_HYPER_TIME) &&
Flags[BUILD_PROOF_OBJECT].val);
if (inf_clock == HYPER_TIME) {
Stats[HYPER_RES_GEN]++;
res->parents->i = HYPER_RES_RULE;
}
else if (inf_clock == NEG_HYPER_TIME) {
Stats[NEG_HYPER_RES_GEN]++;
res->parents->i = NEG_HYPER_RES_RULE;
}
else {
Stats[UR_RES_GEN]++;
res->parents->i = UR_RES_RULE;
if (Flags[BUILD_PROOF_OBJECT].val) {
/* Insert position of NONclashed nuc literal into history. */
struct int_ptr *ip1, *ip2;
ip1 = get_int_ptr();
ip2 = get_int_ptr();
ip1->next = ip2;
ip2->next = res->parents->next->next;
res->parents->next->next = ip1;
ip1->i = LIST_RULE-1;
ip2->i = ur_box;
}
}
Stats[CL_GENERATED]++;
if (heat_is_on()) {
struct clause *giv;
giv = (giv_sat ? giv_sat : nuc);
res->heat_level = giv->heat_level + 1;
}
CLOCK_STOP(inf_clock);
pre_process(res, 0, Sos);
CLOCK_START(inf_clock);
backup = 1;
c_end = c;
c = NULL;
}
else {
if (c == NULL) /* just starting */
c = c_start;
else
c = c->next;
save_nextvar = c->subst->next_var; // Beeson 5.04.04
nuc_atom_instance = apply(c->nuc_atom, nuc_subst);
if (c->evaluable) {
/* evaluate, but don't take any action yet */
nuc_atom_instance = convenient_demod(nuc_atom_instance);
s = sn_to_str(nuc_atom_instance->sym_num);
sign = c->nuc_atom->occ.lit->sign;
if (sign)
c->evaluation = str_ident(s, "$F");
else
c->evaluation = str_ident(s,"$T");
c->already_evaluated = 0;
}
else { /* not evaluable */
c->u_tree = build_tree(nuc_atom_instance, UNIFY,fpa_depth, c->db);
}
zap_term(nuc_atom_instance);
}
}
else { /* backup */
if (c_start == NULL ||
(c != NULL && c->prev == NULL)) /* done with this nucleus */
return;
else {
if (c == NULL)
c = c_end;
else
c = c->prev;
if (!c->evaluable)
clear_subst_1(c->tr);
backup = 0;
c->subst->next_var = save_nextvar; // Beeson 5.04.04
nuc_subst->next_var = save_nextvar2; // Beeson 4.05.04
if(giv_subst)
giv_subst->next_var = save_nextvar3; // Beeson 4.05.04
}
}
if (backup == 0) {
found = 0;
if (c->evaluable) {
if (c->already_evaluated || !c->evaluation)
backup = 1;
else
/* Set flag and proceed. */
c->already_evaluated = 1;
}
else {
f_atom = next_term(c->u_tree, 0);
tr = NULL;
while (f_atom && !found) {
memset(c->subst->bound,0,MAX_VARS*sizeof(char)); // Beeson 7.18.03
memset(c->subst->forbidden,0,MAX_VARS*sizeof(restrictdata)); // Beeson 7.18.03
c->subst->next_var = save_nextvar; // Beeson 5.04.04
nuc_subst->next_var = save_nextvar2; // Beeson 5.04.04
if(giv_subst) // Beeson 5.05.04
giv_subst->next_var = save_nextvar3; // Beeson 5.05.04
/* Sorry this test is so complicated. */
if (
/* Basic satellite test. */
(*sat_proc)(f_atom->occ.lit->container) &&
/* order_hyper & !UR -> maximal_lit */
(!Flags[ORDER_HYPER].val ||
inf_clock == UR_TIME ||
maximal_lit(f_atom->occ.lit)) &&
(
(Flags[LAMBDA_FLAG].val == 0 || // Beeson 6.15.03
( // Beeson 6.15.03
(c->subst->next_var = nuc_subst->next_var) != 0 && // Beeson 6.15.03
(c->subst->next_var = max_vars(giv_sat, f_atom)) != 0 && // Beeson 6.15.03
forbid_bound(c->subst,f_atom) // Beeson 7.17.03
) // Beeson 6.15.03
) // Beeson 6.15.03
) &&
unify(c->nuc_atom,nuc_subst,f_atom,c->subst,&tr)
) {
found = 1;
}
if (!found)
f_atom = next_term(c->u_tree, 0);
}
if (found) {
c->found_atom = f_atom;
c->tr = tr;
}
else {
backup = 1;
}
}
}
} /* while */
} /* clash */
/*************
*
* hyper_res(c) -- hyperresolution
*
* Append kept resolvents to Sos. Each kept
* clause has already passed the pre_process filter (forward
* subsumption, etc.), been integrated, and inserted into
* appropriate indexes.
*
*************/
void hyper_res(struct clause *giv_cl)
{
struct literal *lit, *nuc_lits, *giv_lits, *l1, *l2, *l3;
struct context *nuc_subst, *giv_subst;
struct clash_nd *clash_list, *c1, *c2;
struct clause *nuc;
int m, i, nuc_pos;
struct term *f_atom;
struct fpa_tree *ut;
struct trail *tr;
CLOCK_START(HYPER_TIME);
if (num_literals(giv_cl) == 0) {
CLOCK_STOP(HYPER_TIME);
return;
}
else if (!pos_clause(giv_cl)) { /* given clause is nucleus */
clash_list = NULL;
nuc_lits = NULL;
if(Flags[LAMBDA_FLAG].val)
nuc_subst = get_context2(giv_cl,0); // Beeson 6.13.03
else
{ nuc_subst = get_context();
nuc_subst->multiplier = 0;
}
m = 1;
lit = giv_cl->first_lit;
l2 = NULL; c2 = NULL; /* to quiet lint */
while (lit != NULL) {
/* positive literal || answer literal */
if (lit->sign || lit->atom->varnum == ANSWER) {
l1 = get_literal();
if (nuc_lits == NULL)
nuc_lits = l1;
else
l2->next_lit = l1;
l2 = l1;
l1->sign = lit->sign;
l1->atom = lit->atom;
}
else { /* put negative literal into clash structure */
c1 = get_clash_nd();
if (clash_list == NULL)
clash_list = c1;
else {
c2->next = c1;
c1->prev = c2;
}
c2 = c1;
c2->db = Fpa_clash_pos_lits;
if(Flags[LAMBDA_FLAG].val) // Beeson 6.17.03
c2->subst = get_context2(giv_cl,m++); // Beeson 6.17.03
else // Beeson 6.17.03
{ c2->subst = get_context();
c2->subst->multiplier = m++;
}
c2->nuc_atom = lit->atom;
c2->evaluable = (lit->atom->varnum == EVALUABLE);
}
lit = lit->next_lit;
}
clash(clash_list, nuc_subst, nuc_lits, giv_cl,
(struct context *) NULL, (struct literal *) NULL,
(struct clause *) NULL,
pos_clause, HYPER_TIME, 0, 0);
c1 = clash_list;
while (c1 != NULL) {
free_context(c1->subst);
c2 = c1;
c1 = c1->next;
free_clash_nd(c2);
}
l1 = nuc_lits;
while (l1 != NULL) {
l2 = l1;
l1 = l1->next_lit;
free_literal(l2);
}
free_context(nuc_subst);
CLOCK_STOP(HYPER_TIME);
return;
}
else { /* given clause is satellite (positive) */
if(Flags[LAMBDA_FLAG].val)
{ giv_subst = get_context2(giv_cl,0); /* Beeson 6.13.03 */
nuc_subst = get_context2(giv_cl,1); /* Beeson 6.13.03 */
}
else
{ giv_subst = get_context();
giv_subst->multiplier = 0;
nuc_subst = get_context(); /* substitution for nucleus */
nuc_subst->multiplier = 1;
}
l3 = giv_cl->first_lit;
l2 = NULL; c2 = NULL;
while (l3 != NULL) { /* for each literal in given satellite */
if (!Flags[ORDER_HYPER].val || maximal_lit(l3)) {
/* collect non-clashed lits (including answers) of given sat*/
giv_lits = NULL;
lit = giv_cl->first_lit;
while (lit != NULL) {
if (lit != l3) {
l1 = get_literal();
if (giv_lits == NULL)
giv_lits = l1;
else
l2->next_lit = l1;
l2 = l1;
l1->sign = lit->sign;
l1->atom = lit->atom;
}
lit = lit->next_lit;
}
ut = build_tree(l3->atom, UNIFY,
Parms[FPA_LITERALS].val, Fpa_clash_neg_lits);
f_atom = next_term(ut, 0);
while (f_atom != NULL) { /* for each potential nucleus */
tr = NULL;
nuc = f_atom->occ.lit->container;
// Next ensure that giv_subst->next_var exceeds all var_nums in giv_cl as well as in
// the clause containing f_atom.
giv_subst->next_var = max_vars(giv_cl, f_atom); // Beeson 6.13.03
nuc_subst->next_var = giv_subst->next_var; // Beeson 7.22.03
memset(nuc_subst->bound,0,MAX_VARS*sizeof(char)); // Beeson 7.17.03
memset(nuc_subst->forbidden,0,MAX_VARS*sizeof(restrictdata)); // Beeson 7.18.03
forbid_bound(nuc_subst,f_atom); // Beeson 7.17.03
if (!pos_clause(nuc) &&
unify(l3->atom, giv_subst, f_atom, nuc_subst, &tr)) {
/* we have a nucleus */
/* there are three kinds of literal in the nucleus: */
/* 1. the clashed literal -> do nothing */
/* 2. positive or answer literals -> collect them */
/* 3. negative literals -> put into clash structure */
nuc_lits = NULL;
clash_list = NULL;
m = 2; /* multipliers for found sats start with 2 */
lit = nuc->first_lit;
i = 1; /* find index of clausable lit that sat clashes with. */
nuc_pos = 0;
while (lit != NULL) {
if (lit->atom == f_atom) /* save position */
nuc_pos = i;
/* positive || answer */
else if (lit->sign || lit->atom->varnum == ANSWER) {
l1 = get_literal();
if (nuc_lits == NULL)
nuc_lits = l1;
else
l2->next_lit = l1;
l2 = l1;
l1->sign = lit->sign;
l1->atom = lit->atom;
}
else { /* put literal into clash structure */
i++;
c1 = get_clash_nd();
if (clash_list == NULL)
clash_list = c1;
else {
c2->next = c1;
c1->prev = c2;
}
c2 = c1;
c2->db = Fpa_clash_pos_lits;
if(Flags[LAMBDA_FLAG].val) // Beeson 6.17.03
c2->subst = get_context2(giv_cl,m++); // Beeson 6.17.03
else // Beeson 6.17.03
{ c2->subst = get_context();
c2->subst->multiplier = m++;
}
c2->nuc_atom = lit->atom;
c2->evaluable = (lit->atom->varnum == EVALUABLE);
}
lit = lit->next_lit;
}
clash(clash_list, nuc_subst, nuc_lits, nuc,
giv_subst, giv_lits, giv_cl,
pos_clause, HYPER_TIME, nuc_pos, 0);
/* now deallocate the clash structure and literal nodes */
c1 = clash_list;
while (c1 != NULL) {
free_context(c1->subst);
c2 = c1;
c1 = c1->next;
free_clash_nd(c2);
}
l1 = nuc_lits;
while (l1 != NULL) {
l2 = l1;
l1 = l1->next_lit;
free_literal(l2);
}
clear_subst_1(tr);
}
f_atom = next_term(ut, 0);
}
l1 = giv_lits;
while (l1 != NULL) {
l2 = l1;
l1 = l1->next_lit;
free_literal(l2);
}
}
l3 = l3->next_lit;
}
free_context(giv_subst);
free_context(nuc_subst);
CLOCK_STOP(HYPER_TIME);
return;
}
} /* hyper_res */
/*************
*
* neg_hyper_res(c) -- negative hyperresolution
*
* Append kept resolvents to Sos. Each kept
* clause has already passed the pre_process filter (forward
* subsumption, etc.), been integrated, and inserted into
* appropriate indexes.
*
*************/
void neg_hyper_res(struct clause *giv_cl)
{
struct literal *lit, *nuc_lits, *giv_lits, *l1, *l2, *l3;
struct context *nuc_subst, *giv_subst;
struct clash_nd *clash_list, *c1, *c2;
struct clause *nuc;
int m, i, nuc_pos;
struct term *f_atom;
struct fpa_tree *ut;
struct trail *tr;
/* This code should have been combined with the pos hyper code. */
CLOCK_START(NEG_HYPER_TIME);
if (num_literals(giv_cl) == 0) {
CLOCK_STOP(NEG_HYPER_TIME);
return;
}
else if (!neg_clause(giv_cl)) { /* given clause is nucleus */
clash_list = NULL;
nuc_lits = NULL;
nuc_subst = get_context();
nuc_subst->multiplier = 0;
m = 1;
lit = giv_cl->first_lit;
l2 = NULL; c2 = NULL; /* to quiet lint */
while (lit != NULL) {
/* negative literal || answer literal */
if (!lit->sign || lit->atom->varnum == ANSWER) {
l1 = get_literal();
if (nuc_lits == NULL)
nuc_lits = l1;
else
l2->next_lit = l1;
l2 = l1;
l1->sign = lit->sign;
l1->atom = lit->atom;
}
else { /* put positive literal into clash structure */
c1 = get_clash_nd();
if (clash_list == NULL)
clash_list = c1;
else {
c2->next = c1;
c1->prev = c2;
}
c2 = c1;
c2->db = Fpa_clash_neg_lits;
c2->subst = get_context();
c2->subst->multiplier = m++;
c2->nuc_atom = lit->atom;
c2->evaluable = (lit->atom->varnum == EVALUABLE);
}
lit = lit->next_lit;
}
clash(clash_list, nuc_subst, nuc_lits, giv_cl,
(struct context *) NULL, (struct literal *) NULL,
(struct clause *) NULL,
neg_clause, NEG_HYPER_TIME, 0, 0);
c1 = clash_list;
while (c1 != NULL) {
free_context(c1->subst);
c2 = c1;
c1 = c1->next;
free_clash_nd(c2);
}
l1 = nuc_lits;
while (l1 != NULL) {
l2 = l1;
l1 = l1->next_lit;
free_literal(l2);
}
free_context(nuc_subst);
CLOCK_STOP(NEG_HYPER_TIME);
return;
}
else { /* given clause is satellite (negative) */
giv_subst = get_context(); /* substitution for given satellite */
giv_subst->multiplier = 0;
nuc_subst = get_context(); /* substitution for nucleus */
nuc_subst->multiplier = 1;
l3 = giv_cl->first_lit;
l2 = NULL; c2 = NULL;
while (l3 != NULL) { /* for each literal in given satellite */
if (!Flags[ORDER_HYPER].val || maximal_lit(l3)) {
/* collect non-clashed lits (including answers) of given sat*/
giv_lits = NULL;
lit = giv_cl->first_lit;
while (lit != NULL) {
if (lit != l3) {
l1 = get_literal();
if (giv_lits == NULL)
giv_lits = l1;
else
l2->next_lit = l1;
l2 = l1;
l1->sign = lit->sign;
l1->atom = lit->atom;
}
lit = lit->next_lit;
}
ut = build_tree(l3->atom, UNIFY,
Parms[FPA_LITERALS].val, Fpa_clash_pos_lits);
f_atom = next_term(ut, 0);
while (f_atom != NULL) { /* for each potential nucleus */
tr = NULL;
nuc = f_atom->occ.lit->container;
if (!neg_clause(nuc) &&
unify(l3->atom, giv_subst, f_atom, nuc_subst, &tr)) {
/* we have a nucleus */
/* there are three kinds of literal in the nucleus: */
/* 1. the clashed literal -> do nothing */
/* 2. negative or answer literals -> collect them */
/* 3. positive literals -> put into clash structure */
nuc_lits = NULL;
clash_list = NULL;
m = 2; /* multipliers for found sats start with 2 */
lit = nuc->first_lit;
i = 1; /* find index of clahsable lit that sat clashes with. */
nuc_pos = 0;
while (lit != NULL) {
if (lit->atom == f_atom) /* save position */
nuc_pos = i;
/* negative || answer */
else if (!lit->sign || lit->atom->varnum == ANSWER) {
l1 = get_literal();
if (nuc_lits == NULL)
nuc_lits = l1;
else
l2->next_lit = l1;
l2 = l1;
l1->sign = lit->sign;
l1->atom = lit->atom;
}
else { /* put literal into clash structure */
i++;
c1 = get_clash_nd();
if (clash_list == NULL)
clash_list = c1;
else {
c2->next = c1;
c1->prev = c2;
}
c2 = c1;
c2->db = Fpa_clash_neg_lits;
c2->subst = get_context();
c2->subst->multiplier = m++;
c2->nuc_atom = lit->atom;
c2->evaluable = (lit->atom->varnum == EVALUABLE);
}
lit = lit->next_lit;
}
clash(clash_list, nuc_subst, nuc_lits, nuc,
giv_subst, giv_lits, giv_cl,
neg_clause, NEG_HYPER_TIME, nuc_pos, 0);
/* now deallocate the clash structure and literal nodes */
c1 = clash_list;
while (c1 != NULL) {
free_context(c1->subst);
c2 = c1;
c1 = c1->next;
free_clash_nd(c2);
}
l1 = nuc_lits;
while (l1 != NULL) {
l2 = l1;
l1 = l1->next_lit;
free_literal(l2);
}
clear_subst_1(tr);
}
f_atom = next_term(ut, 0);
}
l1 = giv_lits;
while (l1 != NULL) {
l2 = l1;
l1 = l1->next_lit;
free_literal(l2);
}
}
l3 = l3->next_lit;
}
free_context(giv_subst);
free_context(nuc_subst);
CLOCK_STOP(NEG_HYPER_TIME);
return;
}
} /* neg_hyper_res */
/*************
*
* ur_res(c) -- unit resulting (UR) resolution
*
* Append kept resolvents to Sos. Each kept
* clause has already passed the pre_process filter (forward
* subsumption, etc.), been integrated, and inserted into
* appropriate indexes.
*
*************/
void ur_res(struct clause *giv_cl)
{
struct literal *lit, *nuc_lits, *giv_lits;
struct literal *l1, *l2, *l3, *box, *f_lit;
struct context *nuc_subst, *giv_subst;
struct clash_nd *clash_list, *c1, *c2;
struct clause *nuc;
int m, i, nlits, j, nuc_pos;
struct term *f_atom;
struct fpa_tree *ut;
struct trail *tr;
CLOCK_START(UR_TIME);
nlits = num_literals(giv_cl);
if (nlits == 0) {
CLOCK_STOP(UR_TIME);
return;
}
if (nlits > 1) { /* given clause is nucleus (non-unit) */
clash_list = NULL;
if(Flags[LAMBDA_FLAG].val) // Beeson 5.10.04
nuc_subst = get_context2(giv_cl,0); // Beeson 5.10.04
else // Beeson 5.10.04
{ nuc_subst = get_context();
nuc_subst->multiplier = 0;
}
m = 1;
nuc_lits = get_literal(); /* for boxed literal */
l2 = nuc_lits;
lit = giv_cl->first_lit;
while (lit != NULL) {
if (lit->atom->varnum == ANSWER) { /* if answer literal */
l1 = get_literal();
l2->next_lit = l1;
l2 = l1;
l1->sign = lit->sign;
l1->atom = lit->atom;
}
lit = lit->next_lit;
}
c2 = NULL; /* to quiet lint */
for (i = 1; i < nlits; i++) { /* set up nlits-1 empty clash nodes */
c1 = get_clash_nd();
if (clash_list == NULL)
clash_list = c1;
else {
c2->next = c1;
c1->prev = c2;
}
c2 = c1;
if(Flags[LAMBDA_FLAG].val) // Beeson 5.10.04
c2->subst = get_context2(giv_cl,m++); // Beeson 5.10.04
else // Beeson 5.10.04
{ c2->subst = get_context();
c2->subst->multiplier = m++;
}
}
box = giv_cl->first_lit;
if (Flags[UR_LAST].val) {
/* boxed literal must be the last literal */
while (box->next_lit)
box = box->next_lit;
}
i = 1;
while (box != NULL) {
if (box->atom->varnum != ANSWER) { /* if not answer literal */
c1 = clash_list;
nuc_lits->sign = box->sign;
nuc_lits->atom = box->atom;
lit = giv_cl->first_lit;
while (lit != NULL) {
/* if not boxed or answer literal */
if (lit != box && lit->atom->varnum != ANSWER) {
c1->nuc_atom = lit->atom;
c1->db = (lit->sign ? Fpa_clash_neg_lits : Fpa_clash_pos_lits);
c1 = c1->next;
}
lit = lit->next_lit;
}
if (c1 != NULL) {
abend("ur_res: too many clash nodes (nuc).");
}
clash(clash_list, nuc_subst, nuc_lits, giv_cl,
(struct context *) NULL, (struct literal *) NULL,
(struct clause *) NULL,
unit_clause, UR_TIME, 0, i);
}
box = box->next_lit;
i++;
}
c1 = clash_list;
while (c1 != NULL) {
free_context(c1->subst);
c2 = c1;
c1 = c1->next;
free_clash_nd(c2);
}
l1 = nuc_lits;
while (l1 != NULL) {
l2 = l1;
l1 = l1->next_lit;
free_literal(l2);
}
free_context(nuc_subst);
CLOCK_STOP(UR_TIME);
return;
}
else { /* given clause is satellite (unit) */
if(Flags[LAMBDA_FLAG].val) // Beeson 5.10.04
{ giv_subst = get_context2(giv_cl,0); // Beeson 5.10.04
nuc_subst = get_context2(giv_cl,1); /* substitution for nucleus */
}
else // Beeson 5.10.04
{ giv_subst = get_context(); /* substitution for given satellite */
giv_subst->multiplier = 0;
nuc_subst = get_context(); /* substitution for nucleus */
nuc_subst->multiplier = 1;
}
/* collect any answer literals from given satellite */
/* and get clashable literal (l3) */
giv_lits = NULL;
lit = giv_cl->first_lit;
l2 = NULL; l3 = NULL; c2 = NULL;
while (lit != NULL) {
if (lit->atom->varnum != ANSWER) /* if not answer lit */
l3 = lit; /* the only non-answer literal */
else {
l1 = get_literal();
if (giv_lits == NULL)
giv_lits = l1;
else
l2->next_lit = l1;
l2 = l1;
l1->sign = lit->sign;
l1->atom = lit->atom;
}
lit = lit->next_lit;
}
ut = build_tree(l3->atom, UNIFY, Parms[FPA_LITERALS].val,
l3->sign ? Fpa_clash_neg_lits : Fpa_clash_pos_lits);
f_atom = next_term(ut, 0);
if(f_atom && Flags[LAMBDA_FLAG].val) // Beeson 5.10.04
{ // ensure that fs->next_var exceeds all var_nums in giv_cl as well as in
// the clause containing f_atom.
nuc_subst->next_var = max_vars(giv_cl, f_atom); // Beeson 5.10.04
memset(nuc_subst->bound,0,MAX_VARS*sizeof(char)); // Beeson 5.10.04
forbid_bound(nuc_subst,f_atom); // Beeson 5.10.04
}
while (f_atom != NULL) { /* for each potential nucleus */
tr = NULL;
f_lit = f_atom->occ.lit;
nuc = f_lit->container;
nlits = num_literals(nuc);
if (nlits > 1 &&
(!Flags[UR_LAST].val || f_lit->next_lit) &&
unify(l3->atom, giv_subst, f_atom, nuc_subst, &tr)) {
/* we have a nucleus */
m = 2;
nuc_lits = get_literal(); /* for boxed literal */
/* now append any answer literals to nuc_lits */
l2 = nuc_lits;
lit = nuc->first_lit;
while (lit != NULL) {
if (lit->atom->varnum == ANSWER) { /* if answer literal */
l1 = get_literal();
l2->next_lit = l1;
l2 = l1;
l1->sign = lit->sign;
l1->atom = lit->atom;
}
lit = lit->next_lit;
}
/* build clash structure for this nucleus */
clash_list = NULL;
for (i = 2; i < nlits; i++) { /* nlits-2 empty clash nodes */
c1 = get_clash_nd();
if (clash_list == NULL)
clash_list = c1;
else {
c2->next = c1;
c1->prev = c2;
}
c2 = c1;
if(Flags[LAMBDA_FLAG].val) // Beeson 5.18.04
c2->subst = get_context2(nuc,m++); // Beeson 5.18.04
else
{ c2->subst = get_context();
c2->subst->multiplier = m++;
}
}
box = nuc->first_lit;
if (Flags[UR_LAST].val) {
/* boxed literal must be the last literal */
while (box->next_lit)
box = box->next_lit;
}
i = 1;
while (box != NULL) {
/* if not clashed or answer literal */
if (box != f_lit && box->atom->varnum != ANSWER) {
c1 = clash_list;
nuc_lits->sign = box->sign;
nuc_lits->atom = box->atom;
lit = nuc->first_lit;
j = 1;
nuc_pos = 0;
while (lit != NULL) {
/* if not boxed or clashed or answer literal */
if (lit != box && lit != f_lit && lit->atom->varnum != ANSWER) {
c1->nuc_atom = lit->atom;
c1->db = (lit->sign ? Fpa_clash_neg_lits :
Fpa_clash_pos_lits);
c1 = c1->next;
j++;
}
if (lit == f_lit)
nuc_pos = j; /* For ordered history option */
lit = lit->next_lit;
}
if ( c1 != NULL) {
abend("ur_res: too many clash nodes (sat).");
}
clash(clash_list, nuc_subst, nuc_lits, nuc,
giv_subst, giv_lits, giv_cl,
unit_clause, UR_TIME, nuc_pos, i);
}
box = box->next_lit;
i++;
}
c1 = clash_list;
while (c1 != NULL) {
free_context(c1->subst);
c2 = c1;
c1 = c1->next;
free_clash_nd(c2);
}
l1 = nuc_lits;
while (l1 != NULL) {
l2 = l1;
l1 = l1->next_lit;
free_literal(l2);
}
clear_subst_1(tr);
}
f_atom = next_term(ut, 0);
if(f_atom && Flags[LAMBDA_FLAG].val) // Beeson 6.14.04
{ nuc_subst->next_var = max_vars(giv_cl, f_atom); // Beeson 6.14.04
memset(nuc_subst->bound,0,MAX_VARS*sizeof(char)); // Beeson 6.14.04
forbid_bound(nuc_subst,f_atom); // Beeson 6.14.04
}
}
/* free answer literals from given satellite */
l1 = giv_lits;
while (l1 != NULL) {
l2 = l1;
l1 = l1->next_lit;
free_literal(l2);
}
free_context(giv_subst);
free_context(nuc_subst);
CLOCK_STOP(UR_TIME);
return;
}
} /* ur_res */
/*************
*
* int one_unary_answer(c)
*
*************/
int one_unary_answer(struct clause *c)
{
struct literal *l;
for (l = c->first_lit; l != NULL && l->atom->varnum != ANSWER; l = l->next_lit); /* empty body */
if (l == NULL)
return(0);
else if (sn_to_arity(l->atom->sym_num) != 1)
return(0);
else {
for (l = l->next_lit; l != NULL && l->atom->varnum != ANSWER; l = l->next_lit); /* empty body */
return(l == NULL);
}
} /* one_unary_answer */
/*************
*
* struct term *build_term(sn, arg1, arg2, arg3)
*
*************/
struct term *build_term(int sn,
struct term *arg1,
struct term *arg2,
struct term *arg3)
{
int arity;
struct rel *r1, *r2, *r3;
struct term *t;
arity = sn_to_arity(sn);
if (arity != 3) {
abend("build_term, bad arity.");
}
t = get_term();
t->sym_num = sn;
t->type = COMPLEX;
r1 = get_rel();
r2 = get_rel();
r3 = get_rel();
t->farg = r1;
r1->narg = r2;
r2->narg = r3;
r1->argval = arg1;
r2->argval = arg2;
r3->argval = arg3;
return(t);
} /* build_term */
/*************
*
* void combine_answers(res, a1, s1, a2, s2)
*
*************/
void combine_answers(struct clause *res,
struct term *a1,
struct context *s1,
struct term *a2,
struct context *s2)
{
struct clause *par1, *par2;
int condition_par1;
struct term *condition, *then_part, *else_part;
struct literal *lit1, *lit2, *prev_lit;
par1 = a1->occ.lit->container;
par2 = a2->occ.lit->container;
if (one_unary_answer(par1) && one_unary_answer(par2)) {
condition_par1 = a2->occ.lit->sign;
if (condition_par1)
condition = apply(a1, s1);
else
condition = apply(a2, s2);
for (lit1 = res->first_lit, prev_lit = NULL;
lit1->atom->varnum != ANSWER;
prev_lit = lit1, lit1 = lit1->next_lit);
/* empty body */
for (lit2 = lit1->next_lit; lit2->atom->varnum != ANSWER; lit2 = lit2->next_lit);
/* empty body */
if (condition_par1) {
then_part = lit1->atom->farg->argval;
else_part = lit2->atom->farg->argval;
}
else {
then_part = lit2->atom->farg->argval;
else_part = lit1->atom->farg->argval;
}
if (prev_lit == NULL)
res->first_lit = lit1->next_lit;
else
prev_lit->next_lit = lit1->next_lit;
free_rel(lit1->atom->farg);
free_term(lit1->atom);
free_literal(lit1);
lit2->atom->farg->argval = build_term(str_to_sn("if",3),condition,then_part,else_part);
}
} /* combine_answers */
/*************
*
* struct clause *build_bin_res(a1, s1, a2, s2)
*
* Build a binary resolvent. a1 and a2 are the clashed literals,
* and s1 and s2 are the respective unifying substitutions.
*
*************/
struct clause *build_bin_res(struct term *a1,
struct context *s1,
struct term *a2,
struct context *s2)
{
struct clause *res;
struct literal *lit, *new, *prev;
struct int_ptr *ip0, *ip1, *ip2;
res = get_clause();
prev = NULL;
if(a1->occ.lit == NULL) // Beeson 10.12.02; this happens when a1 is $T or $F being resolved with Ap(X,b)
lit = NULL; // Beeson 10.12.02
else // Beeson 10.12.02
lit = a1->occ.lit->container->first_lit;
while (lit != NULL) {
if (lit->atom != a1) {
new = get_literal();
new->container = res;
if (prev == NULL)
res->first_lit = new;
else
prev->next_lit = new;
prev = new;
new->sign = lit->sign;
new->atom = apply(lit->atom, s1);
new->atom->occ.lit = new;
new->atom->varnum = lit->atom->varnum; /* copy type of atom */
}
lit = lit->next_lit;
}
if(prev != NULL &&
(a2->occ.lit == NULL || // Beeson 10.12.02
a2->occ.lit->container == NULL // Beeson 10.13.02
)
)
{ prev->next_lit = NULL; // Beeson 10.12.02 This marks the end of the new clause, it won't get any literals from a2.
}
if(a2->occ.lit != NULL && // Beeson 10.6.02. Prevent duplicates if a1 or a2 is $T or $F
a2->occ.lit->container != NULL &&
!isFalse(a1) && !isTrue(a1) && !isFalse(a2) && !isTrue(a2)
)
lit = a2->occ.lit->container->first_lit;
else
lit = NULL;
while (lit != NULL) {
if (lit->atom != a2) {
new = get_literal();
new->container = res;
if (res->first_lit == NULL)
res->first_lit = new;
else
prev->next_lit = new;
prev = new;
new->sign = lit->sign;
new->atom = apply(lit->atom, s2);
new->atom->occ.lit = new;
new->atom->varnum = lit->atom->varnum; /* copy type of atom */
}
lit = lit->next_lit;
}
ip0 = get_int_ptr();
ip1 = get_int_ptr();
ip2 = get_int_ptr();
ip0->i = BINARY_RES_RULE;
if(a1->occ.lit) // Beeson 10.12.02
ip1->i = a1->occ.lit->container->id;
else // Beeson 10.12.02
ip1->i = RESOLVE_WITH_TRUE; // Beeson 10.12.02
if(a2->occ.lit && a2->occ.lit->container) // Beeson 10.13.02
ip2->i = a2->occ.lit->container->id;
else // Beeson 10.12.02
ip2->i = RESOLVE_WITH_TRUE; // Beeson 10.12.02
ip0->next = ip1;
ip1->next = ip2;
res->parents = ip0;
if (Flags[DETAILED_HISTORY].val) {
ip0 = get_int_ptr();
ip1 = get_int_ptr();
ip0->next = ip1;
ip1->next = res->parents->next->next->next;
res->parents->next->next->next = ip0;
ip0->i = LIST_RULE - 1;
ip1->i = literal_number(a2->occ.lit);
ip0 = get_int_ptr();
ip1 = get_int_ptr();
ip0->next = ip1;
ip1->next = res->parents->next->next;
res->parents->next->next = ip0;
ip0->i = LIST_RULE - 1;
ip1->i = literal_number(a1->occ.lit);
}
if (Flags[PROG_SYNTHESIS].val)
combine_answers(res, a1, s1, a2, s2);
return(res);
} /* build_bin_res */
/*************
*
* struct clause *apply_clause(c, s)
*
*************/
struct clause *apply_clause(struct clause *c,
struct context *s)
{
struct clause *d;
struct literal *lit, *new, *prev;
d = get_clause();
prev = NULL;
for (lit = c->first_lit; lit; lit = lit->next_lit) {
new = get_literal();
new->container = d;
if (!prev)
d->first_lit = new;
else
prev->next_lit = new;
prev = new;
new->sign = lit->sign;
new->atom = apply(lit->atom, s);
new->atom->occ.lit = new;
new->atom->varnum = lit->atom->varnum; /* copy type of atom */
}
return(d);
} /* apply_clause */
/*************
*
* bin_res(giv_cl) -- binary resolution
*
*************/
void bin_res(struct clause *giv_cl)
{
struct literal *g_lit;
struct term *g_atom, *f_atom;
struct context *gs, *fs;
struct trail *tr;
struct fpa_tree *ut;
struct fpa_index *db;
struct clause *resolvent;
int given_unit = unit_clause(giv_cl);
CLOCK_START(BINARY_TIME);
if(Flags[LAMBDA_FLAG].val) // Beeson 6.26.03
{ gs = get_context2(giv_cl,0); // Beeson changed from get_context 10.6.02
fs = get_context2(giv_cl,1); // Beeson changed from get_context 10.6.02
memset(fs->bound,0,MAX_VARS*sizeof(char)); // Beeson 7.16.03
free_forbidden(fs); // Beeson 1.29.04
}
else
{ gs = get_context();
gs->multiplier = 0;
fs = get_context();
fs->multiplier = 1;
}
g_lit = giv_cl->first_lit;
while (g_lit != NULL) {
g_atom = g_lit->atom;
if (g_atom->varnum != ANSWER) { /* if not answer literal */
if (g_lit->sign)
db = Fpa_clash_neg_lits;
else
db = Fpa_clash_pos_lits;
ut = build_tree(g_lit->atom, UNIFY,
Parms[FPA_LITERALS].val, db);
f_atom = next_term(ut, 0);
if(f_atom) // Beeson 2.13.03
{ // ensure that fs->next_var exceeds all var_nums in giv_cl as well as in
// the clause containing f_atom.
fs->next_var = max_vars(giv_cl, f_atom); // Beeson
memset(fs->bound,0,MAX_VARS*sizeof(char)); // Beeson 1.29.04
forbid_bound(fs,f_atom); // Beeson 7.16.03
fs->next = NULL; // Beeson 12.19.05
}
if(f_atom == NULL &&
g_atom->sym_num == AP &&
g_atom->farg->argval->type == VARIABLE
){ // Beeson 10.6.02
/* unify Ap(X,a) with $F or $T according to g_lit->sign */
if(!g_lit->sign) // Beeson 10.10.02
f_atom = True(NULL); // Beeson 10.10.02
else // Beeson 10.10.02
f_atom = False(NULL); // Beeson 10.10.02
++f_atom->fpa_id; // Beeson 10.13.02; now there's a reference to f_atom
f_atom->occ.lit = get_literal(); // so it will count as an atom
} // Beeson 10.10.02
while (f_atom != NULL) {
tr = NULL;
if(Flags[LAMBDA_FLAG].val)
{ free_forbidden(gs); // Beeson 1.29.04
free_context(gs); // Beeson 1.29.04
gs = get_context2(giv_cl,0); // Beeson 1.29.04
fs->next_var = gs->next_var = max_vars(giv_cl, f_atom); // Beeson 7.22.03
fs->next = NULL; // Beeson 12.19.05
memset(fs->bound,0,MAX_VARS*sizeof(char)); // Beeson 1.29.04
forbid_bound(fs,f_atom); // Beeson 1.29.04
}
if (!Flags[UNIT_RES].val ||
given_unit ||
f_atom->occ.lit->container == NULL || // $T or $F // Beeson 10.13.02
unit_clause(f_atom->occ.lit->container)
)
{ if (unify(g_atom, gs, f_atom, fs, &tr))
{ struct context *m1,*m2;
for(m1=gs,m2=fs; m1; m1=m1->next,m2=m2->next) // Beeson 12.18.05 for multiple unifiers
{ resolvent = build_bin_res(g_atom, m1, f_atom, m2);
Stats[CL_GENERATED]++;
Stats[BINARY_RES_GEN]++;
if (heat_is_on())
resolvent->heat_level = giv_cl->heat_level + 1;
CLOCK_STOP(BINARY_TIME);
pre_process(resolvent, 0, Sos);
CLOCK_START(BINARY_TIME);
}
clear_subst_1(tr);
}
}
f_atom = next_term(ut, 0);
}
}
g_lit = g_lit->next_lit;
}
free_context(gs);
free_context(fs);
CLOCK_STOP(BINARY_TIME);
} /* bin_res */
/*************
*
* first_or_next_factor(c, l1p, l2p)
*
* Generate the first (*l1p == NULL) or next (*l1p and *l2p are the
* previously factored literals) factor from c.
*
*************/
struct clause *first_or_next_factor(struct clause *c,
struct literal **l1p,
struct literal **l2p)
{
int factored = 0;
struct literal *l1 = *l1p;
struct literal *l2 = *l2p;
struct context *subst;
struct trail *tr;
struct clause *factor;
struct literal *l3, *l4, *l5;
if(Flags[LAMBDA_FLAG].val)
subst = get_context2(c,0); // Beeson changed to get_context2, 10.6.02
else
subst = get_context();
if (!l1)
l1 = l2 = c->first_lit;
while (l1 && !factored) {
l2 = l2->next_lit;
while (l2 && !factored) {
tr = NULL;
if (l1->sign == l2->sign &&
unify(l1->atom, subst, l2->atom, subst, &tr)
) {
factored = 1;
}
else
l2 = l2->next_lit;
}
if (!factored)
l1 = l2 = l1->next_lit;
}
if (factored) {
subst->multiplier = 0;
factor = get_clause();
/* do not fill in parents */
l3 = NULL;
l5 = c->first_lit;
while (l5 != NULL) { /* l2 is the literal to exclude */
if (l5 != l2) {
l4 = get_literal();
l4->sign = l5->sign;
l4->container = factor;
if (l3 == NULL)
factor->first_lit = l4;
else
l3->next_lit = l4;
l4->atom = apply(l5->atom, subst);
/* Following is for factor_simp; shouldn't hurt otherwise. */
if (TP_BIT(l5->atom->bits, ORIENTED_EQ_BIT))
SET_BIT(l4->atom->bits, ORIENTED_EQ_BIT);
l4->atom->occ.lit = l4;
l4->atom->varnum = l5->atom->varnum; /* copy type */
l3 = l4;
}
l5 = l5->next_lit;
}
clear_subst_1(tr);
*l2p = l2; *l1p = l1;
}
else
factor = NULL;
free_context(subst);
return(factor);
} /* first_or_next_factor */
/*************
*
* all_factors(c, lst) -- generate and pre_process all binary factors c.
*
* Indirect recursive calls will get factors of factors, etc.
*
*************/
void all_factors(struct clause *c,
struct list *lst)
{
struct literal *l1, *l2;
struct clause *factor;
struct int_ptr *ip0, *ip1;
l1 = NULL;
factor = first_or_next_factor(c, &l1, &l2);
while (factor) {
ip0 = get_int_ptr(); ip0->i = FACTOR_RULE;
ip1 = get_int_ptr(); ip1->i = c->id;
factor->parents = ip0; ip0->next = ip1;
if (Flags[DETAILED_HISTORY].val) {
/* append list of indexes of factored literals */
struct int_ptr *ip3, *ip4, *ip5;
ip3 = get_int_ptr(); ip3->i = LIST_RULE-2;
ip4 = get_int_ptr(); ip4->i = literal_number(l1);
ip5 = get_int_ptr(); ip5->i = literal_number(l2);
ip1->next = ip3; ip3->next = ip4; ip4->next = ip5;
}
Stats[CL_GENERATED]++;
Stats[FACTOR_GEN]++;
CLOCK_STOP(FACTOR_TIME);
CLOCK_STOP(POST_PROC_TIME);
pre_process(factor, 0, lst);
CLOCK_START(POST_PROC_TIME);
CLOCK_START(FACTOR_TIME);
factor = first_or_next_factor(c, &l1, &l2);
}
} /* all_factors */
/*************
*
* factor_simpify(c)
*
* Return the number of literals removed.
*
*************/
int factor_simplify(struct clause *c)
{
struct literal *l1, *l2;
struct clause *f;
struct int_ptr *p0, *p1;
int n = 0;
l1 = NULL;
f = first_or_next_factor(c, &l1, &l2);
while (f) {
if (subsume(f, c)) {
n++;
/* Swap list of literals. */
l1 = c->first_lit;
c->first_lit = f->first_lit;
f->first_lit = l1;
for (l1 = c->first_lit; l1; l1 = l1->next_lit)
l1->container = c;
for (l1 = f->first_lit; l1; l1 = l1->next_lit)
l1->container = f;
cl_del_non(f);
if (Flags[DETAILED_HISTORY].val) {
for (p1 = c->parents, p0 = NULL; p1; p1 = p1->next)
p0 = p1;
p1 = get_int_ptr();
p1->i = FACTOR_SIMP_RULE;
if (p0)
p0->next = p1;
else
c->parents = p1;
}
l1 = NULL;
f = first_or_next_factor(c, &l1, &l2);
}
else {
cl_del_non(f);
f = first_or_next_factor(c, &l1, &l2);
}
}
return(n);
} /* factor_simplify */
./otter/sed.clocks 0000744 0002044 0001012 00000000065 11120534452 012422 0 ustar beeson /CLOCK_START(.*)$/s/)/);/
/CLOCK_STOP(.*)$/s/)/);/
./otter/sed.prototypes 0000744 0002044 0001012 00000000020 11120534453 013364 0 ustar beeson /{/d
s/)$/);/
./otter/share.c 0000744 0002044 0001012 00000032015 11120534453 011716 0 ustar beeson /*
* share.c -- routines to manage the shared data structures
*
*/
#include <assert.h>
#include "header.h"
#define TERM_TAB_SIZE 3793 // Changed by Beeson 2.4.03, per McCune's email.
#ifdef THINK_C /* Macintosh */
#define TERM_TAB_SIZE 200
#endif
/* Hash table of shared terms */
static struct term_ptr *Term_tab[TERM_TAB_SIZE];
/* alphas and betas of pos eq lits are not shared, so they are put here */
/* so that back dedmodulation can find them */
static struct term_ptr *Bd_kludge;
/*************
*
* int hash_term(term)
*
* Return the hash value of a term. It is assumed that
* the subterms are already integrated. The hash value is
* constructed from the functor and the addresses of the
* subterms.
*
*************/
static int hash_term(struct term *t)
{
struct rel *r;
int hashval;
if (t->type == NAME) /* name */
hashval = t->sym_num;
else if (t->type == VARIABLE) /* variable */
hashval = t->sym_num + t->varnum + 25;
else { /* complex */
hashval = t->sym_num;
r = t->farg;
while (r != NULL) {
hashval >>= 1; /* shift right one bit */
hashval ^= (int) r->argval; /* exclusive or */
r = r->narg;
}
}
return(abs(hashval) % TERM_TAB_SIZE);
} /* hash_term */
/*************
*
* int term_compare(t1, t2)
*
* Special purpose term comparison for term integration.
* Succeed iff functors are identical and subterm pointers are
* identical. (Note that this routine is not recursive.)
* (For general purpose routine, see `term_ident'.)
*
*************/
static int term_compare(struct term *t1,
struct term *t2)
{
struct rel *r1, *r2;
if (t1->type != t2->type)
return(0);
else if (t1->type == NAME) /* name */
return(t1->sym_num == t2->sym_num);
else if (t1->type == VARIABLE) /* variable */
return(t1->varnum == t2->varnum && t1->sym_num == t2->sym_num);
else if (t1->sym_num != t2->sym_num)
return(0); /* both complex with different functors */
else {
r1 = t1->farg;
r2 = t2->farg;
while (r1 != NULL && r2 != NULL) {
if (r1->argval != r2->argval)
return(0);
else {
r1 = r1->narg;
r2 = r2->narg;
}
}
return(r1 == NULL && r2 == NULL);
}
} /* term_compare */
/*************
*
* struct term *integrate_term(term)
*
* Incorporate a term into the shared data structures.
* Either the term itself is integrated and returned, or
* the term is deallocated and a previously integrated copy
* is returned. A good way to invoke it is
*
* t = integrate_term(t)
*
*************/
struct term *integrate_term(struct term *t)
{
int hashval, found;
struct term_ptr *p, *prev;
struct rel *r, *r2;
if (t->type == COMPLEX) { /* complex term */
r = t->farg;
while (r != NULL) {
r->argval = integrate_term(r->argval);
r = r->narg;
}
}
hashval = hash_term(t);
p = Term_tab[hashval];
prev = NULL;
found = 0;
while (found == 0 && p != NULL){
if (term_compare(t, p->term))
found = 1;
else {
prev = p;
p = p->next;
}
}
if (found) { /* p->term is integrated copy */
if (t == p->term) {
return p->term;
// print_term_nl(stdout, t); Taken out by Beeson 10.15.02
// abend("integrate_term, already integrated.");
// beta-reduction does use shared terms, and when the first copy is encountered, it will be integrated,
// so when the second copy is encountered, naturally it's already integrated.
// This is harmless.
}
if (t->fpa_id > 0){ /* Beeson 6.4.03; 2nd order unification creates terms that
are referenced more than once and counts the references
using fpa_id. Don't free these terms. */
t->fpa_id--; // Beeson 6.4.03
return p->term; // Beeson 6.4.03
} // Beeson 6.4.03
if (t->type == COMPLEX) { /* if complex, free rels */
r = t->farg;
while (r != NULL) {
r2 = r;
r = r->narg;
free_rel(r2);
}
}
free_term(t);
return(p->term);
}
else { /* not in bucket, so insert at end of bucket and return */
if (t->type == COMPLEX) { /* if complex, set up containment lists */
r = t->farg;
while (r != NULL) {
r->argof = t;
r->nocc = r->argval->occ.rel;
r->argval->occ.rel = r;
r = r->narg;
}
}
p = get_term_ptr();
p->term = t;
p->next = NULL;
if (prev == NULL)
Term_tab[hashval] = p;
else
prev->next = p;
if (Flags[BACK_DEMOD].val && Flags[INDEX_FOR_BACK_DEMOD].val)
fpa_insert(t, Parms[FPA_TERMS].val, Fpa_back_demod);
return(t);
}
} /* integrate_term */
/*************
*
* disintegrate_term(term)
*
* Remove a previously integrated term from the shared data
* structures. A warning is printed if the term has a list of
* superterms.
*
*************/
void disintegrate_term(struct term *t)
{
int hashval;
struct rel *r1, *r2, *r3;
struct term_ptr *p1, *p2;
if (t->occ.rel != NULL) {
fprintf(stderr, "WARNING, disintegrate_term, contained term.\n");
printf("WARNING, disintegrate_term, contained term: ");
print_term_nl(stdout, t);
}
else {
hashval = hash_term(t);
p1 = Term_tab[hashval];
p2 = NULL;
while (p1 != NULL && p1->term != t) {
p2 = p1;
p1 = p1->next;
}
if (p1 == NULL)
abend("disintegrate_term, cannot find term.");
else {
if (p2 == NULL)
Term_tab[hashval] = p1->next;
else
p2->next = p1->next;
free_term_ptr(p1);
if (Flags[BACK_DEMOD].val && Flags[INDEX_FOR_BACK_DEMOD].val) {
CLOCK_START(UN_INDEX_TIME);
fpa_delete(t, Parms[FPA_TERMS].val, Fpa_back_demod);
CLOCK_STOP(UN_INDEX_TIME);
}
if (t->type == COMPLEX) {
r1 = t->farg;
while (r1 != NULL) {
r2 = r1->argval->occ.rel;
r3 = NULL;
while (r2 != NULL && r2 != r1) {
r3 = r2;
r2 = r2->nocc;
}
if (r2 == NULL) {
print_term_nl(stdout, t);
abend("disintegrate_term, bad containment.");
}
else {
if (r3 == NULL)
r1->argval->occ.rel = r1->nocc;
else
r3->nocc = r1->nocc;
if (r1->argval->occ.rel == NULL)
disintegrate_term(r2->argval);
}
r3 = r1;
r1 = r1->narg;
free_rel(r3);
}
}
free_term(t);
}
}
} /* disintegrate_term */
/*************
*
* set_up_pointers(t)
*
*************/
void set_up_pointers(struct term *t)
{
struct rel *r;
for (r = t->farg; r; r = r->narg) {
r->argof = t;
r->argval->occ.rel = r;
set_up_pointers(r->argval);
}
} /* set_up_pointers */
/*************
*
* zap_term(term)
*
* Deallocate a nonshared term. A warning is printed if
* the term or any of its subterms contains a list of superterms.
*
*************/
void zap_term(struct term *t)
{
struct rel *r1, *r2;
if (t->occ.rel != NULL) {
fprintf(stderr, "WARNING, zap_term, contained term.\n");
printf("WARNING, zap_term, contained term: ");
print_term_nl(stdout, t);
printf("term occurs in: ");
print_term_nl(stdout,t->occ.rel->argof);
printf("\n");
}
else {
if (t->type == COMPLEX) { /* complex term */
r1 = t->farg;
while (r1 != NULL) {
zap_term(r1->argval);
r2 = r1;
r1 = r1->narg;
free_rel(r2);
}
}
free_term(t);
}
} /* zap_term */
/*************
*
* print_term_tab(file_ptr) -- Print the table of integrated terms.
*
*************/
void print_term_tab(FILE *fp)
{
int i;
struct term_ptr *p;
for(i=0; i<TERM_TAB_SIZE; i++)
if(Term_tab[i] != NULL) {
fprintf(fp, "bucket %d: ",i);
p = Term_tab[i];
while(p != NULL) {
print_term(fp, p->term);
fprintf(fp, " ");
p = p->next;
}
fprintf(fp, "\n");
}
} /* print_term_tab */
/*************
*
* p_term_tab()
*
*************/
void p_term_tab(void)
{
print_term_tab(stdout);
} /* p_term_tab */
/*************
*
* test_terms(file_ptr)
*
* Print the list of integrated terms. For each term, list its
* subterms and superterms.
*
*************/
void test_terms(FILE *fp)
{
int i;
struct term_ptr *p;
struct rel *r;
for(i=0; i<TERM_TAB_SIZE; i++)
if(Term_tab[i] != NULL) {
fprintf(fp, " bucket %d:\n",i);
p = Term_tab[i];
while(p != NULL) {
print_term(fp, p->term);
fprintf(fp, " containing terms: ");
r = p->term->occ.rel;
while (r != NULL) {
print_term(fp, r->argof);
fprintf(fp, " ");
r = r->nocc;
}
fprintf(fp, "\n");
p = p->next;
}
}
} /* test_terms */
/*************
*
* struct term_ptr *all_instances(atom)
*
* Get all terms (in table of shared terms) that can be rewritten
* with demodulator (atom). Handles lex-dependent demod correctly.
*
*************/
struct term_ptr *all_instances(struct term *atom)
{
struct term *alpha, *beta, *t;
struct term_ptr *tp, *tp1, *instances;
struct context *subst;
struct trail *tr;
int i, lex_dependent, ok;
alpha = atom->farg->argval;
beta = atom->farg->narg->argval;
lex_dependent = (atom->varnum == LEX_DEP_DEMOD);
instances = NULL;
subst = get_context();
subst->multiplier = 1;
for (i = 0; i <= TERM_TAB_SIZE; i++) {
tp = (i == TERM_TAB_SIZE ? Bd_kludge : Term_tab[i]);
while (tp != NULL) {
tr = NULL;
if (otter_match(alpha, subst, tp->term, &tr)) {
if (lex_dependent == 0)
ok = 1;
else {
t = apply(beta, subst);
if (Flags[LRPO].val)
ok = lrpo_greater(tp->term, t);
else
ok = (lex_check(t, tp->term) == LESS_THAN);
zap_term(t);
}
if (ok) {
tp1 = get_term_ptr();
tp1->term = tp->term;
tp1->next = instances;
instances = tp1;
}
clear_subst_1(tr);
}
tp = tp->next;
}
}
free_context(subst);
return(instances);
} /* all_instances */
/*************
*
* struct term_ptr *all_instances_fpa(atom)
*
* Get all terms (in table of shared terms) that can be rewritten
* with demodulator (atom). Handles lex-dependent demod correctly.
*
*************/
struct term_ptr *all_instances_fpa(struct term *atom)
{
struct term *alpha, *beta, *t, *found;
struct term_ptr *tp1, *instances;
struct context *subst;
struct trail *tr;
int lex_dependent, ok;
struct fpa_tree *ut;
alpha = atom->farg->argval;
beta = atom->farg->narg->argval;
lex_dependent = (atom->varnum == LEX_DEP_DEMOD);
instances = NULL;
subst = get_context();
subst->multiplier = 1;
ut = build_tree(alpha, INSTANCE, Parms[FPA_TERMS].val, Fpa_back_demod);
found = next_term(ut, 0);
while (found != NULL) {
tr = NULL;
if (otter_match(alpha, subst, found, &tr)) {
if (lex_dependent == 0)
ok = 1;
else {
t = apply(beta, subst);
if (Flags[LRPO].val)
ok = lrpo_greater(found, t);
else
ok = (lex_check(t, found) == LESS_THAN);
zap_term(t);
}
if (ok) {
tp1 = get_term_ptr();
tp1->term = found;
tp1->next = instances;
instances = tp1;
}
clear_subst_1(tr);
}
found = next_term(ut, 0);
}
free_context(subst);
return(instances);
} /* all_instances_fpa */
/*************
*
* bd_kludge_insert(t)
*
* This has to do with finding terms that can be back demodulated.
* Terms are made available (either indexed or in table of shared
* terms) when integrated. However, alphas and betas are not shared,
* so this routine makes them available, either indexed or inserted
* into the Bd_kludge list.
*
*************/
void bd_kludge_insert(struct term *t)
{
struct term_ptr *tp;
if (Flags[INDEX_FOR_BACK_DEMOD].val)
fpa_insert(t, Parms[FPA_TERMS].val, Fpa_back_demod);
else {
tp = get_term_ptr();
tp->term = t;
tp->next = Bd_kludge;
Bd_kludge = tp;
}
} /* bd_kludge_insert */
/*************
*
* bd_kludge_delete(t)
*
* See Bd_kludge_insert.
*
*************/
void bd_kludge_delete(struct term *t)
{
struct term_ptr *tp1, *tp2;
if (Flags[INDEX_FOR_BACK_DEMOD].val) {
CLOCK_START(UN_INDEX_TIME);
fpa_delete(t, Parms[FPA_TERMS].val, Fpa_back_demod);
CLOCK_STOP(UN_INDEX_TIME);
}
else
{
tp1 = Bd_kludge;
tp2 = NULL;
while (tp1 != NULL && tp1->term != t) {
tp2 = tp1;
tp1 = tp1->next;
}
if (tp1 == NULL) {
fprintf(stderr, "WARNING, bd_kludge_delete, term not found.\n");
printf("WARNING, bd_kludge_delete, term not found: ");
print_term_nl(stdout, t);
}
else if (tp2 != NULL)
tp2->next = tp1->next;
else
Bd_kludge = tp1->next;
free_term_ptr(tp1);
}
} /* bd_kludge_delete */
./otter/TAGS 0000744 0002044 0001012 00000156033 11026756616 011154 0 ustar beeson
check.h,363
#define MAX_LITS 1,0
#define P_RULE_UNDEFINED 5,62
#define P_RULE_INPUT 6,93
#define P_RULE_EQ_AXIOM 7,124
#define P_RULE_INSTANTIATE 8,155
#define P_RULE_PROPOSITIONAL 9,186
#define P_RULE_RESOLVE 10,217
#define P_RULE_PARAMOD 11,248
#define P_RULE_FLIP 12,279
struct proof_object_node proof_object_node14,311
struct proof_object proof_object27,689
cos.h,8738
#define MAX_FLAGS 17,472
#define SOS_QUEUE 19,534
#define SOS_STACK 20,596
#define INPUT_SOS_FIRST 21,659
#define INTERACTIVE_GIVEN 22,726
#define PRINT_GIVEN 23,797
#define PRINT_LISTS_AT_END 24,845
#define BINARY_RES 26,914
#define HYPER_RES 27,959
#define NEG_HYPER_RES 28,1001
#define UR_RES 29,1064
#define PARA_INTO 30,1102
#define PARA_FROM 31,1166
#define DEMOD_INF 32,1230
#define PARA_FROM_LEFT 34,1298
#define PARA_FROM_RIGHT 35,1367
#define PARA_INTO_LEFT 36,1438
#define PARA_INTO_RIGHT 37,1511
#define PARA_FROM_VARS 38,1586
#define PARA_INTO_VARS 39,1654
#define PARA_FROM_UNITS_ONLY 40,1722
#define PARA_INTO_UNITS_ONLY 41,1785
#define PARA_SKIP_SKOLEM 42,1848
#define PARA_ONES_RULE 43,1919
#define PARA_ALL 44,1989
#define DETAILED_HISTORY 46,2058
#define ORDER_HISTORY 47,2135
#define UNIT_DELETION 48,2202
#define DELETE_IDENTICAL_NESTED_SKOLEM 49,2258
#define SORT_LITERALS 50,2332
#define FOR_SUB 51,2392
#define BACK_SUB 52,2437
#define FACTOR 53,2480
#define DEMOD_HISTORY 55,2532
#define ORDER_EQ 56,2593
#define EQ_UNITS_BOTH_WAYS 57,2666
#define DEMOD_LINEAR 58,2733
#define DEMOD_OUT_IN 59,2803
#define DYNAMIC_DEMOD 60,2867
#define DYNAMIC_DEMOD_ALL 61,2931
#define DYNAMIC_DEMOD_LEX_DEP 62,3011
#define BACK_DEMOD 63,3085
#define KNUTH_BENDIX 64,3131
#define LRPO 65,3193
#define LEX_ORDER_VARS 66,3253
#define SYMBOL_ELIM 67,3328
#define CHECK_ARITY 69,3397
#define PROLOG_STYLE_VARIABLES 70,3464
#define ECHO_INCLUDED_FILES 71,3524
#define SIMPLIFY_FOL 72,3592
#define PROCESS_INPUT 73,3665
#define VERY_VERBOSE 75,3726
#define PRINT_KEPT 76,3780
#define PRINT_PROOFS 77,3827
#define PRINT_NEW_DEMOD 78,3880
#define PRINT_BACK_DEMOD 79,3935
#define PRINT_BACK_SUB 80,4000
#define DISPLAY_TERMS 81,4060
#define PRETTY_PRINT 82,4122
#define INDEX_FOR_BACK_DEMOD 84,4185
#define FOR_SUB_FPA 85,4260
#define NO_FAPL 86,4330
#define NO_FANL 87,4393
#define CONTROL_MEMORY 89,4457
#define ORDER_HYPER 90,4521
#define PROPOSITIONAL 91,4587
#define REALLY_DELETE_CLAUSES 92,4651
#define ATOM_WT_MAX_ARGS 93,4727
#define TERM_WT_MAX_ARGS 94,4807
#define FREE_ALL_MEM 95,4887
#define AUTO 99,4977
#define ANCESTOR_SUBSUME 100,5057
#define INPUT_SEQUENT 101,5117
#define OUTPUT_SEQUENT 102,5190
#define GEOMETRIC_RULE 103,5264
#define LINKED_UR_RES 104,5341
#define LINKED_UR_TRACE 106,5417
#define LINKED_SUB_UNIT_USABLE 107,5485
#define LINKED_SUB_UNIT_SOS 110,5707
#define LINKED_UNIT_DEL 113,5923
#define LINKED_TARGET_ALL 117,6242
#define LINKED_HYPER_RES 119,6312
#define PROG_SYNTHESIS 123,6391
#define BIRD_PRINT 124,6450
#define DP_TRANSFORM 125,6521
#define BUILD_PROOF_OBJECT 126,6584
#define LOG_FOR_X_SHOW 127,6657
#define GEOMETRIC_REWRITE_BEFORE 129,6724
#define GEOMETRIC_REWRITE_AFTER 130,6803
#define FORMULA_HISTORY 132,6883
#define KEEP_HINT_SUBSUMERS 134,6965
#define PROOF_WEIGHT 136,7041
#define HYPER_SYMMETRY_KLUDGE 137,7116
#define GL_DEMOD 138,7168
#define DP_INT_DOMAIN 139,7224
#define DISCARD_NON_ORIENTABLE_EQ 140,7302
#define DISCARD_XX_RESOLVABLE 141,7357
#define TPTP_EQ 142,7409
#define AUTO1 143,7488
#define AUTO2 144,7555
#define BELL 145,7621
#define BACK_UNIT_DELETION 146,7697
#define SPLIT_CLAUSE 147,7778
#define SPLIT_WHEN_GIVEN 148,7843
#define SPLIT_ATOM 149,7908
#define SPLIT_POS 150,7982
#define SPLIT_NEG 151,8053
#define SPLIT_NONHORN 152,8124
#define SPLIT_MIN_MAX 153,8195
#define SPLIT_POPULAR 154,8272
#define UNIT_RES 155,8340
#define BUILD_PROOF_OBJECT_2 157,8409
#define SIGINT_INTERACT 158,8480
#define UR_LAST 160,8540
#define LITERALS_WEIGH_ONE 161,8616
#define PICK_DIFF_SIM 162,8649
#define PICK_RANDOM_LIGHTEST 163,8715
#define PICK_LAST_LIGHTEST 164,8781
#define PICK_MID_LIGHTEST 165,8847
#define SOS_ARG 166,8913
#define FOR_SUB_EQUIVALENTS_ONLY 167,8984
#define KEEP_HINT_EQUIVALENTS 168,9064
#define MAX_PARMS 181,9488
#define REPORT 183,9545
#define MAX_SECONDS 185,9619
#define MAX_GEN 186,9689
#define MAX_KEPT 187,9769
#define MAX_GIVEN 188,9844
#define MAX_MEM 189,9920
#define MAX_LITERALS 191,10001
#define MAX_WEIGHT 192,10080
#define MAX_DISTINCT_VARS 193,10145
#define FPA_LITERALS 195,10215
#define FPA_TERMS 196,10282
#define PICK_GIVEN_RATIO 198,10347
#define INTERRUPT_GIVEN 199,10421
#define DEMOD_LIMIT 200,10496
#define MAX_PROOFS 201,10570
#define MIN_BIT_WIDTH 202,10647
#define NEG_WEIGHT 203,10712
#define PRETTY_PRINT_INDENT 204,10792
#define STATS_LEVEL 205,10853
#define CHANGE_LIMIT_AFTER 209,10948
#define NEW_MAX_WEIGHT 210,11013
#define GEO_GIVEN_RATIO 211,11078
#define MAX_UR_DEPTH 213,11156
#define MAX_UR_DED_SIZE 214,11236
#define HEAT 216,11312
#define DYNAMIC_HEAT_WEIGHT 217,11368
#define MAX_ANSWERS 218,11438
#define DEBUG_FIRST 220,11510
#define DEBUG_LAST 221,11572
#define FSUB_HINT_ADD_WT 222,11634
#define BSUB_HINT_ADD_WT 223,11696
#define EQUIV_HINT_ADD_WT 224,11758
#define VERBOSE_DEMOD_SKIP 225,11820
#define FSUB_HINT_WT 227,11877
#define BSUB_HINT_WT 228,11932
#define EQUIV_HINT_WT 229,11987
#define DYNAMIC_DEMOD_DEPTH 231,12043
#define DYNAMIC_DEMOD_RHS 232,12074
#define AGE_FACTOR 234,12106
#define DISTINCT_VARS_FACTOR 235,12176
#define NEW_SYMBOL_LEX_POSITION 236,12246
#define WARN_MEM 238,12282
#define WARN_MEM_MAX_WEIGHT 239,12358
#define SPLIT_SECONDS 240,12411
#define SPLIT_GIVEN 241,12481
#define SPLIT_DEPTH 242,12550
#define ICGNS 244,12613
#define PICK_DIFF 245,12688
#define PICK_DIFF_RANGE 246,12752
#define MAX_STATS 259,13097
#define INPUT_ERRORS 261,13126
#define CL_INPUT 262,13154
#define CL_GENERATED 263,13182
#define CL_KEPT 264,13210
#define CL_FOR_SUB 265,13238
#define CL_BACK_SUB 266,13266
#define CL_TAUTOLOGY 267,13294
#define CL_GIVEN 268,13322
#define CL_WT_DELETE 269,13350
#define REWRITES 270,13378
#define UNIT_DELETES 271,13406
#define EMPTY_CLAUSES 272,13435
#define FPA_OVERLOADS 273,13464
#define FPA_UNDERLOADS 274,13516
#define CL_VAR_DELETES 275,13568
#define FOR_SUB_SOS 276,13620
#define NEW_DEMODS 277,13649
#define CL_BACK_DEMOD 278,13678
#define LINKED_UR_DEPTH_HITS 279,13707
#define LINKED_UR_DED_HITS 280,13739
#define SOS_SIZE 281,13771
#define K_MALLOCED 282,13803
#define CL_NOT_ANC_SUBSUMED 283,13835
#define USABLE_SIZE 287,13898
#define DEMODULATORS_SIZE 288,13930
#define DEMOD_LIMITS 289,13962
#define INIT_WALL_SECONDS 290,14017
#define BINARY_RES_GEN 291,14049
#define HYPER_RES_GEN 292,14081
#define NEG_HYPER_RES_GEN 293,14113
#define UR_RES_GEN 294,14145
#define PARA_INTO_GEN 295,14177
#define PARA_FROM_GEN 296,14209
#define LINKED_UR_RES_GEN 297,14241
#define GEO_GEN 298,14273
#define DEMOD_INF_GEN 299,14305
#define FACTOR_GEN 300,14337
#define HOT_GENERATED 301,14369
#define HOT_KEPT 302,14401
#define FACTOR_SIMPLIFICATIONS 303,14433
#define HOT_SIZE 304,14467
#define PASSIVE_SIZE 305,14499
#define BACK_UNIT_DEL_GEN 306,14531
#define MAX_CLOCKS 320,14938
#define INPUT_TIME 322,14971
#define CLAUSIFY_TIME 323,15002
#define PROCESS_INPUT_TIME 324,15033
#define BINARY_TIME 326,15065
#define HYPER_TIME 327,15096
#define NEG_HYPER_TIME 328,15127
#define UR_TIME 329,15158
#define PARA_INTO_TIME 330,15189
#define PARA_FROM_TIME 331,15220
#define LINKED_UR_TIME 332,15251
#define PRE_PROC_TIME 334,15283
#define RENUMBER_TIME 335,15314
#define DEMOD_TIME 336,15345
#define ORDER_EQ_TIME 337,15376
#define UNIT_DEL_TIME 338,15407
#define WEIGH_CL_TIME 339,15438
#define SORT_LITS_TIME 340,15469
#define FOR_SUB_TIME 341,15500
#define DEL_CL_TIME 342,15531
#define KEEP_CL_TIME 343,15562
#define PRINT_CL_TIME 344,15593
#define CONFLICT_TIME 345,15624
#define NEW_DEMOD_TIME 346,15655
#define POST_PROC_TIME 348,15687
#define BACK_DEMOD_TIME 349,15718
#define BACK_SUB_TIME 350,15749
#define FACTOR_TIME 351,15780
#define UN_INDEX_TIME 353,15812
#define HOT_TIME 354,15843
#define FACTOR_SIMP_TIME 355,15874
#define HINTS_TIME 357,15906
#define HINTS_KEEP_TIME 358,15937
#define BACK_UNIT_DEL_TIME 360,15969
#define PICK_GIVEN_TIME 361,16000
#define MAX_INTERNAL_FLAGS 371,16132
#define SPECIAL_UNARY_PRESENT 373,16165
#define DOLLAR_PRESENT 374,16197
#define LEX_VALS_SET 375,16229
#define REALLY_CHECK_ARITY 376,16261
#define INT_ATTR 378,16294
#define BOOL_ATTR 379,16316
#define DOUBLE_ATTR 380,16338
#define STRING_ATTR 381,16360
#define TERM_ATTR 382,16382
#define MAX_ATTRIBUTES 390,16467
#define BSUB_HINT_WT_ATTR 392,16494
#define FSUB_HINT_WT_ATTR 393,16522
#define EQUIV_HINT_WT_ATTR 394,16550
#define BSUB_HINT_ADD_WT_ATTR 395,16579
#define FSUB_HINT_ADD_WT_ATTR 396,16611
#define EQUIV_HINT_ADD_WT_ATTR 397,16643
#define LABEL_ATTR 398,16676
foreign.h,445
#define MAX_USER_ARGS 81,3251
#define LONG_TYPE 83,3332
#define DOUBLE_TYPE 84,3404
#define BOOL_TYPE 85,3432
#define STRING_TYPE 86,3460
#define TERM_TYPE 87,3488
struct user_function user_function89,3517
#define MAX_USER_FUNCTIONS 95,3669
#define FOO_FUNC 99,3774
#define TEST_LONG_FUNC 100,3809
#define TEST_DOUBLE_FUNC 101,3844
#define TEST_BOOL_FUNC 102,3879
#define TEST_STRING_FUNC 103,3914
#define TEST_TERM_FUNC 104,3949
header.h,6368
# define getrusage(getrusage24,453
#define MAX_LONG_INT 31,634
#define MAX_INT 32,708
#define MAX_UNSIGNED_SHORT 33,781
#define MAX_NAME 37,862
# define MAX_BUF 40,955
# define MAX_BUF 42,1034
#define MAX_VARS 45,1115
#define VAR_TYPE 46,1185
#define FPA_SIZE 49,1299
#define MAX_FS_TERM_DEPTH 51,1352
#define MAX_AL_TERM_DEPTH 52,1419
#define NAME 56,1517
#define VARIABLE 57,1565
#define COMPLEX 58,1584
#define TERM 62,1683
#define NORM_ATOM 63,1729
#define POS_EQ 64,1775
#define NEG_EQ 65,1832
#define ANSWER 66,1889
#define LEX_DEP_DEMOD 67,1943
#define EVALUABLE 68,2008
#define CONDITIONAL_DEMOD 69,2056
#define UNIFY 72,2180
#define INSTANCE 73,2196
#define MORE_GEN 74,2215
#define BINARY_RES_RULE 79,2356
#define HYPER_RES_RULE 80,2387
#define NEG_HYPER_RES_RULE 81,2418
#define UR_RES_RULE 82,2449
#define PARA_INTO_RULE 83,2480
#define PARA_FROM_RULE 84,2511
#define LINKED_UR_RES_RULE 85,2542
#define GEO_RULE 86,2573
#define FACTOR_RULE 88,2605
#define NEW_DEMOD_RULE 89,2636
#define BACK_DEMOD_RULE 90,2667
#define DEMOD_RULE 92,2699
#define UNIT_DEL_RULE 93,2730
#define EVAL_RULE 94,2761
#define GEO_ID_RULE 95,2792
#define FACTOR_SIMP_RULE 96,2823
#define COPY_RULE 97,2854
#define FLIP_EQ_RULE 98,2885
#define CLAUSIFY_RULE 99,2916
#define BACK_UNIT_DEL_RULE 100,2947
#define SPLIT_RULE 101,2978
#define SPLIT_NEG_RULE 102,3009
#define PROPOSITIONAL_RULE 103,3040
#define SEM_RES_RULE 106,3085
#define LIST_RULE 109,3124
#define MAX_USER_EVALUABLE 115,3382
#define SUM_SYM 117,3415
#define PROD_SYM 118,3445
#define DIFF_SYM 119,3475
#define DIV_SYM 120,3505
#define MOD_SYM 121,3535
#define EQ_SYM 123,3566
#define NE_SYM 124,3596
#define LT_SYM 125,3626
#define LE_SYM 126,3656
#define GT_SYM 127,3686
#define GE_SYM 128,3716
#define AND_SYM 130,3747
#define OR_SYM 131,3777
#define NOT_SYM 132,3807
#define IF_SYM 134,3838
#define ID_SYM 136,3869
#define LNE_SYM 137,3899
#define LLT_SYM 138,3929
#define LLE_SYM 139,3959
#define LGT_SYM 140,3989
#define LGE_SYM 141,4019
#define T_SYM 142,4049
#define F_SYM 143,4079
#define NEXT_CL_NUM_SYM 144,4109
#define ATOMIC_SYM 145,4139
#define INT_SYM 146,4169
#define VAR_SYM 147,4199
#define TRUE_SYM 148,4229
#define OUT_SYM 149,4259
#define BIT_AND_SYM 151,4290
#define BIT_OR_SYM 152,4320
#define BIT_XOR_SYM 153,4350
#define BIT_NOT_SYM 154,4380
#define SHIFT_LEFT_SYM 155,4410
#define SHIFT_RIGHT_SYM 156,4440
#define GROUND_SYM 157,4470
#define FSUM_SYM 159,4501
#define FPROD_SYM 160,4565
#define FDIFF_SYM 161,4595
#define FDIV_SYM 162,4625
#define FEQ_SYM 164,4656
#define FNE_SYM 165,4686
#define FLT_SYM 166,4716
#define FLE_SYM 167,4746
#define FGT_SYM 168,4776
#define FGE_SYM 169,4806
#define COMMON_EXPRESSION_SYM 171,4837
#define BITS_SYM 173,4873
#define INT_TO_BITS_SYM 174,4903
#define BITS_TO_INT_SYM 175,4933
#define RENAME_SYM 177,4964
#define UNIQUE_NUM_SYM 178,4994
#define OCCURS_SYM 180,5025
#define VOCCURS_SYM 181,5055
#define VFREE_SYM 182,5085
#define LESS_THAN 186,5156
#define GREATER_THAN 187,5183
#define SAME_AS 188,5210
#define NOT_COMPARABLE 189,5237
#define NOT_GREATER_THAN 190,5264
#define NOT_LESS_THAN 191,5291
#define LRPO_MULTISET_STATUS 193,5319
#define LRPO_LR_STATUS 194,5384
#define XFX 199,5521
#define XFY 200,5535
#define YFX 201,5549
#define FX 202,5563
#define FY 203,5577
#define XF 204,5591
#define YF 205,5605
#define BOOLEAN 209,5669
#define FALSE 210,5690
#define TRUE 211,5706
#define UNDEFINED 212,5721
#define NOT_SPECIFIED 213,5742
#define NUCLEUS 214,5766
#define LINK 215,5789
#define BOTH 216,5812
#define SATELLITE 217,5835
#define ATOM_FORM 221,5906
#define NOT_FORM 222,5926
#define AND_FORM 223,5945
#define OR_FORM 224,5964
#define IMP_FORM 225,5982
#define IFF_FORM 226,6001
#define QUANT_FORM 227,6020
#define ALL_QUANT 229,6042
#define EXISTS_QUANT 230,6062
#define KEEP_SEARCHING 234,6122
#define INPUT_ERROR_EXIT 235,6155
#define ABEND_EXIT 236,6188
#define PROOF_EXIT 237,6221
#define SOS_EMPTY_EXIT 238,6254
#define MAX_GIVEN_EXIT 239,6287
#define MAX_SECONDS_EXIT 240,6320
#define MAX_GEN_EXIT 241,6353
#define MAX_KEPT_EXIT 242,6386
#define MAX_MEM_EXIT 243,6419
#define MALLOC_NULL_EXIT 244,6452
#define INTERACTIVE_EXIT 245,6485
#define SEGV_EXIT 246,6518
#define USR1_EXIT 247,6551
#define POSSIBLE_MODEL_EXIT 248,6584
#define MAX_PICK_WT_EXIT 251,6631
# define CLASS 281,7703
# define CLASS 283,7780
CLASS struct list *Usable;288,7878
CLASS struct list *Sos;289,7905
CLASS struct list *Demodulators;290,7929
CLASS struct list *Passive;291,7962
CLASS struct list *Hot;292,7990
CLASS struct list *Hints;293,8014
CLASS struct list *First;295,8053
CLASS struct fpa_index *Fpa_clash_pos_lits;300,8146
CLASS struct fpa_index *Fpa_clash_neg_lits;301,8190
CLASS struct fpa_index *Fpa_pos_lits;305,8291
CLASS struct fpa_index *Fpa_neg_lits;306,8329
CLASS struct fpa_index *Fpa_clash_terms;310,8420
CLASS struct fpa_index *Fpa_alphas;311,8483
CLASS struct fpa_index *Fpa_back_demod;315,8593
CLASS struct is_tree *Is_pos_lits;319,8716
CLASS struct is_tree *Is_neg_lits;320,8776
CLASS struct imd_tree *Demod_imd;324,8887
CLASS struct term_ptr *Weight_purge_gen;328,8955
CLASS struct term_ptr *Weight_pick_given;329,9030
CLASS struct term_ptr *Weight_terms;330,9098
CLASS struct is_tree *Weight_purge_gen_index;334,9221
CLASS struct is_tree *Weight_pick_given_index;335,9267
CLASS struct is_tree *Weight_terms_index;336,9314
} Flags[343,9474
} Parms[349,9647
CLASS int Internal_flags[351,9672
CLASS long Stats[355,9762
CLASS int Subsume_count[356,9791
CLASS struct clock Clocks[360,9836
CLASS int Cons_sym_num,364,9906
CLASS int Cons_sym_num, Nil_sym_num,364,9906
CLASS int Cons_sym_num, Nil_sym_num, Ignore_sym_num,364,9906
CLASS int Cons_sym_num, Nil_sym_num, Ignore_sym_num, Chr_sym_num,364,9906
CLASS int Cons_sym_num, Nil_sym_num, Ignore_sym_num, Chr_sym_num, Dots_sym_num;364,9906
CLASS struct user_function User_functions[368,10018
CLASS FILE *Null_output;370,10082
CLASS char Float_format[374,10146
CLASS struct term *Overbeek_terms;375,10181
CLASS struct term *Split_atoms;376,10241
CLASS char Bell;378,10299
CLASS int Max_input_id;380,10317
CLASS struct term_ptr **Overbeek_world;384,10409
lisp.h,188
#define BOOLEAN 20,419
#define FALSE 21,440
#define TRUE 22,456
typedef enum { FALSE=0, TRUE=1 } BOOL;BOOL24,477
typedef struct bnode * Bnode;Bnode27,524
struct bnode bnode29,555
macros.h,494
#define CPU_TIME(CPU_TIME14,294
#define CPU_TIME(CPU_TIME17,378
#define CPU_TIME(CPU_TIME27,599
#define CPU_TIME(CPU_TIME36,779
#define CLOCK_START(CLOCK_START50,1080
#define CLOCK_START(CLOCK_START52,1130
#define CLOCK_STOP(CLOCK_STOP75,1701
#define CLOCK_STOP(CLOCK_STOP77,1750
#define SET_BIT(SET_BIT108,2463
#define CLEAR_BIT(CLEAR_BIT109,2515
#define TP_BIT(TP_BIT110,2568
#define SCRATCH_BIT 114,2635
#define ORIENTED_EQ_BIT 115,2664
#define SCRATCH_BIT 119,2714
proto.h,0
types.h,1069
struct term term6,44
struct rel rel19,687
struct sym_ent sym_ent28,1078
struct term_ptr term_ptr43,1854
struct formula_ptr_2 formula_ptr_248,1985
struct fpa_tree fpa_tree53,2160
struct fpa_head fpa_head63,2612
struct fpa_index fpa_index69,2808
struct context context73,2873
struct trail trail81,3193
struct imd_tree imd_tree87,3338
struct imd_pos imd_pos97,3741
struct is_tree is_tree105,4097
struct is_pos is_pos115,4427
struct fsub_pos fsub_pos123,4789
struct literal literal128,5012
typedef enum { Norm, Old_Base, Base, Conj, New_Base, All} scan_type;scan_type137,5193
struct clause clause140,5270
struct list list162,5857
struct clause_ptr clause_ptr167,6013
struct int_ptr int_ptr172,6143
struct ci_ptr ci_ptr177,6244
struct clash_nd clash_nd183,6391
struct clock clock196,7040
struct ans_lit_node ans_lit_node203,7274
struct link_node link_node209,7390
struct formula_box formula_box222,7868
struct formula formula238,8368
struct formula_ptr formula_ptr245,8544
struct cl_attribute cl_attribute250,8626
attrib.c,300
} Attributes[11,104
void init_attributes(19,196
int get_attribute_index(57,1205
int attribute_type(76,1540
struct cl_attribute *get_attribute(102,2223
void set_attribute(116,2479
void delete_attributes(151,3083
struct cl_attribute *term_to_attributes(173,3482
void print_attributes(238,4915
av.c,8475
#define TP_ALLOC_SIZE 13,180
#define ALLOC_ARG_T 14,208
#define TP_ALLOC_SIZE 17,253
#define ALLOC_ARG_T 18,280
static char *Alloc_block;21,315
static char *Alloc_pos;22,390
static struct term *term_avail;26,513
static struct rel *rel_avail;27,545
static struct sym_ent *sym_ent_avail;28,575
static struct term_ptr *term_ptr_avail;29,613
static struct formula_ptr_2 *formula_ptr_2_avail;30,653
static struct fpa_tree *fpa_tree_avail;31,703
static struct fpa_head *fpa_head_avail;32,743
static struct context *context_avail;33,783
static struct trail *trail_avail;34,821
static struct imd_tree *imd_tree_avail;35,855
static struct imd_pos *imd_pos_avail;36,895
static struct is_tree *is_tree_avail;37,933
static struct is_pos *is_pos_avail;38,971
static struct fsub_pos *fsub_pos_avail;39,1007
static struct literal *literal_avail;40,1047
static struct clause *clause_avail;41,1085
static struct list *list_avail;42,1121
static struct clash_nd *clash_nd_avail;43,1153
static struct clause_ptr *clause_ptr_avail;44,1193
static struct ci_ptr *ci_ptr_avail;45,1237
static struct int_ptr *int_ptr_avail;46,1273
static struct link_node *link_node_avail;48,1312
static struct ans_lit_node *ans_lit_node_avail;49,1354
static struct formula_box *formula_box_avail;50,1402
static struct formula *formula_avail;51,1448
static struct formula_ptr *formula_ptr_avail;52,1486
static struct cl_attribute *cl_attribute_avail;53,1532
static int Malloc_calls;55,1581
static unsigned long term_gets,59,1715
static unsigned long term_gets, term_frees,59,1715
static unsigned long term_gets, term_frees, term_avails;59,1715
static unsigned long rel_gets,60,1772
static unsigned long rel_gets, rel_frees,60,1772
static unsigned long rel_gets, rel_frees, rel_avails;60,1772
static unsigned long sym_ent_gets,61,1826
static unsigned long sym_ent_gets, sym_ent_frees,61,1826
static unsigned long sym_ent_gets, sym_ent_frees, sym_ent_avails;61,1826
static unsigned long term_ptr_gets,62,1892
static unsigned long term_ptr_gets, term_ptr_frees,62,1892
static unsigned long term_ptr_gets, term_ptr_frees, term_ptr_avails;62,1892
static unsigned long formula_ptr_2_gets,63,1961
static unsigned long formula_ptr_2_gets, formula_ptr_2_frees,63,1961
static unsigned long formula_ptr_2_gets, formula_ptr_2_frees, formula_ptr_2_avails;63,1961
static unsigned long fpa_tree_gets,64,2045
static unsigned long fpa_tree_gets, fpa_tree_frees,64,2045
static unsigned long fpa_tree_gets, fpa_tree_frees, fpa_tree_avails;64,2045
static unsigned long fpa_head_gets,65,2114
static unsigned long fpa_head_gets, fpa_head_frees,65,2114
static unsigned long fpa_head_gets, fpa_head_frees, fpa_head_avails;65,2114
static unsigned long context_gets,66,2183
static unsigned long context_gets, context_frees,66,2183
static unsigned long context_gets, context_frees, context_avails;66,2183
static unsigned long trail_gets,67,2249
static unsigned long trail_gets, trail_frees,67,2249
static unsigned long trail_gets, trail_frees, trail_avails;67,2249
static unsigned long imd_tree_gets,68,2309
static unsigned long imd_tree_gets, imd_tree_frees,68,2309
static unsigned long imd_tree_gets, imd_tree_frees, imd_tree_avails;68,2309
static unsigned long imd_pos_gets,69,2378
static unsigned long imd_pos_gets, imd_pos_frees,69,2378
static unsigned long imd_pos_gets, imd_pos_frees, imd_pos_avails;69,2378
static unsigned long is_tree_gets,70,2444
static unsigned long is_tree_gets, is_tree_frees,70,2444
static unsigned long is_tree_gets, is_tree_frees, is_tree_avails;70,2444
static unsigned long is_pos_gets,71,2510
static unsigned long is_pos_gets, is_pos_frees,71,2510
static unsigned long is_pos_gets, is_pos_frees, is_pos_avails;71,2510
static unsigned long fsub_pos_gets,72,2573
static unsigned long fsub_pos_gets, fsub_pos_frees,72,2573
static unsigned long fsub_pos_gets, fsub_pos_frees, fsub_pos_avails;72,2573
static unsigned long literal_gets,73,2642
static unsigned long literal_gets, literal_frees,73,2642
static unsigned long literal_gets, literal_frees, literal_avails;73,2642
static unsigned long clause_gets,74,2708
static unsigned long clause_gets, clause_frees,74,2708
static unsigned long clause_gets, clause_frees, clause_avails;74,2708
static unsigned long list_gets,75,2771
static unsigned long list_gets, list_frees,75,2771
static unsigned long list_gets, list_frees, list_avails;75,2771
static unsigned long clash_nd_gets,76,2828
static unsigned long clash_nd_gets, clash_nd_frees,76,2828
static unsigned long clash_nd_gets, clash_nd_frees, clash_nd_avails;76,2828
static unsigned long clause_ptr_gets,77,2897
static unsigned long clause_ptr_gets, clause_ptr_frees,77,2897
static unsigned long clause_ptr_gets, clause_ptr_frees, clause_ptr_avails;77,2897
static unsigned long ci_ptr_gets,78,2972
static unsigned long ci_ptr_gets, ci_ptr_frees,78,2972
static unsigned long ci_ptr_gets, ci_ptr_frees, ci_ptr_avails;78,2972
static unsigned long int_ptr_gets,79,3035
static unsigned long int_ptr_gets, int_ptr_frees,79,3035
static unsigned long int_ptr_gets, int_ptr_frees, int_ptr_avails;79,3035
static unsigned long link_node_gets,81,3102
static unsigned long link_node_gets, link_node_frees,81,3102
static unsigned long link_node_gets, link_node_frees, link_node_avails;81,3102
static unsigned long ans_lit_node_gets,82,3174
static unsigned long ans_lit_node_gets, ans_lit_node_frees,82,3174
static unsigned long ans_lit_node_gets, ans_lit_node_frees, ans_lit_node_avails;82,3174
static unsigned long formula_box_gets,83,3255
static unsigned long formula_box_gets, formula_box_frees,83,3255
static unsigned long formula_box_gets, formula_box_frees, formula_box_avails;83,3255
static unsigned long formula_gets,84,3333
static unsigned long formula_gets, formula_frees,84,3333
static unsigned long formula_gets, formula_frees, formula_avails;84,3333
static unsigned long formula_ptr_gets,85,3399
static unsigned long formula_ptr_gets, formula_ptr_frees,85,3399
static unsigned long formula_ptr_gets, formula_ptr_frees, formula_ptr_avails;85,3399
static unsigned long cl_attribute_gets,86,3477
static unsigned long cl_attribute_gets, cl_attribute_frees,86,3477
static unsigned long cl_attribute_gets, cl_attribute_frees, cl_attribute_avails;86,3477
int **tp_alloc(96,3687
struct term *get_term(157,5498
void free_term(184,5946
struct rel *get_rel(198,6155
void free_rel(225,6578
struct sym_ent *get_sym_ent(239,6773
void free_sym_ent(270,7337
struct term_ptr *get_term_ptr(284,7562
void free_term_ptr(307,7976
struct formula_ptr_2 *get_formula_ptr_2(321,8218
void free_formula_ptr_2(349,8783
struct fpa_tree *get_fpa_tree(363,9050
void free_fpa_tree(390,9549
struct fpa_head *get_fpa_head(404,9781
void free_fpa_head(428,10214
struct context *get_context(442,10440
void free_context(472,11018
struct trail *get_trail(497,11492
void free_trail(519,11849
struct imd_tree *get_imd_tree(533,12060
void free_imd_tree(559,12522
struct imd_pos *get_imd_pos(573,12752
void free_imd_pos(595,13135
struct is_tree *get_is_tree(609,13358
void free_is_tree(634,13790
struct is_pos *get_is_pos(648,14011
void free_is_pos(670,14381
struct fsub_pos *get_fsub_pos(684,14599
void free_fsub_pos(705,14998
struct literal *get_literal(719,15249
void free_literal(744,15696
struct clause *get_clause(758,15921
void free_clause(795,16552
struct list *get_list(809,16765
void free_list(833,17175
struct clash_nd *get_clash_nd(847,17401
void free_clash_nd(871,17835
struct clause_ptr *get_clause_ptr(885,18071
void free_clause_ptr(908,18508
struct ci_ptr *get_ci_ptr(922,18750
void free_ci_ptr(946,19150
struct int_ptr *get_int_ptr(960,19366
void free_int_ptr(983,19761
struct ans_lit_node *get_ans_lit_node(997,19994
void free_ans_lit_node(1023,20486
struct formula_box *get_formula_box(1037,20752
void free_formula_box(1065,21367
struct formula *get_formula(1079,21618
void free_formula(1105,22087
struct formula_ptr *get_formula_ptr(1119,22318
void free_formula_ptr(1143,22774
struct cl_attribute *get_cl_attribute(1157,23035
void free_cl_attribute(1181,23505
struct link_node *get_link_node(1195,23767
void free_link_node(1236,24664
void free_imd_pos_list(1250,24939
void free_is_pos_list(1274,25365
void print_mem(1298,25736
void print_mem_brief(1342,33303
int total_mem(1362,34717
int total_mem_calls(1373,34879
void print_linked_ur_mem_stats(1384,35042
case.c,1324
#define MAX_SPLIT_DEPTH 14,192
#define POS_CLAUSE 16,258
#define NEG_CLAUSE 17,279
#define MIX_CLAUSE 18,300
#define FORK_FAIL 20,322
#define PARENT 21,343
#define CHILD 22,364
#define CHILD_FAIL 23,385
struct int_ptr *Current_case 27,476
struct literal_data literal_data36,807
int To_parent,58,1409
int To_parent, From_parent;58,1409
int To_children,59,1483
int To_children, From_children;59,1483
int splitting(67,1639
int max_split_depth(80,1888
int splitable_literal(93,2126
static struct literal_data compare_literal_data(118,2724
int splitable_clause(150,3442
struct clause *compare_splitable_clauses(176,4008
static void init_literal_data(214,5007
static void p_literal_data(225,5218
static void get_literal_data(244,5846
void print_case(306,7398
void p_case(321,7667
void print_case_n(332,7826
void p_case_n(348,8087
void p_assumption_depths(359,8221
struct int_ptr *current_case(378,8613
void add_subcase(389,8793
int case_depth(409,9147
struct clause *find_clause_to_split(422,9371
struct term *find_atom_to_split(452,10060
int prover_forks(522,12403
int split_clause(646,15547
int split_atom(774,19108
void possible_split(868,21763
void always_split(914,22746
void possible_given_split(943,23318
void assumps_to_parent(992,24546
void exit_with_possible_model(1034,25644
check.c,2554
#define GEN_TAB_SIZE 16,281
struct gen_node gen_node18,307
struct gen_tab gen_tab24,375
static struct gen_tab *Old_proof_tab;30,456
static struct gen_tab *New_proof_old_id_tab;31,494
static struct gen_tab *New_proof_tab;32,539
struct gen_node *get_gen_node(40,636
struct proof_object *get_proof_object(55,889
struct proof_object_node *get_proof_object_node(71,1196
static struct gen_tab *init_gen_tab(97,1745
static int insert_into_gen_tab(115,2102
static void * retrieve_from_gen_tab(150,2734
static void p_gen_tab(164,3014
struct int_ptr *copy_ip_segment(182,3320
void print_int_list(207,3737
void p_int_list(223,4023
static int check_eq_lit(235,4194
int trivial_subst(251,4535
struct proof_object_node *connect_new_node(278,5028
static char *po_rule(307,5647
void print_term_s(330,6202
void p_term_s(356,6687
void print_clause_s(369,6893
void p_clause_s(393,7338
void print_clause_s2(406,7553
void p_clause_s2(444,8305
void print_proof_object_node(455,8467
void p_proof_object_node(525,10019
void print_proof_object(536,10213
void p_proof_object(552,10521
static int new_literal_index(565,10768
static void copy_subst_to_proof_object(581,11066
struct clause *cl_copy_delete_literal(623,11896
int variant(659,12840
static int match_literals(702,13573
struct int_ptr *match_clauses(766,15190
struct clause *cl_append(822,16275
struct clause *identity_resolve(849,16767
static struct clause *identity_paramod(869,17114
void renumber_vars_subst(914,18180
static int translate_unit_deletion(949,18816
static int translate_factor_simp(1027,20950
static struct int_ptr *first_rewrite(1101,22926
static struct int_ptr *first_rewrite_clause(1164,24376
static int translate_demod_nonunit(1197,25363
static int translate_demod_unit(1297,28366
int finish_translating(1389,31055
static int translate_resolution(1576,36706
static struct int_ptr *order_new_lits_for_hyper(1724,41302
static int translate_hyper(1769,42196
int ipx(1883,45642
static int translate_ur(1900,45864
static int translate_factor(2069,50208
static struct term *para_position(2136,51922
static int translate_paramod(2159,52337
static void varmap(2304,56666
static BOOLEAN match2(2318,56986
struct proof_object_node *find_match2(2352,57798
static int translate_step(2375,58393
int contains_answer_literal(2488,61688
int contains_rule(2503,61960
void zap_int_ptr_list(2520,62246
struct int_ptr *trans_2_pos(2536,62461
void type_2_trans(2581,63446
void build_proof_object(2608,64131
void init_proof_object_environment(2696,67381
clause.c,3464
#define CLAUSE_TAB_SIZE 12,159
#define CLAUSE_TAB_SIZE 15,204
static struct clause_ptr *Clause_tab[19,285
static int Clause_id_count;22,365
static struct clause *Hidden_clauses;25,449
#define MAX_LITS 28,543
static char Map_array[29,564
void reset_clause_counter(37,664
int next_cl_num(50,884
void assign_cl_id(63,1097
void hot_cl_integrate(96,2160
void cl_integrate(122,2789
void cl_del_int(182,4146
void cl_del_non(274,6066
void cl_int_chk(304,6661
static struct term *literals_to_term(327,7299
struct term *clause_to_term(361,8005
static struct literal *term_to_literals(381,8346
struct clause *term_to_clause(411,8976
struct clause *read_sequent_clause(460,10050
struct clause *read_clause(661,14256
struct list *read_cl_list(714,15356
int set_vars_cl(760,16287
void print_sequent_clause(786,16740
void print_clause(818,17311
void p_clause(950,20898
void print_cl_list(961,21047
void cl_merge(984,21451
int tautology(1014,22006
int prf_weight(1041,22504
int proof_length(1075,23319
int subsume(1099,23846
int map_rest(1121,24238
int anc_subsume(1180,25676
struct clause *for_sub_prop(1201,26082
struct clause *forward_subsume(1225,26517
struct clause_ptr *back_subsume(1358,30011
struct clause_ptr *unit_conflict(1439,31930
int propositional_clause(1503,33423
int xx_resolvable(1524,33803
int pos_clause(1555,34441
int answer_lit(1574,34812
int pos_eq_lit(1585,35016
int neg_eq_lit(1596,35220
int eq_lit(1607,35425
int neg_clause(1620,35645
int num_literals(1639,36036
int num_answers(1660,36378
int num_literals_including_answers(1681,36700
int literal_number(1698,37058
int unit_clause(1719,37402
int horn_clause(1734,37648
int equality_clause(1753,37994
int symmetry_clause(1771,38327
struct literal *ith_literal(1806,39148
void append_cl(1831,39502
void prepend_cl(1863,40006
void insert_before_cl(1893,40512
void insert_after_cl(1929,41112
void rem_from_list(1965,41699
void insert_clause(2004,42418
int max_literal_weight(2032,42904
int weight_cl(2055,43412
void hide_clause(2086,44094
void del_hidden_clauses(2098,44304
struct clause *cl_copy(2117,44618
int clause_ident(2152,45280
void remove_var_syms(2175,45797
void cl_insert_tab(2192,46091
void cl_delete_tab(2229,46762
struct clause *cl_find(2264,47402
int lit_compare(2292,47877
int ordered_sub_clause(2333,49002
int sub_clause(2378,50086
int sort_lits(2405,50577
void all_cont_cl(2445,51396
void zap_cl_list(2473,51917
int is_eq(2492,52168
void mark_literal(2516,52657
int get_ancestors(2565,53997
int renumber_vars_term(2652,56113
int renumber_vars(2673,56529
int renum_vars_term(2700,56974
void clear_var_names(2742,57707
void cl_clear_vars(2760,57983
static void distinct_vars_rec(2774,58239
int distinct_vars(2803,58860
struct clause *find_first_cl(2824,59220
struct clause *find_last_cl(2842,59474
struct clause *find_random_cl(2860,59726
struct clause_ptr *get_clauses_of_wt_range(2887,60178
int clause_ptr_list_size(2908,60665
struct clause *nth_clause(2922,60910
void zap_clause_ptr_list(2940,61227
struct clause *find_random_lightest_cl(2954,61473
struct clause *find_mid_lightest_cl(2977,61974
struct clause *find_lightest_cl(3006,62701
struct clause *find_lightest_geo_child(3036,63401
struct clause *find_interactive_cl(3059,63835
struct clause *find_given_clause(3119,65283
struct clause *extract_given_clause(3176,66620
int unit_del(3205,67310
void back_unit_deletion(3316,69767
clocks.c,177
void clock_init(15,218
long clock_val(65,1124
void clock_reset(86,1564
char *get_time(98,1826
long system_time(115,2119
long run_time(144,2637
long wall_seconds(193,3504
control.c,523
static struct Distn pick_weight;65,1861
static struct Distn max_vars;66,1894
void scott_control_memory(68,1925
void control_distn(95,3134
void cull_clauses_over(142,4690
int weight_percentile(170,5630
int variable_percentile(197,6651
int clause_pick_weight(225,7663
void init_distributions(236,8098
void init_a_distribution(264,9007
void get_distn(285,9656
void set_distn(357,11891
void output_distn(460,15045
void output_weight_distn(571,18263
void output_variable_distn(586,18782
int percentile(602,19300
demod.c,680
static struct term *contract_lin(18,350
static void dollar_out_non_list(93,1936
static void dollar_out(109,2264
static struct term *dollar_contract(158,4063
static struct term *replace_special(555,16456
static struct term *demod(592,17593
static struct term *left_most_one_step(691,20340
static struct term *demod_out_in(748,21542
static void un_share_special(786,22551
struct term *convenient_demod(813,23001
void zap_term_special(852,24003
struct term *apply_demod(896,25236
void demod_cl(948,26396
void back_demod(1051,29172
int lit_t_f_reduce(1151,31681
int check_input_demod(1215,33183
int dynamic_demodulator(1286,34928
struct clause *new_demod(1350,36423
dp_util.c,1503
#define FUNCTION 8,83
#define RELATION 9,102
} Syms[18,254
int Num_syms;20,268
int Dp_sn,22,283
int Dp_sn, Eq_sn,22,283
int Dp_sn, Eq_sn, Lt_sn;22,283
int kludgey_e_subsume(34,528
void check_for_bad_things(66,1233
int int_term(85,1702
int domain_element(99,1925
static struct term *first_nonvar_arg_term(116,2372
static struct term *first_nonvar_arg(145,2974
static struct term *build_binary_term(163,3321
static struct term *replace_term(183,3719
static void flatten_clause(203,4084
void dp_p_term(233,4717
static void dp_p_clause(254,5052
static void collect_symbols(288,5735
static int occurrences_cl(331,6671
int clause_to_pair(356,7254
static struct list *clause_to_clauses(419,8938
static void process_negative_equalities(461,9831
static void check_transformed_clause(509,10857
static void lone_variable_process(539,11720
static void domain_element_process(567,12419
void dp_transform(602,13146
void print_clause_bare(744,16752
static void instances_recurse(762,17068
int sym_lessthan(787,17566
struct int_ptr *sym_insert(806,17831
int ilist_member(829,18202
void zap_ilist(846,18432
struct int_ptr *fsyms_in_term(860,18607
struct int_ptr *fsyms_in_clause(880,18967
struct int_ptr *fsyms_in_clist(898,19326
struct int_ptr *rsyms_in_clause(913,19600
struct int_ptr *rsyms_in_clist(929,19898
struct clause_ptr *subst_axioms_for_rsym(944,20178
struct clause_ptr *subst_axioms_for_fsym(1027,22243
#define MAX_DOMAIN 1125,24913
void icgns_transform(1127,24937
foreign.c,446
long foo(14,155
long user_test_long(28,343
double user_test_double(45,616
int user_test_bool(62,885
char *user_test_string(79,1152
struct term *user_test_term(96,1460
void declare_user_functions(116,1849
int get_args_for_user_function(211,4633
struct term *long_to_term(289,6201
struct term *double_to_term(307,6517
struct term *bool_to_term(325,6836
struct term *string_to_term(341,7121
struct term *evaluate_user_function(357,7351
formula.c,3021
static int Sk_func_num,11,201
static int Sk_func_num, Sk_const_num;11,201
void print_formula(19,374
void p_formula(87,1809
static struct term *formula_args_to_term(101,2094
struct term *formula_to_term(142,3123
struct formula *term_to_formula(207,4583
struct formula *read_formula(278,6318
struct formula_ptr *read_formula_list(323,7236
void print_formula_list(378,8349
struct formula *copy_formula(396,8720
void zap_formula(433,9494
struct formula *negate_formula(460,9977
struct formula *nnf(495,10754
static void rename_free_formula(603,13339
static struct formula *skolem(631,13962
struct formula *skolemize(722,16180
struct formula *anti_skolemize(742,16544
static void subst_free_term(755,16839
void subst_free_formula(784,17385
void gen_sk_sym(811,17981
int skolem_symbol(849,18677
int contains_skolem_symbol(868,19009
int new_var_name(897,19623
int new_functor_name(926,20173
static void uq_all(949,20570
void unique_all(996,21594
static void mark_free_var_term(1022,22112
static void mark_free_var_formula(1057,22820
struct formula *zap_quant(1084,23547
static void flatten_top_2(1125,24302
void flatten_top(1160,25069
static struct formula *distribute(1183,25530
struct formula *cnf(1264,27078
struct formula *dnf(1307,27910
static void rename_syms_term(1320,28147
void rename_syms_formula(1359,29156
void subst_sn_term(1378,29524
void subst_sn_formula(1405,30065
int gen_subsume_prop(1430,30665
struct formula *subsume_conj(1470,31932
struct formula *subsume_disj(1536,33411
int formula_ident(1599,34728
void conflict_tautology(1634,35671
void ts_and_fs(1676,36657
static int set_vars_term_2(1730,37624
static int set_vars_cl_2(1775,38545
static struct clause *disj_to_clause(1799,38954
static struct list *cnf_to_list(1864,40647
struct list *clausify(1896,41284
struct list *clausify_formula_list(1920,41707
struct formula *negation_inward(1972,42847
struct formula *expand_imp(2017,43823
struct formula *iff_to_conj(2036,44165
struct formula *iff_to_disj(2076,44864
struct formula *nnf_cnf(2109,45488
struct formula *nnf_dnf(2120,45645
struct formula *nnf_skolemize(2131,45808
struct formula *clausify_formed(2142,45991
void rms_conflict_tautology(2164,46471
struct formula *rms_subsume_conj(2219,47566
struct formula *rms_subsume_disj(2285,49047
int free_occurrence(2348,50351
struct formula *rms_distribute_quants(2389,51165
static void separate_free(2428,51992
struct formula *rms_push_free(2492,53275
struct formula *rms_quantifiers(2538,54291
static struct formula *rms_distribute(2614,56002
struct formula *rms(2691,57493
static void introduce_var_term(2739,58452
static void introduce_var(2772,59090
struct formula *renumber_unique(2808,59847
int gen_subsume_rec(2859,61038
int gen_subsume(2904,62516
int gen_conflict(2941,63263
int gen_tautology(2979,64102
struct formula *rms_cnf(3012,64764
struct formula *rms_dnf(3023,64921
static struct formula *push_free(3039,65317
struct formula *distribute_quantifier(3088,66482
fpa.c,919
#define AND 48,1654
#define OR 49,1668
#define LEAF 50,1681
#define MAX_PATH 54,1801
struct fpa_index *alloc_fpa_index(62,1884
static void path_mark_end(83,2261
static int hash_path(112,2855
static int path_comp(130,3100
static int path_size(153,3440
static int *path_copy(171,3650
static void insert_fpa_tab(196,4090
static void delete_fpa_tab(269,5767
void term_fpa_rec(328,7155
void fpa_insert(378,8245
void fpa_delete(405,8887
static struct fpa_tree *get_leaf_node(423,9254
static int all_args_vars(450,9844
static struct fpa_tree *build_tree_local(505,11444
struct fpa_tree *build_tree(599,13535
struct term *next_term(626,14359
struct fpa_tree *build_for_all(733,16810
void zap_prop_tree(772,17606
void print_fpa_tab(787,17890
void p_fpa_tab(819,18476
void print_prop_tree(833,18775
void p_prop_tree(860,19259
void print_path(871,19449
void p_path(905,20073
int new_sym_num(922,20387
geometry.c,348
#define MAX_DEPTH 31,1181
static int is_geometry_symbol(39,1298
static int geo_rewrite_recurse(56,1619
int geo_rewrite(123,3351
static struct term *geo_replace_unif(146,3824
static void geo_generate_unif(173,4306
static void geo_recurse_unif(215,5364
void geometry_rule_unif(260,6538
int child_of_geometry(282,6985
void gl_demod(303,7301
hints.c,271
struct hint_data hint_data65,2095
void process_hint_attributes(79,2366
void print_hint_clause(134,4008
void p_hint_clause(169,4708
void print_hints_cl_list(180,4868
void p_hints_cl_list(203,5247
void adjust_weight_with_hints(217,5522
int hint_keep_test(288,7027
hot.c,733
static struct fpa_index *Hot_clash_pos_lits;23,696
static struct fpa_index *Hot_clash_neg_lits;24,741
static struct fpa_index *Hot_alphas;25,786
static struct fpa_index *Hot_clash_terms;26,823
static struct fpa_index *Ordinary_clash_pos_lits;30,905
static struct fpa_index *Ordinary_clash_neg_lits;31,955
static struct fpa_index *Ordinary_alphas;32,1005
static struct fpa_index *Ordinary_clash_terms;33,1047
void init_hot(41,1187
int heat_is_on(66,1873
void switch_to_hot_index(78,2060
void switch_to_ordinary_index(92,2354
void hot_index_clause(108,2721
void hot_dynamic(127,3051
static void hot_mark_clash(154,3537
static void hot_unmark_clash(195,4312
void hot_mark_clash_cl(240,5355
void hot_inference(280,6131
imd.c,240
static struct imd_tree *insert_imd_tree(16,242
void imd_insert(95,2022
static struct imd_tree *end_term_imd(147,3611
void imd_delete(208,5012
struct term *contract_imd(294,7012
void print_imd_tree(459,11240
void p_imd_tree(498,12025
index.c,283
static void index_mark_clash(15,262
static void un_index_mark_clash(58,1126
static void index_paramod(105,2227
static void un_index_paramod(158,3583
void index_lits_all(215,5299
void un_index_lits_all(249,6186
void index_lits_clash(284,7182
void un_index_lits_clash(312,7900
io.c,2310
#define SYM_TAB_SIZE 18,343
#define MAX_COMPLEX 19,369
struct sequence_member sequence_member23,509
static struct sym_ent *Sym_tab[31,642
int str_double(51,1050
void double_str(77,1502
int str_int(102,1919
void int_str(131,2381
int str_long(163,2878
int bits_ulong(197,3449
void long_str(216,3770
void ulong_bits(246,4186
void cat_str(268,4686
int str_ident(287,4990
void reverse(301,5200
struct sym_ent *insert_sym(322,5596
int str_to_sn(349,6245
void print_syms(431,8289
void p_syms(451,8623
char *sn_to_str(462,8795
int sn_to_arity(481,9144
struct sym_ent *sn_to_node(502,9512
int sn_to_ec(520,9858
struct sym_ent *sym_tab_member(542,10265
int in_sym_tab(569,10729
void free_sym_tab(591,11076
int is_symbol(615,11474
void mark_as_skolem(630,11762
int is_skolem(651,12078
int initial_str(673,12455
int set_vars(694,12950
int set_vars_term(711,13209
int var_name(754,14107
struct term_ptr *read_list(774,14590
void print_list(828,15654
void bird_print(844,15912
#define OPEN_PAREN 935,18840
#define OTHER_PUNC 936,18862
#define NAME_SYM 937,18884
#define SYM_SYM 938,18906
static int next_token_type(949,19111
void write_term(1014,20634
void display_term(1212,25227
void print_term(1246,25938
void p_term(1265,26287
void d_term(1278,26499
void print_term_nl(1291,26722
int print_term_length(1304,26908
void pretty_print_term(1339,27554
void print_variable(1384,28415
void built_in_symbols(1416,29119
int declare_op(1501,32836
void init_special_ops(1546,33594
int process_op_command(1591,34598
static void fill_in_op_data(1658,36215
static int is_white(1695,37013
void skip_white(1714,37402
static int is_symbol_char(1735,37761
static int is_alpha_numeric(1768,38225
int name_sym(1783,38468
static void get_name(1801,38762
void print_error(1856,39857
static struct term *seq_to_quant_term(1915,41129
static struct term *seq_to_term(1982,42717
static struct term *str_to_args(2143,46338
static struct term *str_to_list(2199,47482
static int str_to_sequence(2284,49691
struct term *str_to_term(2392,52364
int read_buf(2449,53931
struct term *term_fixup(2540,55915
struct term *term_fixup_2(2586,56852
struct term *read_term(2618,57587
void merge_sort(2664,58342
int compare_for_auto_lex_order(2707,59184
void auto_lex_order(2748,60038
is.c,298
static struct is_tree *insert_is_tree(15,220
void is_insert(95,2078
static struct is_tree *end_term_is(122,2848
void is_delete(181,4174
struct term_ptr *is_retrieve(270,6410
struct term *fs_retrieve(393,9646
void canc_fs_pos(441,10658
void print_is_tree(463,11019
void p_is_tree(475,11227
ivy.c,413
static struct proof_object *Initial_proof_object 10,114
static int bnode_to_natural(14,249
static struct term *bnode_to_otterterm(29,535
int special_is_symbol(82,1828
void trans_logic_symbols(90,2082
static struct clause *bnode_to_clause(113,2727
struct proof_object *parse_initial_proof_object(135,3236
struct list *init_proof_object(175,4553
struct proof_object *retrieve_initial_proof_object(198,5273
linkhyp.c,30
void linked_hyper_res(14,141
linkur.c,1423
static void construct_children_nodes(125,4479
static struct clause *subsumable_unit(285,8719
static struct clause *linked_unit_del(425,14031
static struct link_node *backward(557,18389
void linked_ur_res(702,22143
static struct int_ptr *build_parental_chain(1096,34190
static struct clause *build_ur_resolvent(1145,35409
static BOOLEAN check_down_tree(1206,36964
static BOOLEAN check_up_tree(1259,38162
static struct term *first_unifiable(1314,39560
static struct link_node *forward(1354,40691
static struct link_node *forward_from_resolved_tree(1484,44106
static void free_linked_node_tree(1558,46038
static struct term *generate_resolvent(1588,46939
static struct link_node *initialize_tree(1630,48052
static BOOLEAN is_in_ancestry(1711,50266
static BOOLEAN keep_clause(1776,52010
static void linked_print_clause(1852,53750
static void linked_print_link_node(1908,54902
static void linked_print_link_node_tree(1983,57094
static BOOLEAN more_targets_here(2008,57733
static struct term *next_unifiable(2040,58505
static BOOLEAN poss_nuc_link(2130,60684
static BOOLEAN pass_parms_check(2162,61462
static BOOLEAN pass_target_depth_check(2245,63629
int process_linked_tags(2263,64038
static BOOLEAN process_this_resolution(2430,68943
static int term_ident_subst(2531,71068
static void write_down_tree(2594,72669
static void write_up_tree(2625,73498
static void write_target_distances(2663,74663
lisp.c,747
#define MAX_WORD 3,19
static char Word[4,40
static int Gets,5,68
static int Gets, Frees;5,68
static BOOLEAN str_ident(15,352
static char *new_str_copy(22,524
static Bnode get_bnode(31,746
static void free_bnode(44,1027
/**/ void zap_btree(54,1215
/**/ BOOLEAN true_listp(65,1428
/**/ void fprint_btree(75,1653
/**/ void p_btree(100,2202
static BOOLEAN white_char(109,2387
static BOOLEAN paren(119,2668
static int fill_word(127,2836
/**/ BOOLEAN nullp(154,3405
static BOOLEAN dotp(159,3500
static void dot_trans 166,3671
/**/ Bnode parse_lisp(194,4261
/**/ int atom(229,5019
/**/ Bnode car(234,5152
/**/ Bnode cdr(239,5283
/**/ Bnode cadr(244,5414
/**/ Bnode caddr(249,5552
/**/ int length(254,5697
/**/ int main(263,5876
lrpo.c,298
static int sym_precedence(16,257
static int lrpo_status(51,1151
static int lrpo_lex(68,1539
static int num_occurrences(109,2537
static struct term *set_multiset_diff(136,3136
static int lrpo_multiset(184,4416
int lrpo(222,5220
int lrpo_greater(267,6403
void order_equalities_lrpo(294,6923
macutils.c,123
#define strID 8,129
#define stackItem 9,147
#define creatorItem 10,167
void AdjustStack(12,190
void SetCreator(26,520
main.c,131
#define OTTER_VERSION 8,118
#define VERSION_DATE 9,151
#define IN_MAIN 11,187
/**/ int main(18,367
void print_banner(169,4661
misc.c,1443
void init(18,202
void abend(60,1132
void read_a_file(80,1504
void sos_argument(780,21033
void read_all_input(848,22442
void set_lex_vals(1056,27542
void set_lrpo_status(1081,28069
void set_special_unary(1102,28544
void set_skolem(1124,29151
void free_all_mem(1141,29465
void output_stats(1241,31562
void print_stats(1286,32415
void print_stats_brief(1376,36527
void p_stats(1401,37422
void print_times(1412,37544
void print_times_brief(1490,41527
void p_times(1545,43801
void append_lists(1556,43975
struct term *copy_term(1614,45247
int biggest_var(1648,45852
int biggest_var_clause(1676,46308
int ground_clause(1695,46632
void zap_list(1706,46839
int occurs_in(1726,47147
int occurrences(1751,47561
int sn_occur(1776,47996
int is_atom(1806,48585
static int id_nested_skolems(1819,48834
int ident_nested_skolems(1858,49534
int ground(1878,49872
void cleanup(1901,50219
int check_stop(1941,51375
void report(1978,52275
void control_memory(2003,52856
static void proof_message(2070,54403
void print_proof(2102,55124
struct clause *check_for_proof(2188,57248
int proper_list(2253,58801
void move_clauses(2273,59223
struct int_ptr *copy_int_ptr_list(2298,59679
int int_list_length(2321,60039
void automatic_1_settings(2339,60410
int sos_has_pos_nonground(2461,65337
void automatic_2_settings(2496,66091
void log_for_x_show(2617,70195
int same_structure(2642,71057
void zap_variable_names(2672,71600
nonport.c,195
void non_portable_init(38,675
void sig_handler(62,1053
char *username(111,2583
char *hostname(140,3073
void interact(169,3510
FILE *init_log_for_x_show(343,8532
int my_process_id(360,8802
options.c,297
void init_options(18,232
void print_options(652,18256
void p_options(693,19049
void auto_change_flag(704,19179
void dependent_flags(727,19737
void auto_change_parm(837,23192
void dependent_parms(863,23779
int change_flag(881,24139
int change_parm(954,26123
void check_options(1035,28298
overbeek.c,205
#define OVERBEEK_WORLD_SIZE 64,1563
static unsigned hash_term2(74,1746
void overbeek_insert(98,2253
int overbeek_weight(130,3070
void print_overbeek_world(160,3720
void check_overbeek_world(197,4482
paramod.c,304
static struct term *apply_substitute(17,337
static struct clause *build_bin_para(76,1757
static void insert_detailed_para_history(154,3996
static void para_from_up(203,5188
static void para_from_alpha(264,6892
void para_from(307,8017
static void para_into_terms(342,8887
void para_into(416,10968
pickdiff.c,588
static struct rel *copy_rels(9,132
static void zap_rels(27,466
static struct rel *remove1(42,705
static struct int_ptr *add_vecs(64,1101
static int le_vecs(86,1537
static struct int_ptr *diff_lists(108,1963
static struct int_ptr *diff(134,2566
static struct int_ptr *min_diff(167,3382
static struct int_ptr *diff2_lists(200,4040
static struct int_ptr *diff2(229,4733
struct int_ptr *cldiff(258,5429
static struct ci_ptr *get_ci_of_wt_range(282,6003
void print_int_ptr(303,6510
void p_int_ptr(317,6817
void zap_ci_ptr_list(331,7040
struct clause *find_pickdiff_cl(348,7289
process.c,183
static void post_process(24,580
void post_proc_all(149,3841
static int given_clause_ok(191,4792
void infer_and_process(212,5217
int proc_gen(355,9045
void pre_process(630,16554
resolve.c,491
static struct clause *build_hyper(17,332
int maximal_lit(176,3926
static void clash(225,5739
void hyper_res(391,9627
void neg_hyper_res(593,14899
void ur_res(797,20268
int one_unary_answer(1044,26480
struct term *build_term(1065,26993
void combine_answers(1100,27587
struct clause *build_bin_res(1162,29172
struct clause *apply_clause(1249,31275
void bin_res(1279,31922
struct clause *first_or_next_factor(1342,33510
void all_factors(1416,35180
int factor_simplify(1457,36280
share.c,563
#define TERM_TAB_SIZE 8,93
#define TERM_TAB_SIZE 11,153
static struct term_ptr *Term_tab[16,221
static struct term_ptr *Bd_kludge;21,422
static int hash_term(34,726
static int term_compare(66,1550
struct term *integrate_term(107,2579
void disintegrate_term(185,4267
void set_up_pointers(255,5783
void zap_term(276,6179
void print_term_tab(306,6760
void p_term_tab(331,7152
void test_terms(345,7393
struct term_ptr *all_instances(379,8091
struct term_ptr *all_instances_fpa(435,9341
void bd_kludge_insert(496,10780
void bd_kludge_delete(520,11166
unify.c,358
#define BIND(BIND10,142
#define DEREFERENCE(DEREFERENCE15,337
int occur_check(28,681
int unify(92,2810
int unify_no_occur_check(172,4568
int match(248,6632
struct term *apply(301,8040
int term_ident(360,9402
void clear_subst_2(394,10240
void clear_subst_1(414,10610
void print_subst(431,10883
void p_subst(453,11364
void print_trail(464,11517
weight.c,742
struct term_ptr *read_wt_list(17,291
static struct is_tree *weight_retrieve(43,858
int noncomplexifying(65,1328
int overbeek_match(81,1650
int weight(112,2278
static int wt_match_dots(176,3653
int wt_match(203,4264
static void set_wt_term(252,5472
static int set_wt_template(287,6371
static void weight_insert(312,7038
void set_wt_list(352,7850
void weight_index_delete(379,8330
static int lex_compare_sym_nums(411,8935
int lex_order(450,9880
int lex_order_vars(517,11860
static int wt_lex_order(587,13822
int lex_check(613,14325
static void get_var_multiset(631,14667
int var_subset(655,15080
static int sym_occur(685,15668
static int sym_elim(719,16451
void order_equalities(764,17537
int term_ident_x_vars(819,18828
./otter/types.h 0000744 0002044 0001012 00000022547 11120534453 011776 0 ustar beeson /*
* types.h -- type declarations
*
*/
struct term {
struct rel *farg; /* subterm list; used for complex only */
union { /* term is atom iff (NAME or COMPLEX) && varnum > 0 */
struct rel *rel; /* superterm list; used for all except atoms */
struct literal *lit; /* containing literal; used for atoms */
} occ;
int fpa_id; /* used to order fpa lists */
unsigned short sym_num; /* used for names, complex, and sometimes vars */
VAR_TYPE varnum; /* used for variables */
unsigned char type; /* NAME, VARIABLE, or COMPLEX */
unsigned char bits; /* bit flags (see macros.h) */
};
struct rel { /* relations between terms */
struct term *argval; /* subterm */
struct term *argof; /* superterm */
struct rel *narg; /* rest of subterm list */
struct rel *nocc; /* rest of superterm list */
unsigned char path; /* used in paramod to mark path to into term */
unsigned char clashable; /* paramodclashability flag */
};
struct sym_ent { /* symbol table entry */
struct sym_ent *next;
int sym_num; /* unique identifier */
int arity; /* arity 0 for constants, variables */
int lex_val; /* can be used to assign a lexical value */
int eval_code; /* identifies evaluable functors ($ symbols) */
int skolem; /* identifies Skolem constants and functions */
int special_unary; /* identifies special unary symbol for lex check */
int lex_rpo_status; /* status for LRPO */
char name[MAX_NAME]; /* the print symbol */
int special_op; /* for infix/prefix/postfix functors */
int op_type; /* for infix/prefix/postfix functors */
int op_prec; /* for infix/prefix/postfix functors */
int sort; /* Beeson 8.10.02 */
};
struct term_ptr { /* for constructing a list of pointers to terms */
struct term *term;
struct term_ptr *next;
};
struct formula_ptr_2 { /* for many-linked list of pointers to formulas */
struct formula *f;
struct formula_ptr_2 *prev, *next, *left, *right, *up, *down;
};
struct fpa_tree { /* for constructing fpa path lookup tree */
struct term_ptr *terms; /* for leaves only */
struct fpa_tree *left; /* for AND and OR nodes */
struct fpa_tree *right; /* for AND and OR nodes */
struct term *left_term; /* for OR nodes only */
struct term *right_term; /* for OR nodes only */
int type; /* 1 AND, 2 OR, 3 LEAF */
int *path; /* for debugging only */
};
struct fpa_head { /* head of an FPA list */
struct term_ptr *terms; /* list of terms with path */
struct fpa_head *next; /* next FPA list */
int *path;
};
struct fpa_index {
struct fpa_head *table[FPA_SIZE];
};
typedef struct int_ptr *restrictdata; // Beeson 8.10.02
struct context { /* substitution table */
struct term *terms[MAX_VARS];
struct context *contexts[MAX_VARS];
unsigned char bound[MAX_VARS]; /* store a 1 for lambda-bound variables, 0 for free variables */
restrictdata forbidden[MAX_VARS]; // Beeson 8.9.02
int multiplier; /* needed for apply, not for unify or match */
int built_in_multiplier; /* the use of this is optional */
int next_var; // Beeson 8.16.02; type changed 6.24
struct context *next; // Beeson 12.3.05 to make linked lists of contexts
};
struct trail { /* to record an entry in a substitution table */
struct context *context;
struct trail *next;
restrictdata fp; // Beeson 6.26.03
int varnum;
};
struct imd_tree { /* index/match/demodulate tree */
struct imd_tree *next, *kids;
struct term_ptr *atoms;
unsigned short lab; /* variable number or symbol number */
unsigned char type; /* VARIABLE, NAME, or COMPLEX */
/* the following are used for leaves only */
VAR_TYPE max_vnum; /* max. variable number, for clearing substitution */
};
struct imd_pos { /* save a stack of states for backtrack in imd indexing */
struct imd_pos *next;
struct imd_tree *imd;
struct rel *rel_stack[MAX_AL_TERM_DEPTH]; /* save position in given term */
int reset; /* flag for clearing instantiation on backtracking */
int stack_pos; /* for backtracking */
};
struct is_tree { /* index-subsume tree */
struct is_tree *next; /* sibling */
union {
struct is_tree *kids; /* for internal nodes */
struct term_ptr *terms; /* for leaves */
} u;
unsigned short lab; /* variable number or symbol number */
unsigned char type; /* VARIABLE, NAME, or COMPLEX */
};
struct is_pos { /* save a stack of states for backtrack in is indexing */
struct is_pos *next;
struct is_tree *is;
struct term *varvals[MAX_VARS]; /* Beeson 4.29.04 */
struct rel *rel_stack[MAX_FS_TERM_DEPTH]; /* save position in given term */
int reset; /* flag for clearing instantiation on backtracking */
int stack_pos; /* for backtracking */
};
struct fsub_pos { /* to save position in set of subsuming literals */
struct term_ptr *terms; /* list of identical terms from leaf of is tree */
struct is_pos *pos; /* stack of states for backtracking */
};
struct literal {
struct clause *container; /* containing clause */
struct literal *next_lit;
struct term *atom;
char sign;
BOOLEAN target;
};
#ifdef SCOTT
typedef enum { Norm, Old_Base, Base, Conj, New_Base, All} scan_type;
#endif
struct clause {
struct int_ptr *parents;
struct list *container;
struct clause *prev_cl, *next_cl; /* prev and next clause in list */
struct literal *first_lit;
int id;
int pick_weight;
struct cl_attribute *attributes;
short type; /* for linked inf rules */
unsigned char bits; /* for linked inf rules */
char heat_level;
int next_var; // Beeson
#ifdef SCOTT
/* Ahh yes, I dream of a language with inheritance:-) */
int given;
int length;
int num_sets;
boolean in_set[MAXISET_ARRAY];
scan_type stype;
int back_subs;
#endif
};
struct list { /* the primary way to build a list of clauses */
struct clause *first_cl, *last_cl;
char name[MAX_NAME]; /* name of list */
};
struct clause_ptr { /* an alternate way to build a list of clauses */
struct clause *c;
struct clause_ptr *next;
};
struct int_ptr { /* for building a list of integers */
struct int_ptr *next;
int i;
};
struct ci_ptr { /* for building a list of <clause,int_ptr> pairs */
struct ci_ptr *next;
struct clause *c;
struct int_ptr *v;
};
struct clash_nd { /* for hyper and UR--one for each clashable lit of nuc */
struct term *nuc_atom; /* atom from nucleus */
struct fpa_index *db; /* fpa index to use for finding satellites */
struct fpa_tree *u_tree; /* unification path tree (position in sats) */
struct context *subst; /* unifying substitution */
struct trail *tr; /* trail to undo substitution */
struct term *found_atom; /* unifying atom */
int evaluable; /* $ evaluation */
int evaluation; /* $ evaluation */
int already_evaluated; /* $ evaluation */
struct clash_nd *prev, *next; /* links */
};
struct clock { /* for timing operations, see cos.h, macros.h, clocks.c */
long accum_sec; /* accumulated time */
long accum_usec;
long curr_sec; /* time since clock has been turned on */
long curr_usec;
};
struct ans_lit_node {
struct ans_lit_node *next;
struct link_node *parent;
struct literal *lit;
};
struct link_node {
struct link_node *parent, *next_sibling, *prev_sibling, *first_child;
struct ans_lit_node *child_first_ans, *child_last_ans;
BOOLEAN first;
BOOLEAN unit_deleted; /* TRUE if goal_to_resolve has been unit deleted */
struct term *goal, *goal_to_resolve;
struct clause *current_clause;
struct context *subst;
struct trail *tr;
struct fpa_tree *unif_position;
int near_poss_nuc, farthest_sat, target_dist, back_up;
};
struct formula_box {
int type; /* FORMULA, OPERATOR */
int subtype; /* COMPLEX_FORM, ATOM_FORM */
/* OR_OP, AND_OP, NOT_OP, EXISTS_OP, ALL_OP */
struct formula *f;
char str[100];
int length, height; /* size of box */
int x_off, y_off; /* offset from parent */
int abs_x_loc, abs_y_loc; /* absolute location of box in window */
struct formula_box *first_child;
struct formula_box *next;
struct formula_box *parent;
};
struct formula {
struct formula *parent, *first_child, *next;
struct term *t; /* for atoms and for quantifier variables */
char type;
char quant_type;
};
struct formula_ptr {
struct formula *f;
struct formula_ptr *next;
};
struct cl_attribute {
int name;
union {
int i;
double d;
char *s;
struct term *t;
} u;
struct cl_attribute *next;
};
./otter/unify.c 0000744 0002044 0001012 00000042602 11120534453 011751 0 ustar beeson /*
* unify.c -- unification and matching routines
*
*/
/* Modifications by Beeson:
7.23.02 moved BIND and DEREFERENCE to unify.h and added include commands
8.7.02
12.4.05 modified unify to return multiple unifiers.
*/
#include "header.h"
#include "unify.h" // Beeson
#include "unify2.h" // Beeson
#include "bsym.h" // Beeson
#include "bterms.h" // Beeson
#include "beta.h" // Beeson
#include <assert.h> // Beeson
// #define DIAGNOSTICS // DEBUG
/*************
*
* int occur_check(varnum, var_context, term, term_context)
*
* Return 0 iff variable occurs in term under substitution
* (including var==term).
* or if term is forbidden to variable (and Flags[LAMBDA_FLAG].val)
* Also, if Flags[LAMBDA_FLAG].val, variable CAN occur in term,
* if its occurrence is bound.
*
*************/
int occur_check(int vn,
struct context *vc,
struct term *t,
struct context *c)
{ if(Flags[LAMBDA_FLAG].val)
return occur_check2(vn,vc,t,c); // Beeson 7.6.06, see file unify2.c
if (t->type == NAME)
return 1;
else if (t->type == COMPLEX) {
struct rel *r = t->farg;
while (r != NULL && occur_check(vn, vc, r->argval, c))
r = r->narg;
return (r == NULL);
}
else { /* variable */
int tvn = t->varnum;
if (tvn == vn && c == vc)
return 0; /* fail occur_check here */
else if (c->terms[tvn] == NULL)
return 1; /* uninstantiated variable */
else
return occur_check(vn, vc, c->terms[tvn], c->contexts[tvn]);
}
} /* occur_check */
/*************
*
* int unify(t1, c1, t2, c2, trail_address)
*
* Attempt to unify t1 in context c1 with t2 in context c2.
* If successful, return 1 and and a pointer to the trail (a record
* of the substitutions). The trail is extended by adding new
* entries to the front, and the front is returned. On entry,
* *trail_address must be either NULL or the result of a previous
* call to unify. If unification fails, the trail is unchanged.
* A context is a substitution table along with a multiplier for
* the variables. The multiplier need not be present for
* unification, but it is needed for `apply'.
*
* An example of its use:
*
* c1 = get_context(); c1->multiplier = 0;
* c2 = get_context(); c2->multiplier = 1;
* tr = NULL;
* if (unify(t1, c1, t2, c2, &tr)) {
* print_subst(stdout, c1);
* print_subst(stdout, c2);
* print_trail(stdout, tr);
* t3 = apply(t1, c1);
* t4 = apply(t2, c2);
* printf("apply substitution: ");
* print_term(stdout, t3); printf(" ");
* print_term(stdout, t4); printf("\n");
* clear_subst_1(tr);
* zap_term(t3);
* zap_term(t4);
* }
* else
* printf("unify fails\n");
* free_context(c1);
* free_context(c2);
*
*************/
/*______________________________________________________________*/
int unify(struct term *t1,
struct context *c1,
struct term *t2,
struct context *c2,
struct trail **trp)
{ int saveit1, saveit2; // Beeson
DEREFERENCE(t1, c1)
DEREFERENCE(t2, c2)
/* Now, neither t1 nor t2 is an assigned variable. */
if( Flags[LAMBDA_FLAG].val) // Beeson 6.16.03
{ if(t1->type == VARIABLE && c1->bound[t1->varnum] != 0)
{ if(t2->type == VARIABLE && c1 == c2 && t2->varnum == t1->varnum)
return 1;
else
return 0;
}
if(t2->type == VARIABLE && c2->bound[t2->varnum] != 0)
return 0;
saveit1 = c1->next_var;
saveit2 = c2->next_var;
}
if (t1->type == VARIABLE){
// The bound[] array is filled with zeroes unless Flags[LAMBDA_FLAG].val is set.
int vn1 = t1->varnum;
if (t2->type == VARIABLE) {
/* both t1 and t2 are variables */
if (vn1 == t2->varnum && c1 == c2)
return 1; /* identical */
else if(Flags[LAMBDA_FLAG].val && // Beeson 6.26.03
(forbidden2(vn1,c1,t2->varnum,c2) || forbidden2(t2->varnum,c2,vn1,c1)) // Beeson 6.26.03
) // Beeson 6.26.03
return 0; // Beeson 6.26.03
else {
BIND(vn1, c1, t2, c2, trp);
return 1;
}
}
else {
/* t1 variable, t2 not variable */
if (occur_check(vn1, c1, t2, c2)) {
BIND(vn1, c1, t2, c2, trp);
return 1;
}
else
return 0; /* failed occur_check */
}
}
else if (t2->type == VARIABLE){
/* t2 variable, t1 not variable */
int vn2 = t2->varnum;
if (occur_check(vn2, c2, t1, c1)) {
BIND(vn2, c2, t1, c1, trp);
return 1;
}
else
return 0; /* failed occur_check */
}
else if(Flags[LAMBDA_FLAG].val && (t1->sym_num == AP || t2->sym_num == AP) &&
unify2(t1,c1,t2,c2,trp) // Beeson
)
return 1;
else if (t1->sym_num != t2->sym_num )
return 0; /* fail because of symbol clash */
else if (t1->type == NAME)
return 1;
else { /* both COMPLEX with same functor */
struct trail *tpos = *trp; /* save trail position in case of failure */
struct rel *r1, *r2;
if(Flags[LAMBDA_FLAG].val && BINDER(t1->sym_num)) // Beeson 8.7.02
/* It isn't necessary to rename the lambda-bound variable(s),
even if there is a nested bound occurrence inside this one.
When entering the nested occurrence, the variable will be
re-assigned. But therefore, if THIS is a nested occurrence,
the variable might already be bound to something, and we
should save the binding and restore it, rather than assume it is NULL.
*/
r1 = unify_lambda(t1,c1,t2,c2,trp,tpos);
else if(c1->next == NULL && c2->next == NULL) // normal unification
{ r1 = t1->farg;
r2 = t2->farg;
while (r1 && unify(r1->argval, c1, r2->argval, c2, trp)) {
r1 = r1->narg;
r2 = r2->narg;
}
}
else // multiple unifiers possible
{ int flag1=0, flag2=0;
struct context *m1,*m2, *prev1 = NULL, *prev2=NULL;
int count_unifiers = 0;
struct context *last1=c1, *last2=c2;
while(last1->next && last2->next)
{ last1=last1->next;
last2=last2->next;
}
if(last1->next || last2->next)
assert(0); // the two lists must have the same length
for(m1=c1,m2=c2; m1!= last1; prev1 = m1, prev2 = m2, m1 = m1->next,m2=m2->next)
{ flag2 = 0;
r1 = t1->farg;
r2 = t2->farg;
while(r1 && unify(r1->argval,m1,r2->argval,m2,trp))
{ r1 = r1->narg;
r2 = r2->narg;
}
if(r1)
{ // this (m1,m2) doesn't unify; delete it from the list
if(prev1)
{ prev1->next = m1->next;
prev2->next = m2->next;
}
else
{ // it was the first in the list
*c1 = *(m1->next);
*c2 = *(m2->next);
}
free_context(m1);
free_context(m2);
}
}
}
if (r1 == NULL)
return 1;
else { /* restore trail and fail */
struct trail *tp = *trp;
while (tp != tpos) {
struct trail *t3 = tp;
undo_forbidden(tp); // Beeson 6.26.03
tp->context->terms[tp->varnum] = NULL;
tp = tp->next;
free_trail(t3);
}
*trp = tpos;
if(Flags[LAMBDA_FLAG].val)
restore_vars(c1,c2,saveit1, saveit2); // Beeson 1.29.04
return 0;
}
}
} /* unify */
/*************
*
* int unify_no_occur_check(t1, c1, t2, c2, trp)
*
*************/
int unify_no_occur_check(struct term *t1,
struct context *c1,
struct term *t2,
struct context *c2,
struct trail **trp)
{
DEREFERENCE(t1, c1);
DEREFERENCE(t2, c2);
/* Now, neither t1 nor t2 is a bound variable. */
if (t1->type == VARIABLE) {
int vn1 = t1->varnum;
if (t2->type == VARIABLE && vn1 == t2->varnum && c1 == c2)
return 1; /* identical */
else {
/* occur check would be here */
BIND(vn1, c1, t2, c2, trp);
return 1;
}
}
else if (t2->type == VARIABLE) {
int vn2 = t2->varnum;
/* occur check would be here */
BIND(vn2, c2, t1, c1, trp);
return 1;
}
else if (t1->sym_num != t2->sym_num)
return 0; /* fail because of symbol clash */
else if (t1->type == NAME)
return 1;
else { /* both COMPLEX with same functor */
struct trail *tpos = *trp; /* save trail position in case of failure */
struct rel *r1 = t1->farg;
struct rel *r2 = t2->farg;
while (r1 && unify_no_occur_check(r1->argval, c1, r2->argval, c2, trp)) {
r1 = r1->narg;
r2 = r2->narg;
}
if (r1 == NULL)
return 1;
else { /* restore trp and fail */
struct trail *tp = *trp;
while (tp != tpos) {
struct trail *t3 = tp;
tp->context->terms[tp->varnum] = NULL;
tp = tp->next;
free_trail(t3);
}
*trp = tpos;
return 0;
}
}
} /* unify_no_occur_check */
/*************
*
* int otter_match(t1, c1, t2, trail_address) -- one-way unification.
*
* Match returns 1 if t2 is an instance of {t1 in context c1}.
* This is not a very general version, but it is useful for
* demodulation and subsumption. It assumes that the variables
* of t1 and t2 are separate, that none of the variables in t2
* have been instantiated, and that none of those t2's variables
* will be instantiated. Hence, there is no context for t2,
* no need to dereference more than one level, and no need for
* an occur_check.
*
* The use of the trail is the same as in `unify'.
*
*************/
int otter_match(struct term *t1,
struct context *c1,
struct term *t2,
struct trail **trp)
{ if(Flags[LAMBDA_FLAG].val)
return match2(t1,c1,t2,trp); // Beeson's code
if (t1->type == VARIABLE) { /* t1 variable */
int vn = t1->varnum;
if (c1->terms[vn] == NULL) {
BIND(vn, c1, t2,NULL , trp);
return 1;
}
{ return term_ident(c1->terms[vn], t2);
// term_ident now counts two terms as equivalent if they
// differ only by renaming lambda-bound variables
}
}
else if (t2->type == VARIABLE) /* t1 not variable, t2 variable, so fail */
return 0;
else if (t1->sym_num != t2->sym_num) /* neither term is a variable */
return 0; /* fail because of symbol clash */
else
{ /* following handles both names and complex terms */
struct trail *tpos = *trp; /* save trail position in case of failure */
struct rel *r1 = t1->farg;
struct rel *r2 = t2->farg;
/* arities are same because sym_nums are the same */
while (r1 != NULL && otter_match(r1->argval, c1, r2->argval, trp)) {
r1 = r1->narg;
r2 = r2->narg;
}
if (r1 == NULL)
return 1;
else { /* restore from trail and fail */
struct trail *tp = *trp;
while (tp != tpos) {
struct trail *t3 = tp;
tp->context->terms[tp->varnum] = NULL;
tp = tp->next;
free_trail(t3);
}
*trp = tpos;
return 0;
}
}
} /* match */
/*************
*
* struct term *apply(term, context) -- Apply a substitution to a term.
*
* Apply always succeeds and returns a pointer to the
* instantiated term.
*
*************/
struct term *apply(struct term *t,
struct context *c)
{
/* dereference if variable */
/* A NULL context means that the subst was generated by match. */
/* If the context is NULL, then apply just copies the term. */
while (t->type == VARIABLE && c != NULL && c->terms[t->varnum] != NULL) {
int vn = t->varnum;
t = c->terms[vn];
c = c->contexts[vn];
}
if (t->type == VARIABLE) { /* unbound variable */
struct term *t2 = get_term();
t2->type = VARIABLE;
if (c == NULL)
t2->varnum = t->varnum;
else
t2->varnum = c->multiplier * MAX_VARS + t->varnum;
return t2;
}
else if (t->type == NAME) { /* name */
struct term *t2 = get_term();
t2->type = NAME;
t2->sym_num = t->sym_num;
return t2;
}
else { /* complex term */
struct rel *r1, *r2, *r3;
struct term *t2;
int vv;
struct term *saveit;
if(Flags[LAMBDA_FLAG].val && BINDER(t->sym_num)) // Beeson
{ vv = t->farg->argval->varnum; // Beeson
saveit = c->terms[vv]; // Beeson
c->terms[vv] = NULL; // Beeson
}
t2 = get_term();
t2->type = COMPLEX;
t2->sym_num = t->sym_num;
r3 = NULL;
r1 = t->farg;
while (r1 != NULL ) {
r2 = get_rel();
if (r3 == NULL)
t2->farg = r2;
else
r3->narg = r2;
r2->argval = apply(r1->argval, c);
r3 = r2;
r1 = r1->narg;
}
if(Flags[LAMBDA_FLAG].val && BINDER(t->sym_num)) // Beeson
c->terms[vv] = saveit; // Beeson
return t2;
}
} /* apply */
/*************
*
* int term_ident(term1, term2) -- Compare two terms.
*
* If identical return 1; else return 0. The bits
* field is not checked.
*
*************/
/* Beeson's comment: McCune's code is for true identity, i.e. returns false if
t1 and t2 differ only by renaming lambda-bound variables.
term_ident2 is used to allow terms to count as equivalent if the
differ only be renaming bound variables. Because these are recursive
functions, we don't want to check LAMBDA_FLAG at each level.
Therefore term_ident checks it and switches either to McCune's original
term_ident, now called McCune_term_ident, or to term_ident2 in unify2.c
*/
static int McCune_term_ident(struct term *t1, struct term *t2);
int term_ident(struct term *t1, struct term *t2)
{ if(Flags[LAMBDA_FLAG].val)
return term_ident2(t1,t2,0);
return McCune_term_ident(t1,t2);
}
static int McCune_term_ident(struct term *t1, struct term *t2)
{ if (t1->type != t2->type)
return 0;
else if (t1->type == COMPLEX) {
if (t1->sym_num != t2->sym_num)
return 0;
else {
struct rel *r1 = t1->farg;
struct rel *r2 = t2->farg;
while (r1 && r2 && McCune_term_ident(r1->argval,r2->argval)) { // Beeson added && r2
r1 = r1->narg;
r2 = r2->narg;
}
return (r1 == NULL && r2==NULL); // Beeson added second clause here
}
}
else if (t1->type == VARIABLE)
return (t1->varnum == t2->varnum);
else /* NAME */
return (t1->sym_num == t2->sym_num);
} /* McCune term_ident */
/*************
*
* clear_subst_2(trail_1, trail_2) -- Clear part of a substitution.
*
* It is assumed that trail_2 (including NULL) is a subtrail
* of trail_1. This routine clears entries starting at trail_1,
* up to (but not including) trail_2.
*
*************/
void clear_subst_2(struct trail *t1,
struct trail *t2)
{
if (t1 == NULL || t1 == t2)
return;
else {
clear_subst_2(t1->next, t2);
t1->context->terms[t1->varnum] = NULL;
free_trail(t1);
}
} /* clear_subst_2 */
/*************
*
* clear_subst_1(trail_1) -- Clear a substitution.
*
* Clear all members of the trail.
*
*************/
void clear_subst_1(struct trail *t1)
{
if (t1 == NULL)
return;
else {
clear_subst_1(t1->next);
t1->context->terms[t1->varnum] = NULL;
free_trail(t1);
}
} /* clear_subst_1 */
/*************
*
* print_subst(file_ptr, context)
*
*************/
void print_subst(FILE *fp,
struct context *c)
{
int i,j;
fprintf(fp, "Substitution in context %x, multiplier %d\n", (unsigned) c, c->multiplier);
for (i=0; i< MAX_VARS; i++)
if (c->terms[i] != NULL) {
fprintf(fp, "v%d -> ", i);
print_term(fp, c->terms[i]);
fprintf(fp, " context %x", (unsigned) c->contexts[i]);
for(j=0;j<MAX_VARS/(8*sizeof(int));j++) // Beeson 8.9.02
fprintf(fp, " forbidden %x\n", c->forbidden[i][j]); // Beeson 8.9.02
}
} /* print_subst */
/*************
*
* p_subst(context)
*
*************/
void p_subst(struct context *c)
{
print_subst(stdout, c);
} /* p_subst */
/*************
*
* print_trail(file_ptr, context)
*
*************/
void print_trail(FILE *fp,
struct trail *t)
{
struct trail *t2;
fprintf(fp, "Trail:");
t2 = t;
while (t2 != NULL) {
fprintf(fp, " <%d,%x>", t2->varnum, (unsigned) t2->context);
t2 = t2->next;
}
fprintf(fp, ".\n");
} /* print_trail */
./otter/unify.h 0000744 0002044 0001012 00000001077 11120534454 011760 0 ustar beeson
// Beeson 6.26.06 added fourth line of BIND, but can't comment that line without
// causing compile errors.
#define BIND(i, c1, t2, c2, trp) { struct trail *tr; \
c1->terms[i] = t2; c1->contexts[i] = c2; \
tr = get_trail(); tr->varnum = i; tr->context = c1; \
if(t2->type == VARIABLE && Flags[LAMBDA_FLAG].val && c2) fix_forbidden(i,c1,t2->varnum,c2,tr); \
tr->next = *trp; *trp = tr; }
#define DEREFERENCE(t, c) { int i; \
while (t->type == VARIABLE && c->terms[i = t->varnum]) \
{ t = c->terms[i]; c = c->contexts[i]; } }
./otter/warnings 0000744 0002044 0001012 00000025665 11026756616 012254 0 ustar beeson Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
is assigned a value that is never used
\otter\otter-~1.2-b\source\overbeek.c
is assigned a value that is never used
is assigned a value that is never used
is assigned a value that is never used
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\case.c
Parameter is never used
Function should return a value
Parameter is never used
Parameter is never used
Parameter is never used
Function should return a value
Parameter is never used
Function should return a value
is assigned a value that is never used
is assigned a value that is never used
Call to function with no prototype
is assigned a value that is never used
Undefined structure
Undefined structure
Undefined structure
is declared but never used
\otter\otter-~1.2-b\source\ivy.c
Conversion may lose significant digits
Conversion may lose significant digits
is assigned a value that is never used
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Undefined structure
\otter\otter-~1.2-b\source\pickdiff.c
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\attrib.c
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\unify.c
Conversion may lose significant digits
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\share.c
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\resolve.c
is assigned a value that is never used
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\process.c
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\paramod.c
Conversion may lose significant digits
Conversion may lose significant digits
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\options.c
Parameter is never used
Conversion may lose significant digits
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\nonport.c
Parameter is never used
Parameter is never used
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\misc.c
is assigned a value that is never used
is assigned a value that is never used
Possibly incorrect assignment
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\main.c
Function should return a value
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\lrpo.c
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\linkur.c
Possibly incorrect assignment
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\linkhyp.c
Parameter is never used
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\is.c
Conversion may lose significant digits
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\io.c
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
is assigned a value that is never used
is assigned a value that is never used
is assigned a value that is never used
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Possibly incorrect assignment
Possibly incorrect assignment
Possibly incorrect assignment
Possibly incorrect assignment
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Possibly incorrect assignment
Conversion may lose significant digits
Conversion may lose significant digits
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\index.c
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\imd.c
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\hot.c
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\hints.c
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Possibly incorrect assignment
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\geometry.c
Parameter is never used
Conversion may lose significant digits
Conversion may lose significant digits
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\fpa.c
Conversion may lose significant digits
Conversion may lose significant digits
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\formula.c
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
is assigned a value that is never used
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
is assigned a value that is never used
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
is assigned a value that is never used
is assigned a value that is never used
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\foreign.c
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\demod.c
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\clocks.c
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\clause.c
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
is assigned a value that is never used
is assigned a value that is never used
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\check.c
is assigned a value that is never used
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
is assigned a value that is never used
is assigned a value that is never used
is assigned a value that is never used
is assigned a value that is never used
is assigned a value that is never used
is assigned a value that is never used
is assigned a value that is never used
is assigned a value that is never used
is assigned a value that is never used
is assigned a value that is never used
is assigned a value that is never used
is declared but never used
\otter\otter-~1.2-b\source\av.c
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\weight.c
Conversion may lose significant digits
Conversion may lose significant digits
Conversion may lose significant digits
Undefined structure
Undefined structure
Undefined structure
\otter\otter-~1.2-b\source\otter32b.exe
./otter/weight.c 0000744 0002044 0001012 00000047456 11120534454 012123 0 ustar beeson /*
* weight.c -- Routines to weigh clauses, literals and terms.
* (also some routines that handle lexical ordering (not LRPO)).
*
*/
#include "header.h"
/*************
*
* struct term_ptr *read_wt_list(fp, ep)
*
* read_list then set_vars for each term.
*
*************/
struct term_ptr *read_wt_list(FILE *fp,
int *ep)
{
struct term_ptr *p1, *p2;
Internal_flags[REALLY_CHECK_ARITY] = 1;
p1 = read_list(fp, ep, 0); /* don't integrate */
for (p2 = p1; p2; p2 = p2->next) {
if (!set_vars(p2->term)) {
fprintf(stdout, "ERROR, too many variables, max is %d: ", MAX_VARS);
print_term_nl(stdout, p2->term);
(*ep)++;
}
}
Internal_flags[REALLY_CHECK_ARITY] = 0;
return(p1);
} /* read_wt_list */
/*************
*
* static struct is_tree *weight_retrieve(t, wt_index)
*
*************/
static struct is_tree *weight_retrieve(struct term *t,
struct is_tree *wt_index)
{
struct is_tree *is;
if (!wt_index)
return(NULL);
else {
is = wt_index->u.kids;
while (is && ((t->type != is->type) ||
(t->type != VARIABLE && (t->sym_num != is->lab))))
is = is->next;
return(is);
}
} /* weight_retrieve */
/*************
*
* int noncomplexifying(c) -- True iff c is a noncomplexifying substitution
*
*************/
int noncomplexifying(struct context *c)
{
int i;
for (i = 0; i < MAX_VARS; i++) {
if (c->terms[i] && c->terms[i]->type == COMPLEX)
return(0);
}
return(1);
} /* noncomplexifying */
/*************
*
* int overbeek_match(t) -- True iff t is instance of one of the overbeek_terms.
*
*************/
int overbeek_match(struct term *t)
{
struct term *l, *member;
struct context *c;
struct trail *tr;
c = get_context();
/* Assume Overbeek_terms is a proper list. */
for (l = Overbeek_terms; l->sym_num != Nil_sym_num; l = l->farg->narg->argval) {
member = l->farg->argval;
tr = NULL;
if (otter_match(member, c, t, &tr)) { // Beeson 3.25.06 changed name of function
if (noncomplexifying(c)) {
clear_subst_1(tr);
free_context(c);
return(1);
}
else
clear_subst_1(tr);
}
}
free_context(c);
return(0);
} /* overbeek_match */
/*************
*
* int weight(term, wt_index) -- Return the weight a term.
*
*************/
int weight(struct term *t,
struct is_tree *wt_index)
{
struct is_tree *is;
struct term_ptr *p;
struct rel *r;
int wt, w1, max;
if (overbeek_weight(t, &wt))
return wt;
is = weight_retrieve(t, wt_index);
if (is)
p = is->u.terms;
else
p = NULL;
wt = 0;
while (p != NULL &&
wt_match(t, p->term->farg->argval, &wt, wt_index) == 0) {
p = p->next;
wt = 0;
}
if (p != NULL) /* we have a match */
return(wt + p->term->farg->narg->argval->fpa_id);
else if (is_atom(t) && t->varnum == ANSWER)
return(0); /* default weight of answer atom */
else if (t->type == VARIABLE || t->type == NAME)
return(1); /* default weight of symbol */
else { /* compute default weight of term or atom */
/*
if (flag is set)
weight of t is (max or weights of args) + 1
else
weight of t is (sum weights of subterms) + 1
*/
if (is_atom(t))
max = Flags[ATOM_WT_MAX_ARGS].val;
else
max = Flags[TERM_WT_MAX_ARGS].val;
wt = 0;
r = t->farg;
while (r != NULL) {
if (is_atom(t) && Overbeek_terms && overbeek_match(r->argval))
w1 = 0;
else
w1 = weight(r->argval, wt_index);
if (max)
wt = (w1 > wt ? w1 : wt);
else
wt += w1;
r = r->narg;
}
return(wt + 1);
}
} /* weight */
/*************
*
* wt_match_dots()
*
*************/
static int wt_match_dots(struct term *t,
struct term *template,
int *wtp,
struct is_tree *wt_index)
{
if (wt_match(t, template, wtp, wt_index))
return(1);
else {
struct rel *r;
for (r = t->farg; r; r = r->narg) {
if (wt_match_dots(r->argval, template, wtp, wt_index))
return(1);
}
return(0);
}
} /* wt_match_dots */
/*************
*
* int weight_match(term, template, wtp, wt_index)
*
* Attempt to match a term with a weight template. If
* successful, add the weight of the term to *wtp, and
* return(1); else return(0).
*
*************/
int wt_match(struct term *t,
struct term *template,
int *wtp,
struct is_tree *wt_index)
{
struct rel *r1,*r2;
int go;
if (template->type == COMPLEX && template->sym_num == Dots_sym_num &&
wt_match_dots(t, template->farg->argval, wtp, wt_index))
return(1);
else if (t->type != template->type)
return(0);
else if (t->type == VARIABLE)
return(1);
else if (t->type == NAME)
return(t->sym_num == template->sym_num);
else { /* complex */
if (t->sym_num != template->sym_num)
return(0);
else {
go = 1;
r1 = t->farg;
r2 = template->farg;
while (go && r1 != NULL && r2 != NULL) {
if (TP_BIT(r2->argval->bits, SCRATCH_BIT))
/* term is a multiplier */
*wtp += r2->argval->fpa_id * weight(r1->argval,wt_index);
else
go = wt_match(r1->argval, r2->argval, wtp, wt_index);
r1 = r1->narg;
r2 = r2->narg;
}
return(go && r1 == NULL && r2 == NULL);
}
}
} /* wt_match */
/*************
*
* static void set_wt_term(term)
*
* Mark multipliers with SCRATCH_BIT,
* and store the multipliers in fpa_id field.
*
* This week, multipliers look like this: $(100), $(-3)
*
*************/
static void set_wt_term(struct term *t)
{
struct rel *r;
int n;
if (t->type == COMPLEX) {
if (is_symbol(t, "$", 1) && t->farg->argval->type == NAME &&
str_int(sn_to_str(t->farg->argval->sym_num), &n)) {
/* this is a trick to mark a multiplier */
SET_BIT(t->bits, SCRATCH_BIT);
t->fpa_id = n;
}
else {
for (r = t->farg; r; r = r->narg)
set_wt_term(r->argval);
}
}
} /* set_wt_term */
/*************
*
* static int set_wt_template(template)
*
* Make sure that the template is OK, and mark the multipliers
* and the adder. Return 1 for success and 0 for failure.
* Example weight templates: weight(f($1,f($3,a)),5),
* weight(x,-100), (all variables have weight -100),
* weight(f(x,g(a,x)),30) (x matches any variable, and the
* two occurrences of x don't have to match the same variable.
*
*************/
static int set_wt_template(struct term *t)
{
int n;
/* first make sure that template is ok; if ok, str_int gets adder */
if (t->type != COMPLEX || str_ident(sn_to_str(t->sym_num), "weight") == 0
|| t->farg == NULL || t->farg->narg == NULL
|| t->farg->narg->narg != NULL || t->farg->narg->argval->type != NAME
|| str_int(sn_to_str(t->farg->narg->argval->sym_num), &n) == 0) {
return(0);
}
else {
/* stash adder in fpa_id field */
t->farg->narg->argval->fpa_id = n;
set_wt_term(t->farg->argval);
return(1);
}
} /* set_wt_template */
/*************
*
* static void weight_insert(t, wt_index)
*
*************/
static void weight_insert(struct term *t,
struct is_tree *wt_index)
{
struct is_tree *is;
struct term_ptr *tp, *new_tp;
struct term *t1;
new_tp = get_term_ptr();
new_tp->term = t;
is = weight_retrieve(t->farg->argval, wt_index);
if (is) {
/* Put new template at end of list. */
tp = is->u.terms;
while (tp->next)
tp = tp->next;
tp->next = new_tp;
}
else {
t1 = t->farg->argval;
is = get_is_tree();
is->type = t1->type;
if (t1->type == VARIABLE)
is->lab = t1->varnum;
else
is->lab = t1->sym_num;
is->u.terms = new_tp;
is->next = wt_index->u.kids;
wt_index->u.kids = is;
}
} /* weight_insert */
/*************
*
* set_wt_list(wt_list, wt_index, error_ptr) -- Set a list of weight termplates.
*
*************/
void set_wt_list(struct term_ptr *wt_list,
struct is_tree *wt_index,
int *ep)
{
struct term_ptr *p;
*ep = 0;
p = wt_list;
while (p != NULL) {
if (set_wt_template(p->term) == 0) {
fprintf(stdout, "ERROR, weight template: ");
print_term_nl(stdout, p->term);
(*ep)++;
}
else
weight_insert(p->term, wt_index);
p = p->next;
}
} /* set_wt_list */
/*************
*
* void weight_index_delete(wt_index)
*
*************/
void weight_index_delete(struct is_tree *wt_index)
{
struct is_tree *is1, *is2;
struct term_ptr *tp1, *tp2;
if (wt_index) {
is1 = wt_index->u.kids;
while (is1) {
tp1 = is1->u.terms;
while (tp1) {
/* Do not free template; it belongs to Weight_list. */
tp2 = tp1;
tp1 = tp1->next;
free_term_ptr(tp2);
}
is2 = is1;
is1 = is1->next;
free_is_tree(is2);
}
free_is_tree(wt_index);
}
} /* weight_index_delete */
/*************
*
* lex_compare_sym_nums(n1, n2)
*
* We must always have a total order on the symbols.
*
*************/
static int lex_compare_sym_nums(int n1,
int n2)
{
int v1, v2;
struct sym_ent *p1, *p2;
if (n1 == n2)
return(SAME_AS);
else {
p1 = sn_to_node(n1);
p2 = sn_to_node(n2);
v1 = p1->lex_val;
v2 = p2->lex_val;
if (v1 < v2)
return(LESS_THAN);
else if (v1 > v2)
return(GREATER_THAN);
else
/* This occurs if a lex command omits symbols or if
* new symbols are introduced on the fly.
*/
return(compare_for_auto_lex_order(p1, p2));
}
} /* lex_compare_sym_nums */
/*************
*
* int lex_order(t1, t2)
*
* Return SAME_AS, GREATER_THAN, LESS_THAN, or NOT_COMPARABLE.
*
* A variable is comparable only to an identical variable
* (nonground terms can still be compared: if a < b, f(a,x) < f(b,y).)
* For pairs of nonvariables, use the lex_val field of the symbol_table node;
* if identical, use the sym_num's of the terms.
*
*************/
int lex_order(struct term *t1,
struct term *t2)
{
struct rel *r1, *r2;
int i, t1_special, t2_special;
/* The following handles special unary functions that are to be */
/* ignored during lex_check. For example, when using lex-dependent */
/* demodulation to sort AC expressions, you can make the canonical */
/* form be a + -a + b + -b + c + -c. */
if (Internal_flags[SPECIAL_UNARY_PRESENT]) {
t1_special = (t1->type == COMPLEX && sn_to_node(t1->sym_num)->special_unary);
t2_special = (t2->type == COMPLEX && sn_to_node(t2->sym_num)->special_unary);
if (t1_special && !t2_special) {
if (term_ident(t1->farg->argval, t2))
return(GREATER_THAN);
else
return(lex_order(t1->farg->argval, t2));
}
else if (!t1_special && t2_special) {
if (term_ident(t2->farg->argval, t1))
return(LESS_THAN);
else
return(lex_order(t1, t2->farg->argval));
}
else if (t1_special && t2_special) {
int argcomp = lex_order(t1->farg->argval, t2->farg->argval);
if (argcomp != SAME_AS)
return(argcomp);
/* else fall through and treat as normal terms */
}
}
/* end of special_unary code */
if (t1->type == VARIABLE)
if (t2->type == VARIABLE)
return(t1->varnum == t2->varnum ? SAME_AS : NOT_COMPARABLE);
else
return(occurs_in(t1, t2) ? LESS_THAN : NOT_COMPARABLE);
else if (t2->type == VARIABLE)
return(occurs_in(t2, t1) ? GREATER_THAN : NOT_COMPARABLE);
else if (t1->sym_num == t2->sym_num) {
r1 = t1->farg;
r2 = t2->farg;
i = SAME_AS;
while (r1 && (i = lex_order(r1->argval,r2->argval)) == SAME_AS) {
r1 = r1->narg;
r2 = r2->narg;
}
return(i);
}
else
return(lex_compare_sym_nums(t1->sym_num, t2->sym_num));
} /* lex_order */
/*************
*
* int lex_order_vars(t1, t2)
*
* Similar to lex_order, except that variables are lowest, and are ordered
* by number.
*
*************/
int lex_order_vars(struct term *t1,
struct term *t2)
{
struct rel *r1, *r2;
int i, t1_special, t2_special;
/* The following handles special unary functions that are to be */
/* ignored during lex_check. For example, when using lex-dependent */
/* demodulation to sort AC expressions, you can make the canonical */
/* form be a + -a + b + -b + c + -c. */
if (Internal_flags[SPECIAL_UNARY_PRESENT]) {
t1_special = (t1->type == COMPLEX && sn_to_node(t1->sym_num)->special_unary);
t2_special = (t2->type == COMPLEX && sn_to_node(t2->sym_num)->special_unary);
if (t1_special && !t2_special) {
if (term_ident(t1->farg->argval, t2))
return(GREATER_THAN);
else
return(lex_order_vars(t1->farg->argval, t2));
}
else if (!t1_special && t2_special) {
if (term_ident(t2->farg->argval, t1))
return(LESS_THAN);
else
return(lex_order_vars(t1, t2->farg->argval));
}
else if (t1_special && t2_special) {
int argcomp = lex_order_vars(t1->farg->argval, t2->farg->argval);
if (argcomp != SAME_AS)
return(argcomp);
/* else fall through and treat as normal terms */
}
}
/* end of special_unary code */
if (t1->type == VARIABLE)
if (t2->type == VARIABLE)
if (t1->varnum == t2->varnum)
return(SAME_AS);
else
return(t1->varnum > t2->varnum ? GREATER_THAN : LESS_THAN);
else
return(LESS_THAN);
else if (t2->type == VARIABLE)
return(GREATER_THAN);
else if (t1->sym_num == t2->sym_num) {
r1 = t1->farg;
r2 = t2->farg;
i = SAME_AS;
while (r1 && (i = lex_order_vars(r1->argval,r2->argval)) == SAME_AS) {
r1 = r1->narg;
r2 = r2->narg;
}
return(i);
}
else
return(lex_compare_sym_nums(t1->sym_num, t2->sym_num));
} /* lex_order_vars */
/*************
*
* int wt_lex_order(t1, t2)
*
* Return SAME_AS, GREATER_THAN, LESS_THAN, or NOT_COMPARABLE.
*
*************/
static int wt_lex_order(struct term *t1,
struct term *t2)
{
int i1, i2;
i1 = weight(t1, Weight_terms_index);
i2 = weight(t2, Weight_terms_index);
if (i1 > i2)
return(GREATER_THAN);
else if (i1 < i2)
return(LESS_THAN);
else
return(lex_order(t1, t2));
} /* wt_lex_order */
/*************
*
* int lex_check(t1, t2)
*
* Return SAME_AS, GREATER_THAN, LESS_THAN, or NOT_COMPARABLE.
*
* Consult a flag to see if variables should be considered.
*
*************/
int lex_check(struct term *t1,
struct term *t2)
{
if (Flags[LEX_ORDER_VARS].val)
return(lex_order_vars(t1, t2));
else
return(lex_order(t1, t2));
} /* lex_check */
/*************
*
* get_var_multiset(t, a)
*
* Get (or continue getting) multiset of variables in t by
* Filling in array a.
*
*************/
static void get_var_multiset(struct term *t,
int *a)
{
struct rel *r;
if (t->type == VARIABLE)
a[t->varnum]++;
else if (t->type == COMPLEX) {
r = t->farg;
while (r != NULL) {
get_var_multiset(r->argval, a);
r = r->narg;
}
}
} /* get_var_multiset */
/*************
*
* int var_subset(t1, t2)
*
* True if vars(t1) is a subset of vars(t2)
*
*************/
int var_subset(struct term *t1,
struct term *t2)
{
int t1_vars[MAX_VARS], t2_vars[MAX_VARS], i;
for (i = 0; i < MAX_VARS; i++)
t1_vars[i] = t2_vars[i] = 0;
get_var_multiset(t1, t1_vars);
get_var_multiset(t2, t2_vars);
/* now make sure every variable in t1 is in t2 */
for (i = 0; i < MAX_VARS; i++)
if (t2_vars[i] == 0 && t1_vars[i] != 0)
return(0);
return(1);
} /* var_subset */
/*************
*
* int sym_occur(sym_num, t)
*
* True if sym_num is the symbol number of one of the constants
* or functors in t.
*
*************/
static int sym_occur(int sym_num,
struct term *t)
{
struct rel *r;
int found;
if (t->type == VARIABLE)
return(0);
else if (t->sym_num == sym_num)
return(1); /* NAME or COMPLEX */
else if (t->type == NAME)
return(0);
else { /* complex with different sym_num */
r = t->farg;
found = 0;
while (r != NULL && found == 0) {
found = sym_occur(sym_num, r->argval);
r = r->narg;
}
return(found);
}
} /* sym_occur */
/*************
*
* sym_elim(alpha, beta)
*
* True if alpha is complex, all args of alpha are unique vars, functor
* of alpha doesn't occur in beta, and subset(vars(beta),vars(alpha)) .
* (If true, alpha = beta can be made into a symbol-eliminating
* demodulator.)
*
*************/
static int sym_elim(struct term *alpha,
struct term *beta)
{
struct rel *r;
struct term *t1;
int i, a[MAX_VARS], ok;
if (alpha->type == VARIABLE)
return(0);
else {
if (alpha->type == NAME)
ok = 0;
else {
/* check for list of unique vars */
for (i = 0; i < MAX_VARS; i++)
a[i] = 0;
ok = 1;
r = alpha->farg;
while (r != NULL && ok) {
t1 = r->argval;
ok = (t1->type == VARIABLE && a[t1->varnum] == 0);
a[t1->varnum] = 1;
r = r->narg;
}
}
if (ok == 0)
return(0);
else { /* check that functor of alpha doesn't occur in beta */
/* and that vars(beta) is a subset of vars(alpha) */
return(sym_occur(alpha->sym_num, beta) == 0 && var_subset(beta, alpha));
}
}
} /* sym_elim */
/*************
*
* order_equalities(c)
*
* For each equality literal (pos or neg), flip args if the right
* side is heavier. After possible filp, if the left side is
* heavier, set the ORIENTED_EQ_BIT in the atom.
* If the atom is flipped, set SCRATCH_BIT.
*
*************/
void order_equalities(struct clause *c)
{
struct literal *l;
struct rel *r1, *r2;
struct term *alpha, *beta;
int alpha_bigger, beta_bigger;
for (l = c->first_lit; l; l = l->next_lit) {
alpha_bigger = 0; beta_bigger = 0;
if (eq_lit(l)) {
r1 = l->atom->farg;
r2 = r1->narg;
alpha = r1->argval;
beta = r2->argval;
if (!term_ident(alpha, beta)) {
if (Flags[SYMBOL_ELIM].val && sym_elim(alpha, beta))
alpha_bigger = 1;
else if (Flags[SYMBOL_ELIM].val && sym_elim(beta, alpha))
beta_bigger = 1;
else if (occurs_in(beta, alpha))
alpha_bigger = 1;
else if (occurs_in(alpha, beta))
beta_bigger = 1;
else {
int rc;
rc = wt_lex_order(alpha, beta);
if (rc == GREATER_THAN)
alpha_bigger = 1;
else if (rc == LESS_THAN)
beta_bigger = 1;
}
if (alpha_bigger || beta_bigger) {
if (beta_bigger) {
r1->argval = beta;
r2->argval = alpha;
SET_BIT(l->atom->bits, SCRATCH_BIT);
}
SET_BIT(l->atom->bits, ORIENTED_EQ_BIT);
}
}
}
}
} /* order_equalities */
/*************
*
* int term_ident_x_vars(term1, term2) -- Compare two terms, ignoring variables
*
* If identical except for vars, return(1); else return(0). The bits
* field is not checked.
*
*************/
int term_ident_x_vars(struct term *t1,
struct term *t2)
{
struct rel *r1, *r2;
if (t1->type != t2->type)
return(0);
else if (t1->type == COMPLEX) {
if (t1->sym_num != t2->sym_num)
return(0);
else {
r1 = t1->farg;
r2 = t2->farg;
while (r1 && term_ident_x_vars(r1->argval,r2->argval)) {
r1 = r1->narg;
r2 = r2->narg;
}
return(r1 == NULL);
}
}
else if (t1->type == VARIABLE)
return(1);
else /* NAME */
return(t1->sym_num == t2->sym_num);
} /* term_ident_x_vars */
./otter2/ 0000777 0002044 0001012 00000000000 11120534563 010536 5 ustar beeson ./otter2/beta.c 0000644 0002044 0001012 00000036013 11120534563 011614 0 ustar beeson /* beta reduction */
/* Author: M. Beeson */
#include <assert.h>
#include "header.h"
#include "beta.h"
#include "bterms.h"
#include "bsym.h"
#include "unify2.h" // forbid
#include "unify.h" // BIND
static int rename_variables(term b, term a, int varnums[MAX_VARS], int *nextvar);
static struct term * fsubst(struct term *a, struct term *x, struct term *b, struct context *c);
// substitute a for x in b, using context c, renaming bound variables in c if necessary
/*__________________________________________________________________________*/
struct term * beta_reduce(struct term *t, struct context *c)
/* if t = ap(lambda(x,q), r) then return q[x:==r], renaming bound variables
of q if required to avoid conflict with the free variables of r. The returned
term is entirely new, but the original term is not destroyed. If t does
not have this form, then NULL is returned.
*/
{ struct term *x,*r,*s,*q, *ans;
if(FUNCTOR(t) != AP)
return NULL;
s = ARG0(t);
if(FUNCTOR(s) != LAMBDA)
return NULL;
x = ARG0(s);
q = ARG1(s);
r = ARG1(t);
#if 0 // DEBUG
fprintf(stdout,"\n fsubst ");
print_term_nl(stdout, r);
fprintf(stdout," for ");
print_term_nl(stdout,x);
fprintf(stdout," in ");
print_term_nl(stdout, q);
fprintf(stdout," yields\n");
#endif
ans = fsubst(r,x,q,c);
#if 0 // DEBUG
print_term_nl(stdout,ans);
#endif
return ans;
}
/*____________________________________________________________________________*/
static void vars_in(term t, int *varnums)
/* traverse t and mark in varnums the variables that occur in t, by putting a
1 at the index given by var_num. varnums is presumed to have dimension MAX_VARS. */
{ struct rel *r;
if (t->type == NAME)
return;
if (t->type == COMPLEX)
{ for(r = t->farg; r; r= r->narg)
{ vars_in(r->argval, varnums);
}
return;
}
// now t->type == VAR
varnums[t->varnum] = 1;
}
/*____________________________________________________________________________*/
int otter_contains(term t, term x)
/* x is presumed to be a variable or constant. Return 1 if t contains x, 0 if not */
{ struct rel *r;
int rval = 0;
if(t->type == NAME && x->type== NAME)
return t->sym_num == x->sym_num;
if(t->type == VARIABLE && x->type == VARIABLE)
return t->varnum == x->varnum;
if(t->type == NAME || t->type == VARIABLE)
return 0;
// Now t->type == COMPLEX
for(r = t->farg; r; r= r->narg)
{ rval = otter_contains(r->argval, x);
if(rval)
break;
}
return rval;
}
/*____________________________________________________________________________*/
static int rename_vars(term t, int varnums[MAX_VARS], int *nextvar)
/* Rename the bound variables in t by giving them var_nums whose entry in varnums is 0.
If varnums fills up return 1, otherwise return 0 for success. Increase *nextvar
if necessary to be larger than any of the renamed variables.
*/
{ struct rel *r;
term v;
int i;
if(t->type == VARIABLE && varnums[t->varnum] > 1)
{ t->varnum = varnums[t->varnum]-2;
return 0;
}
if(t->type != COMPLEX)
return 0;
r = t->farg;
if(BINDER(t->sym_num))
{ v = r->argval;
if(varnums[v->varnum] > 1)
v->varnum = varnums[v->varnum]-2; // already renamed
else
{ for(i=0;i<MAX_VARS;i++)
{ if(varnums[i] == 0)
{ varnums[v->varnum] = i+2; // store for further occurrences of this variable
v->varnum = i;
varnums[i] = 1; // don't use this variable again.
if(*nextvar <= i)
*nextvar = i+1;
break;
}
}
if(i==MAX_VARS)
return 1; // too many variables
}
r = r->narg;
}
// go on to the rest of the args (or do all the args if no bound variable was encountered)
for(;r; r=r->narg)
{ rename_vars(r->argval, varnums,nextvar);
}
return 0;
}
/*____________________________________________________________________________*/
static int rename_variables(term b, term a, int varnums[MAX_VARS], int *nextvar)
/* rename bound variables in b that occur in a (free or bound) so that
afterwards, no variable in a occurs bound in b. [Thus when a is substituted
for some free variable in b, there will be no accidental capture of the free
variables of a.] Do not use any varnum less than the initial value
of *nextvar.
Return 0 for success, 1 if renaming would create more than
MAX_VARS variables. Increase *nextvar from its initial value, if necessary,
to be larger than any renamed variable in b.
*/
{ int err,i;
// first traverse a and mark in varnums the variables that occur in a;
vars_in(a,varnums);
for(i=0;i<*nextvar;i++)
varnums[i]= 1;
// Now rename the bound variables of b to avoid the marked variables.
err = rename_vars(b,varnums, nextvar);
return err;
}
/*_________________________________________________________________________________________*/
static struct term * fsubst2(struct term *a, struct term *x, struct term *b, struct context *c)
/* substitute a for unbound occurrences of x in b, using context c. It is assumed
that the bound variables in b do not occur free in a.
It is not assumed that x is a variable, but if it is, b could contain subterms that
bind the same variable x again, so such subterms are skipped, i.e. copied.
This function is used in beta-reduction but a more general fsubst is used in unify2,
see fsubst3 in fsubst.c. An example of the difference is
substituting z for g(X) in g(Y). This function will return the unmodified g(Y).
fubst3 and fsubst4 will return z after unifying g(X) and g(Y) using the contexts and
trail that are required as extra parameters to those functions.
*/
{ term t, ans;
struct rel *r,*s;
struct context *d;
if(x->type == COMPLEX)
{ if(term_ident2(x,b,0))
return copy_term(a);
}
if(b->type == COMPLEX)
{ if(BINDER(b->sym_num) && VARNUM(ARG0(b))== VARNUM(x))
return copy_term(b);
ans = get_term();
ans->sym_num = b->sym_num;
ans->type = COMPLEX;
s = get_rel();
ans->farg = s;
for(r = b->farg; r; r=r->narg)
{ s->argval = fsubst2(a,x,r->argval,c);
++s->argval->fpa_id; // FIX THIS -- McCune says not necessary
if(r->narg)
{ s->narg = get_rel();
s = s->narg;
}
// zap_term_special(r->argval); removed 2.7.03
}
return ans;
}
if(b->type == NAME)
return copy_term(b);
// now b->type == VARIABLE
if(b->varnum < MAX_VARS)
t = c->terms[b->varnum];
else
t = NULL;
if(!t)
{ if(x->varnum == b->varnum)
return copy_term(a);
return copy_term(b);
}
d = c->contexts[b->varnum];
// t->fpa_id++; /* count of extra references to a term */ // gets incremented AFTER the call.
return fsubst2(a,x,t,d);
}
/*____________________________________________________________________________*/
static struct term * fsubst(struct term *a, struct term *x, struct term *b, struct context *c)
/* Rename bound variables in b to avoid conflict with free variables of a. Then
substitute a for unbound occurrences of x in b, using context c.
It is NOT assumed that x is a variable. But if it is a bound variable,
b could contain subterms that bind the same variable x again, so such subterms are
skipped, i.e. copied.
*/
{ int varnums[MAX_VARS];
int err;
memset(varnums, 0, MAX_VARS * sizeof(int));
if(x->type == VARIABLE)
{ if(x->varnum < MAX_VARS)
varnums[x->varnum] = 1;
}
err = rename_variables(b,a,varnums,&c->next_var);
if(err)
abend("Too many variables required to rename bound variables to avoid accidental capture.");
return fsubst2(a,x,b,c);
}
/*__________________________________________________________________________*/
void rename2(int i, int j, term c)
/* rename variable i as variable j in term c */
{ struct rel *r;
if(c->type == NAME)
return;
if(c->type == VARIABLE)
{ if(c->varnum == i)
{ c->varnum = j;
if(c->sym_num) // variable left over from user input
c->sym_num = 0;
}
return;
}
for(r = c->farg;r;r = r->narg)
rename2(i,j,r->argval);
}
/*__________________________________________________________________________*/
void forbid_all(struct term *a, struct context *c1, struct term *x, struct context *c2)
/* forbid all uninstantiated free variables in a, other than x itself, to take the value x */
{ struct rel *r;
if(a->type == VARIABLE && (TYPE(x) != VARIABLE || a->varnum != x->varnum || c1 != c2))
{ if(c1->terms[a->varnum])
{ // a is already instantiated
forbid_all(c1->terms[a->varnum],c1->contexts[a->varnum],x,c2);
return;
}
// now a is an uninstantiated variable
if(c1->bound[a->varnum] == 0 && !forbidden2(a->varnum,c1,x->varnum,c2))
forbid(a,c1,x,c2);
return;
}
else if(a->type == NAME || (a->type == VARIABLE && a->varnum == x->varnum))
return;
// now a->type == COMPLEX
r = a->farg;
while(r != NULL)
{ forbid_all(r->argval,c1,x,c2);
r = r->narg;
}
}
/*__________________________________________________________________________*/
static void forbid_all2(struct term *a, struct context *c1, struct term *x, struct context *c2)
/* forbid all uninstantiated variables in a, other than x itself or
a variable in another context with the same varnum, to take the value x */
{ struct rel *r;
if(a->type == VARIABLE && (TYPE(x) != VARIABLE || a->varnum != x->varnum))
{ if(c1->terms[a->varnum])
{ // a is already instantiated
forbid_all2(c1->terms[a->varnum],c1->contexts[a->varnum],x,c2);
return;
}
// now a is an uninstantiated variable
if(c1->bound[a->varnum] == 0 && !forbidden2(a->varnum,c1,x->varnum,c2))
forbid(a,c1,x,c2);
return;
}
else if(a->type == NAME || (a->type == VARIABLE && a->varnum == x->varnum))
return;
// now a->type == COMPLEX
r = a->farg;
while(r != NULL)
{ forbid_all2(r->argval,c1,x,c2);
r = r->narg;
}
}
/*__________________________________________________________________________*/
void rename_bound(struct term *a, struct context *c1, struct term *b, struct context *c2, struct trail **trp)
/* It is assumed that a and b are terms with the same functor f, and
that this functor satisfies BINDING(f). For example, a = lambda(x,t)
and b = lambda(y,s). BIND one of the variables to the other (unless
they're already identical. Also, make both bound variables
forbidden to all variables in the scope of the binding, i.e. in
ARG1(a) and ARG1(b) except x.
*/
{ int varnums[MAX_VARS];
term x = ARG0(a);
term y = ARG0(b);
if(c1 == c2 && x->varnum == y->varnum)
return; // not necessary to do anything--don't BIND a variable to itself
validate_context(c1); // DEBUG 6.17.03
validate_context(c2); // DEBUG 6.17.03
fprintf(stdout,"Renaming bound variables in:\n"); // DEBUG 6.30.03
print_term_nl(stdout,a);
print_term_nl(stdout,b); // DEBUG 6.30.03
memset(varnums,0,MAX_VARS *sizeof(int));
vars_in(b,varnums);
BIND(x->varnum,c1,y,c2,trp);
forbid_all(ARG1(a),c1,x,c1);
forbid_all2(ARG1(b),c2,x,c1); // 6.29.03
forbid_all(ARG1(b),c2,y,c2); // 6.26,29.03
forbid_all2(ARG1(b),c2,x,c1); // 6.26,29.03
}
/*____________________________________________________________*/
int forbid_bound(struct context *p, struct term *t)
/* make all bound variables in t forbidden to all variables
occurring in the scope of the binding operator. This is called
by get_context2. Also, make p->bound[i] = 1 when variable i occurs
bound in t. Return value is always 1--this function needs to be
called in an if-test so it needs a return value.
*/
{ struct term *x;
struct rel *r;
if(t->type == COMPLEX && BINDER(t->sym_num))
{ x = ARG0(t);
if(x->type != VARIABLE)
{ fprintf(stdout, "Oops, non-variable appears where variable expected in\n");
print_term_nl(stdout,t);
assert(0);
}
p->bound[x->varnum] = 1;
for(r = t->farg->narg;r;r=r->narg)
forbid_all(r->argval,p,x,p);
}
if(t->type == COMPLEX)
{ for(r=t->farg;r;r=r->narg)
forbid_bound(p,r->argval);
}
return 1;
}
void clear_forbidden(struct context *c)
// free all memory in the forbidden[i] lists and set them to 0
{ int i;
for(i=0;i<MAX_VARS;i++)
{ if(c->forbidden[i])
{ free_int_ptr(c->forbidden[i]);
c->forbidden[i] = 0;
}
}
}
/*________________________________________________________________________*/
struct context *get_context2(struct clause *c, int multiplier)
/* Beeson 8.16.02
It is used to replace get_context, when there is a parent clause at hand,
so that the next_var field can be set sensibly. The next_var field
should point to a var_num greater than all the var_nums of variables in the
clause c. Each bound variable should be forbidden to all variables
occurring in the scope of the binding operator. The bound[] array
of the context should be set to contain a 1 for each variable occurring
bound in clause c. In Otter2, each variable in a clause must occur
bound or free--it cannot have some free and some bound occurrences. It
can have several bound occurrences, with scopes either disjoint or nested.
*/
{
struct context *p = get_context();
static int count=0;
struct literal *lit;
if(c==NULL)
abend("get_context2 called with a NULL parameter"); // c must point to a context
memset(p->terms,0,MAX_VARS * sizeof(int*));
memset(p->forbidden,0,MAX_VARS * sizeof(restrictdata));
memset(p->contexts,0,MAX_VARS * sizeof(struct context *));
memset(p->bound,0,MAX_VARS * sizeof(char));
p->multiplier = multiplier;
p->next_var = c->next_var;
if(c->next_var < 0)
assert(0);
for(lit = c->first_lit; lit; lit = lit->next_lit)
forbid_bound(p,lit->atom);
p->next = NULL; // added 12.3.05
return(p);
} /* get_context2 */
/*_________________________________________________________*/
struct context * copy_context(struct context *c)
/* return a copy of c, but in all new space, with a NULL next pointer */
{ struct context *p = get_context();
memcpy(p->terms,c->terms,MAX_VARS * sizeof(int*));
memcpy(p->forbidden,c->forbidden,MAX_VARS*sizeof(restrictdata));
memcpy(p->contexts,c->contexts,MAX_VARS *sizeof(struct context *));
memcpy(p->bound,c->bound,MAX_VARS *sizeof(char));
p->multiplier = c->multiplier;
p->next_var = c->next_var;
p->next = NULL;
return p;
}
./otter2/beta.h 0000644 0002044 0001012 00000001700 11120534563 011614 0 ustar beeson struct term * beta_reduce(struct term *t, struct context *c);
void rename_bound(struct term *, struct context *,struct term *, struct context *, struct trail **);
int otter_contains(struct term *t, struct term *x);
struct context *get_context2(struct clause *c, int multiplier);
struct context * copy_context(struct context *c);
int equals(struct term *a, struct term *b);
void rename2(int i, int j, struct term *c);
int forbid_bound(struct context *p, struct term *t);
void clear_forbidden(struct context *c);
void forbid_all(struct term *a, struct context *c1, struct term *x, struct context *c2);
void prepare_context(struct term *t1, struct context *c1, int max);
struct clause *getContainingClause(struct term *t);
int check_lambdas(struct clause *c);
#define SYMBOL(t) (t->sym_num)
#define BINDER(f) (f == LAMBDA || f == SUM || f == PRODUCT || f == INTEGRAL || f == LIMIT ||f == SETOF) // list binding operators by symbol number
./otter2/bignum.h 0000644 0002044 0001012 00000011125 11120534563 012164 0 ustar beeson /* Bignum arithmetic package by M. Beeson */
/* Uses dynamic arrays instead of linked lists */
/* includes addition, subtraction, multiplication, division, exponentiation,
gcd, conversion to decimal form, and output. */
/* bignum digits are 'unsigned', which makes them either 16 or 32 bits on
the architectures in use at the time of writing. However, the code should
also work on future architectures with for example 64 bit integers, except
as follows: Functions 'longmult' and 'longdiv' are written in assembly
language and conditionally compiled. They will work correctly for 16-bit
ints and 32-bit longs or for 32-bit ints and 32-bit longs; if in
the future we have 32-bit ints and 64-bit longs or eventually even
64-bit ints and 64-bit longs, more work will be required.
*/
typedef unsigned digit;
/* don't change the definition of digit; the use of MAX assumes that
digits and the .ln field of bignums are the same. */
typedef struct { unsigned ln; /* number of "digits" */
digit *val; /*least significant digits first */
} bignum;
typedef struct { int sign; /* 1 is positive, -1 is negative, 0 is zero */
bignum n; /* numerator */
bignum d; /* denominator */
} bigrat;
digit *getspace(unsigned); /* bignum.c */
void freespace(digit *); /* release space allocated by getspace */
#define NN 32U
/* Microsoft Visual C 5.0 doesn't compile the following properly.
It evaluates (trialq >> NN) to a nonzero value when trialq is a digit!
#define NN ((unsigned)(sizeof(digit)<<3))
*/
#define LEFTDIGIT ((unsigned)(1 << (NN-1))) /* 1 in the leftmost place of a digit */
#define MAX ((digit) -1)
#define INC(i) ((i==0)?1:((i==1)?2:((i==2)?0:(i++%3)))) /* ++i mod 3 */
/* Function prototypes */
int smallgcd(digit,digit);
void longmult(digit x, digit y, digit *lo, digit *hi);
void longdiv(unsigned x, unsigned y, unsigned z, unsigned *q, unsigned *r);
MEXPORT_BIGNUMS void bigplus2(bignum x, bignum y, bignum *ansp);
MEXPORT_BIGNUMS void bigplus(bignum x, bignum y, bignum *ansp);
MEXPORT_BIGNUMS void mult_by_digit2(bignum x, digit d, bignum *ansp);
MEXPORT_BIGNUMS void mult_by_digit(bignum x, digit d, bignum *ansp);
MEXPORT_BIGNUMS void bigmult2(bignum x, bignum y, bignum *ansp);
MEXPORT_BIGNUMS void bigmult(bignum x, bignum y, bignum *ansp);
MEXPORT_BIGNUMS int compare(bignum x, bignum y);
MEXPORT_BIGNUMS digit mod_digit(bignum x, digit y);
MEXPORT_BIGNUMS bignum btod(bignum x, unsigned n);
MEXPORT_BIGNUMS void bigminus2(bignum x, bignum y, bignum *ansp);
MEXPORT_BIGNUMS void bigminus(bignum x, bignum y, bignum *ansp);
void right_shift(bignum x, int i, bignum *y);
MEXPORT_BIGNUMS void divide_by_digit(bignum x, digit y, bignum *q, digit *r);
MEXPORT_BIGNUMS void divide_by_digit2(bignum x, digit y, bignum *q, digit *r);
MEXPORT_BIGNUMS bignum long_to_bignum(unsigned long x);
MEXPORT_BIGNUMS int bigdivide(bignum x, bignum y, bignum *q, bignum *r);
MEXPORT_BIGNUMS int bigdivide2(bignum x, bignum y, bignum *q, bignum *r);
MEXPORT_BIGNUMS int bigpower(bignum x, digit d, bignum *ansp);
MEXPORT_BIGNUMS int bigsqrt(bignum x, bignum *ansp, bignum *remp);
MEXPORT_BIGNUMS int bigsqrt2(bignum x, bignum *ans, bignum *remp);
MEXPORT_BIGNUMS void biggcd(bignum x, bignum y, bignum *ansp);
int convert_and_print(bignum x, int separator);
MEXPORT_BIGNUMS int bigroot(unsigned n, bignum x, bignum *ansp, bignum *remp);
MEXPORT_BIGNUMS int bigroot2(unsigned n, bignum x, bignum *ansp, bignum *remp);
MEXPORT_BIGNUMS int bigfactorial(unsigned n, bignum *ansp);
MEXPORT_BIGNUMS int string_bignum(char *s, unsigned n, bignum *xp);
MEXPORT_BIGNUMS char *bignum_string(bignum x, int separator);
MEXPORT_BIGNUMS int get_small_factors(bignum, unsigned *, int *, bignum *,unsigned *);
MEXPORT_BIGNUMS void modexp(bignum, bignum,bignum, bignum *); /* file bigmod.c */
MEXPORT_BIGNUMS void modexp2(bignum, bignum,bignum, bignum *); /* file bigmod.c */
MEXPORT_BIGNUMS int bignum_double(bignum,double *);
MEXPORT_BIGNUMS int bigrat_double(bignum,bignum, double *);
MEXPORT_BIGNUMS void fftmult(bignum,bignum,bignum *);
#define freespace(x) free2(x)
MEXPORT_BIGNUMS unsigned addmod(unsigned a, unsigned b, unsigned m);
MEXPORT_BIGNUMS unsigned mulmod(unsigned a, unsigned b, unsigned m);
MEXPORT_BIGNUMS int intbinomial(long n, long k, bignum *ans);
MEXPORT_BIGNUMS int ratbinomial(long n, long d, long k, bigrat *ans);
MEXPORT_BIGNUMS bignum bigint(long n);
MEXPORT_BIGNUMS int bignum_long(bignum b, long *ans);
MEXPORT_BIGNUMS int primality_test(bignum b);
./otter2/bsym.c 0000644 0002044 0001012 00000022736 11120534563 011662 0 ustar beeson #include <string.h>
#include <ctype.h>
#include <assert.h>
#include "bsym.h"
static int bsym1(char *s,int arity)
// If s is the string form of a built-in symbol such as "+", "*", then return its
// MathXpert number; if not, return 0.
{ // see LITERALFUNCTOR in functors.h in MathXpert
if(s[1] == 0 && arity == 2)
{ switch(s[0])
{ case '*' : return 42;
case '+' : return 43;
case '/' : return 47;
case '=' : return 61;
case '^' : return 94;
case ':' : return 58;
case '<' : return 60;
case '>' : return 62;
}
return 0;
}
if(!strcmp(s,"-") && arity == 1) return 45;
if(!strcmp(s,"<=") && arity == 2) return LE;
if(!strcmp(s,">=") && arity == 2) return GE;
return 0;
}
#define LITERALFUNCTOR(f) ((f)==42 || (f)==43 || (f)==45 || (f)==47 || (f)==58 || (f)==60 || (f)==61 || (f)==62 || (f)==94)
// supply fixed symbol numbers for built-in symbols
int bsym(char *s,int arity)
{ char buffer[32];
int i,ans;
int n = strlen(s);
if(n > 10)
return 0;
/* first we must detect +, *, ^, etc. */
ans = bsym1(s,arity);
if(ans)
return ans;
memset(buffer,0, 32);
for(i=0;i<n;i++)
buffer[i] = toupper(s[i]);
if(arity==4)
{ if (!strcmp(buffer,"SUM")) return SUM;
if (!strcmp(buffer,"PRODUCT")) return PRODUCT;
return 0;
}
if(arity == 2)
{ switch(buffer[0])
{ case 'A' : switch(buffer[1])
{ case 'L' : if (!strcmp(buffer,"ALL")) return FORALL;
break;
case 'N' : if (!strcmp(buffer,"AND")) return AND;
case 'P' : if (!strcmp(buffer, "AP")) return AP;
break;
case 'O': if (!strcmp(buffer,"OR")) return OR;
break;
}
break;
case 'B': if (!strcmp(buffer,"BINOMIAL")) return BINOMIAL;
break;
case 'E': if (!strcmp(buffer,"EXISTS")) return EXISTS;
break;
case 'I': if (!strcmp(buffer,"IF")) return IF;
if (!strcmp(buffer,"IMPLIES")) return IMPLIES;
break;
case 'L': if (!strcmp(buffer,"LIM")) return LIMIT;
if (!strcmp(buffer,"LIMIT")) return LIMIT;
if (!strcmp(buffer,"LAMBDA")) return LAMBDA;
if( !strcmp(buffer,"LOGB")) return LOGB;
break;
case 'O': if(!strcmp(buffer,"OR")) return OR;
break;
case 'R': if (!strcmp(buffer,"ROOT")) return ROOT;
break;
case 'S': if (!strcmp(buffer,"SET")) return SETOF;
break;
}
return 0;
}
if(arity == 1)
{ switch(buffer[0])
{ case 'A':
switch (buffer[1])
{ case 'B' : if (!strcmp(buffer,"ABS")) return ABS;
break;
case 'C' : if (!strcmp(buffer,"ACOS")) return ACOS;
if (!strcmp(buffer,"ACOT")) return ACOT;
if (!strcmp(buffer,"ACSC")) return ACSC;
if (!strcmp(buffer,"ACOSH")) return ACOSH;
if (!strcmp(buffer,"ACOTH")) return ACOTH;
if (!strcmp(buffer,"ACSCH")) return ACSCH;
break;
case 'R' : if (!strcmp(buffer,"ARCSIN")) return ASIN;
if (!strcmp(buffer,"ARCCOS")) return ACOS;
if (!strcmp(buffer,"ARCTAN")) return ATAN;
if (!strcmp(buffer,"ARCSEC")) return ASEC;
if (!strcmp(buffer,"ARCCSC")) return ACSC;
if (!strcmp(buffer,"ARCCOT")) return ACOT;
if (!strcmp(buffer,"ARCSINH")) return ASINH;
if (!strcmp(buffer,"ARCCOSH")) return ACOSH;
if (!strcmp(buffer,"ARCTANH")) return ATANH;
if (!strcmp(buffer,"ARCSECH")) return ASECH;
if (!strcmp(buffer,"ARCCSCH")) return ACSCH;
if (!strcmp(buffer,"ARCCOTH")) return ACOTH;
break;
case 'S' : if (!strcmp(buffer, "ASEC")) return ASEC;
if (!strcmp(buffer, "ASECH")) return ASECH;
if (!strcmp(buffer,"ASIN")) return ASIN;
if (!strcmp(buffer,"ASINH")) return ASINH;
break;
case 'T' : if (!strcmp(buffer, "ATAN")) return ATAN;
if (!strcmp(buffer, "ATANH")) return ATANH;
break;
}
break;
case 'B': if (!strcmp(buffer,"BETA")) return BETAFUNCTION;
break;
case 'C': if (!strcmp(buffer,"COS")) return COS;
if (!strcmp(buffer,"COSH")) return COSH;
if (!strcmp(buffer,"COT")) return COT;
if (!strcmp(buffer,"COTH")) return COTH;
if (!strcmp(buffer,"CSC")) return CSC;
if (!strcmp(buffer,"CSCH")) return CSCH;
if (!strcmp(buffer,"CASES")) return CASES;
if (!strcmp(buffer,"COFI")) return CONSTANTOFINTEGRATION;
/* must be parseable for cut-and-paste to work */
if (!strcmp(buffer,"COSINTEGRAL")) return COSINTEGRAL;
break;
case 'D': // if (!strcmp(buffer,"DEG")) return DEG;
if (!strcmp(buffer,"DET")) return DET;
if (!strcmp(buffer,"DIFF")) return DIFF;
if (!strcmp(buffer,"DIGAMMA")) return DIGAMMA;
break;
case 'E': if (!strcmp(buffer,"ERF")) return ERF;
if (!strcmp(buffer,"ERFC")) return ERFC;
if (!strcmp(buffer,"EVAL")) return EVAL;
if (!strcmp(buffer,"EXPINTEGRALE")) return EXPINTEGRALE;
if (!strcmp(buffer,"EXPINTEGRALI")) return EXPINTEGRALE;
break;
case 'F': if (!strcmp(buffer,"FLOOR")) return FLOOR;
if( !strcmp(buffer,"FACTORIAL")) return FACTORIAL;
break;
case 'G': if (!strcmp(buffer,"GCD")) return GCD;
if (!strcmp(buffer,"GAMMA")) return GAMMA;
break;
case 'I' : if (!strcmp(buffer,"INTEGRAL")) return INTEGRAL;
if (!strcmp(buffer,"I")) return BESSELI;
if (!strcmp(buffer,"INCOMPLETEBETA")) return INCOMPLETEBETA;
if (!strcmp(buffer,"INCOMPLETEGAMMA")) return INCOMPLETEGAMMA;
if (!strcmp(buffer,"INCOMPLETEGAMMAP")) return INCOMPLETEGAMMAP;
if (!strcmp(buffer,"IM")) return IMAGPART;
// if (!strcmp(buffer,"INVERSE")) return MATRIXINVERSE;
break;
case 'J': if (!strcmp(buffer,"J")) return BESSELJ;
break;
case 'K': if (!strcmp(buffer,"K")) return BESSELK;
break;
case 'L': if (!strcmp(buffer,"LOG")) return LOG;
if (!strcmp(buffer,"LN")) return LN;
if (!strcmp(buffer,"LOGINTEGRAL")) return LOGINTEGRAL;
break;
case 'M': if (!strcmp(buffer,"MATRIX")) return MATRIX;
if (!strcmp(buffer,"MOD")) return MOD;
if(!strcmp(buffer,"MIN")) return MINFUNCTOR;
if(!strcmp(buffer,"MAX")) return MAXFUNCTOR;
break;
case 'N': if (!strcmp(buffer,"NOT")) return NOT;
break;
case 'P': if (!strcmp(buffer,"PE")) return WEIERSTRASSP;
if (!strcmp(buffer,"PRODUCT")) return PRODUCT;
if (!strcmp(buffer,"POLYGAMMA")) return POLYGAMMA;
break;
case 'R': if (!strcmp(buffer,"RE")) return REALPART;
break;
case 'S': if (!strcmp(buffer,"SIN")) return SIN;
if (!strcmp(buffer,"SINH")) return SINH;
if (!strcmp(buffer,"SEC")) return SEC;
if (!strcmp(buffer,"SECH")) return SECH;
if (!strcmp(buffer,"SQRT")) return SQRT;
if (!strcmp(buffer,"SININTEGRAL")) return SININTEGRAL;
if (!strcmp(buffer,"SG")) return SG;
break;
case 'T': if (!strcmp(buffer,"TAN")) return TAN;
if (!strcmp(buffer,"TANH")) return TANH;
break;
case 'W': if (!strcmp(buffer,"WEIERSTRASSP")) return WEIERSTRASSP;
break;
case 'Y': if (!strcmp(buffer,"Y")) return BESSELY;
break;
case 'Z': if (!strcmp(buffer,"ZETA")) return RIEMANNZETA;
break;
}
}
return 0; /* not a known functor */
}
./otter2/bsym.h 0000644 0002044 0001012 00000006512 11120534563 011661 0 ustar beeson int bsym(char *s, int arity); // return symbol number for built-in non-evaluable symbol
#define ACOS 21 /* This should stay first--automode.c relies on it */
#define ACOT 22
#define ACSC 23
#define ASEC 24
#define ASIN 25
#define ATAN 26
#define SIN 27
#define COS 28
#define SEC 29
#define TAN 30
#define CSC 31
#define COT 32
#define SG 33
#define SQRT 34
#define LN 35
#define LOG 36
#define ABS 37
#define DET 38 /* determinant of a matrix */
#define SINH 39
#define COSH 40
#define TANH 41
#define FACTORIAL 46
#define FLOOR 48
#define NOT 49
#define REALPART 50
#define IMAGPART 51
#define BESSELJ 53
#define BESSELY 54
#define BESSELI 55
#define BESSELK 56
#define GCD 57
#define BINOMIAL 59
#define BIGOH 91
#define MAXFUNCTOR 93
/* 94 is '^', a literal functor */
#define MINFUNCTOR 123 /* for the function 'min' */
#define GE 124 /* Keep GE,LE,NE,MOD together and in this order */
#define LE 125
#define NE 126
#define MOD 127
#define IMPLIES 129 /* -> when used as logical implication */
#define ARROW 129 /* -> when used in lim(x->0,f(x)) */
#define SEQ 130 /* not used in Mathpert, meant for theorem-proving */
#define DIFF 131
#define INTEGRAL 132
#define LOGB 133
#define IF 134
#define AND (unsigned short) 135
#define OR (unsigned short) 136
#define ROOT 138
#define LIMIT 139
#define CASES 140
#define SUM 141 /* indexed sums */
#define PRODUCT 142 /* indexed products */
#define EVAL 143 /* as in evaluating f with respect to x from a to b,
used when evaluating definite integrals */
/* cannot be parsed, is only created by operators */
#define VECTOR 144 /* can't be bblocked or displayed */
#define POLY 151 /* for polynomials with all coefficients present, even zero ones*/
#define MATRIXMULT 152
#define MATRIX 153
/* Next the rest of the hyperbolic and inverse hyperbolic functions */
#define CSCH 154
#define SECH 155
#define COTH 156
#define ASINH 157
#define ACOSH 158
#define ATANH 159
#define ACSCH 160
#define ASECH 161
#define ACOTH 162
/* Now come the 'special functions' (other than the Bessel functions, which
are listed above) */
#define GAMMA 163
#define DIGAMMA 164
#define ERF 165
#define ERFC 166
#define POLYGAMMA 167
#define COSINTEGRAL 168
#define LOGINTEGRAL 169
#define SININTEGRAL 170
#define EXPINTEGRALI 171
#define BETAFUNCTION 172 /* as opposed to atom BETA */
#define INCOMPLETEBETA 173
#define EXPINTEGRALE 174
#define INCOMPLETEGAMMA 175
#define INCOMPLETEGAMMAP 176
#define COMPLETE_ELLIPTIC1 177
#define COMPLETE_ELLIPTIC2 178
#define COMPLETE_ELLIPTIC3 179
#define ELLIPTICF 180
#define ELLIPTICE 181
#define ELLIPTICPI 182
#define EXISTS 183
#define FORALL 184
#define ALL 184
#define INFINITESIMAL 185
#define LAMBDA 186 /* for lambda abstraction; */
#define AP 187 /* for lambda-calculus function application */
#define NUMERATOR 188 /* projection functions for RATIONAL -> INTEGER x NATNUM */
#define DENOM 189
#define CONSTANTOFINTEGRATION 190
#define RIEMANNZETA 191 /* parsed but not used */
#define SERIES 192
#define SETOF 193
#define WEIERSTRASSP 194 /* not actually used; should stay last in this list */
./otter2/bterms.c 0000644 0002044 0001012 00000013253 11120534563 012176 0 ustar beeson // author: Beeson
// purpose: utility functions to construct and access parts of terms
// original date 8.3.02
// last modified 10.12.02
// 3.24.06 made make_term static
#include <assert.h>
#include "header.h"
#include "bterms.h"
#include "bsym.h"
// #include "unify.h"
/*__________________________________________________________________________*/
int arity(term t)
{ int ans = 0;
struct rel *r;
for(r = t->farg; r ; r = r->narg)
++ans;
return ans;
}
/*__________________________________________________________________________*/
static term make_term(int f, int n)
/* Make a term with space for n arguments, later to be inserted by argrep */
/* If n = 0, it returns a name, not a variable */
{ struct term *t = get_term();
struct rel *r;
int k;
if(n == 0)
{ t -> type = NAME;
t -> sym_num = f;
return t;
}
t->type = COMPLEX;
t->sym_num = f < MAX_BUILTINS ? f : str_to_sn(sn_to_str(f),1);
r = get_rel();
t->farg = r;
for(k=1;k<n;k++)
{ r->narg = get_rel();
r = r->narg;
}
r->narg = NULL;
return t;
}
/*___________________________________________________________________________*/
term make_atom(char *name, struct literal *l)
/* return a new atom specified by its string name */
/* It must have a containing literal pointed to by l */
{ struct term *ans = get_term();
ans->type = NAME;
ans->sym_num = str_to_sn(name,0);
ans->occ.lit = l;
ans->varnum = 0;
ans->farg = NULL;
return ans;
}
/*___________________________________________________________________________*/
term True(struct literal *l)
/* return the atom "true" */
{ return make_atom("$T",l);
}
/*___________________________________________________________________________*/
term False(struct literal *l)
/* return the atom "false" */
{ return make_atom("$F",l);
}
/*___________________________________________________________________________*/
int isTrue(term a)
/* return 1 if a is the atom "true" */
{ if(a->type != NAME)
return 0;
return a->sym_num == str_to_sn("$T",0);
}
/*___________________________________________________________________________*/
int isFalse(term a)
/* return 1 if a is the atom "false" */
{ if(a->type != NAME)
return 0;
return a->sym_num == str_to_sn("$F",0);
}
/*______________________________________________________________________________*/
static void make_argof(struct term *a, struct term *t)
/* append t to the superterm list of a */
/* increment the reference counts of both a and t */
{ struct rel *r = a->occ.rel;
struct rel *m;
if(!r)
{ a->occ.rel = get_rel();
a->occ.rel->argof = t;
t->fpa_id++;
a->fpa_id++;
return;
}
while(r)
{ m = r;
r = r->nocc;
}
m->nocc = get_rel();
m->nocc->argof = t;
t->fpa_id++;
a->fpa_id++;
}
/*___________________________________________________________________________*/
void argrep(term t, int n, term newarg)
/* replace the n-th arg of term t with newarg if it has that many args */
{ int k;
term old;
struct rel *r = t->farg;
for(k=0;k < n && r ; k++)
{ r = r->narg;
}
if(!r)
{ assert(0); // erroneous call
return;
}
old = r->argval;
r->argval = newarg;
make_argof(newarg,t);
if(old != NULL) // it could be NULL if t has just been made by make_term
zap_term_special(old); // now there's one less reference to it.
}
/*____________________________________________________________________________*/
term arg(int i, term t)
/* return the i'th argument of t */
{ int k;
struct rel *r = t->farg;
for(k=0; k<i && r ; k++)
{ r = r->narg;
}
if(!r)
{ assert(0);
return NULL; // erroneous call
}
return r->argval;
}
/*______________________________________________________________________________*/
term cases(term a, term b, term c, term d)
/* make a CASES term with the given arguments */
{ term t = make_term(CASES,4);
argrep(t,0,a);
argrep(t,1,b);
argrep(t,2,c);
argrep(t,3,d);
return t;
}
/*______________________________________________________________________________*/
term lambda(term a, term b)
/* make a LAMBDA term with the given arguments */
{ term t = make_term(LAMBDA,2);
if(a->type != VARIABLE)
assert(0);
argrep(t,0,a);
argrep(t,1,b);
return t;
}
/*______________________________________________________________________________*/
term ap(term a, term b)
/* make an AP term with the given arguments */
{ term t = make_term(AP,2);
argrep(t,0,a);
argrep(t,1,b);
return t;
}
/*______________________________________________________________________________*/
term otter_or(term a, term b)
/* make an OR term with the given arguments */
{ term t = make_term(OR,2);
argrep(t,0,a);
argrep(t,1,b);
return t;
}
/*______________________________________________________________________________*/
#if 0
term and(term a, term b)
/* make an AND term with the given arguments */
{ term t = make_term(AND,2);
argrep(t,0,a);
argrep(t,1,b);
return t;
}
#endif
/*_______________________________________________________________________*/
int set_vars2(struct term *t, int *nextvar)
// Beeson 10.6.02, enhancement of McCune's set_vars in io.c
{ int i, rval;
char *varnames[MAX_VARS];
memset(varnames,0,MAX_VARS * sizeof(char *)); // Beeson 10.6.02, replacing a for-loop
rval = set_vars_term(t, varnames);
if(!rval)
return 0;
for(i=0;i<MAX_VARS;i++)
{ if(varnames[i] == NULL)
break;
}
*nextvar = i;
if(i == MAX_VARS)
assert(0);
return 0;
} /* set_vars2 */
./otter2/bterms.h 0000644 0002044 0001012 00000001221 11120534563 012173 0 ustar beeson typedef struct term *term;
typedef struct int_ptr *intlist;
#define MAX_BUILTINS 256
#define FUNCTOR(t) (t->sym_num)
#define VARNUM(t) (t->varnum)
#define ARG0(t) (t->farg->argval)
#define ARG1(t) (t->farg->narg->argval)
#define TYPE(t) (t->type)
struct term *True(struct literal *);
struct term *False(struct literal *);
int isFalse(struct term *);
int isTrue(struct term *);
void argrep(term t, int n, term newarg);
term arg(int i, term t);
int arity(term t);
term lambda(term, term);
term cases(term,term,term,term);
term ap(term,term);
term otter_or(term,term);
int set_vars2(struct term *t, int *nextvar);
./otter2/englpem.h 0000644 0002044 0001012 00000000055 11120534563 012332 0 ustar beeson const char * ParserErrorMessage(int err);
./otter2/evalbignum.jnk 0000644 0002044 0001012 00000003540 11120534563 013371 0 ustar beeson // Beeson 10.23.03
// Enable Otter2 to evaluate terms using bignum arithmetic.
// This process goes from strings to strings as Otter does not
// store values of terms.
#include "export.h" // Beeson
#include "bignum.h" // Beeson
#include "header.h" // Otter
#include "heap.h"
#include "heaps.h"
static int heap_ready;
static unit *mem;
int *eval_bignum(char *ret, unsigned N, int opcode, char *s, char *t)
// ans should have space for N decimal digits
// s and t are strings defining integers in decimal representation.
// opcode is one of SUM_SYM, PROD_SYM,DIFF_SYM, DIV_SYM, MOD_SYM.
// perform the operation and put the answer in *ans as a
// string in decimal representation, if it will have at
// most N digits. Return 0 for success, 1 for too long an answer.
{ bignum ans, junk,x,y;
char *r;
if(!heap_ready)
{ mem = (unit *) malloc(256 * sizeof(unit));
if(!mem)
abend("Malloc failed when allocating heap for bignum arithmetic.");
create_heap(0, mem,256);
init_heap(256);
}
if(string_bignum(s,strlen(s),&x))
return NULL;
if(string_bignum(t,strlen(t),&y))
return NULL;
// OK, both successfully converted to bignums
switch (opcode)
{ case SUM_SYM: bigplus(x,y,&ans); break;
case PROD_SYM: bigmult(x,y,&ans); break;
case DIFF_SYM: bigminus(x,y,&ans); break;
case DIV_SYM: bigdivide(x,y,&ans,&junk);
freespace(junk.val);
break;
case MOD_SYM: bigdivide(x,y,&junk,&ans);
freespace(junk.val);
break;
}
r = bignum_string(ans,1);
freespace(ans.val);
freespace(x.val);
freespace(y.val);
if(strlen(r) > N)
return 0; // this will cause an abend after the return
strcpy(ret,r);
return 0;
}
./otter2/export.h 0000644 0002044 0001012 00000007364 11120534563 012236 0 ustar beeson #ifndef __BORLANDC__ // 32-bit Microsoft Visual C code
#define huge
#define EXPORT
#ifdef ALGEBRA_DLL
#define MEXPORT_ALGEBRA __declspec(dllexport)
#else
#define MEXPORT_ALGEBRA __declspec(dllimport)
#endif
#ifdef AUTOMODE_DLL
#define MEXPORT_AUTOMODE __declspec(dllexport)
#else
#define MEXPORT_AUTOMODE __declspec(dllimport)
#endif
#ifdef AUTOTEST_DLL
#define MEXPORT_AUTOTEST __declspec(dllexport)
#else
#define MEXPORT_AUTOTEST __declspec(dllimport)
#endif
#ifdef BIGNUMS_DLL
#define MEXPORT_BIGNUMS __declspec(dllexport)
#else
#define MEXPORT_BIGNUMS __declspec(dllimport)
#endif
#ifdef CGRAPH_DLL
#define MEXPORT_CGRAPH __declspec(dllexport)
#else
#define MEXPORT_CGRAPH __declspec(dllimport)
#endif
#ifdef DEVAL_DLL
#define MEXPORT_DEVAL __declspec(dllexport)
#else
#define MEXPORT_DEVAL __declspec(dllimport)
#endif
#ifdef ENGLISH_DLL
#define MEXPORT_ENGLISH __declspec(dllexport)
#else
#define MEXPORT_ENGLISH __declspec(dllimport)
#endif
#ifdef GETMENU_DLL
#define MEXPORT_GETMENU __declspec(dllexport)
#else
#define MEXPORT_GETMENU __declspec(dllimport)
#endif
#ifdef GETPROB_DLL
#define MEXPORT_GETPROB __declspec(dllexport)
#else
#define MEXPORT_GETPROB __declspec(dllimport)
#endif
#ifdef HEAP_DLL
#define MEXPORT_HEAP __declspec(dllexport)
#else
#define MEXPORT_HEAP __declspec(dllimport)
#endif
#ifdef INTERACT_DLL
#define MEXPORT_INTERACT __declspec(dllexport)
#else
#define MEXPORT_INTERACT __declspec(dllimport)
#endif
#ifdef MSTRING_DLL
#define MEXPORT_MSTRING __declspec(dllexport)
#else
#define MEXPORT_MSTRING __declspec(dllimport)
#endif
#ifdef NATLANG_DLL
#define MEXPORT_NATLANG __declspec(dllexport)
#else
#define MEXPORT_NATLANG __declspec(dllimport)
#endif
#ifdef PARSER_DLL
#define MEXPORT_PARSER __declspec(dllexport)
#else
#define MEXPORT_PARSER __declspec(dllimport)
#endif
#ifdef POLYVAL_DLL
#define MEXPORT_POLYVAL __declspec(dllexport)
#else
#define MEXPORT_POLYVAL __declspec(dllimport)
#endif
#ifdef PROVER_DLL
#define MEXPORT_PROVER __declspec(dllexport)
#else
#define MEXPORT_PROVER __declspec(dllimport)
#endif
#ifdef SAVEDOC_DLL
#define MEXPORT_SAVEDOC __declspec(dllexport)
#else
#define MEXPORT_SAVEDOC __declspec(dllimport)
#endif
#ifdef SYMSOUT_DLL
#define MEXPORT_SYMSOUT __declspec(dllexport)
#else
#define MEXPORT_SYMSOUT __declspec(dllimport)
#endif
#ifdef TMENU_DLL
#define MEXPORT_TMENU __declspec(dllexport)
#else
#define MEXPORT_TMENU __declspec(dllimport)
#endif
#ifdef TRIGCALC_DLL
#define MEXPORT_TRIGCALC __declspec(dllexport)
#else
#define MEXPORT_TRIGCALC __declspec(dllimport)
#endif
#ifdef USERFUNC_DLL
#define MEXPORT_USERFUNC __declspec(dllexport)
#else
#define MEXPORT_USERFUNC __declspec(dllimport)
#endif
#ifdef VAR_DLL
#define MEXPORT_VAR __declspec(dllexport)
#else
#define MEXPORT_VAR __declspec(dllimport)
#endif
#ifdef SERIES_DLL
#define MEXPORT_SERIES __declspec(dllexport)
#else
#define MEXPORT_SERIES __declspec(dllimport)
#endif
#ifdef SPLASH_DLL
#define MEXPORT_SPLASH __declspec(dllexport)
#else
#define MEXPORT_SPLASH __declspec(dllimport)
#endif
#else // 16-bit code for the Borland compiler
#define EXPORT _export
#define MEXPORT_ALGEBRA
#define MEXPORT_AUTOMODE
#define MEXPORT_AUTOTEST
#define MEXPORT_BIGNUMS
#define MEXPORT_CGRAPH
#define MEXPORT_DEVAL
#define MEXPORT_ENGLISH
#define MEXPORT_GETMENU
#define MEXPORT_GETPROB
#define MEXPORT_HEAP
#define MEXPORT_INTERACT
#define MEXPORT_MSTRING
#define MEXPORT_NATLANG
#define MEXPORT_PARSER
#define MEXPORT_POLYVAL
#define MEXPORT_PROVER
#define MEXPORT_SAVEDOC
#define MEXPORT_SYMSOUT
#define MEXPORT_TMENU
#define MEXPORT_TRIGCALC
#define MEXPORT_USERFUNC
#define MEXPORT_VAR
#define MEXPORT_SERIES
#define MEXPORT_SPLASH
#endif
./otter2/externalsimplify.jnk 0000644 0002044 0001012 00000025702 11120534563 014643 0 ustar beeson /* M. Beeson, for the Otter-lambda to MathXpert link */
/* ExternalSimplify takes clauses in string form and passes them to MathXpert for simplification, returning answers also in string form. The input strings are readable
by MathXpert and the output strings are readable by Otter.
*/
/* This same pattern can be followed to link any external program to Otter to
process clauses, changing them into "reduced" equivalent versions of the same clauses.
Since the results are used by Otter in the same way as demodulation, the answers should
be equivalent to the input, rather than just consequences, although if they are merely
consequences, deductions will still be sound, we just might lose some desired conclusions.
If you want to make deductions externally rather than reductions, the architecture
that calls ExternalSimplify should be modified to retain the original clauses too.
*/
/* Last modified 1.17.06
3.20.06 removed superfluous include heaps.h, function.h, printdialog.h, freeptr.h
changed pem to ParserErrorMessage
7.2.06 added init_optable call.
*/
#include <string.h>
#include <stdlib.h>
#include <stdio.h> // fprintf
#include <assert.h>
#define EXTERNALSIMP_DLL
#include "externalsimplify.h"
#include "export.h"
#include "globals.h"
#include "graphstr.h"
#include "document.h"
#include "userfunc.h"
#include "parser.h"
#include "ssolve.h"
#include "activate.h"
#include "cflags.h"
#include "mpmem.h"
#include "prover.h"
#include "mpstring.h"
#include "optable.h"
#include "probtype.h" // SIMPLIFY
#include "mathpertlink.h"
#include "englpem.h" /* ParserErrorMessage */
#include "automode.h" /* init_optable */
static PDOCDATA pProofData;
PDOCDATA GetDocData(void)
{ return pProofData;
}
/*___________________________________________________________*/
static void select_eigenvariable(term t)
/* choose the first non-bound variable in varlist that
occurs in t, and call set_eigenvariable to make it the
eigenvariable. If there's no such variable, just take
the first variable in varlist; if there are no variables
at all, do nothing.
*/
{ term *varlist = get_varlist();
varinf *varinfo = get_varinfo();
int i;
int n = get_nvariables();
for(i=0;i<n;i++)
{ if(varinfo[i].scope != BOUND && contains(t,FUNCTOR(varlist[i])))
{ set_eigenvariable(i);
return;
}
}
/* t is a constant term, so just pick SOME non-bound variable */
for(i=0;i<n;i++)
{ if(varinfo[i].scope != BOUND )
{ set_eigenvariable(i);
return;
}
}
/* the entire clause has no non-bound variables */
if(n > 0)
set_eigenvariable(0); // even if it's bound
// and if there are no variables at all don't do anything.
}
/*___________________________________________________________*/
static char *term_string(term t)
{ int m = mpsize(t);
char *ans = calloc(m+20,sizeof(char)); /* m+1 should be fine, but just in case.. */
mpstring(t,ans,m+1);
return ans;
}
/*___________________________________________________________*/
static int almost_equals(term a, term b)
/* return 1 if one has the form not(a=b)and the other has the form ne(u,v);
return 0 otherwise.
*/
{ if(FUNCTOR(a) == NOT && FUNCTOR(b) == NE)
{ SETFUNCTOR(b,'=',2);
return equals(ARG(0,a),b);
}
if(FUNCTOR(b) == NOT && FUNCTOR(a) == NE)
{ SETFUNCTOR(a,'=',2);
return equals(a,ARG(0,b));
}
return 0;
}
/*___________________________________________________________*/
static term negation(term t)
{ if(FUNCTOR(t) == NOT)
return ARG(0,t);
if(FUNCTOR(t) == NE)
return equation(ARG(0,t),ARG(1,t));
if(FUNCTOR(t) == LE)
return lessthan(ARG(1,t),ARG(0,t));
if(FUNCTOR(t) == '<')
return le(ARG(1,t),ARG(0,t));
if(FUNCTOR(t) == '=')
return ne(ARG(0,t),ARG(1,t));
return not(t);
}
/*___________________________________________________________*/
int MEXPORT_EXTERNALSIMP ExternalSimplify(int nlits, char **atoms, char *signs,
int *nNewLits, char **NewAtoms, char *NewSigns)
/* The first three parameters represent an Otter clause in string form,
namely, the number of literals, an array of strings, one for each atom,
holding a term in string form, terminated by a period, and an array
of the signs of the literals. The entries in the sign array are those
used in Otter: 0 for negation, 1 for positive occurrence.
The last three parameters similarly represent the output, the result of
simplifying the input clause. The number of literals can change; it comes
back in *nNewLits. NewAtoms is an array of strings, each entry of
which contains an atom in string form (must be parseable by Otter), ending
in a period. Newsigns is an array of the signs of those literals.
The dimension of these two output arrays is given by the initial value
of *newLits.
Return 0 if some simplification took place. If not, return 1.
Return -1 if memory for the MathXpert heap can't be found.
Space for the output strings is created using calloc. This function
leaves the MathXpert heaps in the same condition it found them.
*/
{ int i,j,err,k,flag,r;
int next_assumption, save_domain_assumptions;
term *input;
term *output;
char *rest;
term t,q;
int outputsize;
int max_outup = *nNewLits;
int heapsize = 1 << 15; /* in units of 16 bytes, yielding 512 kb total*/
pProofData = (PDOCDATA) malloc(sizeof(DOCDATA));
memset(pProofData,0,sizeof(DOCDATA));
pProofData->currenttopic = _epsilon_delta;
pProofData->docnumber = 1;
// init_optable();
err = init_doc_data(SYMBOLDOC, pProofData);
if(err == 1)
{ printf("init_doc_data failed");
free(pProofData);
return 1;
}
activate(pProofData);
set_polyvalfactorflag(0); // don't content-factor
set_polyvalfactorflag2(0);
set_problemtype(SIMPLIFY);
gensym(1);
input = (term *) calloc(nlits, sizeof(term));
outputsize = 5*nlits + 20;
if (outputsize > max_outup)
outputsize = max_outup;
output = (term *) calloc(outputsize, sizeof(term));
if(!input || !output)
{ fprintf(stderr, "Out of memory in ExternalSimplify\n");
release_doc_data(pProofData);
free(pProofData);
return 1;
}
for(i=0;i<nlits;i++)
{ // parse atoms[i]; negate the result if signs[i] == 0;
// then put this term in input[i];
err = mparse(&t, atoms[i],&rest);
if(err)
{ fprintf(stderr,"Parser error parsing %s\n", atoms[i]);
fprintf(stderr,"Unparsed part is %s\n",rest);
fprintf(stderr,ParserErrorMessage(err));
release_doc_data(pProofData);
free(pProofData);
return 1;
}
if(signs[i] == 0)
t = negation(t);
permcopy(t,&input[i]);
vaux(input[i]);
set_valuepointers(&input[i]);
}
for(i=0;i<nlits;i++)
{ term q = input[i];
if(FUNCTOR(q) == NOT)
q = ARG(0,q);
if(INEQUALITY(FUNCTOR(q))) // includes the case '='
{ check(domain(ARG(0,q)));
check(domain(ARG(1,q)));
}
else
err = check(domain(input[i]));
if(err == 1) // one literal can't be defined
{ // so nothing you could say about it could be true, e.g.
// sqrt(-1) = sqrt(-1) is false
permfree(&input[i]);
permcopy(make_term(FALSEFUNCTOR,0),&input[i]);
}
if(err != 0)
assert(0); // check can only return 2 if problemtype is SOLVE but now it's SIMPLIFY
}
save_domain_assumptions = get_nextassumption();
k=0;
flag = 0; // set when some literal actually simplifies
for(i=0;i<nlits;i++)
{ // assume the negations of all the input[j] for j > i
// and the negations of the output[j] for 0 <= j < k
// then simplify input[i] using lpt
if(k==outputsize)
{ flag = 0; // fail, but don't cause an abend.
fprintf(stdout,"\nSimplification failed: too many literals\n");
goto out;
}
for(j=i+1;j<nlits;j++)
assume(negation(input[j]));
for(j=0;j<k;j++)
{ if(NewSigns[j] == 0)
assume(output[j]);
else
assume(negation(output[j]));
}
next_assumption = get_nextassumption();
select_eigenvariable(input[i]);
t = lpt(input[i]);
if(!equals(t,input[i]) && !almost_equals(t,input[i]))
flag = 1;
if( FUNCTOR(t) == TRUEFUNCTOR)
{ // one literal is TRUE so whole clause is TRUE
NewAtoms[0] = "0=0"; // not 'true', so it will be subsumed in Otter
NewSigns[0] = 1; // 7.5.05
*nNewLits= 1;
release_doc_data(pProofData); // this also destroys the MathXpert heap
free(pProofData);
return 0;
}
if(FUNCTOR(t) == FALSEFUNCTOR)
{ // skip this clause
for(j=save_domain_assumptions;j< get_nextassumption();j++)
permfree(&get_assumptions()[j]);
set_nextassumption(save_domain_assumptions);
continue;
}
if(FUNCTOR(t) == NOT)
{ t = ARG(0,t);
NewSigns[k] = 0;
}
else if(FUNCTOR(t) == NE)
{ t = equation(ARG(0,t),ARG(1,t));
NewSigns[k] = 0;
}
else if(FUNCTOR(t) == OR)
{ for(r=0;r<ARITY(t);r++)
{ q = ARG(r,t);
if(FUNCTOR(q) == NOT)
{ q = ARG(0,q);
NewSigns[k] = 0;
}
else
NewSigns[k] = 1;
NewAtoms[k] = term_string(q);
permcopy(q,&output[k]);
++k;
}
continue;
}
else
NewSigns[k] = 1;
NewAtoms[k] = term_string(t);
permcopy(t,&output[k]);
++k;
for(j=next_assumption; j < get_nextassumption(); j++)
{ // put in the negation of any new assumptions
// but not the domain assumptions or the negations of the other literals
NewSigns[k] = 1;
NewAtoms[k] = term_string(get_assumption(j));
permcopy(get_assumption(j),&output[k]);
++k;
}
set_nextassumption(save_domain_assumptions); // back to where only domains were assumed.
reset_heap(NULL); // assumptions are in perm memory so not on heap
}
/* free the MathXpert document that was created for this call */
release_doc_data(pProofData);
// delete_document(pProofData);
out:
if(!flag)
{ free(input);
free(output);
free(pProofData);
return 1;
}
*nNewLits = k;
free(pProofData); // it was malloc'ed above
free(input);
free(output);
return 0;
}
./otter2/fsubsto.c 0000644 0002044 0001012 00000036467 11120534563 012403 0 ustar beeson /* Author: M. Beeson */
#include <assert.h>
#include "header.h"
#include "beta.h"
#include "bterms.h"
#include "bsym.h"
#include "unify2.h" // forbid
#include "fsubsto.h"
#include "unify.h" // BIND
static struct term *apply2(struct term *t,struct context *c);
/*_________________________________________________________________________________________*/
struct term * fsubst3(struct term *a, struct term *x, struct context * c1, struct term *b, struct context *c2, struct trail **trp)
/* substitute a for (x,c1) in (b,c2). It is assumed that a is a variable that does not
occur in contexts c1 or c2.
If x is not a variable, then substituting a for (x,c1) in b should yield a if
x equals b ; but more generally if x,c1 UNIFIES with b,c2 it should
yield a. Example: substitute z for g(X) in g(Y), should succeed with result z,
recording the substitution X = Y in the context(s) and adding to the trail appropriately.
If x is an unassigned variable, we
call unify. But otherwise we just return a copy of b.
The return value must be a term that makes sense in context c2.
Hence the BIND call at the end.
After this returns, the variable a is going to become a lambda-bound variable, so
the bindings that are made in c2 during fsubst3 should neither bind a, nor bind any
other variable to a term depending on a.
*/
{ term t, w, ans;
struct rel *r,*s;
struct context *d;
if(x->type == COMPLEX || x->type == NAME)
{ if(term_ident2(x,b,0)) // constant terms, equal except for renaming of bound variables
return copy_term(a);
if(c1==c2 && term_ident2(x,b,0))
return copy_term(a);
if(unify(x,c1,b,c2,trp))
return copy_term(a); // this can't bind a or bind to a since a doesn't occur in c1 or c2.
}
if(b->type == COMPLEX)
{ if(BINDER(b->sym_num) && VARNUM(ARG0(b))== VARNUM(a) && c1 == c2)
return copy_term(b); // should never happen since a doesn't occur in c1, c2.
// without that hypothesis, we should rename the bound variable of b first
ans = get_term();
ans->sym_num = b->sym_num;
ans->type = COMPLEX;
s = get_rel();
ans->farg = s;
for(r = b->farg; r; r=r->narg)
{ s->argval = fsubst3(a,x,c1,r->argval,c2,trp);
if(r->narg)
{ s->narg = get_rel();
s = s->narg;
}
}
return ans;
}
if(b->type == NAME)
return copy_term(b);
// now b->type == VARIABLE
if(c2->bound[b->varnum])
return copy_term(b); // do not substitute for a lambda bound variable!
if(x->varnum == b->varnum && c1 == c2)
return copy_term(a); // even if b has a value in c2
t = c2->terms[b->varnum];
d = c2->contexts[b->varnum];
if(!t)
return copy_term(b);
DEREFERENCE(t,d);
w = fsubst3(a,x,c1,t,d,trp);
if(w->type == VARIABLE && w->varnum == a->varnum)
return w; // a->varnum must be a, since it didn't occur in either c1 or c2 to begin with.
if(d == c2)
return w;
/* Originally I was going to create a new variable and BIND it to w.
But that will violate the specification that nothing should be bound in c2
to a term containing a. Instead we must actually carry out the substitutions in d: */
return apply2(w,d);
}
/*__________________________________________________________*/
struct clause *getContainingClause(struct term *t)
// If you can get to a clause by repeatedly taking t->occ.rel->argof
// until this is NULL and then t->occ.lit->container, return that clause.
// If not (which will happen e.g. it t is TRUE or FALSE) return NULL.
{ struct term *p = t;
while(p->occ.rel && p->occ.rel->argof &&
(p->type == VARIABLE || p->varnum == 0)
)
p=p->occ.rel->argof;
if(p->occ.lit == NULL)
return NULL;
return p->occ.lit->container;
}
/*__________________________________________________________*/
static struct term *getContainingAtom(struct term *t)
{ struct term *p = t;
while(p->occ.rel && p->occ.rel->argof &&
(p->type == VARIABLE || p->varnum == 0)
)
p=p->occ.rel->argof;
return p;
}
/*__________________________________________________________*/
void prepare_context(struct term *t1, struct context *c1, int max)
/* set the forbid and next_var fields in c1 and c2 so that all bound variables in t1 are
marked bound in c1, and all bound variables in t2 are marked bound in c2, and
next_var exceeds all varnums in t1 and also is at least max.
*/
{ struct clause *cl1 = getContainingClause(t1);
struct literal *lit;
memset(c1->forbidden,0,MAX_VARS *sizeof(int));
memset(c1->bound,0,MAX_VARS *sizeof(int));
for(lit = cl1->first_lit; lit; lit = lit->next_lit)
forbid_bound(c1,lit->atom);
c1->next_var = max_vars(cl1,t1);
if(c1->next_var < max)
c1->next_var = max;
}
/*_______________________________________________________*/
//static // temporarily exposed for debugging
int check_lambda(struct term *t)
/* return 0 if t has a subterm of the form lambda(s,.. where s is not a variable.
Otherwise return 1. */
{ struct rel *r;
if(t->type != COMPLEX)
return 1;
if(FUNCTOR(t)== LAMBDA && ARG0(t)->type != VARIABLE)
return 0;
for(r=t->farg;r;r=r->narg)
{ if(!check_lambda(r->argval))
return 0;
}
return 1;
}
/*_______________________________________________________*/
int check_lambdas(struct clause *c)
/* return 0 if there are any terms lambda(s,.. where s is not a variable.
Before returning, free the clause, its literals, and all their terms.
If there are no such illegal lambda-terms, return 1.
*/
{ struct literal *q, *p = NULL;
for(q = c->first_lit;q;q=q->next_lit)
{ if( !check_lambda(q->atom))
goto fail;
}
return 1;
fail:
for(q = c->first_lit;q;q=q->next_lit)
{ free_term(q->atom);
if(p) free_literal(p);
p = q;
}
free_literal(p);
free_clause(c);
return 0;
}
/*_________________________________________________________________________*/
int blocking_functor(int f)
/* return 1 if f is the sym_num of "ind", "ind1", "ind2", ..."ind5",
or of none of those have sym_nums, of "g" or "e" Return 0 otherwise.
Arity of these functors could be 1 or 2 depending on the formulation
of induction.
*/
{
static int g[5]; // space for the induction functors
static int k; // number of induction functors
struct sym_ent *se;
int j;
char buffer[5];
if(k == -1) // no induction functors, already checked
return 0;
if(k==0)
{ // first call; get the induction functors
se = sym_tab_member("ind", 2);
if(se)
{ g[k] = se->sym_num;
++k;
}
se = sym_tab_member("ind",1);
if(se)
{ g[k] = se->sym_num;
++k;
}
strcpy(buffer,"ind");
buffer[4] = 0;
for(j=0;j<4;j++)
{ buffer[3] = '1' + j;
se = sym_tab_member(buffer,2);
if(se)
{ g[k] = se->sym_num;
++k;
}
se = sym_tab_member(buffer,1);
if(se)
{ g[k] = se->sym_num;
++k;
}
}
if(k==0)
{ se = sym_tab_member("g",2);
if(se)
{ g[k] = se->sym_num;
++k;
}
se = sym_tab_member("g",1);
if(se)
{ g[k] = se->sym_num;
++k;
}
se = sym_tab_member("e",1); // used for Hilbert's epsilon symbol
if(se)
{ g[k] = se->sym_num;
++k;
}
}
if(k==0)
{ k = -1;
return 0;
}
}
for(j=0;j<k;j++)
if(g[j] == f)
return 1;
return 0;
}
/*_________________________________________________________________________*/
static struct term * fsubst6(struct term *a,struct term *x, struct context * c1, struct term *b, struct context *c2, struct trail **trp, int mask, int first, int *last)
/* Presumes that x is a constant or Skolem term (in induction proofs)
and that a is a variable that does not
occur in contexts c1 or c2. Substitute a for occurrences of x in b that are not
subterms of a term with an "induction functor" g, AND are not subterms of any
lambda term. Presumes that INDUCTION_FLAG
is set, and it looks for a function symbol (of arity 2) "ind" or "induction", or failing that,
"g".
Like fsubst3, this must return a term that makes sense in
context c2.
The parameter mask is used when backtracking is desired. A value of 1 for mask
indicates no backtracking; just substitute for all occurrences of x in b. But if mask
is nonzero, then number the occurrences of x in b and substitute for those whose
numbers match the bits of mask. For example, if mask is (in binary) 001001, and there
are six occurrences of x, substitute for the third and sixth occurrences.
First and *last are used to count the occurrences of x that have been checked.
*/
{ term t, w, ans;
struct rel *r,*s;
struct context *d;
int next;
*last = first;
if(term_ident2(x,b,0))
{ *last = first + 1;
if( (1 << first) & mask )
return copy_term(a);
else
return copy_term(b);
}
if(x->type == VARIABLE && unify(x,c1,b,c2,trp))
{ *last = first+1;
if( (1 << first) & mask)
return copy_term(a);
else
return copy_term(b);
}
if(b->type == NAME)
return copy_term(b);
if(b->type == COMPLEX)
{ if(BINDER(b->sym_num) && VARNUM(ARG0(b))== VARNUM(a) && c1 == c2)
return copy_term(b); // should never happen since a doesn't occur in c1, c2.
if(blocking_functor(b->sym_num))
return copy_term(b); // per the specs
ans = get_term();
ans->sym_num = b->sym_num;
ans->type = COMPLEX;
s = get_rel();
ans->farg = s;
r = b->farg;
for(r = b->farg; r; r=r->narg)
{ s->argval = fsubst6(a,x,c1,r->argval,c2,trp,mask,first,&next);
first = next;
if(r->narg)
{ s->narg = get_rel();
s = s->narg;
}
}
*last = next;
return ans;
}
// now b->type == VARIABLE
t = c2->terms[b->varnum];
if(c2->bound[b->varnum])
return copy_term(b); // added 6.26.05
if(!t)
{ if(x->varnum == b->varnum)
{ *last = 1 + first;
if( (1 << first) & mask)
return copy_term(a);
return copy_term(b);
}
}
d = c2->contexts[b->varnum];
w = fsubst6(a,x,c1,t,d,trp,mask,first,last);
BIND(a->varnum,c1,w,c2,trp);
return copy_term(a);
}
/*_________________________________________________________________________*/
struct term * fsubst5(struct term *a,struct term *x, struct context * c1, struct term *b, struct context *c2, struct trail **trp, int mask)
/* Presumes that x is a constant or Skolem term (in induction proofs)
and that a is a variable that does not
occur in contexts c1 or c2. Substitute a for occurrences of x in b that are not
subterms of a term with an "induction functor" g, AND are not subterms of any
lambda term. Presumes that INDUCTION_FLAG
is set, and it looks for a function symbol (of arity 2) "ind" or "induction", or failing that,
"g".
Like fsubst3, this must return a term that makes sense in
context c2.
The parameter mask is used when backtracking is desired. A value of 1 for mask
indicates no backtracking; just substitute for all occurrences of x in b. But if mask
is nonzero, then number the occurrences of x in b and substitute for those whose
numbers match the bits of mask. For example, if mask is (in binary) 001001, and there
are six occurrences of x, substitute for the third and sixth occurrences.
*/
{ term t, w, ans;
struct rel *r,*s;
struct context *d;
int last;
if(Parms[MAX_UNIFIERS].val != 1)
return fsubst6(a,x,c1,b,c2, trp, mask,0,&last);
if(term_ident2(x,b,0))
return copy_term(a);
if(x->type == VARIABLE && unify(x,c1,b,c2,trp))
return copy_term(a);
if(b->type == NAME)
return copy_term(b);
if(b->type == COMPLEX)
{ if(BINDER(b->sym_num) && VARNUM(ARG0(b))== VARNUM(a) && c1 == c2)
return copy_term(b); // should never happen since a doesn't occur in c1, c2.
if(blocking_functor(b->sym_num))
return copy_term(b); // per the specs
ans = get_term();
ans->sym_num = b->sym_num;
ans->type = COMPLEX;
s = get_rel();
ans->farg = s;
r = b->farg;
for(r = b->farg; r; r=r->narg)
{ s->argval = fsubst5(a,x,c1,r->argval,c2,trp,mask);
if(r->narg)
{ s->narg = get_rel();
s = s->narg;
}
}
return ans;
}
// now b->type == VARIABLE
t = c2->terms[b->varnum];
if(c2->bound[b->varnum])
return copy_term(b); // added 6.26.05
if(!t)
{ if(x->varnum == b->varnum)
return copy_term(a);
return copy_term(b);
}
d = c2->contexts[b->varnum];
w = fsubst5(a,x,c1,t,d,trp,mask);
BIND(a->varnum,c1,w,c2,trp);
return copy_term(a);
}
/*_______________________________________________________*/
static struct term *apply2(struct term *t,
struct context *c)
/* Like McCune's apply, but keeps varnums below MAX_VARS, using next_var */
{
/* dereference if variable */
/* A NULL context means that the subst was generated by match. */
/* If the context is NULL, then apply just copies the term. */
while (t->type == VARIABLE && c != NULL && c->terms[t->varnum] != NULL) {
int vn = t->varnum;
t = c->terms[vn];
c = c->contexts[vn];
}
if (t->type == VARIABLE) { /* unbound variable */
struct term *t2 = get_term();
t2->type = VARIABLE;
if (c == NULL)
t2->varnum = t->varnum;
else
{ t2->varnum = c->next_var; // here's where apply2 differs from apply
++c->next_var;
if(c->next_var == MAX_VARS)
abend("Too many variables.");
}
return t2;
}
else if (t->type == NAME) { /* name */
struct term *t2 = get_term();
t2->type = NAME;
t2->sym_num = t->sym_num;
return t2;
}
else { /* complex term */
struct rel *r1, *r2, *r3;
struct term *t2;
int vv;
struct term *saveit;
if(Flags[LAMBDA_FLAG].val && BINDER(t->sym_num))
{ vv = t->farg->argval->varnum;
saveit = c->terms[vv];
c->terms[vv] = NULL;
}
t2 = get_term();
t2->type = COMPLEX;
t2->sym_num = t->sym_num;
r3 = NULL;
r1 = t->farg;
while (r1 != NULL ) {
r2 = get_rel();
if (r3 == NULL)
t2->farg = r2;
else
r3->narg = r2;
r2->argval = apply2(r1->argval, c);
r3 = r2;
r1 = r1->narg;
}
if(Flags[LAMBDA_FLAG].val && BINDER(t->sym_num)) // Beeson
c->terms[vv] = saveit; // Beeson
return t2;
}
} /* apply2 */
./otter2/fsubsto.h 0000644 0002044 0001012 00000000766 11120534563 012401 0 ustar beeson struct term * fsubst3(struct term *a, struct term *x, struct context *c1, struct term *b, struct context *c2, struct trail **trp);
// substitute a for x in b, using context c, renaming bound variables in c if necessary
struct term * fsubst5(struct term *a, struct term *x, struct context * c1, struct term *b, struct context *c2, struct trail **trp, int mask);
// substitute a for constant x in b, skipping terms occuring inside induction-functor symbols
int blocking_functor(int f);
./otter2/getconstant.c 0000644 0002044 0001012 00000024255 11120534563 013237 0 ustar beeson /* M. Beeson, for Otter-lambda */
/* Extracted from unify2.c, 6.3.04 */
/* 6.30.04 modified get_constant_aux to not return an is_number term.
7.1.04 when getConstant calls getConstants, the last parameter should be 'flag'
7.1.04 if(flag.. should be if(flag > 0.. at line 196
12.4.05 added depth parameter to getConstants and wrote constant_term.
12.5.05 modified constant_term
3.20.06 made include filenames lowercase
*/
#include <assert.h>
#include <ctype.h> // isdigit
#include "header.h"
#include "unify.h" /* BIND and DEREFERENCE */
#include "bterms.h"
#include "bsym.h"
#include "beta.h"
#include "unify2.h"
#include "proto.h" // occur_check
#include "fsubsto.h"
#include "getconstant.h"
//#define DIAGNOSTICS
static int is_number(struct term *t);
static struct term_ptr *getConstants(struct term *t, int flag, int depth);
/*_______________________________________________________________________________*/
static int NatNum(int parent, int argNumber, int s)
/* s is the sym_num of some constant, occurring as the argNumber'th argument
of a term with sym_num parent. Check the types list, if it is non-NULL, and
return 1 if this constant has type NatNum, 0 if not. If the types list is NULL,
check if the name of this constant begins with n,m,k,i, or j, and return 1
if it does, and 0 if it doesn't.
*/
{ /* for now the types list isn't implemented, so we only do the second thing. */
char *p = sn_to_str(s);
if(!p)
assert(0);
return strchr("nmkijNMKIJ",p[0]) ? 1 : 0;
}
/*_______________________________________________________________________________*/
static struct term *getConstant_aux(int parent, int argNumber, struct term * t, int intflag)
/* return a constant term contained in t. If intflag is 1,
it must be an integer term; if it's 2, it must be a blocking-functor term;
if it's zero, any constant will do. If no such constant exists in t, return NULL.
Parent is the sym_num of the parent of t, which is needed to consult the types
list. t occurs in the parent term as the argNumber'th arg.
*/
{
struct rel *r;
struct term *ans;
int k;
if(t->type == NAME && intflag != 2 && !is_number(t))
{ if(intflag==1)
return NatNum(parent, argNumber, t->sym_num) ? t : NULL;
else
return t;
}
if(blocking_functor(t->sym_num))
return intflag == 2 ? t : NULL;
for(r=t->farg, k = 0;r;r=r->narg, ++k)
{ ans = getConstant_aux(t->sym_num,k,r->argval,intflag);
if(ans)
return ans;
}
return NULL;
}
/*_______________________________________________________________________________*/
struct term *getConstant(struct term * t)
/* return a constant (or constant term) contained in t. If INDUCTION_FLAG is set,
an integer constant is returned if there is one; otherwise (i.e.
if INDUCTION_FLAG is not set, or there is no integer constant), any constant will do.
If no such constant exists in t, return a blocking-functor Skolem term if there is one.
Otherwise, return NULL.
*/
{ struct term *trythis = NULL;
int i,flag;
struct term_ptr *left=NULL, *right=NULL,*p, *q;
if(t->type == NAME)
return t; // ideally this should only be done if t has the same type as
// the desired ground type of Ap.
if(! strcmp(sn_to_str(t->sym_num),"="))
{ /* Now t is an equation, so we prefer a constant that appears on both sides */
if(Flags[INDUCTION_FLAG].val == 0)
return getConstant_aux(0,0,t,0);
for(flag = Flags[INDUCTION_FLAG].val; flag >= -1; flag--)
{ /* when INDUCTION_FLAG is set, first try for an integer constant,
then any constant (name), then a blocking functor term. The
flag-controlled loop tries these three. In each case take
the rightmost constant on the left that occurs on both sides,
if there is one that occurs on both sides.
*/
left = getConstants(ARG0(t),flag,1);
right = getConstants(ARG1(t),flag,1);
#ifdef DIAGNOSTICS
fprintf(stdout,"in getConstant, left = "); // DEBUG
for(p = left;p;p=p->next) print_term_nl(stdout,p->term);// DEBUG
fprintf(stdout,"right = ");// DEBUG
for(p = right;p;p=p->next) print_term_nl(stdout,p->term);// DEBUG
#endif
for(p=left;p;p=p->next)
{ trythis = p->term;
// is trythis in the list right?
for(q = right;q;q=q->next)
{ if(term_ident2(trythis,q->term,0))
goto out;
}
}
// No good constant on both sides.
// free left and right
for(i=0;i<2;i++)
{ p = i ? right : left;
while (p)
{ q = p;
p = p->next;
free_term_ptr(q);
}
}
}
for(flag = Flags[INDUCTION_FLAG].val; flag >= -1; flag--)
{ /* sometimes we want a constant that only occurs on one side.
*/
if(t->occ.lit->sign)
{
left = getConstants(ARG0(t),flag,0);
right = getConstants(ARG1(t),flag,0);
#ifdef DIAGNOSTICS
fprintf(stdout,"in getConstant, left = "); // DEBUG
for(p = left;p;p=p->next) print_term_nl(stdout,p->term);// DEBUG
fprintf(stdout,"right = ");// DEBUG
for(p = right;p;p=p->next) print_term_nl(stdout,p->term);// DEBUG
#endif
if(left)
{ trythis = left->term;
goto out;
}
if(right)
{ trythis = right->term;
goto out;
}
// free left and right
for(i=0;i<2;i++)
{ p = i ? right : left;
while (p)
{ q = p;
p = p->next;
free_term_ptr(q);
}
}
}
}
return NULL; // failure, no good constant anywhere in sight.
}
// Now, t is not an equation, so it's not required to have the constant on both sides.
// Plenty of inequalities are proved by induction using a variable on one side only.
// Also inequations p!=q are proved that way, and unify can be called with '=' when
// we put in a negative form of the induction axioms as in file le2.in
trythis = getConstant_aux(0,0,t,1);
if(trythis)
goto out;
trythis = getConstant_aux(0,0,t,0);
if(trythis)
goto out;
trythis = getConstant_aux(0,0,t,2);
out:
// free left and right
for(i=0;i<2;i++)
{ p = i ? right : left;
while (p)
{ q = p;
p = p->next;
free_term_ptr(q);
}
}
return trythis;
}
/*_______________________________________________________________________________*/
static int is_number(struct term *t)
// return 1 if t's name is a character string composed of digits only.
// return 0 otherwise
{ char *p = sn_to_str(t->sym_num);
for(; *p;p++)
{ if(!isdigit(*p))
return 0;
}
return 1;
}
/*_______________________________________________________________________________*/
static int constant_term(struct term *t)
/* return 1 if t is a constant term, including terms satisfying blocking_functor,
which may contain lambda-bound variables.
Return 0 otherwise. */
{ struct rel *r;
if(t->type == VARIABLE)
return 0;
if(t->type == NAME)
return 1;
if(blocking_functor(t->sym_num))
return 1;
for(r=t->farg;r;r=r->narg)
{ if(! constant_term(r->argval))
return 0;
}
return 1;
}
/*_______________________________________________________________________________*/
static struct term_ptr *getConstants(struct term *t, int flag, int depth)
/* If flag == 0, return a list of all constants (names) or constant terms in t,
in order encountered from right to left, up to depth d. (Names have depth 0).
But don't count "0", "1", etc. as names, and don't go into
blocking-functor terms, i.e. skip constants occurring in blocking functor-terms.
But DO count Hilbert epsilon-symbol terms, i.e. with functor e.
If flag == 1, return a list of all constants (names) that satisfy Natnum in t,
in the order encountered from right to left, not counting "0", "1", etc., but skip
blocking-functor terms as before.
If flag = -1, include blocking-functor terms as well as names.
*/
{ struct rel *r;
int argnum;
struct sym_ent *se;
struct term_ptr *p, *marker, *ans;
if(t->type == VARIABLE)
return NULL;
if(t->type == NAME)
{ if(is_number(t))
return NULL;
p = get_term_ptr();
p-> term = t;
p->next = NULL;
return p;
}
// now t->type == COMPLEX
if(blocking_functor(t->sym_num))
{ if(flag == 0 &&
(se = sym_tab_member("e",1)) != NULL &&
(unsigned short) se->sym_num == t->sym_num
)
{ p = get_term_ptr();
p -> term = t;
p -> next = NULL;
return p;
}
if(flag != -1)
return NULL;
p = get_term_ptr();
p -> term = t;
p -> next = NULL;
return p;
}
ans = NULL;
for(r=t->farg,argnum=0;r; r=r->narg,++argnum)
{ if(flag > 0 && r->argval->type==NAME && !NatNum(t->sym_num,argnum,r->argval->sym_num))
continue;
p = getConstants(r->argval,flag,depth);
if(p == NULL)
continue;
marker = p;
while(marker->next)
marker = marker->next;
marker->next = ans;
ans = p;
}
if(constant_term(t))
{ int w = weight(t,Weight_pick_given_index);
if(w <= depth + 1 )
{ p = get_term_ptr();
p -> term = t;
p->next = ans;
ans = p;
}
}
return ans;
}
./otter2/getconstant.h 0000644 0002044 0001012 00000000055 11120534563 013234 0 ustar beeson struct term *getConstant(struct term * t);
./otter2/is2.c 0000644 0002044 0001012 00000020145 11120534563 011375 0 ustar beeson /* M. Beeson, 4.27.04
retrieval from an is_tree of subsuming terms.
This function, based on McCune's is_retrieve, has been written
for Otter-lambda so that it properly handles the complications
resulting from the fact that the scope of lambda-bound variables
is only the lambda term that contains them, rather than the whole
clause. The changes are quite extensive and tricky.
3.27.06 made two dated changes that prevented segmentation faults on Unix
*/
#include <assert.h>
#include "header.h"
#include "is2.h"
#include "beta.h" // for Beeson's BINDER macro
#include "bsym.h" // LAMBDA
// #define DIAGNOSTICS // for debug printout
struct term_ptr *is_retrieve2(struct term *t,
struct context *subst,
struct is_tree *is,
struct is_pos **is_pos)
{
struct rel *rel_stack[MAX_FS_TERM_DEPTH];
struct is_tree *i1 = NULL;
struct is_pos *pos, *ip2;
int found, backup, varnum, j, reset, sym;
int top = 0;
int lflag=0;
int varstack2[MAX_FS_TERM_DEPTH];
int varstack3[MAX_FS_TERM_DEPTH];
int varstack_top=0;
#ifdef DIAGNOSTICS
if(t == NULL)
fprintf(stdout,"Coming back to is_retrieve for more\n");
else
fprintf(stdout,"Entering is_retrieve with :");print_term_nl(stdout, t); // DEBUG
#endif
if (t != NULL) { /* first call */
pos = NULL;
top = -1;
i1 = is->u.kids;
backup = 0;
}
else if (*is_pos != NULL) { /* continuation with more to try */
pos = *is_pos; /* must remember to set is_pos on return */
backup = 1;
}
else /* continuation with nothing more to try */
return(NULL);
while (1) { /* loop until a leaf is found or done with tree */
if (backup) {
if (pos == NULL)
return(NULL);
else { /* pop top of stack (most recent variable node)
and restore state */
// we may have been inside one more more lambda terms when backtracking occurred.
// In that case some of the values of 'top-1' stored on varstack3
// are between the present value of top-1 and the new value pos->stack_pos-1.
// On the other hand we may be backtracking INTO a lambda term that we had
// already passed through.
while(varstack_top > 0 && // Beeson 3.27.06
varstack3[varstack_top-1] <= top-1 &&
varstack3[varstack_top-1] >= pos->stack_pos-1
)
{ // just finished last arg of a lambda term
int vn = varstack2[varstack_top-1]; // Beeson 4.25.04
subst->terms[vn] = NULL;
varstack_top--;
#ifdef DIAGNOSTICS
printf("Leaving lambda term\n"); // DEBUG
fprintf(stdout,"Resetting variable %d\n to NULL",vn); // DEBUG
#endif
}
top = pos->stack_pos;
for (j = 0; j <= top; j++)
rel_stack[j] = pos->rel_stack[j];
memcpy(subst->terms,pos->varvals,MAX_VARS*sizeof(struct term *));
i1 = pos->is;
t = subst->terms[i1->lab];
if ( pos->reset) /* undo variable binding */
{ subst->terms[i1->lab] = NULL;
#ifdef DIAGNOSTICS
fprintf(stdout, "Unbinding %d \n", i1->lab);
#endif
}
i1 = i1->next;
ip2 = pos;
pos = pos->next;
free_is_pos(ip2);
}
}
/* at this point, i1 is the next node to try */
found = 0;
/* first try to match input term t with a variable node */
while (found == 0 && i1 != NULL && i1->type == VARIABLE) {
varnum = i1->lab;
if (subst->terms[varnum] == NULL || lflag)
{ /* if not bound, bind it; also if it's a lambda-variable that was bound, bind it anew */
subst->terms[varnum] = t;
subst->contexts[varnum] = NULL;
#ifdef DIAGNOSTICS
fprintf(stdout,"Binding %d to ",varnum); print_term_nl(stdout,t); // DEBUG
fprintf(stdout,"varstack_top = %d and top = %d\n", varstack_top, top);
#endif
found = 1;
reset = 1;
if(lflag)
{ lflag = 0;
#ifdef DIAGNOSTICS
fprintf(stdout,"Setting lflag to 0\n");
fprintf(stdout, "storing variable %d in varstack2[%d]\n", varnum, varstack_top-1);
#endif
varstack2[varstack_top-1] = varnum; // the variable being bound to lambda term
if(t->type != VARIABLE)
assert(0);
}
}
else { /* bound variable, succeed iff identical */
/* that is, identical up to renaming lambda-bound variables!--Beeson */
found = term_ident(subst->terms[varnum], t);
reset = 0;
}
if (found) { /* save state */
ip2 = get_is_pos();
ip2->next = pos;
pos = ip2;
pos->is = i1;
pos->reset = reset;
for (j = 0; j <= top; j++)
pos->rel_stack[j] = rel_stack[j];
memcpy(pos->varvals,subst,MAX_VARS*sizeof(struct term *));
pos->stack_pos = top;
}
else /* try next variable */
i1 = i1->next;
}
backup = 0;
if (found == 0) { /* couldn't match t with (another) variable */
if (t->type == VARIABLE)
backup = 1; /* because we can't instantiate given term */
else { /* NAME or COMPLEX */
sym = t->sym_num;
while (i1 != NULL && (int) i1->lab < sym)
i1 = i1->next;
if (i1 == NULL || i1->lab != sym)
backup = 1;
else if (t->type == COMPLEX && t->sym_num != Ignore_sym_num) {
top++;
if (top >= MAX_FS_TERM_DEPTH)
abend("is_retrieve, increase MAX_FS_TERM_DEPTH.");
rel_stack[top] = t->farg; /* save pointer to subterms */
#ifdef DIAGNOSTICS
fprintf(stdout,"Pushing "); print_term_nl(stdout,t->farg->argval); // DEBUG
fprintf(stdout,"Now t is "); print_term_nl(stdout,t); // DEBUG
#endif
if(BINDER(t->sym_num))
{
int vn = t->farg->argval->varnum; // the lambda variable
varstack3[varstack_top] = top-1; // where the list of args of the lambda term is stored
#ifdef DIAGNOSTICS
fprintf(stdout, "Setting varstack3[%d] = %d", varstack_top, top-1);
#endif
++varstack_top;
lflag = 1; // used when we go to bind the lambda-variable.
#ifdef DIAGNOSTICS
fprintf(stdout,"Setting lflag to 1\n");
fprintf(stdout, "Entering lambda term\n"); // DEBUG
#endif
}
}
}
}
if (backup == 0) { /* get next term from rel_stack */
while (top >= 0 && rel_stack[top] == NULL)
{ if(varstack_top > 0 && // Beeson 3.27.06
varstack3[varstack_top-1] == top - 1) // Beeson 4.2.04
{ // just finished last arg of a lambda term
int vn = varstack2[varstack_top-1]; // Beeson 4.2.04
#ifdef DIAGNOSTICS
printf("Leaving lambda term\n"); // DEBUG
fprintf(stdout,"Resetting variable %d to NULL ",vn); // DEBUG
#endif
subst->terms[vn] = NULL;
varstack_top--; // Beeson 4.2.04
} // Beeson 4.2.04
top--;
} // Beeson 4.2.04
if (top == -1) { /* found a term */
*is_pos = pos;
return(i1->u.terms);
}
else { /* pop a term and continue */
t = rel_stack[top]->argval;
#ifdef DIAGNOSTICS
fprintf(stdout,"just popped "), print_term_nl(stdout,t); // DEBUG
#endif
rel_stack[top] = rel_stack[top]->narg;
i1 = i1->u.kids;
}
}
} /* end of while(1) loop */
} /* is_retrieve2 */
./otter2/is2.h 0000644 0002044 0001012 00000000216 11120534563 011377 0 ustar beeson struct term_ptr *is_retrieve2(struct term *t,
struct context *subst,
struct is_tree *is,
struct is_pos **is_pos);
./otter2/mathpertlink.h 0000644 0002044 0001012 00000000413 11120534563 013403 0 ustar beeson int init_doc_data(int kind, PDOCDATA pdata);
void activate( PDOCDATA pdoc);
#define _epsilon_delta 200
#define CM_TRACE 22330
#define EPSILON_DELTA 428 /* totally arbitrary */
int mparse(term *t, char *in, char **rest);
void release_doc_data(PDOCDATA pdata);
./otter2/mathpertlink.jnk 0000644 0002044 0001012 00000030766 11120534563 013754 0 ustar beeson /* 1.17.06 removed calls to SetFontSize and all mention of display_control so
this can be compiled without symsout.dll.
3.20.06 made include files lowercase and removed a superfluous include.
*/
#ifdef __WIN32
#define EXTERNALSIMP_DLL
#endif
#include <malloc.h>
#include <assert.h>
#include <string.h>
#include "export.h"
#include "globals.h"
#include "graphstr.h"
#include "document.h"
#include "userfunc.h"
#include "parser.h"
#include "heaps.h"
#include "ssolve.h"
#include "activate.h"
#include "cflags.h"
#include "mpmem.h"
#include "mathpertlink.h"
static parser_control parser_flags = { 2, /* separator, see display.c */
'.', /* decimalchar */
0, /* unwritten_mult */
1, /* complex */
2, /* long identifiers not allowed */
0, /* letflag */
"fFgGhH "
};
/* remaining fields have to be dynamically initialized */
int mparse(term *t, char *in, char **rest)
{ return bparse(&parser_flags,t,in,rest);
}
/*___________________________________________________________*/
static int nextdocument = 1; /* next document will get this number */
static int ndocuments; /* total number of open documents */
/* you might have documents 1,3,9 open for example, then
ndocuments is 3 and nextdocument is 2 */
typedef struct
{ unsigned long hwnd;
int docnumber;
} docstruct;
static docstruct documents[MAXDOCUMENTS];
/*________________________________________________*/
static void add_document(unsigned long hwnd)
/* adjust the documents array, and the variables ndocuments and
nextdocument. Presumes that ndocuments < MAXDOCUMENTS so that there
is room to add a new document. */
{ int i,j;
if(ndocuments >= MAXDOCUMENTS)
assert(0);
/* Now insert nextdocument into the documents array in the right
place to maintain sorted order. */
for(i=0;i<=ndocuments;i++)
{ if(documents[i].docnumber > nextdocument)
break;
}
if(i==ndocuments+1)
/* nextdocument is larger than all in-use document numbers,
so it goes at the end */
{ documents[ndocuments].docnumber = nextdocument;
documents[ndocuments].hwnd = (unsigned long) hwnd;
}
else /* nextdocument comes just before documents[i]. So we
move documents[i] and all subsequent entries down
one in the documents array and put nextdocument in at
documents[i] */
{ for(j=ndocuments-1;j >= i; j--)
documents[j+1] = documents[j];
documents[i].docnumber = nextdocument;
documents[i].hwnd = (unsigned long) hwnd;
}
++ndocuments;
/* Now set the new value of nextdocument */
/* It should be the least positive integer not in the array documents */
for(i=1;i<=MAXDOCUMENTS;i++)
{ /* is i in the documents array? */
for(j=0;j<ndocuments;j++)
{ if(documents[j].docnumber == i)
break;
if(documents[j].docnumber > i)
{ /* i is the answer, since documents is in sorted order */
nextdocument = i;
return;
}
}
if(j < ndocuments)
continue;
/* i was larger than all elements of the documents array */
nextdocument = i;
return;
}
}
/*______________________________________________________________________*/
static void delete_document(int k)
/* remove document number k, adjusting nextdocument and the
documents array and decrementing ndocuments */
{ int i,j;
for(i=0;i<ndocuments;i++)
{ if(documents[i].docnumber == k)
break;
}
assert(i < ndocuments);
if(k < nextdocument)
nextdocument = k;
/* Next compact the documents array to fill the gap */
for(j=i;j<ndocuments-1;j++)
documents[j] = documents[j+1];
documents[ndocuments-1].docnumber = 0; // 7.14.2004
documents[ndocuments-1].hwnd = 0; // 7.14.2004
--ndocuments;
}
/*___________________________________________________________________*/
static int allocate_doc_data(PSYMBOLDATA pdata)
/* initialize the data required for a document */
/* Do NOT assume the document is active */
/* When this is called, mainchoice and problemtype have
already been initialized, and must get stored in the
document data structure. */
/* allocate the document's heap */
/* allocate the following fields of the document structure:
varlist, varinfo, model, assumptions, defns, parameters,
history, permspace, permhistory. Memory for these structures is
allocated on the Windows global heap, where it can be
realloc'd if necessary so that in essence these arrays have
no fixed dimension.
Does not allocate 'graphs' (which is an array of fixed
dimension MAXGRAPHS) and does not allocate the graph
structures in that array either (setupdata does that).
Return 0 for success,
1 for too many documents already,
2 for not enough memory to allocate the heap or other structures
*/
{ int err;
unsigned long heapsize_in_bytes;
pdata->docnumber = nextdocument;
/* adjust ndocuments and nextdocument and the documents array */
add_document(0); /* it hasn't got a window handle yet */
pdata->DocVarData.maxvariables = 32;
pdata->DocVarData.nvariables = 0;
pdata->DocVarData.eigenvariable = 0;
pdata->DocVarData.maxparameters = MAXPARAMS;
pdata->DocVarData.nparameters = 0;
pdata->DocVarData.maxdefns = 32;
pdata->DocVarData.nextdefn = 0;
pdata->DocProverData.solver = ssolve;
pdata->DocProverData.maxassumptions = 64;
pdata->DocProverData.nextassumption = 0;
pdata->DocProverData.maxtheorems = 10;
pdata->DocProverData.nexttheorem = 0;
pdata->DocProverData.maxhistory = 512;
pdata->DocProverData.maxworkspace = 0xffffU; /* almost 64 K, but in longs, so = 256K bytes */
pdata->DocProverData.nextworkspace = 0;
pdata->ngraphs = 0; /* in the the case of a graph document,
setupdata will change this. */
pdata->heapsize = (2 << 15); /* in units, yielding a one-megabyte = 2L << 18 heap */
heapsize_in_bytes = (((unsigned long) (pdata->heapsize)) << 4);
pdata->heap = (unit *) malloc(heapsize_in_bytes);
if(pdata->heap==NULL)
{ pdata->heapsize =0;
return 2;
}
err = create_heap(pdata->docnumber,pdata->heap,pdata->heapsize);
if(err)
return err;
pdata->DocVarData.varlist = (term *) malloc(pdata->DocVarData.maxvariables * sizeof(term));
if(pdata->DocVarData.varlist == NULL)
return 2;
pdata->DocVarData.varinfo = (varinf *) malloc(pdata->DocVarData.maxvariables * sizeof(varinf));
if(pdata->DocVarData.varinfo == NULL)
return 2;
pdata->DocVarData.parameters = (parameter *) malloc(pdata->DocVarData.maxparameters * sizeof(parameter));
if(pdata->DocVarData.parameters == NULL)
return 2;
pdata->DocVarData.defns = (defn *) malloc(pdata->DocVarData.maxdefns * sizeof(defn));
if(pdata->DocVarData.defns == NULL)
return 2;
pdata->DocProverData.assumptions = (assumption **) malloc(pdata->DocProverData.maxassumptions * sizeof(assumption *));
if(pdata->DocProverData.assumptions == NULL)
return 2;
pdata->DocProverData.theorems = (term *) malloc(pdata->DocProverData.maxtheorems * sizeof(term));
if(pdata->DocProverData.theorems == NULL)
return 2;
pdata->DocProverData.history = (term *) malloc(pdata->DocProverData.maxhistory * sizeof(term));
if(pdata->DocProverData.history == NULL)
return 2;
pdata->DocProverData.workspace = (unsigned long *) malloc(sizeof(long) * pdata->DocProverData.maxworkspace);
if(pdata->DocProverData.workspace == NULL)
return 2;
pdata->DocProverData.permhistory = (unsigned *) malloc(pdata->DocProverData.maxhistory*sizeof(unsigned));
if(pdata->DocProverData.permhistory == NULL)
return 2;
pdata->DocControlData.opseq = (operation *) malloc(pdata->DocProverData.maxhistory* sizeof(operation));
if(pdata->DocControlData.opseq == NULL)
return 2;
pdata->DocControlData.nlinedata = pdata->DocProverData.maxhistory + 5;
pdata->DocControlData.linedatahistory = (linedata *) malloc(pdata->DocControlData.nlinedata * sizeof(linedata));
if(pdata->DocControlData.linedatahistory == NULL)
return 2;
/* pdata->DocPolydata is not yet initialized */
return 0;
}
/*___________________________________________________________________*/
void release_doc_data(PSYMBOLDATA pdata)
/* free all the space allocated by allocate_doc_data.
In the case of a graph document, setupdata allocates some space
but only on the document heap, and the document heap is here
given back to the operating system anyway, so there's no need
to worry about calling free2 here to undo setupdata.
This must not be called while pdata is the active document.
*/
{ int k = pdata->docnumber;
free(pdata->heap);
remove_heap(pdata->docnumber);
free(pdata->DocVarData.varlist);
free(pdata->DocVarData.varinfo);
free(pdata->DocProverData.assumptions);
free(pdata->DocProverData.theorems);
free(pdata->DocProverData.history);
free(pdata->DocProverData.workspace);
free(pdata->DocVarData.parameters);
free(pdata->DocVarData.defns);
free(pdata->DocProverData.permhistory);
free(pdata->DocControlData.opseq);
free(pdata->DocControlData.linedatahistory);
delete_document(k);
}
/*________________________________________________________*/
int init_doc_data(int kind, PDOCDATA pdata)
/* This is done under WM_CREATE for a symbol or graph document.
It may NOT assume the document is active.
'kind' is either GRAPHDOC or SYMBOLDOC.
pdata->currenttopic has already been set when a menu choice was
made, in symproc.c.
*/
{ int err;
pdata->problemtype = EPSILON_DELTA;
err = allocate_doc_data(pdata);
if(err)
return 1;
/* problemtype and currenttopic go to symbols.dll via DocControlData: */
pdata->DocControlData.problemtype = pdata->problemtype;
pdata->DocControlData.currenttopic = pdata->currenttopic;
/* No need to set this stuff as output from the document is not used in Otter-lambda */
#if 0
pdata->DocControlData.linebreaks = 1;
pdata->magnification = 19;
pdata->backgroundcolor = RGB(255,255,255); /* white */
pdata->textcolor = 0; /* black */
pdata->reasoncolor = 0; /* black */
pdata->highlightcolor = RGB(0,0,255); /* blue, in 3-bit RGB as used by display */
pdata->textweight = 0; /* not boldface */
pdata->DocControlData.linebreaks = (kind != GRAPHDOC);
/* linebreaks ON in symbol documents but off in graph documents */
pdata->progresshwnd = 0;
#endif
gensym(1); /* reset indexing of subscripted variables */
set_cofi_index(1); /* start numbering constants of integration from 1 */
// reset_induction(); /* reset static variables in induct.c */
init_model(pdata->currenttopic,pdata->DocControlData.model);
init_polyvalflags(&pdata->DocPolyData);
pdata->DocPolyData.arith = get_arithflag(); // it's set during init_model
pdata->DocControlData.inhibitions = NULL;
pdata->DocVarData.currentline = -1;
return 0;
}
/*____________________________________________________________________*/
void activate( PDOCDATA pdoc)
/* pdoc is a pointer to a DOCDATA structure */
/* Deactivate the current active document, if any.
Extract the values of the document variables from pdoc
and assign them to the corresponding global variables.
Switch the heap manager to the heap of pdoc. */
/* This gets called whenever we create or activate a symbol
document, i.e. under WM_CREATE, WM_MDIACTIVATE or WM_PAINT in
SymbolWndProc or GraphWndProc. */
{
switch_heaps(pdoc->docnumber);
activate_polyvalDLL(&(pdoc->DocPolyData));
activate_symbolDLL(&(pdoc->DocControlData));
pdoc->DocPolyData.hwnd= pdoc->hwnd;
pdoc->DocControlData.hwnd = pdoc->hwnd;
/* docnumber, heap, and heapsize are not made global */
init_varDLL(&(pdoc->DocVarData));
init_proverDLL(&(pdoc->DocProverData));
/* saveas is never made global */
/* neither are magnification and the color fields */
if(pdoc->kind == SYMBOLDOC && !pdoc->initialized)
{
#if 0
reset_induction(); /* reset static variables in induct.c */
#endif
set_control_flags(pdoc->problemtype, pdoc->currenttopic);
pdoc->initialized = 1;
}
}
./otter2/mpstring.h 0000644 0002044 0001012 00000000102 11120534563 012537 0 ustar beeson int mpsize(term t);
int mpstring(term t, char *buffer, int m);
./otter2/mpstring.jnk 0000644 0002044 0001012 00000042367 11120534563 013115 0 ustar beeson /* M. Beeson, for MathpXert (but this copy modified for Otter-lambda) */
/* Given a term t, produce a string that parses to t */
/* This version produces a string that Otter-lambda can parse; it
is not required that MathXpert can parse the string. In particular
SUM, PRODUCT, and INTEGRAL terms have arguments in a different order,
so the bound variable comes first.
/*
Original data 8.1.96
modified 6.21.99
1.8.00 corrected psize and pstring on bignums
1.21.00 corrected psize, adding needparen to match pstring
1.20.00 added #ifdef PRODUCTION to block assertion failure in release version
3.9.01 corrected pstring and psize on 9*2 etc.
3.26.01 corrected pstring for CONSTANTOFINTEGRATION
5.31.01 eliminated needparen from pstring--always use parentheses when arity is 1.
11.15.03 Changed name of file and function to mpstring; now this is
part of the Otter2/ExternalSimp project and no longer part of mathpert.
11.15.03 modified so it uses an explicit '*' when writing out product terms,
as that's what Otter needs to see.
6.26.05 modified mpsize and mpstring to insert an extra space after '+' and '*' (and '-' in sums) as that's what Otter needs.
7.22.05 modified mpsize and mpstring for AND and OR
5.17.06 replaced ltoa and itoa with sprintf
*/
#include <assert.h>
#include <string.h>
#include <stdio.h> // sprintf
#include "export.h"
#include "terms.h"
#include "display.h"
#include "display1.h"
#include "dispfunc.h"
#include "pstring.h" /* my_gcvt0 */
static char *defined_atom_string(term t);
/*_______________________________________________________________*/
term preProcess(term t)
/* Assumes f = FUNCTOR(t) is SUM, PRODUCT, INTEGRAL, LIMIT, or DIFF.
Change the order or arguments and/or the form of the term to be
what Otter-lambda wants to see. Otter needs the bound variable to be the first argument. */
/* Doesn't yet handle derivatives, indefinite integrals, and one-sided limits */
/* FINISH THIS */
{ unsigned short f,n;
int i;
term ans;
f = FUNCTOR(t);
n = ARITY(t);
if(f == LIMIT && n == 2)
{ /* given lim(x->a,t) produce lim(x,t,a) */
ans = make_term(f,3);
ARGREP(ans,0,ARG(0,ARG(0,t)));
ARGREP(ans,1,ARG(1,t));
ARGREP(ans,2,ARG(1,ARG(0,t)));
return ans;
}
if(f == SUM || f == PRODUCT || (f == INTEGRAL && n == 4))
{ ans = make_term(f,n);
// switch the first two arguments
ARGREP(ans,0,ARG(1,t));
ARGREP(ans,1,ARG(0,t));
for(i=2;i<n;i++)
ARGREP(ans,i,ARG(i,t));
return ans;
}
assert(0);
ans = make_term(0,0); // avoid a warning message
return ans;
}
/*_______________________________________________________________*/
int mpsize(term t)
/* return a number of bytes sufficient for the output of pstring,
not counting the null terminator. */
/* This function counts 23 bytes per double and 10 bytes per integer
over 100, but only 2 bytes for integers less than 100,
and sizeof(int) times the length of a bignum.
*/
{ unsigned short f,n;
int i,ans;
term u;
int needparen;
char buffer[32];
f = FUNCTOR(t);
if(f == SUM || f == PRODUCT || f == INTEGRAL || f == LIMIT || f == DIFF)
t = preProcess(t); // convert to Otter-lambda's desired form first
if(OBJECT(t))
{ switch(TYPE(t))
{ case INTEGER:
return INTDATA(t) < 100 ? 2 : 10;
case DOUBLE:
return 23; /* 18 digits plus "e+030" */
case BIGNUM:
ans = (int) (1.6054934 * (BIGNUMDATA(t)).ln + 1) +1;
/* see btod and bignum_string in bignum.c
for explanation of this line. */
return 6*ans + 1;
}
}
if(ISATOM(t))
{ if(('a' <= f && f <= 'z') ||
('A' <= f && f <= 'Z')
)
return (int) strlen(atom_string(t));
if(PREDEFINED_ATOM(f))
return (int) strlen(defined_atom_string(t));
if(SUBSCRIPT(f))
return (int) strlen(atom_string(t)) + 10;
}
n = ARITY(t);
if(f == '+' || f == '*')
{ ans = 0;
for(i=0;i<n;i++)
{ u = ARG(i,t);
ans += mpsize(u);
ans += 2; /* +1 for the '+' or '*' sign and one more for a space */
if(f == '*' && FRACTION(u))
needparen = 1;
/* in 2d display a fraction in a product does not need parens,
but in parseable text, it does: 3 (sqrt(3)/2) is
different from 3 sqrt(3)/2. */
else if(f == '+' && NEGATIVE(u))
needparen = 1; // unlike in MathXpert
else
needparen = paren(f,FUNCTOR(u),(unsigned short)(i == 0 ? LEFT : i == n-1 ? RIGHT: CENTRAL));
if(needparen)
ans += 4; /* two for the parentheses, two more for spaces before the '(' */
}
return ans-1; /* -1 because no '+' needed after last arg */
}
if(f == FACTORIAL)
{ ans = 2 + mpsize(ARG(0,t));
if(!ATOMIC(ARG(0,t)))
ans += 2; /* for parentheses */
return ans;
}
if(INEQUALITY(f) || f == '/' || f == '^' || f == ':')
{ ans = mpsize(ARG(0,t)) + mpsize(ARG(1,t));
if(f == '=' || f == '<' || f == '>')
return ans+3;
if(f == LE || f == GE)
return ans+4;
if(f == '^')
{ if(ATOMIC(ARG(0,t)) && ATOMIC(ARG(1,t)))
return ans + 2;
if(ATOMIC(ARG(0,t)) || ATOMIC(ARG(1,t)))
return ans + 4;
return ans +6;
}
if(f == '/')
{ if(paren(FRACT, FUNCTOR(ARG(0,t)),LEFT))
ans += 3;
if(paren(FRACT, FUNCTOR(ARG(1,t)),RIGHT))
ans += 3;
return ans + 2; /* 1 for the '/' sign */
}
if(f == ':')
return ans + 1; /* 1 for the ':' */
}
if(f == AND)
strcpy(buffer,"and");
else if (f == OR)
strcpy(buffer,"or");
else
functor_string(f,0,buffer);
ans = (int) strlen(buffer) + 2; /* 2 for parentheses */
for(i=0;i<n;i++)
ans += mpsize(ARG(i,t)) + 1; /* 1 for the comma */
return ans-1; /* we counted one comma too many */
}
/*_______________________________________________________________*/
int mpstring(term t, char *buffer, int m)
/* write into buffer a string that will parse to t.
Assumes that there are m+1 bytes available in buffer.
Return the number of bytes actually used, not counting the null
terminator, or 0 if m bytes is not enough space.
*/
{ char *printstring,*fstring,*marker;
int k,i,ans;
term u;
unsigned short f,n;
char temp[40];
int needparen;
f = FUNCTOR(t);
if(f == SUM || f == PRODUCT || f == INTEGRAL || f == LIMIT || f == DIFF)
t = preProcess(t); // convert to Otter-lambda's desired form first
if(OBJECT(t))
{ switch(TYPE(t))
{ case INTEGER:
sprintf(temp,"%ld",INTDATA(t));
if((int)strlen(temp) > m)
return 0;
strcpy(buffer,temp);
return (int) strlen(buffer);
case DOUBLE:
my_gcvt0(DOUBLEDATA(t),16,temp);
/* 16 is the precision to use. Even though we
use less precision for display, for capturing terms
we want the full precision available.
*/
if((int) strlen(temp) > m)
return 0;
strcpy(buffer,temp);
return (int) strlen(buffer);
case BIGNUM:
printstring = bignum_string(BIGNUMDATA(t),1);
/* the 1 says not to separate the digits by comma or any other character.
Commas in a bignum won't parse */
ans = (int) strlen(printstring);
if(ans > m)
{ free2(printstring);
return 0;
}
strcpy(buffer,printstring);
free2(printstring);
return ans;
}
}
if(ISATOM(t))
{ if(('a' <= f && f <= 'z') ||
('A' <= f && f <= 'Z')
)
{ printstring = atom_string(t);
strcpy(buffer,printstring);
return (int) strlen(buffer);
}
if(PREDEFINED_ATOM(f))
{ printstring = defined_atom_string(t);
strcpy(buffer,printstring);
return (int)strlen(buffer);
}
if(SUBSCRIPT(f))
{ int subscript;
term temp = t;
SETFUNCTOR(temp,VARNAME(f),0);
strcpy(buffer,atom_string(temp));
subscript = SUBSCRIPT(f)-1;
sprintf(buffer + strlen(buffer), "%d",subscript);
return (int)strlen(buffer);
}
}
n = ARITY(t);
if(f == '+' || f == '*' )
{ /* a + b + c is the desired output form */
marker = buffer;
ans = 0;
for(i=0;i<n;i++)
{ u = ARG(i,t);
#if 0 // '-' is not treated specially as an arg of '+' as it is in MathXpert.
if(f == '+' && NEGATIVE(u))
{ u = ARG(0,u);
if(i==0)
{ *marker = '-';
++marker;
++ans;
}
}
#endif
/* does u need parentheses? */
if(f == '*' && FRACTION(u))
needparen = 1;
/* in 2d display a fraction in a product does not need parens,
but in parseable text, it does: 3 (sqrt(3)/2) is
different from 3 sqrt(3)/2. */
else if(f == '+' && NEGATIVE(u) && n > 2)
needparen = 1; // Otter can't parse 2-c+a, it needs 2 + (-c) +a
else
needparen = paren(f,FUNCTOR(u),(unsigned short)(i == 0 ? LEFT : i == n-1 ? RIGHT: CENTRAL));
if(needparen)
{ strcat(marker," (");
--m;
ans+=2; /* a+ (b+c) not a+(b+c) because Otter chokes on the latter */
marker+=2;
}
k = mpstring(u,marker,m);
if(k==0)
return 0; /* doesn't fit */
if(k > m)
return 0;
m -= k;
marker += k;
ans += k;
if(needparen)
{ strcat(marker,")");
--m;
++ans;
++marker;
}
if(i < n-1)
{ strcat(marker,f == '+' ? "+ " :
f == '*' ? "* " : ", "
);
marker+=2;
ans+=2;
--m;
}
}
if(ans != (int) strlen(buffer))
assert(0);
return ans;
}
if(f == FACTORIAL)
/* DEGREE is postfix on output, but it is typed in as deg(30); so FACTORIAL
is the only postfix function on input. */
{ if(!ATOMIC(ARG(0,t)))
{ buffer[0] = '(';
ans = mpstring(ARG(0,t),buffer+1,m-1);
if(ans == 0 || ans >= m-2)
return 0;
strcat(buffer,")! ");
return ans+4;
}
else
{ ans = mpstring(ARG(0,t),buffer,m);
if(ans == 0 || ans >= m-1)
return 0;
strcat(buffer,"! "); /* extra space to avoid writing != which parses as NE */
return ans+2;
}
}
if(f == ':' && ISINTEGER(ARG(1,t))) /* a type judgement like x:N */
{ marker = buffer;
buffer[0] = 0;
ans = 0;
k = mpstring(ARG(0,t),marker,m);
if(k == 0 || k >= m)
return 0;
ans +=k;
marker += k;
m -= k;
strcat(buffer,":");
++marker;
++ans;
--m;
if(m == 0)
return 0;
switch(INTDATA(ARG(1,t)))
{ case INTEGER:
fstring = "Z";
break;
case DCOMPLEX:
fstring = "C";
break;
case NATNUM:
fstring = "N";
break;
case R:
fstring = "R";
break;
case RATIONAL:
fstring = "Q";
break;
default:
assert(0);
}
strcat(buffer,fstring);
++ans;
return ans;
}
if(INEQUALITY(f) || f == '/' || f == '^' || f == ARROW || f == ':')
{ fstring = f == '=' ? " = " :
f == '<' ? " < " :
f == '>' ? " > " :
f == LE ? " <= ":
f == GE ? " >= ":
f == '/' ? "/ " :
f == '^' ? "^ " :
f == ARROW ? "->" :
f == ':' ? ":" : /* used only for compound or variable types */
/* atomic types are handled above */
" != "; /* NE */
marker = buffer;
buffer[0] = 0;
ans = 0;
for(i=0;i<2;i++)
{ u = ARG(i,t);
/* does u need parentheses? */
if(f == '/')
needparen = paren(FRACT, FUNCTOR(u), (unsigned short)(i ? RIGHT: LEFT));
else if(f == '^' && !ATOMIC(u))
needparen = 1;
else
needparen = 0;
if(needparen)
{ if(m==0)
return 0;
strcat(buffer,"(");
--m;
++ans;
++marker;
}
k = mpstring(u,marker,m);
if(k == 0 || k >= m)
return 0;
ans +=k;
marker += k;
m -= k;
if(needparen)
{ if(m==0)
return 0;
strcat(buffer,")");
--m;
++ans;
++marker;
}
if(i==0)
{ int len = (int)strlen(fstring);
if(m < len)
return 0;
strcat(buffer,fstring);
ans += len;
marker += len;
m -= len;
}
}
return ans;
}
if(f == LIMIT)
{ strcpy(buffer,"lim(");
ans = (int)strlen(buffer);
marker = buffer + ans;
m -= ans;
k = mpstring(ARG(0,t),marker,m);
ans += k;
if(k == 0)
return 0;
if(k >= m-3)
return 0;
m-=k;
marker += k;
if(n == 3)
{ mpstring(ARG(1,t),marker,m); /* '+' or '-' is written */
++marker;
--m;
++ans;
}
*marker = ',';
++marker;
--m;
++ans;
k = mpstring(ARG(n-1,t),marker,m);
if(k == 0)
return 0;
if(k >= m-2)
return 0;
m -= k;
marker += k;
*marker = ')';
++marker;
*marker = '\0';
m -= 2;
ans += k+2;
return ans;
}
/* Now the string will be in prefix form */
if(f == AND)
strcpy(temp,"and");
else if (f == OR)
strcpy(temp,"or");
else
functor_string(f,0,temp);
if(m < 4)
return 0;
if(m < 10)
{ if((int) strlen(temp) > m-3)
return 0;
}
strcpy(buffer,temp);
strcat(buffer,"(");
marker = buffer + strlen(buffer);
m -= (int)strlen(buffer);
ans = (int)strlen(buffer);
for(i=0;i<n;i++)
{ k=mpstring(ARG(i,t),marker,m);
if(k == 0)
return 0;
if(k >= m-3 && i < n-1)
return 0;
m-=k;
marker += k;
ans += k;
if(i < n-1)
{ strcat(marker,",");
++marker;
++ans;
--m;
}
}
strcat(buffer,")");
++ans;
if(ans != (int) strlen(buffer))
assert(0);
return ans;
}
/*_______________________________________________________________________*/
static char *defined_atom_string(term t)
/* return e.g. "theta" for THETA, etc. */
{ unsigned short f = FUNCTOR(t);
switch(f)
{ case FALSEFUNCTOR: return "false";
case TRUEFUNCTOR: return "true";
case ALPHA: return "alpha";
case BETA: return "beta";
case LITTLEGAMMA: return "gamma";
case INFINITY: return "infinity";
case DELTA: return "delta";
case EPSILON: return "epsilon";
case LAMBDA: return "lambda";
case MU: return "mu";
case SIGMA: return "sigma";
case PI_ATOM: return "pi";
case THETA: return "theta";
case PHI: return "phi";
case LEFT: return "-";
case RIGHT: return "+";
case UNDEFINED: return "undefined";
case SETOF: return "set";
case BOUNDED_OSCILLATIONS: return "undefined";
/* used only internally */
case UNBOUNDED_OSCILLATIONS: return "undefined";
/* used only internally */
case TINY: assert(0);
/* an infinitesimal for internal use by the theorem-prover */
default: assert(0);
}
return "";
}
./otter2/parsererrormessages.c 0000644 0002044 0001012 00000007007 11120534563 015000 0 ustar beeson /* M. Beeson, for MathXpert.
Parser error messages in English
Should be viewed and translated in ISO-Latin1 character set
2.1.98 extracted from parser.c
3.29.99 modified
6.26.99 added 332 and 333
6.29.04 added 334
1.17.06 this copy moved to the ExternalSimp project associated with Otter-lambda
*/
#include <assert.h>
/*_________________________________________________________________*/
const char * ParserErrorMessage(int err)
/* returns a string to be printed to the screen in case of parsing error */
/* input is the 'err' value returned by 'parse' */
{ if( (259 <= err) && (err <= 277 ))
return "Expression expected";
switch (err)
{
case 256: return "Logical expression must follow NOT";
case 257: return "Logical expression must follow logical OR";
case 258: return "Logical expression must follow logical AND";
case 278: return "Right parenthesis expected";
case 279: return "Right bracket expected";
case 280: return "Right brace expected";
case 281: return "Number expected";
case 282: return "Use parentheses before minus here";
case 283: return "Wrong number of arguments";
case 284: return "Can't understand function argument";
case 285: return "Can't understand exponent";
case 294: return "Open parentheses or bracket expected";
case 295: return "Expected more arguments";
case 296: return "Comma expected";
case 297: return "Right parenthesis expected";
case 301: return "Too large a decimal number";
case 302: return "Number too large";
case 310: return "Function argument expected";
case 311: return "Parentheses expected after function name";
case 312: return "Function name can have at most 31 characters";
case 313: return "Parentheses unbalanced";
case 314: return "Brackets unbalanced";
case 315: return "Braces unbalanced";
case 316: return "Can't understand this";
case 317: return "Nested braces that don't form a legal matrix";
case 318: return "Missing | to finish absolute value";
case 319: return "Second argument of sum must be a variable";
case 320: return "Can't understand function argument, try using parentheses";
case 321: return "Subscript too large -- may not exceed 1000";
case 322: return "Subscript on function must be a nonnegative integer";
case 323: return "Too many subscripted variables.";
case 324: return "Too many long variable names.";
case 325: return "Too many long function names.";
case 326: return "Inequality expected.";
case 327: return "Expecting an inequality or interval after 'if'.";
case 328: return "Semicolon can only be used after 'if' in a definition by cases. Separate elements of a list by comma.";
case 329: return "Variable name too long.";
case 330: return "Type expected. The colon is used to specify the kind or 'type' of a variable.";
case 331: return "To enter a Greek letter or a symbol such as infinity, just type out the name, for example \"theta\".";
case 332: return "Integer expected as first argument of root"; /* don't translate 'root' */
case 333: return "Integer expected as first argument of Bessel function";
case 334: return "First argument of lambda must be a variable."; /* Not needed for MathXpert */
default: assert(0);
}
return "illegal input"; /* avoid a warning message */
}
./otter2/simplify.h 0000744 0002044 0001012 00000000245 11120534563 012541 0 ustar beeson struct clause * Simplify(struct clause *c);
int SimplifyInPlace(struct clause *c);
struct clause * Solve(struct clause *c);
int SolveInPlace(struct clause *c);
./otter2/simplify.jnk 0000644 0002044 0001012 00000036311 11120534563 013076 0 ustar beeson /* M. Beeson, 11.4.03
Connections between Otter and external simplification routines.
Communication is via ASCII strings. Terms are converted to strings
and all the literals of a clause are passed at once to an external
simplification function. The result comes back, again as an array of
strings (and an array of signs of the literals), and is converted
back to a new Otter clause. The memory used for both arrays of intermediate
strings is freed.
7.1.04 added postProcess
7.24.05 modified postProcess
3.20.06 changed include filenames to lowercase
7.2.06 changed 2 to 1 in line 154
7.20.08 added EXTERNAL_SIMPLIFY
*/
// #define DIAGNOSTICS // to see diagnostic printout
#include <stdlib.h> // calloc and free
#include <assert.h>
#include "header.h"
#include "simplify.h"
#include "externalsimplify.h"
#include "bsym.h"
#include "proto.h"
#include "export.h"
#include "heap.h"
#include "heaps.h"
// #define EXTERNAL_SIMPLIFY // comment this out to cut the link with MathXpert so it can compile without MathXpert
// If you want to supply some other simplification code you can put this back in
static FILE *tfp = NULL;
/*___________________________________________________________*/
void out_of_space(void)
{ abend("Out of space in MathXpert heap: more than one megabyte used for a simplification.");
}
/*_________________________________________________________________*/
static int needs_translation(struct term *t)
// return 1 if t contains SUM, PRODUCT, LIMIT, DIFF, or INTEGRAL
{ struct rel *r;
if(t->type!= COMPLEX)
return 0;
if(t->sym_num == SUM || t->sym_num == PRODUCT || t->sym_num == LIMIT ||
t->sym_num == DIFF || t->sym_num == INTEGRAL
)
return 1;
for(r=t->farg;r;r=r->narg)
{ if(needs_translation(r->argval))
return 1;
}
return 0;
}
/*_________________________________________________________________*/
static struct term *Translate(struct term *t)
// return a completely new term that can shortly be destroyed
// the term should translate t to the form Mathpert wants to see
// doesn't handle LIMITS, DIFF, or indefinite integrals yet FINISH THIS
{ struct term *ans;
struct rel *r, *r2, *r3, *r4;
if(t == NULL)
assert(0);
ans = get_term();
ans->type = t->type;
ans->sym_num = t->sym_num;
ans->varnum = t->varnum;
if (t->type != COMPLEX)
return(ans);
r3 = NULL;
r = t->farg;
if(t->sym_num == SUM || t->sym_num == PRODUCT || t->sym_num == INTEGRAL)
{ // switch the first and second arguments
r2 = get_rel();
ans->farg = r2;
r3 = get_rel();
r2->narg = r3;
r3->argval = Translate(r->argval);
r = r->narg;
r2->argval = Translate(r->argval);
r = r->narg;
if(r == NULL)
{ r3->narg = NULL;
return ans;
}
while(r)
{ r4 = get_rel();
r3->narg = r4;
r4->argval = Translate(r->argval);
r3 = r4;
r = r->narg;
}
return ans;
}
while (r)
{ r2 = get_rel();
if (r3 == NULL)
ans->farg = r2;
else
r3->narg = r2;
r2->argval = Translate(r->argval);
r3 = r2;
r = r->narg;
}
return(ans);
}
static void postProcess(char *s)
/* change != to /= in s */
/* and when '+' is followed immediately by '-', replace '+' by ' '. */
{ char *marker;
int i;
for(marker = s; marker[1]; ++marker)
{ if(marker[0] == '!' && marker[1] == '=')
*marker = '/';
if(marker[0] == '+')
{ for(i=1;;i++)
{ if(marker[i] != ' ')
break;
}
if(marker[i] == '-')
marker[0] = ' ';
}
}
}
/*_________________________________________________________________*/
static char * term_str(struct term *in)
/* convert an Otter term to a string */
/* Otter has code to print terms to a FILE * but not directly to a string.
Here we imitate print_term_length in writing the term to a temporary file
and reading it back into a character array. However, unlike print_term_length,
we do not want to impose a fixed limit on the length of that character array.
The return string is allocated using calloc by this function, so it can be
freed later on.
A complication is that because Otter-lambda requires bound variables to
be the first argument, terms involving SUM, PRODUCT, LIMIT, INTEGRAL, and
DIFF have to be translated to be readable by Mathpert. It would be nice
if these translations could be user-specified in list(translations) to support
different external simplifiers. For now that is done by Translate().
*/
{ int i;
// int c;
int length; // the length of the term as a string
fpos_t Length;
char *s; // will be allocated as soon as we know length.
int translation = needs_translation(in);
struct term *t = translation ? Translate(in) : in;
if (!tfp)
tfp = tmpfile();
rewind(tfp);
print_term(tfp, t);
// print_term_nl(stdout,t); DEBUG
fprintf(tfp, "%c", '\0'); /* end marker */
fgetpos(tfp,&Length);
// Length is 64 bits long, but according to the definition of fpos_t in stdio.h,
// depending on the target platform it could be a 64 bit int
// or a structure type. Hence the following complicated line of code:
// c = *((int *)(&Length) + 1); // high bits of Length. */
// But this code doesn't work right on Unix. So, let's forget the whole idea of checking c
fflush(tfp);
rewind(tfp);
// if(c)
// abend("term too big, or other error, in calling external simplification.");
length = * ((int *)(&Length));
s = calloc(length,sizeof(char));
if(!s)
abend("term too big, or other error, in calling external simplification.");
for (i = 0, s[i]=getc(tfp); s[i] ; s[++i]=getc(tfp));
if(translation)
zap_term(t);
postProcess(s); // change != to /=
return s;
}
/*_________________________________________________________________*/
static void set_vars_clause(struct clause *ans)
// fill in the t->varnum fields everywhere, consistently.
// similar to set_vars but that only works on one term at a time.
{ char *varnames[MAX_VARS];
struct literal *L;
memset(varnames,0,MAX_VARS * sizeof(char *));
for(L=ans->first_lit;L;L=L->next_lit)
set_vars_term(L->atom,varnames);
}
/*_________________________________________________________________*/
struct clause * Simplify(struct clause *c)
/* call an external simplification function (from Mathpert, for example) to
simplify each literal in the clause. While simplifying each literal,
the external routine should assume the negations of the other literals.
If there was any simplification, it returns the new clause, leaving the
old clause unmodified, and adds 'SIMPLIFY_RULE' to the justification list.
If there was no simplification to be done it returns NULL.
Example 1: if the input clause is a unit
clause f(sqrt(a^2)) = g(a), then it would simplify to f(a) = g(a) | a < 0,
since the side condition for simplifying sqrt(a^2) to a is a >= 0, so we
add the negation of that condition to the output clause.
Example 2: If the input clause is sqrt(a^2) != a, then it simplifies to a != a | a < 0,
which in turn simplifies to a < 0. Hence if a >= 0 is already deduced, after
the Simplify step is complete one more step will finish the proof.
Example 3:
if the input clause is sqrt(a^2) = a | a < 0,
then the negation of a < 0 (namely a >= 0) is assumed before simplifying sqrt(a^2) = a,
so it simplifies to true. Then true | a < 0 is true, so the entire clause becomes
true and is dropped. This is correct as it contains no information beyond what
simplify can supply. The same is true if sqrt(a^2) = a simplifies to a >= 0;
then again the clause simplies to true.
Example 4:
if the input clause is sqrt(a^2) = a, then it simplifies to a >= 0 and this is
returned. This is a DIFFERENT RULE of simplification than just sqrt(a^2) = a
if a >= 0, as it also contains the information that sqrt(a^2) = a is false when a < 0.
If we only had the latter simplification rule (i.e. leaving open the possibility
that sqrt(a^2) might = a when a is negative) then simplify would yield 'true'
with the assumption a >= 0. The new clause is then true | a < 0 which is true.
This may not look right at first but it is: it means, if you can derive
a contradiction from 'true', then you can derive one from sqrt(a^2) = a.
Look how this works: if we also had a < 0, we'd be able to get a contradiction
using the first rule [that sqrt(a^2) = a reduces to a >= 0],
proving the theorem that if a < 0 then sqrt(a^2) != a.
But using the second rule, we would not be able to finish the proof, which is correct.
Domains: we need to assume the domain of the clause throughout. Then, at the end,
we need to add back in the negations of the literals whose conjunction is the domain.
Some of those assumptions might be 'or' terms; that will cause trouble in bringing the
output to clausal form.
*/
{ struct int_ptr *p1,*q1;
int err = 1;
int p = 0;
int nlits = 1;
char **lits, **NewLits;
int i,nNewLits;
struct literal *L, *last_lit;
struct clause *ans;
char *signs, *newSigns;
static int nospace_flag = 0;
if(!nospace_flag)
set_nospace_handler(out_of_space);
if(!c->first_lit)
return 0;
for(L=c->first_lit;L->next_lit;L=L->next_lit)
++nlits;
lits = (char **) calloc(nlits, sizeof(char *));
signs = (char *) calloc(nlits, sizeof(char));
for(i=0,L=c->first_lit;L;L=L->next_lit,++i)
{ lits[i] = term_str(L->atom); // prepare strings to pass to external simplifier
signs[i] = L->sign;
}
if(i != nlits)
assert(0);
nNewLits = 100 + nlits;
NewLits = (char **) calloc(nNewLits,sizeof(char*));
newSigns = (char *) calloc(nNewLits, sizeof(char));
#ifdef DIAGNOSTICS
for(i=0;i<nlits;i++) // use this if you need to see output before ExternalSimplify runs
fprintf(stdout,"Simplifying: %s\n", lits[i]);
#endif
#ifdef EXTERNALSIMPLIFY
err = ExternalSimplify(nlits,lits,signs, &nNewLits,NewLits,newSigns); // call external simplification code
#endif
#ifdef DIAGNOSTICS
if(err)
{ for(i=0;i<nlits;i++)
{ fprintf(stdout,"Did not simplify: %s\n", lits[i]);
}
}
if(!err && nlits == nNewLits)
{ for(i=0;i<nlits;i++)
{ if(signs[i])
fprintf(stdout,"Simplifying: %s\n", lits[i]);
else
fprintf(stdout,"Simplifying: -(%s)\n", lits[i]);
if(newSigns[i])
fprintf(stdout,"To : %s\n", NewLits[i]);
else
fprintf(stdout,"To : -(%s)\n", NewLits[i]);
}
}
else if(!err)
{ for(i=0;i<nlits;i++)
{ if(signs[i]) fprintf(stdout,"Simplifying: %s\n", lits[i]);
else fprintf(stdout,"Simplifying -(%s)\n", lits[i]);
}
for(i=0;i<nNewLits;i++)
{ if(newSigns[i]) fprintf(stdout, "To : %s\n", NewLits[i]);
else fprintf(stdout, "To : - (%s)\n", NewLits[i]);
}
}
#endif
for(i=0;i<nlits;i++)
free(lits[i]); // allocated by term_str before the call to ExternalSimplify
free(lits);
free(signs);
if(err == -1)
abend("Malloc could not allocate memory for the MathXpert heap.");
if(err)
return NULL; // no simplification;
// simplification succeeded
// construct new clause
ans = get_clause();
ans->first_lit = NULL; // in case nNewLits == 1 and the only literal is 'false'
for(i=0;i<nNewLits;i++,L = L->next_lit)
{ while( i<nNewLits &&
(
(!strcmp(NewLits[i],"false") && newSigns[i] == 1) ||
(!strcmp(NewLits[i],"true") && newSigns[i] == 0)
)
)
++i;
if(i==nNewLits)
break;
L = get_literal();
if(i==0)
ans->first_lit = L;
else
last_lit->next_lit = L;
last_lit = L;
L->sign = newSigns[i];
p = 0;
L->atom = str_to_term(NewLits[i],&p,0);
if(L->atom == NULL)
assert(0);
L->atom->occ.lit = L;
L->container = ans;
if(L->atom->sym_num == NE)
{ L->atom->sym_num = '=';
L->sign = L->sign ? 0 : 1;
}
if (L->atom->sym_num == '=')
{ L->atom->varnum = L->sign ? POS_EQ : NEG_EQ;
// vital, or it won't be indexed for use by paramodulation
}
else
L->atom->varnum = NORM_ATOM;
}
set_vars_clause(ans); // fill in the t->varnum fields everywhere, consistently.
// Finally, add SIMPLIFY_RULE to the list of justifications for this new clause
ans->parents = get_int_ptr();
// Now copy c->parents
q1 = ans->parents;
for(p1 = c->parents; p1; p1 = p1->next)
{ q1->i = p1->i;
q1->next = get_int_ptr();
q1 = q1->next;
}
q1->i = SIMPLIFY_RULE; // Now add SIMPLIFY to the list of justifications
q1->next = get_int_ptr();
q1->next->i = c->id;
q1->next->next = NULL;
free(NewLits);
free(newSigns);
#ifdef DIAGNOSTICS
fprintf(stdout,"Input to Simplify\n"); // DEBUG
print_clause(stdout,c); // DEBUG
fprintf(stdout,"Simplified Otter clause:\n"); // DEBUG
print_clause(stdout,ans); // DEBUG
#endif
return ans; // success
}
/*_________________________________________________________________*/
int SimplifyInPlace(struct clause *c)
/* Like Simplify, but in case there is simplification to be done,
it replaces the literals of *c with the new literals and appends
SIMPLIFY_RULE to the list of justifications of c, rather than
using a new clause and list of justifications. Return 0 if
some simplification took place, and 1 if no simplification took place.
*/
{ struct clause *ans;
struct literal *l;
struct int_ptr *p,*q;
ans = Simplify(c);
if(!ans)
return 1;
// should decrease reference counts of the literals in c
for(l=ans->first_lit;l;l=l->next_lit)
l->container = c;
c->first_lit = ans->first_lit;
p = c->parents;
if(p == NULL)
{ c->parents = get_int_ptr();
c->parents->i = SIMPLIFY_RULE;
c->parents->next = NULL;
}
while(p->next)
{ q = p;
p = p->next;
}
p->next = get_int_ptr();
p->next->i = SIMPLIFY_RULE;
p->next->next = NULL;
return 0;
}
/*_____________________________________________________________________*/
struct clause *Solve(struct clause *c)
// similar to Simplify, but tries to find a value of the variables
// return NULL if clause can't be solved. Otherwise return a new
// clause, leaving c undisturbed.
{ struct clause *ans;
ans = c; // stub for now
return ans;
}
/*_____________________________________________________________________*/
int SolveInPlace(struct clause *c)
// similar to Simplify, but tries to find a value of the variables
// puts the solved clause where c was, destroying old literals.
// Return 0 for success, 1 for failure to solve.
{ struct clause *ans;
ans = c; // stub for now
return 1;
}
./otter2/typecheck.c 0000644 0002044 0001012 00000013101 11120534563 012651 0 ustar beeson /* M. Beeson 5.16.04
Typechecking for Otter-lambda
Typechecking is turned on by set(types), and there should be
a list(types) in the input file containing terms of the form
type(returntype, f(arg0type, arg1type,...)).
*/
#include <assert.h>
#include "header.h"
#include "unify.h" /* BIND and DEREFERENCE */
#include "bterms.h"
#include "bsym.h"
#include "beta.h"
/*_______________________________________________________________*/
static int possible_type(struct term *rType, struct term *t,
int parent,int argNumber,struct context *c)
/* return 1 if according to the Types list, t can occur with
value type rType as the argNumber-th argument of a complex term with sym_num parent.
Presumes Types is not NULL.
*/
{ struct clause *p;
struct literal *l;
struct term *s;
struct term *returnType;
struct term *value;
static int forgotten[5];
static int nforgotten;
int k;
struct rel *r,*r2;
#if 0
fprintf(stdout, "can "); // DEBUG
print_term_nl(stdout,t); // DEBUG
fprintf(stdout, "have type "); // DEBUG
print_term_nl(stdout,rType); // DEBUG
#endif
if(t->type == COMPLEX)
{ for(p = Types->first_cl; p; p = p->next_cl)
{ l = p->first_lit;
s = l->atom;
returnType = ARG0(s);
value = ARG1(s);
if(returnType != rType || value->type != COMPLEX || value->sym_num != t->sym_num )
continue;
r = t->farg;
r2 = value->farg;
for(k=0;r && r2;k++,r=r->narg,r2=r2->narg)
{ if(!possible_type(r2->argval,r->argval,t->sym_num,k,c))
break;
}
if(r || r2)
continue;
return 1;
}
return 0;
}
if(t->type == NAME)
{ int found = 0;
for(p = Types->first_cl; p; p = p->next_cl)
{ l = p->first_lit;
s = l->atom;
returnType = ARG0(s);
value = ARG1(s);
if(value->type != NAME)
continue;
if( t->sym_num == value->sym_num)
{ if(returnType == rType)
return 1;
found = 1;
}
}
if(!found)
{ for(k=0;k<nforgotten;k++)
{ if(forgotten[k] == t->sym_num)
return 0;
}
fprintf(stderr, "\nYou have set(types), but you did not assign a type to the constant ");
print_term_nl(stderr,t);
if(nforgotten < 5)
{ forgotten[k] = t->sym_num;
++nforgotten;
}
}
return 0;
}
if(t->type == VARIABLE && c->terms[t->varnum])
return possible_type(rType,c->terms[t->varnum],parent,argNumber,c->contexts[t->varnum]);
if(t->type == VARIABLE )
return 1; // for now--FIX THIS
return 0;
}
/*_______________________________________________________________*/
int type_check(struct term *t, int parent, int argNumber, struct context *c)
/* called when set(types) command is in effect, so Types should be
non-NULL (but isn't required to be).
Return 1 if t can occur as an argNumber-th argument of sym_num parent,
interpreting variables that occur in t as belong to context c.
*/
/* This could be made more efficient by use of a hash table.
*/
{ struct clause *p;
struct literal *l;
struct term *s;
struct term *returnType;
struct term *value;
// fprintf(stdout, "Type checking: "); // DEBUG
// print_term_nl(stdout,t); // DEBUG
if(!Types)
{ abend("You have set(types) and set(lambda) but no list(types). Lambda-unification will therefore always fail.");
return 0;
}
for(p = Types->first_cl; p; p = p->next_cl)
{ l = p->first_lit;
s = l->atom;
if(s->type != COMPLEX || s->farg == NULL || s->farg->narg == NULL)
abend("Invalid entry in types list; entries must match type(a,b).");
value = ARG1(s);
if(value->type != COMPLEX)
continue; // a term like type(int,c) will be used in possible_type, not here
returnType = ARG0(value);
if(t->type != value->type)
continue;
if(value->type != COMPLEX)
continue;
if(parent != value->sym_num)
continue;
if(possible_type(returnType,t,parent,argNumber,c))
return 1;
}
// fprintf(stdout,"Type checking failed on.\n"); // DEBUG
return 0;
}
/*____________________________________________________*/
int getConstantType(struct term *t)
// assumes t is a constant; return the syn_num of its type
// or return -1 if t has no type in the Types list.
{ struct clause *c;
int f;
char *p;
struct term *s;
if(t->type != NAME)
assert(0);
f = str_to_sn("type",2);
if(Types == NULL)
{ if(Flags[TYPES_FLAG].val)
assert(0); // not supposed to call this unless Flags[TYPEFLAG].val
else
abend("You have set(types) but no list(types).");
}
for(c = Types->first_cl; c ; c = c->next_cl)
{ s = c->first_lit->atom;
if(s->sym_num != f || ARG1(s)->sym_num != t->sym_num)
continue;
return ARG0(s)->sym_num;
}
p = sn_to_str(t->sym_num);
fprintf(stderr,"You haven't recorded the type of constant %s in the types list. You may be missing possible inferences.\n",p);
return -1; // t has no recorded type
}
./otter2/typecheck.h 0000644 0002044 0001012 00000000163 11120534563 012662 0 ustar beeson int type_check(struct term *t, int parent, int argNumber, struct context *c);
int getConstantType(struct term *t); ./otter2/unify2.c 0000644 0002044 0001012 00000212537 11120534563 012124 0 ustar beeson /* Second-order unification for Otter */
/* M. Beeson */
/*
11.24.00 original date
7.24.05 last modified
11.27.05 modified at the dated line.
12.18.05 modified code for multiple unifiers
3.20.06 made include filenames lowercase
5.21.06 added code for unifying Ap(r,w) with t, when r is not a variable, at lines 795 ff.
This enables things like Ap(Ap(x,y),z) = 3, yielding x = lambda(u,u), y = lambda(v,v), z = 3.
7.10.06 changes to occur_check2.
*/
// #define DIAGNOSTICS
#include <assert.h>
#include <stdlib.h>
#include "header.h"
#include "unify.h" /* BIND and DEREFERENCE */
#include "bterms.h"
#include "bsym.h"
#include "beta.h"
#include "unify2.h"
#include "proto.h" // occur_check
#include "fsubsto.h"
#include "getconstant.h"
#ifndef max
#define max(a,b) ((a) > (b) ? (a) : (b))
#endif
static int get_var(struct term * w, struct context *c1, struct term * t, struct context *c2, struct trail **trp);
static struct term *getMaskingSubterm(struct term *a, struct context **cp,
struct term *X, struct context *c1,
struct term *t, struct context *c2,
struct term *w);
static void forbid_all_but(struct term *z,struct context *d, struct term *a, struct context *c1, struct term *x, struct context *c2);
/*_____________________________________________________________
This file implements untyped lambda-unification as described in
Beeson's paper in IJCAR-2004.
It presupposes lambda-terms and application terms, and beta-reduction.
It also requires the notion of a variable being "forbidden" to another
variable, so that unification will never assign a value to X that
contains variables forbidden to X.
/*_____________________________________________________________*/
#define BIT(i,r) ((r[i/sizeof(int)] & (1 << (i%r))) >> (i % r))
/*_____________________________________________________________*/
static int is_answer_literal(struct term *t)
/* return 1 if t is (the atom of) an answer literal */
{ if(t->type == COMPLEX && t->varnum == ANSWER)
return 1;
return 0;
}
/*_____________________________________________________________*/
static int variable_free(struct term *t)
/* return 1 if t does not contain any variables, 0 if it does */
{ struct rel *r;
int q;
if(t->type == VARIABLE)
return 0;
if(t->type == NAME)
return 1;
for(r = t->farg; r; r= r->narg)
{ q = variable_free(r->argval);
if(!q)
return 0;
}
return 1;
}
/*_____________________________________________________________*/
void trace(char *x, term t)
/* used for debugging */
{ fprintf(stdout,"\n%s",x);
print_term(stdout,t);
}
/*____________________________________________________________*/
struct term *newvar(struct context *c1, struct context *c2)
/* return a new variable, whose varnum will be the max of k, c1->next_var,
and c2->next_var, and increase c1->next_var and c2->next_var to be one
more than this new varnum.
*/
{ struct term *ans;
if(c1->next_var == -2 || c2->next_var == -2)
abend("newvar called on a context created with get_context instead of get_context2");
if(c1->next_var == -1 || c2->next_var == -1)
{ abend("Too many new variables requested in newvar");
}
ans = get_term();
ans->sym_num = 0; // 6.30.03
ans->type = VARIABLE;
ans->varnum = c1->next_var > c2->next_var ? c1->next_var : c2->next_var;
if(ans->varnum > MAX_VARS) // DEBUG
assert(0); // DEBUG
c1->next_var = ans->varnum + 1;
c2->next_var = ans->varnum + 1;
if(c1->next_var == MAX_VARS)
c1->next_var = -1;
if(c2->next_var == MAX_VARS)
c2->next_var = -1;
return ans;
}
/*____________________________________________________________*/
/* functions to access and set the entries of the 'forbidden' part of a context;
each entry in the 'forbidden' array is of type restrictdata, which is a struct int_ptr *.
Each entry in this list is four bytes long. The low-order byte is the varnum, the
three upper bytes are the context multiplier. More than 4096 contexts will cause
an abend. */
void forbid(term x, struct context *c1, term y, struct context *c2)
/* set an entry in c1 forbidding x to take a value depending on (y, c2).
If c2 is NULL then y is a constant. If c2 is not NULL than (y,c2) is a variable.
*/
{ intlist p = get_int_ptr();
if(x->type != VARIABLE)
assert(0);
if(x->varnum > MAX_VARS)
assert(0);
if(c2)
{ if(y->varnum > 256)
assert(0);
if(y->type != VARIABLE)
assert(0);
FSETVARNUM(p->i,y->varnum);
FSETVAR(p->i);
FSETMULTIPLIER(p->i,c2->multiplier);
p->next = c1->forbidden[x->varnum];
c1->forbidden[x->varnum] = p;
return;
}
else // y is a constant
{ FSETSYMNUM(p->i, y->sym_num);
FSETCONSTANT(p->i);
p->next = c1->forbidden[x->varnum];
c1->forbidden[x->varnum] = p;
return;
}
}
int forbidden2(int vn, struct context *c1, int vn2, struct context *c2)
/* vn and vn2 are variable numbers in contexts c1 and c2 respectively.
Return 1 if (vn2, c2) is forbidden to (vn,c1). Return 0 otherwise.
*/
{ struct int_ptr *marker;
int a;
marker = c1->forbidden[vn];
if(c1 == c2 && vn == vn2)
return 1; // a variable is always forbidden to itself
while(marker)
{ a = marker->i;
if(FISVAR(a))
{ if( FMULTIPLIER(a)==c2->multiplier &&
vn2 == FVARNUM(a)
)
return 1;
}
marker = marker->next;
}
return 0;
}
static int forbidden(term x,struct context *c1, term y, struct context *c2)
/* return 1 if y,c2 is a variable forbidden to x in context c1,
or if y is a constant forbidden to x in context c1,
of if y is a complex term and some subterm of y is forbidden to x in context c1.
*/
{ struct int_ptr *marker;
int a;
struct rel *r;
if(x->type != VARIABLE)
assert(0);
if(y->type == COMPLEX)
{ for(r=y->farg; r; r=r->narg)
{ if(forbidden(x,c1,r->argval,c2))
return 1;
}
return 0;
}
// now y is a constant or variable in context c2
marker = c1->forbidden[x->varnum];
if(y->type == VARIABLE)
{ if(c1 == c2 && y->varnum == x->varnum)
return 1; // a variable is always forbidden to itself
while(marker)
{ a = marker->i;
if(FISVAR(a))
{ if( c2->multiplier == FMULTIPLIER(a) &&
y->varnum == FVARNUM(a)
)
return 1;
}
marker = marker->next;
}
}
else // y->type == NAME, y is a constant
{ while(marker)
{ a = marker->i;
if(!FISVAR(a) && FSYMNUM(a) == y->sym_num)
return 1;
marker = marker->next;
}
}
return 0;
}
/*_____________________________________________________________*/
void validate_context(struct context *c)
// Beeson's function, for debugging only.
{ int i;
for(i=0;i<MAX_VARS;i++)
{ if(c->terms[i])
{ if(c->contexts[i] == NULL)
assert(0);
if(c->contexts[i] == (struct context *) 0xcdcdcdcd)
assert(0);
if(!occur_check(i,c,c->terms[i],c->contexts[i]))
{ occur_check(i,c,c->terms[i],c->contexts[i]); // repeat so we can debug
assert(0);
}
if(c->bound[i] && c->terms[i] &&
!(c->terms[i]->type == VARIABLE && c->contexts[i]->bound[c->terms[i]->varnum] != 0)
)
{ printf("variable %d is bound to ",i),
print_term_nl(stdout, c->terms[i]);
assert(0);
}
}
}
if(c->multiplier < 0)
assert(0);
if(c->next_var < 0)
assert(0);
}
/*________________________________________________________________*/
static int unify2_aux(struct term *s, struct context *c1, struct term *t, struct context * c2, struct trail ** trp)
/* It is presumed that s has the form Ap(X,q) where X is assigned in c1 to some
other term. In particular X might be assigned to a lambda-term lambda(w,p) in
some context c3 (which might or might not be c1).
Handle unify2's job in that case by temporarily labeling w as not lambda-bound in c3
and then assign it to (q,c1), then try to unify (p,c3) and (t,c2), then restore the bound label
for (w,c3) afterwards. In case the dereferenced value of X is not a lambda-term,
just make a recursive call to unify2.
There is a problem here in case q already contains w. Of course Otter-lambda
clauses don't contain the same variable both free and bound, so q can't contain
w free, but it might contain another bound occurrence of w. In that case, having temporarily
labeled w as not-bound, we're in trouble as the convention that the same variable
can't be free and bound will be violated for the duration of this temporary assumption.
There is another problem in that when p and t are unified, some variable in c2
might be bound to (w,c3). That binding, if it occurs, must be removed from the
trail and from c2->terms before exiting.
*/
{ struct trail *savetrail;
struct trail *tp = *trp;
struct trail *prev = NULL;
struct context *c3 = c1;
struct term *p = ARG0(s);
struct term *w;
int failflag = 0;
int rval;
DEREFERENCE(p,c3) // c3 could be different than c1
if(p->type != COMPLEX || FUNCTOR(p) != LAMBDA)
// return unify2(p,c3,t,c2,trp); // FIX THIS--this isn't right
return 0; // 11.29.05
w = ARG0(p);
if(w->type != VARIABLE)
assert(0);
#ifdef DIAGNOSTICS
V(c3,c2); // DEBUG
#endif
if(c3->bound[w->varnum] != 1) // debug
assert(0); // debug
c3->bound[w->varnum]= 0; // until after the unify call
if(!(c3==c2 && ARG1(s)->type == VARIABLE && ARG1(s)->varnum == w->varnum))
{ savetrail = *trp;
BIND(w->varnum,c3,ARG1(s),c3,trp);
#ifdef DIAGNOSTICS
fprintf(stdout,"Binding %d to ", w->varnum); print_term_nl(stdout,ARG1(s)); // DEBUG
#endif
free_trail(*trp);
*trp = savetrail;
}
#ifdef DIAGNOSTICS
// V(c3,c2); // DEBUG
fprintf(stdout,"Calling unify on \n"); // DEBUG
print_term_nl(stdout,ARG1(p)); // DEBUG
print_term_nl(stdout,t); // DEBUG
#endif
rval = unify(ARG1(p),c3,t,c2,trp); // corrected 7.17.03
if(c3->terms[w->varnum]->type != VARIABLE)
failflag = 1;
c3->bound[w->varnum] = 1; // restoring the original value
c3->terms[w->varnum] = NULL; // removing any assignment to the bound variable
// Now, what about an assignment in c2 to (w,c3)?
while(tp)
{ if( tp->context == c2 &&
c2->terms[tp->varnum]->type == VARIABLE &&
c2->contexts[tp->varnum] == c3 &&
c2->terms[tp->varnum]->varnum == w->varnum
)
{ c2->contexts[tp->varnum] = NULL;
c2->terms[tp->varnum] = NULL;
undo_forbidden(tp);
if(prev == NULL)
*trp = tp->next;
else
prev->next = tp->next;
}
tp = tp->next;
}
if(!rval || failflag)
return 0;
return rval;
}
/*_____________________________________________________________*/
int unify2(struct term *s, struct context *c1,struct term *t, struct context *c2, struct trail **trp)
/* lambda unification. t1 and t2 are presumed to be already
dereferenced. For documentation of the parameters see unify in unify.c.
Return 1 for success, 0 for failure, and restore the entrance value of *trp before failing.
Also, if any new terms are created, they must be destroyed on failure.
// FIX THIS--this destruction on failure is not done yet.
Any new terms that are created should NOT be integrated terms.
Since terms arising from previously kept clauses WILL be integrated terms,
they need to be copied first.
If Flags[LAMBDA_FLAG] == 2, that means this is called during para_from, and we
don't want to instantiate new variables by lambda-unification during paramodulation,
so two AP terms should unify only as they normally would. Nevertheless we have to
be careful not to unify a lambda-bound variable with anything.
*/
{ int index;
term w,p,X,z,q,Y,x,b2,r;
struct context *c3;
int rval,k;
int saveit1= -1, saveit2= -1;
struct trail *tpos = *trp; /* save trail position in case of failure */
// V(c1,c2); // DEBUG 7.27.03
if(c1->next_var >= 0)
saveit1 = c1->next_var;
if(c2->next_var >= 0)
saveit2 = c2->next_var;
if(FUNCTOR(s) == AP && FUNCTOR(t) == AP)
{ // see if the args unify by first-order unification. Can't just
// call unify since unify will call unify2.
struct rel *r1 = s->farg;
struct rel *r2 = t->farg;
#ifdef DIAGNOSTICS
{ fprintf(stdout,"Calling unify2 on\n"); // DEBUG 6.16.03
print_term_nl(stdout, s); // DEBUG 6.16.03
fprintf(stdout,"and\n"); // DEBUG 6.16.03
print_term_nl(stdout,t); // DEBUG 6.16.03
V(c1,c2); // DEBUG 7.27.03
}
#endif
while (r1 && unify(r1->argval, c1, r2->argval, c2, trp))
{ r1 = r1->narg;
r2 = r2->narg;
}
if (r1 == NULL)
return 1;
else
{ /* restore trail and continue */
struct trail *tp = *trp;
while (tp != tpos)
{ struct trail *t3 = tp;
undo_forbidden(tp); // Beeson 6.26.03
tp->context->terms[tp->varnum] = NULL;
tp = tp->next;
free_trail(t3);
}
}
*trp = tpos;
// don't return here--go on to second-order unification.
}
#if 0 // DEBUG
{ struct context *last1=c1, *last2=c2;
while(last1->next && last2->next)
{ last1=last1->next;
last2=last2->next;
}
if(last1->next || last2->next)
assert(0); // the two lists must have the same length
}
#endif
if(FUNCTOR(s) == AP && FUNCTOR(ARG0(s)) == LAMBDA)
{ // s permits a top-level beta-reduction
term a = ARG1(s); // corrected 6.24.03
term b = ARG1(ARG0(s));
#ifdef DIAGNOSTICS
{ fprintf(stdout,"Calling unify2 on\n"); // DEBUG 6.16.03
print_term_nl(stdout, s); // DEBUG 6.16.03
fprintf(stdout,"and\n"); // DEBUG 6.16.03
print_term_nl(stdout,t); // DEBUG 6.16.03
V(c1,c2); // DEBUG 7.7.03
}
#endif
/* Now ARG0(ARG0(s)) is lambda-bound in c1
but in b it is free, and it might occur bound elsewhere in c1,
so to keep the property that no variable occurs both free and bound
in the same clause, we have to rename this variable. */
x = newvar(c1,c2);
b2 = copy_term(b);
rename2(ARG0(ARG0(s))->varnum,x->varnum,b2);
BIND(x->varnum,c1,a,c1,trp);
free_term(x); // added 7.13.03
rval = unify(b2,c1,t,c2,trp);
if(!rval)
{ free_term(b2);
goto fail;
}
return 1;
}
if(FUNCTOR(t) == AP && FUNCTOR(ARG0(t)) == LAMBDA)
{ // t permits a top-level beta-reduction
term a = ARG1(t);
term b = ARG1(ARG0(t));
#ifdef DIAGNOSTICS
{ fprintf(stdout,"Calling unify2 on\n"); // DEBUG 6.16.03
print_term_nl(stdout, s); // DEBUG 6.16.03
fprintf(stdout,"and\n"); // DEBUG 6.16.03
print_term_nl(stdout,t); // DEBUG 6.16.03
V(c1,c2); // DEBUG 6.27.03
}
#endif
x = newvar(c1,c2);
b2 = copy_term(b);
rename2(ARG0(ARG0(t))->varnum,x->varnum,b2);
BIND(x->varnum,c2,a,c2,trp);
free_term(x); // added 7.13.03
// V(c1,c2); // DEBUG 7.27.03
rval = unify(s,c1,b2,c2,trp);
if(!rval)
{ free_term(b2);
goto fail;
}
return 1;
}
if(FUNCTOR(s)== AP && t->type == VARIABLE &&
occur_check(t->varnum,c2,s,c1)
)
{ BIND(t->varnum,c2,s,c1,trp)
return 1;
}
if(FUNCTOR(t) == AP && s->type == VARIABLE &&
occur_check(s->varnum,c1,t,c2)
)
{ BIND(s->varnum,c1,t,c2,trp)
return 1;
}
if(Flags[LAMBDA_FLAG].val==2)
goto fail; // this is reached when doing paramodulation
if(FUNCTOR(s) == AP &&
TYPE(ARG0(s)) == VARIABLE // &&
)
{ /*lambda unification */
#ifdef DIAGNOSTICS
fprintf(stdout,"Calling unify2 on\n"); // DEBUG 6.16.03
print_term_nl(stdout, s); // DEBUG 6.16.03
fprintf(stdout,"and\n"); // DEBUG 6.16.03
print_term_nl(stdout,t); // DEBUG 6.16.03
#endif
index = ARG0(s)->varnum;
if(c1->next_var == 0) // DEBUG
assert(0); //DEBUG
if(c1->terms[index])
{ /* alreadyinstantiated */
rval = unify2_aux(s,c1,t,c2,trp);
if(rval)
return rval;
goto fail;
}
// s = ap(X,w) with X not instantiated
if(FUNCTOR(t) == AP &&
TYPE(ARG0(t)) == VARIABLE
)
{ int index2 = ARG0(t)->varnum;
if(!c2->terms[index2] && !(c1==c2 && index == index2))
{ // ARG(0,t) is not already instantiated,
// and is not the same variable as ARG(0,s)
BIND(index,c1,ARG0(t),c2,trp);
// V(c1,c2); // DEBUG 7.27.03
rval = unify(ARG1(s),c1,ARG1(t),c2,trp);
if(!rval)
goto fail;
return rval;
}
else
{ rval = unify2_aux(t,c2,s,c1,trp);
if(rval) // if ARG(0,t) dereferences to a lambda-term
return rval;
goto fail;
}
}
w = ARG1(s);
X = ARG0(s);
if(c1->bound[X->varnum])
goto fail; /* this definitely can legally happen,
e.g. when unifying Ap(X,w) with something containing a lambda term
that contains another Ap in the body of the lambda term
then getConstant returns some c and call fsubst3(z for c in the Ap term),
which in turn tries to unify c with the Ap term. The first arg in that
inner Ap term can be bound by the outer lambda. */
if(is_answer_literal(t))
return 0; // example, Ap(X,s) unifying with $ANS(X).
// don't put an occurs check here, since in case t is forbidden to X,
// t may actually be allowed to contain X, e.g. t = g(X).
if(Flags[CASES_FLAG].val &&
// variable_free(t) && // added and removed several times
// this causes us to generate cases terms only using constants for the
// case distinctions. It prevents example-CADE.in from working right.
!forbidden(X,c1,t,c2) && !forbidden(X,c1,w,c1)
)
{ if(! occur_check(ARG0(s)->varnum,c1,t,c2))
goto fail;
if(c1->next_var == -2 || c2->next_var == -2)
{ fprintf(stdout, "unify2 called with contexts created by get_context instead of get_context2\n"); // DEBUG 7.14.03
// don't let it go to an abend in next_var--this is called e.g. from para_from, so
// just don't use unify2 for paramodulation.
goto fail;
}
/* take X == lambda z. cases(z,w,t,Y(z)) where Y is a new variable
z needs to be a variable that is not bound in t; but newvar() only
avoids free vars. */
for(k=max(c1->next_var,c2->next_var); c2->bound[k] || c1->bound[k];k++)
{ if(k==MAX_VARS)
abend("can't create a new variable for lambda-unification.");
}
// be sure that newvar will avoid the bound variables of t
/* if(k < c2->next_var)
c2->next_var = k;
if(k < c1->next_var)
c1->next_var = k; */ // commented out as candidate for removal 5.21.06
Y = newvar(c1,c2);
z = newvar(c1,c2);
if(variable_free(t))
{ /* t may be an atom, not a term, which means that its superterm
list points to a literal, not a list of
superterms. Therefore we make a copy of it. */
struct term *t3 = copy_term(t);
struct term *w3 = copy_term(w);
t3->occ.rel = NULL;
/* t is in context c2, but it's variable-free, so it's really
in no context at all. */
p = lambda(z,cases(z,w3,t3,ap(Y,z)));
c1->bound[z->varnum] = 1;
}
else // with variable-free in the code above, we wouldn't ever get here.
{ /* t is in context c2, so we can't create cases(z,w,t,Y(z)) sensibly,
as it wouldn't belong in context c1 or in context c2. Instead we
create a new variable in context c1 and bind it to (t,c2). After
the inference step, when rename_variables is called, this variable
will disappear. */
struct term *w4 = copy_term(w);
q = newvar(c1,c2);
BIND(q->varnum,c1,t,c2,trp)
++t->fpa_id;
p = lambda(z,cases(z,w4,q,ap(Y,z)));
c1->bound[z->varnum] = 1;
}
// V(c1,c2); // DEBUG 7.22.03
BIND(X->varnum,c1,p,c1,trp);
++p->fpa_id;
// V(c1,c2); // DEBUG 6.27.03
return 1;
}
else
{ struct term *rr;
int oflag;
int W;
/* now t is forbidden to X, or cases terms are not wanted.
To unify Ap(X,W) with t, produce
X = lambda z. t[W:=z].
*/
for(k=max(c1->next_var,c2->next_var); c2->bound[k] || c1->bound[k];k++)
{ if(k==MAX_VARS)
abend("can't create a new variable for lambda-unification.");
}
// be sure that newvar will avoid the bound variables of t
if(k < c2->next_var)
c2->next_var = k;
if(k < c1->next_var)
c1->next_var = k;
z = newvar(c1,c2);
rr = copy_term(t);
oflag = occur_check(X->varnum,c1,t,c2);
if(w->type == VARIABLE && oflag &&
(W = get_var(w,c1,t,c2,trp)) >= 0
)
rename2(W,z->varnum,rr); // simpler than fsubst3
else if(w->type == VARIABLE && oflag)
{ /* t is variable-free and w is unassigned.
We're unifying Ap(X,w) with t,and we don't want cases terms.
Example: t is pow(b,c)=0 in proving
by induction that integral domains have no nilpotents.
In that example we want to produce rr = pow(z,c).
In general we want rr to be the result of substituting
z for a constant in t. If INDUCTION_FLAG is set,
that variable should be of type NatNum. We bind
w to n. Thus Ap(X,w) = Ap(lambda(z,t[n:=z]),w) =
t[n:=z][z:=w]) = t since w is bound to n.
*/
struct term *n = getConstant(t);
if(n == NULL)
{ if(FUNCTOR(t) == LAMBDA)
n = t; /* example, t = lambda(u,u) as arises when unifying
Ap(Ap(x,y),z) with 3; first we create Z and unify
Ap(Z,z) with 3 getting Z := lamba(u,u), and then
we unify Ap(x,y) with Z, that is, with lambda(u,u),
getting x:= lambda(v,v), y:= lambda(u,u), z:= 3.
See test file curry1.in */
else
goto fail;
}
#ifdef DIAGNOSTICS
fprintf(stdout,"getConstant returns: "), print_term_nl(stdout,n); // DEBUG
#endif
if(Flags[INDUCTION_FLAG].val)
{ int max_unifiers = Parms[MAX_UNIFIERS].val;
int mask;
int success = 0;
struct context *c3,*c4;
struct context *savec1next = c1->next;
struct context *savec2next = c2->next;
if(max_unifiers > 1)
{ c3 = copy_context(c2);
c2->next = c3;
c3 = c2;
c4 = copy_context(c1);
c1->next = c4;
c4 = c1;
}
else
{ c3 = c2;
c4 = c1;
}
for(mask=1;mask<=max_unifiers;mask++)
{
rr = fsubst5(z,n,c3,t,c3,trp,mask);
#ifdef DIAGNOSTICS
fprintf(stdout, "fsubst5 called on \n"); // DEBUG
print_term_nl(stdout,z),// DEBUG
print_term_nl(stdout,n),// DEBUG
print_term_nl(stdout,t),// DEBUG
fprintf(stdout, "yielding \n");// DEBUG
print_term_nl(stdout,rr);// DEBUG
#endif
if(!occur_check(X->varnum,c1,rr,c3))
{ free_term(rr);
continue;
}
else
{ success = 1;
#ifdef DIAGNOSTICS
printf("mask = %d ",mask); print_term_nl(stdout,rr); // DEBUG
#endif
BIND(w->varnum,c4,n,c3,trp);
q = lambda(z,rr);
c3->bound[z->varnum] = 1;
BIND(X->varnum,c4,q ,c3,trp);
#ifdef DIAGNOSTICS
fprintf(stdout,"unify2 succeeds with: \n"); // DEBUG 7.3.03
print_term_nl(stdout,q); // DEBUG 7.3.03
#endif
c3 = c3->next;
c4 = c4->next;
if(mask + 1 <= max_unifiers)
{ c3->next = copy_context(c2);
c4->next = copy_context(c1);
}
}
}
if(!success)
{ c1->next = savec1next;
c2->next = savec2next;
goto fail;
}
if(max_unifiers > 1)
{ assert(c3->next == NULL);
assert(c4->next == NULL);
c3->next = savec2next;
// thus the new unifiers are inserted in the pre-existing list of unifiers, if any
}
#if 0 // DEBUG
{ struct context *last1=c1, *last2=c2;
while(last1->next && last2->next)
{ last1=last1->next;
last2=last2->next;
}
if(last1->next || last2->next)
assert(0); // the two lists must have the same length
}
#endif
return 1;
}
else
{ // V(c1,c2); // DEBUG
rr = fsubst3(z,n,c2,t,c2,trp);
// V(c1,c2); // DEBUG
BIND(w->varnum,c1,n,c2,trp);
}
}
else if (w->type == VARIABLE && // and the occurs check failed
(r = getMaskingSubterm(NULL,&c3,X,c1,t,c2,w)) != NULL
)
{ /* the next clause would produce X = lambda z.z and
w = t, which is a solution since X(w) = t then,
but not the one we want. Instead we want a subterm
r of t such that r contains all the occurrences of
X or variables forbidden to X in t, and r occurs
as the second arg of an Ap subterm in t, and no
proper subterm of r has those properties. We then
get rr by substituting z for r in t. If there
is no such term then BIND z in c2 to (w,c1) and
BIND X to lambda(z,z) and w to t. If there is,
BIND w to r and X to lambda(z,rr).
*/
#ifdef DIAGNOSTICS
fprintf(stdout, "getMaskingSubterm returned:\n"); // DEBUG
print_term_nl(stdout,r); // DEBUG
#endif
rr = fsubst3(z,r,c3,t,c2,trp);
#ifdef DIAGNOSTICS
fprintf(stdout,"rr = \n"); // DEBUG
print_term_nl(stdout,rr); // DEBUG
#endif
if(!rr || !occur_check(X->varnum,c1,rr,c2))
assert(0);
// V(c1,c2); // DEBUG
// Maybe r is a variable in c3 that's already bound to w.
// If so, we don't want to bind w to r.
if(r->type == VARIABLE && c3->terms[r->varnum] != 0 &&
c3->terms[r->varnum]->type == VARIABLE &&
c3->contexts[r->varnum] == c1 &&
c3->terms[r->varnum]->varnum == w->varnum
)
; // do nothing
else
BIND(w->varnum,c1,r,c3,trp);
// V(c1,c2); // DEBUG
}
else // w is not a variable
{ rr = fsubst3(z,w,c1,t,c2,trp);
if(rr == NULL ||
(rr->sym_num == '=' && occur_check(z->varnum,c2,rr,c2)) //7.3.04
)
goto fail;
#ifdef DIAGNOSTICS
fprintf(stdout, "fsubst3 called on \n"); // DEBUG
print_term_nl(stdout,z),// DEBUG
print_term_nl(stdout,w),// DEBUG
print_term_nl(stdout,t),// DEBUG
fprintf(stdout, "yielding \n");// DEBUG
print_term_nl(stdout,rr);// DEBUG
V(c1,c2);
#endif
if(c1->terms[X->varnum])
{ struct context *c3 = c1;
struct term * tt = X;
DEREFERENCE(tt,c3);
if(c3 != c2 || !term_ident(tt,rr))
goto fail;
}
if(!occur_check2(X->varnum,c1,rr,c2) ||
c1->terms[X->varnum] || // 6.13.04
c1->terms[z->varnum] // 6.13.04
)
{ free_term(rr);
goto fail;
}
}
if(forbidden(X,c1,rr,c2))
{ zap_term_special(rr); // fsubst3 made a copy
goto fail; // the substitution must have eliminated all forbidden constants/variables, or we fail.
}
# if 0
// the following lines implement weak unification, see Solving For Functions by Beeson
// produce X = lambda z. or(t[w:= z], Y(z))
Y = newvar(c1,c2);
rr = otter_or(rr,ap(Y,z));
#endif
q = lambda(z,rr);
c2->bound[z->varnum] = 1;
if(!occur_check2(X->varnum,c1,q,c2))
{ free_term(q);
goto fail;
}
BIND(X->varnum,c1,q ,c2,trp);
#ifdef DIAGNOSTICS
fprintf(stdout,"unify2 succeeds with: \n"); // DEBUG 7.3.03
print_term_nl(stdout,q); // DEBUG 7.3.03
#endif
return 1;
}
}
if(FUNCTOR(t)== AP &&
FUNCTOR(s) != AP
// TYPE(ARG0(t)) == VARIABLE commented out 5.22.06
)
// switch the order of the arguments
return unify(t,c2,s,c1,trp);
if(FUNCTOR(s) == AP && TYPE(ARG0(s)) != VARIABLE)
{ struct term *r = ARG0(s);
struct term *w = ARG1(s);
/* Create a fresh variable Z, unify Ap(Z,w) with t, producing sigma;
unify Z sigma with r sigma, producing tau; undefine sigma tau on Z and return the result. */
struct term *Z = newvar(c1,c2);
struct term *left = ap(Z,w);
if(!unify2(left,c1,t,c2,trp) || !unify(Z,c1,r,c1,trp))
{ free_term(left);
free_term(Z);
goto fail;
}
// now c1,c2 specify sigma tau
// There's no need to remove the value given to Z in c1; it just won't be used.
return 1; // success
}
fail: /* restore trail and fail */
{ struct trail *tp = *trp;
while (tp != tpos)
{ struct trail *t3 = tp;
undo_forbidden(tp);
tp->context->terms[tp->varnum] = NULL;
tp = tp->next;
free_trail(t3);
}
*trp = tpos;
restore_vars(c1,c2,saveit1,saveit2);
return 0;
}
}
/*________________________________________________*/
void restore_vars(struct context *c1, struct context *c2, int saveit1, int saveit2)
// restore the bound arrays in the two contexts, and restore next_var.
{ int i;
if(c1->next_var >= 0)
{ for(i=saveit1; i<c1->next_var; i++)
c1->bound[i] = 0;
c1->next_var = saveit1;
}
if(c2->next_var >= 0)
{ for(i=saveit2; i<c2->next_var; i++)
c2->bound[i] = 0;
c2->next_var = saveit2;
}
}
/*__________________________________________________________________*/
void split_not_or(struct clause *c)
/* From -or(a,b) | c infer -a | c and -b | c. Similarly for -or(a1,...an).
From -or(and(a1,a2),b) | c infer -a1 | -a2 | c and -b | c.
Append the new inferences to sos.
*/
{ struct literal *marker = c->first_lit;
struct literal *marker2, *prev;
struct literal *q;
struct term *t;
struct clause *aclause;
struct rel *r;
struct int_ptr *ip0,*ip1;
while(marker)
{ if(!marker->sign && marker->atom->sym_num == OR)
break; // the rule will apply.
marker=marker->next_lit;
}
if(!marker)
return; // not applicable
t = marker->atom; // the OR term
for(r=t->farg;r;r=r->narg) // go through the args of t
{ aclause = get_clause();
// copy c into aclause, but put r->argval in at the place corresponding to marker,
// with a negation sign.
prev = NULL;
for(marker2 = c->first_lit;marker2; marker2=marker2->next_lit)
{ if(marker2 == marker)
{ q = get_literal();
q->sign = 0;
q->atom = copy_term(r->argval);
if(!prev)
aclause->first_lit = q;
else
prev->next_lit = q;
q->next_lit = NULL;
q->container = aclause;
prev = q;
continue;
}
// make a copy of the next literal in c and append it to aclause
q = get_literal();
q->atom = copy_term(marker2->atom);
q->container = marker2->container;
if(prev)
prev->next_lit = q;
else
aclause->first_lit = q;
prev = q;
q->next_lit = NULL;
q->sign = marker2->sign;
q->target = marker2->target;
q->container = aclause;
}
// set the parents of aclause
ip0 = get_int_ptr();
ip1 = get_int_ptr();
ip1->next = NULL;
ip0->i = SPLIT_NOT_OR;
ip0->next = ip1;
ip1->i = c->id;
aclause->parents = ip0;
// now append aclause to sos
pre_process(aclause,0,Sos);
}
}
/*__________________________________________________________________*/
void split_and(struct clause *c)
/* From and(a,b) | c infer a | c and b | c. Similarly for and(a1,...an) | c.
From and(or(a1,a2),b) | c infer a1 | a2 | c and b | c.
Append the new inferences to sos.
*/
{ struct literal *marker = c->first_lit;
struct literal *marker2, *prev;
struct literal *q;
struct term *t;
struct clause *aclause;
struct rel *r;
struct int_ptr *ip0,*ip1;
while(marker)
{ if(marker->sign && marker->atom->sym_num == AND)
break; // the rule will apply.
marker=marker->next_lit;
}
if(!marker)
return; // not applicable
t = marker->atom; // the AND term
for(r=t->farg;r;r=r->narg) // go through the args of t
{ aclause = get_clause();
// copy c into aclause, but put r->argval in at the place corresponding to marker
prev = NULL;
for(marker2 = c->first_lit;marker2; marker2=marker2->next_lit)
{ if(marker2 == marker)
{ q = get_literal();
q->sign = 1;
q->atom = copy_term(r->argval);
if(!prev)
aclause->first_lit = q;
else
prev->next_lit = q;
q->next_lit = NULL;
q->container = aclause;
prev = q;
continue;
}
// make a copy of the next literal in c and append it to aclause
q = get_literal();
q->atom = copy_term(marker2->atom);
q->container = marker2->container;
if(prev)
prev->next_lit = q;
else
aclause->first_lit = q;
prev = q;
q->next_lit = NULL;
q->sign = marker2->sign;
q->target = marker2->target;
q->container = aclause;
}
// set the parents of aclause
ip0 = get_int_ptr();
ip1 = get_int_ptr();
ip1->next = NULL;
ip0->i = SPLIT_AND;
ip0->next = ip1;
ip1->i = c->id;
aclause->parents = ip0;
// now append aclause to sos
pre_process(aclause,0,Sos);
}
}
/*________________________________________________________________________________*/
void split_or(struct clause *c)
/* From or(a,b) | c infer a | b | c.
Similarly for or(a1,...,an).
Append the new clause to sos.
*/
{ struct literal *marker = c->first_lit;
struct literal *marker2, *prev;
struct literal *q;
struct term *t;
struct clause *aclause;
struct rel *r;
struct int_ptr *ip0,*ip1;
while(marker)
{ if(marker->sign && marker->atom->sym_num == OR)
break; // the rule will apply.
marker=marker->next_lit;
}
if(!marker)
return; // not applicable
t = marker->atom; // the OR term
aclause = get_clause(); // we only need one new clause.
// copy c into aclause, but put in new literals at the place corresponding to marker,
prev = NULL;
for(marker2 = c->first_lit;marker2; marker2=marker2->next_lit)
{ if(marker2 == marker)
{ for(r = t->farg;r;r=r->narg)
{ q = get_literal();
q->sign = 1;
q->atom = copy_term(r->argval);
if(!prev)
aclause->first_lit = q;
else
prev->next_lit = q;
q->next_lit = NULL;
q->container = aclause;
prev = q;
continue;
}
}
else
{ // make a copy of the next literal in c and append it to aclause
q = get_literal();
q->atom = copy_term(marker2->atom); // what about ref counts, etc? Should I copy this term?
q->container = marker2->container;
if(prev)
prev->next_lit = q;
else
aclause->first_lit = q;
prev = q;
q->next_lit = NULL;
q->sign = marker2->sign;
q->target = marker2->target;
q->container = aclause;
}
}
// set the parents of aclause
ip0 = get_int_ptr();
ip1 = get_int_ptr();
ip1->next = NULL;
ip0->i = SPLIT_OR;
ip0->next = ip1;
ip1->i = c->id;
aclause->parents = ip0;
// now append aclause to sos
pre_process(aclause,0,Sos);
}
/*________________________________________________________________________________*/
void split_not_and(struct clause *c)
/* From -and(a,b) | c infer -a | -b | c.
Similarly for -and(a1,...,an).
Append the new clause to sos.
*/
{ struct literal *marker = c->first_lit;
struct literal *marker2, *prev;
struct literal *q;
struct term *t;
struct clause *aclause;
struct rel *r;
struct int_ptr *ip0,*ip1;
while(marker)
{ if(!marker->sign && marker->atom->sym_num == AND)
break; // the rule will apply.
marker=marker->next_lit;
}
if(!marker)
return; // not applicable
t = marker->atom; // the AND term
aclause = get_clause(); // we only need one new clause.
// copy c into aclause, but put in new literals at the place corresponding to marker,
// with a negation sign, corresponding to the args of t.
prev = NULL;
for(marker2 = c->first_lit;marker2; marker2=marker2->next_lit)
{ if(marker2 == marker)
{ for(r = t->farg;r;r=r->narg)
{ q = get_literal();
q->sign = 0;
q->atom = copy_term(r->argval);
if(!prev)
aclause->first_lit = q;
else
prev->next_lit = q;
q->next_lit = NULL;
q->container = aclause;
prev = q;
continue;
}
}
else
{ // make a copy of the next literal in c and append it to aclause
q = get_literal();
q->atom = copy_term(marker2->atom); // what about ref counts, etc? Should I copy this term?
q->container = marker2->container;
if(prev)
prev->next_lit = q;
else
aclause->first_lit = q;
prev = q;
q->next_lit = NULL;
q->sign = marker2->sign;
q->target = marker2->target;
q->container = aclause;
}
}
// set the parents of aclause
ip0 = get_int_ptr();
ip1 = get_int_ptr();
ip1->next = NULL;
ip0->i = SPLIT_NOT_AND;
ip0->next = ip1;
ip1->i = c->id;
aclause->parents = ip0;
// now append aclause to sos
pre_process(aclause,0,Sos);
}
/*________________________________________________________________________________*/
int max_vars(struct clause *c, struct term *t)
/* return the least number larger than the maximum varnum in c and larger than
the maximum varnum in the clause containing t.
If this is MAX_VARS, cause an abend. You can pass
either c or t as NULL if you want to consider only a clause, or only a term.
*/
{ int max = 0;
struct clause *other;
other = getContainingClause(t);
if(!other)
return c->next_var; // happens when t = $T or $F
if(!c)
return other->next_var;
return c->next_var > other->next_var ? c->next_var : other->next_var;
}
/*________________________________________________________________________________*/
void undo_forbidden(struct trail *tp)
// undo the changes to the forbidden list of the variable that was bound when
// this tp was created.
{ struct term *bound = tp->context->terms[tp->varnum];
if(bound == NULL)
return; // nothing to do. Variable was a bound variable that went out of scope?
if(bound->type == VARIABLE && Flags[LAMBDA_FLAG].val)
{ restrictdata marker, marker2;
struct context *context2 = tp->context->contexts[tp->varnum];
int varnum2 = bound->varnum;
marker = context2->forbidden[varnum2];
while( marker != tp->fp)
{ marker2 = marker;
marker = marker->next;
free_int_ptr(marker2);
}
context2->forbidden[varnum2] = tp->fp;
}
}
/* _________________________________________________________________________*/
struct int_ptr *prepend(struct int_ptr *a, struct int_ptr *b)
/* make a copy of a, and make its last member point to *b, and
return a pointer to the front of this new list */
{ struct int_ptr *marker, *marker2;
struct int_ptr *ans;
if(a == NULL)
return b;
marker = a;
ans = get_int_ptr();
marker2 = ans;
while(marker->next)
{ marker2->i = marker->i;
marker2->next = get_int_ptr();
marker = marker->next;
marker2 = marker2->next;
}
marker2->i = marker->i;
marker2->next = b;
return ans;
}
/* _________________________________________________________________________*/
void fix_forbidden(int i, struct context *c1, int j, struct context *c2, struct trail *tr)
/* variable number i in c1 is being bound to variable number j in c2.
Change the forbidden list in c2 accordingly and store the old one in tr
*/
{ tr->fp = c2->forbidden[j];
if(c1->forbidden[i])
c2->forbidden[j] = prepend(c1->forbidden[i], c2->forbidden[j]);
}
/*_____________________________________________________________________________*/
static void freevars(struct term *t, int varnums[MAX_VARS])
/* fill in 1 for the entries in varnums corresponding to free variables
of t, and -1 for the bound variables, and 0 for variables that don't occur. */
{ struct rel *r;
if(t->type == VARIABLE && varnums[t->varnum] != -1)
{ varnums[t->varnum] = 1;
return;
}
if(t->type == NAME)
return;
if(BINDER(t->sym_num))
varnums[ARG0(t)->varnum] = -1;
for(r = t->farg;r;r=r->narg)
freevars(r->argval,varnums);
}
/*_____________________________________________________________________________*/
static int get_var(struct term *w, struct context *c1, struct term * t, struct context *c2, struct trail **trp)
/* If w is already assigned in c1 to a variable in c2, return that variable's
varnum.
Otherwise, if there are free variables in t that are not yet assigned a value in c2,
and are free in t, return one of them, assigning it in c2 to (w,c1).
Otherwise, dereference one of the variables in (t,c2) and
return a variable contained in the dereferenced value. If no such variable exists
return NULL.
*/
{ int varnums[MAX_VARS];
int i,j;
if(w->type == VARIABLE)
{ struct term *W = c1->terms[w->varnum];
if(W != NULL)
{ // w has been assigned a value in c1->terms[w->varnum]
struct context *c3 = c1;
if(W->type == VARIABLE)
{ DEREFERENCE(W,c3)
if(W->type == VARIABLE && c3==c2)
return W->varnum;
}
}
// maybe some variable in c2 has been assigned w as a value
for(j=0;j<MAX_VARS;j++)
{ if(c2->terms[j] == w && c2->contexts[j] == c1)
return w->varnum;
if(j == c2->next_var)
break;
}
}
memset(varnums,0,MAX_VARS*sizeof(int));
freevars(t,varnums);
for(i=0; i < c2->next_var;i++)
{ if(varnums[i] == 1 &&
occur_check(i,c2,w,c1) &&
c2->bound[i] == 0 && // not a lambda-bound variable
c2->terms[i] == NULL // not already assigned in c2
)
{ BIND(i,c2,w,c1,trp);
return i;
}
}
return -1;
}
/*_______________________________________________________*/
struct rel * unify_lambda(struct term *t1, struct context *c1,
struct term *t2, struct context *c2, struct trail **trp, struct trail *tpos)
/* t1 and t2 have the same functor and it satisfies BINDER, e.g. is LAMBDA.
This is called from unify and should return NULL if unification is to
succeed, and non-NULL if it is to fail. The trail will be restored in
unify after this function returns.
*/
{ struct term *saveboundval1, *saveboundval2;
int savebound1, savebound2;
intlist saveforbidden1, saveforbidden2;
int bindflag = 0;
struct rel *r1 = t1->farg;
struct rel *r2 = t2->farg;
struct context *c4;
struct term *pq;
if(t1 == t2 && c1 == c2)
return NULL; // happens fairly often, so speed up.
if(ARG0(t1)->type != VARIABLE || ARG0(t2)->type != VARIABLE) // 7.18.03
assert(0); // 7.18.03
#ifdef DIAGNOSTICS
V(c1,c2); // 7.18.03
fprintf(stdout,"Trying to unify\n"); // DEBUG
print_term_nl(stdout,t1); print_term_nl(stdout,t2); // DEBUG
#endif
saveboundval1 = c1->terms[ARG0(t1)->varnum];
saveboundval2 = c2->terms[ARG0(t2)->varnum];
savebound1 = c1->bound[ARG0(t1)->varnum];
savebound2 = c2->bound[ARG0(t2)->varnum];
c1->bound[ARG0(t1)->varnum] = 1; // 7.2.04; was 0 since 7.18.03
c2->bound[ARG0(t2)->varnum] = 1; //7.2.04; was 0 since 7.18.03
saveforbidden1 = c1->forbidden[ARG0(t1)->varnum]; //6.13.04
c1->forbidden[ARG0(t1)->varnum] = NULL; //6.13.04
saveforbidden2 = c1->forbidden[ARG0(t2)->varnum]; //6.13.04
c1->forbidden[ARG0(t2)->varnum] = NULL; //6.13.04
if(c1 != c2 || ARG0(t1)->varnum != ARG0(t2)->varnum)
{ BIND(ARG0(t1)->varnum,c1,ARG0(t2),c2,trp); // 7.19.03
bindflag = 1;
free_trail(*trp); // 7.19.03
*trp = tpos; // 7.19.03
}
#ifdef DIAGNOSTICS
V(c1,c2); // DEBUG 7.17.03
#endif
// example: Unify lambda(x,y) with lambda(x,f(x)). The "solution" y = f(x)
// is wrong since substituting y = f(x) in lambda(x,y) gives lambda(z,f(x)),
// because the bound variable is renamed to avoid capture. Therefore:
forbid_all_but(ARG0(t2),c2,t1,c1,ARG0(t2),c2); // Added 8.01.03; changed 6.1.04
// forbid_all_but(ARG0(t2),c2,t2,c2,ARG0(t1),c1); // Added 4.29.04
forbid_all(t2,c2,ARG0(t2),c2);
#ifdef DIAGNOSTICS
V(c1,c2); // DEBUG 8.01.03
#endif
r1 = r1->narg;
r2 = r2->narg; // we've already unified the first arguments
while (r1 && unify(r1->argval, c1, r2->argval, c2, trp))
{ r1 = r1->narg;
r2 = r2->narg;
}
pq = c1->terms[ARG0(t1)->varnum]; // which is a variable in c2 if bindflag
if(pq && pq->type == VARIABLE)
{ // catch a loop in which pq is assigned back to ARG0(t1)->varnum in c1
struct term *w = c2->terms[pq->varnum];
if(w != NULL && c2->contexts[pq->varnum] == c1 &&
w->type == VARIABLE && w->varnum == ARG0(t1)->varnum)
assert(0); // this shouldn't happen
else
{ c4 = c2;
DEREFERENCE(pq,c4);
}
}
if(pq && pq->type != VARIABLE)
{ r1 = (struct rel *) 1; // not zero, so unification will fail
goto out;
}
pq = c2->terms[ARG0(t2)->varnum];
if(pq && pq->type == VARIABLE)
{ struct term *w = c1->terms[pq->varnum];
if(w != NULL && c1->contexts[pq->varnum] == c2 &&
w->type == VARIABLE && w->varnum == ARG0(t2)->varnum)
assert(0);
else
{ c4 = c1;
DEREFERENCE(pq,c4);
}
}
if(pq && pq->type != VARIABLE)
{ r1 = (struct rel *) 1; // not zero, so unification will fail
goto out;
}
out:
if(c1->forbidden[ARG0(t1)->varnum])
free_int_list(c1->forbidden[ARG0(t1)->varnum]);
c1->forbidden[ARG0(t1)->varnum] = saveforbidden1;
if(c2->forbidden[ARG0(t2)->varnum])
free_int_list(c2->forbidden[ARG0(t2)->varnum]);
c2->forbidden[ARG0(t2)->varnum] = saveforbidden2;
c1->bound[ARG0(t1)->varnum] = savebound1; // Beeson 7.19.03 restore original value
c2->bound[ARG0(t2)->varnum] = savebound2; // Beeson 7.19.03
c1->terms[ARG0(t1)->varnum] = saveboundval1; // Beeson 7.19.03
/* but don't try to restore c2->terms[ARG0(t2)->varnum] this way, since it either
hasn't changed, or was assigned by unify, and will be reset when unify fails below. */
// c2->terms[ARG0(t2)->varnum] = saveboundval2; // Beeson 7.19.03 WRONG
if(r1 == NULL && c2->terms[ARG0(t2)->varnum])
{ // unify is going to succeed, so we do need to get rid of the
// entry c2->terms[ARG0(t2)->varnum]. But it has to be done through
// the trail.
struct trail *t3 = *trp;
struct trail *prev = NULL;
while(t3 && (t3->varnum != ARG0(t2)->varnum || t3->context != c2))
{ prev = t3;
t3 = t3->next;
}
if(!t3)
assert(0); // that assignment had to be made somewhere in the trail
// Now remove that entry in the trail.
if(prev)
prev->next = t3->next;
else
*trp = t3 ->next;
undo_forbidden(t3);
t3->context->terms[t3->varnum] = NULL;
free_trail(t3);
}
#ifdef DIAGNOSTICS
if(FUNCTOR(ARG1(t1)) != AP && FUNCTOR(ARG1(t2)) != AP) //DEBUG
{
if(r1) // DEBUG
fprintf(stdout, "unify failed\n"); // DEBUG
else // DEBUG
{ V(c1,c2); // DEBUG
fprintf(stdout, "unify succeeded\n"); // DEBUG
}
}
#endif
return r1;
}
/*________________________________________________________________________________*/
static struct term *getMaskingSubterm(struct term *a, struct context **cp,
struct term *X, struct context *c1,
struct term *t, struct context *c2,
struct term *w)
/* (X,c1) is a variable; t contains X or some variable(s) forbidden to X.
Return a subterm r of t that
(1) contains all the occurrences in t of X or variables forbidden to X;
(2) occurs as the second arg of an Ap term;
(3) r does not contain any variables marked as lambda-bound in context c2,
or any variables forbidden to w in c1.
(4) no subterm of r has properties (1)-(3).
If there is no such subterm, and a is NULL, return NULL;
else return ARG1(a). Precondition: a is passed in as either NULL
(for the toplevel call) or as an Ap term containing t as a subterm of its
second arg.
*/
{ struct rel *r,*q;
int oflag;
int count = 0;
int argnumber = 0;
int whicharg;
if(t->type == NAME ||
(t->type == VARIABLE && c2->terms[t->varnum] == NULL)
)
{ if(c2->bound[t->varnum]) // 7.5.05
return NULL; // 7.5.05
if(forbidden(t,c2,w,c1)) // 7.5.05
return NULL; // 7.5.05
return a ? ARG1(a) : NULL;
}
if(t->type == VARIABLE)
return getMaskingSubterm(a,cp,X,c1,c2->terms[t->varnum],c2->contexts[t->varnum],w);
for(r = t->farg;r;r = r->narg, ++argnumber)
{ oflag = occur_check2(X->varnum,c1,r->argval,c2);
if(!oflag)
{ ++count;
if(count == 1)
{ q = r;
whicharg = argnumber;
}
}
}
if(count == 1)
{ if(FUNCTOR(t) == AP && whicharg == 1)
{ a = t;
*cp = c2;
}
return getMaskingSubterm(a,cp,X,c1,q->argval,c2,w);
}
if(a== NULL)
return NULL;
return ARG1(a); // can't go deeper
}
/*_________________________________________________*/
void free_int_list(struct int_ptr *p)
{ if(p->next == NULL)
{ free_int_ptr(p);
return;
}
free_int_list(p->next);
free_int_ptr(p);
}
/*_________________________________________________*/
void free_forbidden(struct context *c)
// free the linked lists in c->forbidden and reset each entry to NULL
{ int i;
for(i=0;i<MAX_VARS;i++)
{ if(c->forbidden[i])
free_int_list(c->forbidden[i]);
}
memset(c->forbidden,0,MAX_VARS*sizeof(unsigned char));
}
/*_________________________________________________*/
int term_ident2(struct term *t1,struct term *t2, int depthflag)
// return 1 if t1 and t2 are identical except for
// renaming of bound variables. This is only applied
// to well-formed terms that are either in the same context
// or are constant (contain only lambda-bound variables).
{ static int matched[MAX_VARS];
int oldmatch,v;
if(depthflag == 0)
memset(matched,0,MAX_VARS*sizeof(int));
if (t1->type != t2->type)
return 0;
if (t1->type == COMPLEX)
{ if (t1->sym_num != t2->sym_num)
return 0;
else
{ struct rel *r1 = t1->farg;
struct rel *r2 = t2->farg;
if (BINDER(t1->sym_num))
{ v = r1->argval->varnum % MAX_VARS;
oldmatch = matched[v]; // entering scope of this bound variable
matched[v] = r2->argval->varnum + 1;
}
while (r1 && r2 && term_ident2(r1->argval,r2->argval,1))
{ r1 = r1->narg;
r2 = r2->narg;
}
if(BINDER(t1->sym_num))
matched[v] = oldmatch; // leaving scope of this bound variable
return (r1 == NULL && r2 == NULL);
}
}
if (t1->type == VARIABLE)
{ if(matched[t1->varnum % MAX_VARS] == t2->varnum+1)
return 1;
return (t1->varnum == t2->varnum);
}
else /* NAME */
return (t1->sym_num == t2->sym_num);
} /* term_ident2 */
/*_______________________________________________*/
static void distinct_free_vars_rec(struct term *t,
int *a, int *b,
int *max)
// similar to McCune's distinct_free_vars_rec in clause.c
// but does not count lambda-bound variables
{
struct rel *r;
int i, vn;
if (t->type == VARIABLE)
{ vn = t->varnum;
// first check that it's not in the b array
for(i=0;i<MAX_VARS && b[i] != -1 && b[i] != vn; i++);
if(i != MAX_VARS && b[i]!= vn)
{ // it's not bound, so enter it in the a array
for (i = 0; i < MAX_VARS && a[i] != -1 && a[i] != vn; i++);
if (i != MAX_VARS && a[i] == -1)
{ a[i] = vn;
*max = i+1;
}
}
}
else if (t->type == COMPLEX)
{ if(BINDER(t->sym_num))
{ int vn = t->farg->argval->varnum;
// enter vn in the b array if it's not already there
for(i=0;i < MAX_VARS && b[i] != -1 && b[i] != vn; i++);
if(i != MAX_VARS && b[i] == -1)
b[i] = vn;
// check for an error:
for(i=0;i < MAX_VARS && a[i] != -1 && a[i] != vn;i++);
if(i<MAX_VARS && a[i] == vn)
assert(0);
}
for (r = t->farg; r && *max < MAX_VARS; r = r->narg)
distinct_free_vars_rec(r->argval, a,b, max);
}
} /* distinct_vars_rec */
int distinct_free_vars(struct clause *c)
// replacement for McCune's distinct_vars, that does not count
// lambda-bound variables.
{
struct literal *lit;
int a[MAX_VARS], i,j, max;
int b[MAX_VARS]; // for the bound variables
for (i = 0; i < MAX_VARS; i++)
{ a[i] = -1;
b[i] = -1;
}
for (lit = c->first_lit, max = 0; lit; lit = lit->next_lit)
distinct_free_vars_rec(lit->atom, a,b, &max);
// Now just check that no variable occurs both free and bound.
for(i=0;a[i]!= -1 && i < MAX_VARS; i++)
for(j=0;b[j]!= -1 && j < MAX_VARS; j++)
{ if(a[i] == b[j])
{ // printf("Got here\n");
abend("variable occurs both free and lambda-bound in the same clause.");
}
}
return(max);
} /* distinct_free_vars */
/*_______________________________________________________*/
/* match2 is a substitute for McCune's 'match' in unify.c
That needs to be supplemented to handle examples like the following.
Let c = g(n,lambda(x,a+x=x+a)) and c' like c but with y in place of x.
Then we want c+a = a+c' to match c+a = a+c since they differ only
by renaming bound variables. McCune's match will work one way
but not the other, giving c+a=a+c as an instance of c+a = a+c'
but not the other way around, since when it comes to the second
occurrence of x, it fails because x has already been bound to x and
cannot now be bound to y.
*/
int match2(struct term *t1,
struct context *c1,
struct term *t2,
struct trail **trp)
{ int vn;
struct term *saveit;
intlist saveforbidden;
struct trail *tpos,*tp;
struct rel *r1,*r2;
if (t1->type == VARIABLE)
{ /* t1 variable */
vn = t1->varnum;
if (c1->terms[vn] == NULL)
{ BIND(vn, c1, t2,NULL , trp);
return 1;
}
return term_ident(c1->terms[vn], t2);
// term_ident now counts two terms as equivalent if they
// differ only by renaming lambda-bound variables
}
if (t2->type == VARIABLE) /* t1 not variable, t2 variable, so fail */
return 0;
/* Now neither term is a variable */
if (t1->sym_num != t2->sym_num)
return 0; /* fail because of symbol clash */
if(BINDER(t1->sym_num))
{ vn = ARG0(t1)->sym_num;
saveit = c1->terms[vn];
// saveit could be non-null if the same lambda-bound variable
// is bound again inside the scope of the outer binding
saveforbidden = c1->forbidden[vn];
c1->forbidden[vn] = NULL;
c1->terms[vn] = ARG0(t2);
}
/* following handles both names and complex terms */
tpos = *trp; /* save trail position in case of failure */
r1 = t1->farg;
r2 = t2->farg;
while (r1 && r2 && match2(r1->argval, c1, r2->argval, trp))
{ r1 = r1->narg;
r2 = r2->narg;
}
if(BINDER(t1->sym_num))
{ c1->terms[vn] = saveit;
if(c1->forbidden[vn])
free_int_list(c1->forbidden[vn]);
c1->forbidden[vn] = saveforbidden;
}
if (r1 == NULL && r2 == NULL)
return 1;
/* restore from trail and fail */
tp = *trp;
while (tp != tpos)
{ struct trail *t3 = tp;
tp->context->terms[tp->varnum] = NULL;
tp = tp->next;
free_trail(t3);
}
*trp = tpos;
return 0;
} /* match */
/*___________________________________________________________________________*/
int occur_check2(int vn,
struct context *vc,
struct term *t,
struct context *c)
/* Return 0 iff variable vn occurs in term t under substitution
(including vn = t).
or if t is forbidden to vn (and Flags[SECOND_ORDER_FLAG].val)
Also, if Flags[SECOND_ORDER_FLAG].val, variable CAN occur in t,
if its occurrence is bound.
*/
{ if (t->type == NAME)
return 1;
else if (t->type == COMPLEX) {
struct rel *r = t->farg;
if(BINDER(t->sym_num)) // Beeson 7.6.03
{ // assert(r->argval->type == VARIABLE);
int savebound;
// if( vn == r->argval->varnum) 7.10.06 commented this out
// return 1; // bound occurrences are allowed
savebound = c->bound[r->argval->varnum];
c->bound[r->argval->varnum] = 1;
while (r != NULL && occur_check2(vn, vc, r->argval, c))
r = r->narg;
c->bound[t->farg->argval->varnum] = savebound;
}
else
{ while (r != NULL && occur_check2(vn, vc, r->argval, c))
r = r->narg;
}
return (r == NULL);
}
else { /* variable */
int tvn = t->varnum;
if (tvn == vn && c == vc)
return 0; /* fail occur_check here */
else if(forbidden2(vn,vc,tvn,c))
return 0;
else if (c->terms[tvn] == NULL)
return 1; /* uninstantiated variable */
else if (c->bound[tvn] && c->terms[tvn]->type == VARIABLE && c->contexts[tvn]->bound) // 7.10.2006
return 1; /* a temporarily instantiated variable as described in the comments above */
else
return occur_check2(vn, vc, c->terms[tvn], c->contexts[tvn]);
}
} /* occur_check2 */
/*__________________________________________________________________________*/
static void forbid_all_but(struct term *z,struct context *d, struct term *a, struct context *c1, struct term *x, struct context *c2)
/* forbid all uninstantiated free variables in a, other than x itself, and z, to take the value x */
/* presumes z is a variable. When a == x, return without doing anything, even if
a is already instantiated. */
{ struct rel *r;
int savebound,vn;
if(z->type != VARIABLE)
assert(0);
if(a->type == VARIABLE &&
((a->varnum == z->varnum)||c1->bound[a->varnum])
)
return; // doing nothing
if(a->type == VARIABLE && (TYPE(x) != VARIABLE || a->varnum != x->varnum || c1 != c2))
{ if(c1->terms[a->varnum])
{ // a is already instantiated
forbid_all_but(z,d,c1->terms[a->varnum],c1->contexts[a->varnum],x,c2);
return;
}
// now a is an uninstantiated variable
if(c1->bound[a->varnum] == 0 && !forbidden2(a->varnum,c1,x->varnum,c2))
forbid(a,c1,x,c2);
return;
}
else if(a->type == NAME ||
(a->type == VARIABLE &&
(a->varnum == x->varnum || a->varnum == z->varnum)
)
)
return;
// now a->type == COMPLEX
if(BINDER(a->sym_num))
{ vn = ARG0(a)->varnum;
savebound = c1->bound[vn];
c1->bound[vn] = 1;
}
r = a->farg;
while(r != NULL)
{ forbid_all_but(z,d,r->argval,c1,x,c2);
r = r->narg;
}
if(BINDER(a->sym_num))
c1->bound[vn] = savebound;
}
/*__________________________________________________*/
static int bd_aux(struct term *t)
/* return the binding depth of t, i.e the max number
of nested lambdas contained in c. One lambda with
no lambdas inside counts as binding depth 1.
*/
{ int ans = 0;
struct rel *r;
int k;
if(t->type == NAME || t->type == VARIABLE)
return 0;
if(t->sym_num == LAMBDA)
return 1 + bd_aux(ARG1(t));
for(r= t->farg; r; r=r->narg)
{ k = bd_aux(r->argval);
if( ans < k)
ans = k;
}
return ans;
}
/*__________________________________________________*/
int binding_depth(struct clause *c)
/* return the maximum number of nested lambdas contained in c.
One lambda with no lambdas inside counts as binding depth 1.
*/
{ struct literal *l;
int ans=0,k;
for(l = c->first_lit; l ; l = l->next_lit)
{ if(l == c->first_lit)
ans = bd_aux(l->atom);
else
{ k = bd_aux(l->atom);
if(k > ans)
ans = k;
}
}
return ans;
}
/*_______________________________________________________*/
void rename3(struct term *t, struct context *c)
/* If t contains lambda-bound variables that occur free in c,
rename them, and adjust c->nextvar accordingly. Specifically,
if variable with varnum k is encountered, check if
c->bound[k], and if so do nothing; if not check if
k >= c->next_var, and if so do nothing except adjust
c->next_var = k+1; and if k < c->next_var, rename k to
c->next_var and increment c->next_var.
*/
{ if(t->type != COMPLEX)
return;
//if(BINDER(t->sym_num))
}
/*______________________________________________________*/
static int count33;
static struct context *hey;
#define MY_BIT 04
int verify(struct term *t, struct context *c)
/* check whether t occurs as a subterm of itself. Return 0
if it does, 1 if it is OK. */
{ struct rel *r;
++count33;
if(t->type == VARIABLE && c->terms[t->varnum])
{ int rval = verify(c->terms[t->varnum], c->contexts[t->varnum]);
if(!rval)
printf("Hey");
return rval;
}
if(t->type != COMPLEX) return 1;
if(TP_BIT (t->bits, MY_BIT))
{ print_term(stdout,t);
return 0;
}
if(t == (struct term *) 0x012889b4)
{ printf("Straw's cheaper\n");
hey = c;
}
SET_BIT(t->bits,MY_BIT);
r = t->farg;
if(r == 0)
printf("Ooops!");
while(r && verify(r->argval, c))
r = r->narg;
CLEAR_BIT(t->bits,MY_BIT);
if(r)
print_term(stdout,t);
return r ? 0 : 1;
}
./otter2/unify2.h 0000644 0002044 0001012 00000005614 11120534563 012125 0 ustar beeson
int unify2(struct term *t1, struct context *c1, struct term *t2, struct context *c2, struct trail **trp);
struct rel * unify_lambda(struct term *t1, struct context *c1,
struct term *t2, struct context *c2, struct trail **trp, struct trail *tpos);
int term_ident2(struct term *t1,struct term *t2, int depthflag); // used in match
void forbid(struct term *x, struct context *c1, struct term *y, struct context *c2);
int forbidden2(int vn, struct context *c1, int vn2, struct context *c2);
struct term *newvar(struct context *c1, struct context *c2);
struct term *newvar2(struct context *c1, struct context *c2);
void split_or(struct clause *);
void split_and(struct clause *);
void split_not_or(struct clause *);
void split_not_and(struct clause *);
int max_vars(struct clause *c, struct term *t);
void undo_forbidden(struct trail *tp);
void fix_forbidden(int i, struct context *c1, int j, struct context *c2, struct trail *tr);
void restore_vars(struct context *c1, struct context *c2, int saveit1, int saveit2);
void free_int_list(struct int_ptr *p);
void free_forbidden(struct context *c);
void validate_context(struct context *c); // for debugging only
#define V(c1,c2) {validate_context(c1); validate_context(c2);}
int distinct_free_vars(struct clause *c);
int match2(struct term *t1,struct context *c1,struct term *t2,struct trail **trp);
int occur_check2(int varnum, struct context *c1, struct term *t, struct context *c2);
int binding_depth(struct clause *c);
void rename3(struct term *t, struct context *c);
/* restrictdata is defined as int_ptr, so each entry forbidden[varnum]
in a context is a linked list of integers. Each entry in that list represents
a variable or a constant forbidden to varnum in that context. The entry in
that list is manipulated using the following macros. (We use a list of
integers instead of a list of more structured objects to avoid modifying
McCune's Otter files any more than necessary.)
*/
// in these macros, "F" for "Forbidden"
#define FISVAR(x) (((x) & (1UL << 31)) ? 1 : 0)
#define FSETVAR(x) (int)(( (x) |= (1UL << 31)))
#define FSETCONSTANT(x) ( (x) &= 0x7ffffffU)
#define FSYMNUM(x) ((x) & 0x7ffffff) // for storing sym_num of a constant
#define FSETSYMNUM(x,y) ( x = ((y) & 0x7ffffff))
#define FVARNUM(x) ((x) & 0x3f) // six nonzero bits, since varnums are < 64
#define FSETVARNUM(x,y) ( x = (int) ((unsigned)x & (1UL << 31)) | (((unsigned)x) & 0xffffffc0) | (y))
#define FMULTIPLIER(x) ((int)(((unsigned)((x) & 0x7fffffc0)) >> 6)) // 25 bits, omitting the most significant and the 6 least significant.
// used for storing the context multiplier of a variable
#define FSETMULTIPLIER(x,y) (x = (((y) << 6) | (((unsigned) x) & (1UL << 31)) | (((unsigned) x) & 0x3f)))
/* context multipliers stored in the forbidden list must not be longer than 25 bits then */
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists