-rw-r--r-- 74658 holtrace-20250624/holtrace-verify.c raw
#include <stdio.h>
#include <stdlib.h>
#include <inttypes.h>
#include "vector.h"
#include "in.h"
VECTOR_define_inline(char)
typedef long long num;
VECTOR_define_inline(num)
// ===== general constraints
#define CUTOFF 288230376151711743LL
// but likely to abort before that from running out of heap space
// also, could abort from running out of stack space for recursion
// want this in production, ignoring NDEBUG, always having side effects
#define know(property) ((property) ? 0 : (fprintf(stderr,"code line %d: internal error: failed %s\n",__LINE__,#property), exit(100)))
static num curline = 1; // 1-numbered for error messages
static void reject(const char *err)
{
fprintf(stderr,"line %lld: %s\n",curline,err);
exit(100);
}
// ===== general parsing
// some allowed variations:
// will accept leading zeros
// will not require, e.g., id-1 to be !
// will accept space even when not needed
static num subid_core(const char **s,num id)
{
const char *t = *s;
if (*t == '\n') reject("missing numeric argument");
if (*t == '!') { *s = t+1; return id-1; }
if (*t == '@') { *s = t+1; return id-2; }
if (*t == '#') { *s = t+1; return id-3; }
if (*t == '$') { *s = t+1; return id-4; }
if (*t == '%') { *s = t+1; return id-5; }
if (*t == '^') { *s = t+1; return id-6; }
if (*t == '&') { *s = t+1; return id-7; }
if (*t == '*') { *s = t+1; return id-8; }
if (*t == '(') { *s = t+1; return id-9; }
if (*t == ')') { *s = t+1; return id-10; }
int negate = 0;
if (*t == '-') { ++t; negate = 1; }
num result = 0;
for (;;) {
char c = *t;
if (result >= CUTOFF) {
fprintf(stderr,"line %lld: refusing to handle number %lld\n",curline,result);
exit(100);
}
if (c >= '0' && c <= '9')
result = 32*result+(c-'0');
else if (c >= 'A' && c <= 'V')
result = 32*result+(c-'7');
else break;
++t;
}
if (*t == ' ') ++t;
if (t == *s) reject("non-numeric argument where numeric is expected");
*s = t;
return negate ? id-result : result;
}
static num subid(const char **s,num id)
{
num result = subid_core(s,id);
if (result < 0 || (result >= id && id >= 0)) {
fprintf(stderr,"line %lld: result %lld out of range\n",curline,result);
exit(100);
}
return result;
}
static void noteol(const char *s)
{
if (*s == '\n') reject("empty name");
}
static void eol(const char *s)
{
if (*s != '\n') reject("extra arguments");
}
// ===== name operations
static int name_cmp(const char *s,const char *t)
{
for (;;) {
char a = *s++;
char b = *t++;
if (a > b) return 1;
if (a < b) return -1;
if (a == '\n') return 0;
}
}
static int name_is(const char *s,const char *t)
{
for (;;) {
char a = *s++;
char b = *t++;
if (a != b) return 0;
if (a == '\n') return 1;
}
}
static int name_is_withsplit(const char *s,const char *t,char split)
{
for (;;) {
char a = *s++;
char b = *t++;
if (a == '\n') return b == split;
if (b == split) return 0;
if (a != b) return 0;
}
}
static int nameprimes_is(const char *s,num sprimes,const char *t,num tprimes)
{
for (;;) {
char a = *s;
if (a != '\n') ++s; else if (sprimes) { a = '\''; --sprimes; }
char b = *t;
if (b != '\n') ++t; else if (tprimes) { b = '\''; --tprimes; }
if (a != b) return 0;
if (a == '\n') return 1;
}
}
static num hash_mix(num h)
{
uint32_t h0 = h;
uint32_t h1 = h>>32;
h0 ^= (h1<<5)|(h1>>27);
h1 += (h0<<7)|(h0>>25);
h0 ^= (h1<<11)|(h1>>21);
h1 += (h0<<16)|(h0>>16);
h0 ^= (h1<<5)|(h1>>27);
h1 += (h0<<7)|(h0>>25);
h = h1;
h <<= 32;
h |= h0;
return h;
}
static num name_hash(const char *s)
{
num result = 632422315470652589LL;
for (;;) {
char c = *s++;
if (c == '\n') return result;
result = hash_mix(result+c);
}
}
// ===== type operations
static num numtypes;
typedef struct {
num pos; // position in type_data_state
} type_ptr;
static inline type_ptr pos2type(num pos) {
type_ptr result;
result.pos = pos;
return result;
}
typedef struct {
const char *name;
num subtypes; // -1 for tyvar
num subtypepos; // position in type_subtype_state
num hash;
} type_data;
VECTOR_define_inline(type_data)
VECTOR_define_inline(type_ptr)
static vector_type_data type_data_state;
static inline type_data type2data(type_ptr type) {
return vector_type_data_read(&type_data_state,type.pos);
}
static inline num type2hash(type_ptr type) {
return type2data(type).hash;
}
static vector_type_ptr type_subtype_state;
static inline type_ptr pos2subtype(num pos) {
return vector_type_ptr_read(&type_subtype_state,pos);
}
static int type_cmp(type_ptr type,type_ptr TYPE)
{
if (type.pos == TYPE.pos) return 0;
type_data t = type2data(type);
type_data T = type2data(TYPE);
if (t.subtypes >= 0 && T.subtypes < 0) return 1;
if (T.subtypes >= 0 && t.subtypes < 0) return -1;
int result = name_cmp(t.name,T.name);
if (result) return result;
if (t.subtypes < 0) return 0;
know(T.subtypes == t.subtypes);
for (num i = 0;i < t.subtypes;++i) {
type_ptr subtype = pos2subtype(t.subtypepos+i);
type_ptr SUBTYPE = pos2subtype(T.subtypepos+i);
result = type_cmp(subtype,SUBTYPE);
if (result) return result;
}
return 0;
}
static int type_is(type_ptr type,type_ptr TYPE)
{
if (type.pos == TYPE.pos) return 1;
type_data t = type2data(type);
type_data T = type2data(TYPE);
if (t.hash != T.hash) return 0;
if (t.subtypes != T.subtypes) return 0;
if (!name_is(t.name,T.name)) return 0;
if (t.subtypes < 0) return 0;
know(T.subtypes == t.subtypes);
for (num i = 0;i < t.subtypes;++i) {
type_ptr subtype = pos2subtype(t.subtypepos+i);
type_ptr SUBTYPE = pos2subtype(T.subtypepos+i);
if (!type_is(subtype,SUBTYPE)) return 0;
}
return 1;
}
static int type_is_tyvar(type_ptr type)
{
type_data t = type2data(type);
return t.subtypes < 0;
}
static int type_is_tyvarnamed(type_ptr type,const char *name,char split)
{
type_data t = type2data(type);
if (t.subtypes >= 0) return 0;
return name_is_withsplit(t.name,name,split);
}
// does not constrain arguments
static int type_is_appnamed(type_ptr type,const char *name,char split)
{
type_data t = type2data(type);
if (t.subtypes < 0) return 0;
return name_is_withsplit(t.name,name,split);
}
static int type_is_bool(type_ptr type)
{
type_data t = type2data(type);
if (t.subtypes != 0) return 0;
return name_is(t.name,"bool\n");
}
static int type_is_fun(type_ptr type,type_ptr *from,type_ptr *to)
{
type_data t = type2data(type);
if (t.subtypes != 2) return 0;
if (!name_is(t.name,"fun\n")) return 0;
if (from) *from = pos2subtype(t.subtypepos);
if (to) *to = pos2subtype(t.subtypepos+1);
return 1;
}
static int type_is_funfromto(type_ptr type,type_ptr from,type_ptr to)
{
type_data t = type2data(type);
if (t.subtypes != 2) return 0;
if (!name_is(t.name,"fun\n")) return 0;
if (!type_is(from,pos2subtype(t.subtypepos))) return 0;
if (!type_is(to,pos2subtype(t.subtypepos+1))) return 0;
return 1;
}
// XXX simplicity: could merge with type_some_subst_is
static int type_is_equality(type_ptr type)
{
type_ptr from,to,tofrom,toto;
if (!type_is_fun(type,&from,&to)) return 0;
if (!type_is_fun(to,&tofrom,&toto)) return 0;
if (!type_is(from,tofrom)) return 0;
return type_is_bool(toto);
}
// XXX simplicity: could merge with type_some_subst_is
static int type_is_choice(type_ptr type)
{
type_ptr from,to,fromfrom,fromto;
if (!type_is_fun(type,&from,&to)) return 0;
if (!type_is_fun(from,&fromfrom,&fromto)) return 0;
if (!type_is(fromfrom,to)) return 0;
return type_is_bool(fromto);
}
static int type_is_abstype(type_ptr abstype,const char *abstypename,const char *tyvarnames,num numtyvars,char split)
{
type_data t = type2data(abstype);
if (t.subtypes != numtyvars) return 0;
if (!name_is_withsplit(t.name,abstypename,split)) return 0;
const char *z = tyvarnames;
for (num i = 0;i < numtyvars;++i) {
type_ptr subtype = pos2subtype(t.subtypepos+i);
if (!type_is_tyvarnamed(subtype,z,split)) return 0;
while (*z != split) ++z;
++z;
}
return 1;
}
// 1 if TYPE is result of tyvarnames->abstype substitution into type
static int type_tyvarnames_subst_is(type_ptr type,type_ptr TYPE,type_ptr abstype,num numtyvars,const char *tyvarnames,char split)
{
if (!numtyvars) return type_is(type,TYPE);
type_data t = type2data(type);
type_data T = type2data(TYPE);
if (t.subtypes != T.subtypes) return 0;
if (t.subtypes >= 0) {
if (!name_is(t.name,T.name)) return 0;
for (num i = 0;i < t.subtypes;++i) {
type_ptr subtype = pos2subtype(t.subtypepos+i);
type_ptr SUBTYPE = pos2subtype(T.subtypepos+i);
if (!type_tyvarnames_subst_is(subtype,SUBTYPE,abstype,numtyvars,tyvarnames,split))
return 0;
}
return 1;
}
const char *z = tyvarnames;
for (num i = 0;i < numtyvars;++i) {
if (type_is_tyvarnamed(type,z,split)) {
// e.g. tyvars are A B C
// and we've found that type matches B
// so now want to check that TYPE matches second position in abstype
type_data a = type2data(abstype);
know(a.subtypes == numtyvars);
type_ptr abstypei = pos2subtype(a.subtypepos+i);
return type_is(TYPE,abstypei);
}
while (*z != split) ++z;
++z;
}
// type is tyvar not in tyvars
// so look for exact match
return type_is(type,TYPE);
}
static int type_subst_is(vector_type_ptr *from,vector_type_ptr *to,type_ptr type,type_ptr TYPE)
{
type_data t = type2data(type);
type_data T = type2data(TYPE);
if (t.subtypes >= 0) {
if (T.subtypes != t.subtypes) return 0;
if (!name_is(t.name,T.name)) return 0;
for (num i = 0;i < t.subtypes;++i) {
type_ptr subtype = pos2subtype(t.subtypepos+i);
type_ptr SUBTYPE = pos2subtype(T.subtypepos+i);
if (!type_subst_is(from,to,subtype,SUBTYPE))
return 0;
}
return 1;
}
num len = vector_type_ptr_len(from);
know(len == vector_type_ptr_len(to));
for (num i = 0;i < len;++i)
if (type_is(type,vector_type_ptr_read(from,i)))
return type_is(TYPE,vector_type_ptr_read(to,i));
return type_is(type,TYPE);
}
static int type_substboth_is(vector_type_ptr *from,vector_type_ptr *to,type_ptr type,type_ptr TYPE)
{
type_data t = type2data(type);
type_data T = type2data(TYPE);
if (t.subtypes < 0) {
num len = vector_type_ptr_len(from);
know(len == vector_type_ptr_len(to));
for (num i = 0;i < len;++i)
if (type_is(type,vector_type_ptr_read(from,i))) {
type = vector_type_ptr_read(to,i);
break;
}
return type_subst_is(from,to,TYPE,type);
}
if (T.subtypes < 0) {
num len = vector_type_ptr_len(from);
know(len == vector_type_ptr_len(to));
for (num i = 0;i < len;++i)
if (type_is(TYPE,vector_type_ptr_read(from,i))) {
TYPE = vector_type_ptr_read(to,i);
break;
}
return type_subst_is(from,to,type,TYPE);
}
if (T.subtypes != t.subtypes) return 0;
if (!name_is(t.name,T.name)) return 0;
for (num i = 0;i < t.subtypes;++i) {
type_ptr subtype = pos2subtype(t.subtypepos+i);
type_ptr SUBTYPE = pos2subtype(T.subtypepos+i);
if (!type_substboth_is(from,to,subtype,SUBTYPE))
return 0;
}
return 1;
}
// XXX simplicity: maybe merge with type_subst_is
static int type_find_subst_append(vector_type_ptr *from,vector_type_ptr *to,type_ptr type,type_ptr TYPE)
{
type_data t = type2data(type);
type_data T = type2data(TYPE);
if (t.subtypes >= 0) {
if (T.subtypes != t.subtypes) return 0;
if (!name_is(t.name,T.name)) return 0;
for (num i = 0;i < t.subtypes;++i) {
type_ptr subtype = pos2subtype(t.subtypepos+i);
type_ptr SUBTYPE = pos2subtype(T.subtypepos+i);
if (!type_find_subst_append(from,to,subtype,SUBTYPE))
return 0;
}
return 1;
}
num len = vector_type_ptr_len(from);
know(len == vector_type_ptr_len(to));
for (num i = 0;i < len;++i)
if (type_is(type,vector_type_ptr_read(from,i)))
return type_is(TYPE,vector_type_ptr_read(to,i));
vector_type_ptr_append(from,type);
vector_type_ptr_append(to,TYPE);
return 1;
}
// 1 if TYPE is result of some substitution into type
static int type_some_subst_is(type_ptr type,type_ptr TYPE)
{
static vector_type_ptr from;
static vector_type_ptr to;
vector_type_ptr_empty(&from);
vector_type_ptr_empty(&to);
if (!type_find_subst_append(&from,&to,type,TYPE)) return 0;
know(type_subst_is(&from,&to,type,TYPE));
return 1;
}
// accumulates unique tyvars in result (not necessarily sorted)
// on top of any existing tyvars
// each tyvar represented as an index within in_buf
// and uniqueness being determined by type_is
static void type_vars_append(vector_type_ptr *result,type_ptr type)
{
type_data t = type2data(type);
if (t.subtypes < 0) {
for (num i = 0;i < vector_type_ptr_len(result);++i)
if (type_is(vector_type_ptr_read(result,i),type))
return;
vector_type_ptr_append(result,type);
return;
}
for (num i = 0;i < t.subtypes;++i)
type_vars_append(result,pos2subtype(t.subtypepos+i));
}
static void type_vars(vector_type_ptr *result,type_ptr type)
{
vector_type_ptr_empty(result);
type_vars_append(result,type);
}
// ===== term operations
static num numterms;
typedef struct {
num pos; // position in term_data_state
} term_ptr;
static inline term_ptr pos2term(num pos) {
term_ptr result;
result.pos = pos;
return result;
}
typedef struct {
type_ptr type;
num hash;
num frees;
num freepos;
union {
const char *name; // for tag 'c' or 'd'
struct {
term_ptr v;
term_ptr x;
} terms; // for tag 'e' or 'f'
} split;
char tag;
} term_data;
VECTOR_define_inline(term_ptr)
VECTOR_define_inline(term_data)
static vector_term_data term_data_state;
static inline term_data term2data(term_ptr term) {
return vector_term_data_read(&term_data_state,term.pos);
}
static inline num term2hash(term_ptr term) {
return term2data(term).hash;
}
static inline char term2tag(term_ptr term) {
return term2data(term).tag;
}
static vector_term_ptr termfrees_state;
static type_ptr term2type(term_ptr term)
{
term_data t = term2data(term);
return t.type;
}
static int term_is_const(term_ptr term,type_ptr *type,const char **name)
{
term_data t = term2data(term);
if (t.tag != 'c') return 0;
if (type) *type = t.type;
if (name) *name = t.split.name;
return 1;
}
static int term_is_var(term_ptr term,type_ptr *type,const char **name)
{
term_data t = term2data(term);
if (t.tag != 'd') return 0;
if (type) *type = t.type;
if (name) *name = t.split.name;
return 1;
}
static int term_is_comb(term_ptr term,type_ptr *type,term_ptr *funterm,term_ptr *pointterm)
{
term_data t = term2data(term);
if (t.tag != 'e') return 0;
if (type) *type = t.type;
if (funterm) *funterm = t.split.terms.v;
if (pointterm) *pointterm = t.split.terms.x;
return 1;
}
static int term_is_abs(term_ptr term,type_ptr *type,term_ptr *fromterm,term_ptr *toterm)
{
term_data t = term2data(term);
if (t.tag != 'f') return 0;
if (type) *type = t.type;
if (fromterm) *fromterm = t.split.terms.v;
if (toterm) *toterm = t.split.terms.x;
return 1;
}
static int term_is(term_ptr term,term_ptr TERM)
{
if (term.pos == TERM.pos) return 1;
term_data t = term2data(term);
term_data T = term2data(TERM);
if (t.hash != T.hash) return 0;
if (t.tag != T.tag) return 0;
if (!type_is(t.type,T.type)) return 0;
if (t.tag == 'c' || t.tag == 'd') return name_is(t.split.name,T.split.name);
if (!term_is(t.split.terms.v,T.split.terms.v)) return 0;
if (!term_is(t.split.terms.x,T.split.terms.x)) return 0;
return 1;
}
// should match ordav in hol-light/fusion.ml
// which is orda when term,TERM are each variables
// caller here guarantees that term,TERM are variables
static int term_alphaorder_cmp_vars(term_ptr term,term_ptr TERM,vector_term_ptr *L)
{
if (term.pos == TERM.pos) return 0;
num lenL = vector_term_ptr_len(L);
for (num i = 2*(lenL/2)-2;i >= 0;i -= 2) {
term_ptr var = vector_term_ptr_read(L,i);
term_ptr VAR = vector_term_ptr_read(L,i+1);
if (term_is(term,var)) return term_is(TERM,VAR) ? 0 : -1;
if (term_is(TERM,VAR)) return 1;
}
term_data t = term2data(term);
term_data T = term2data(TERM);
return name_cmp(t.split.name,T.split.name);
}
// can extend L while running but restores it
static int term_alphaorder_cmp_recursive(term_ptr term,term_ptr TERM,vector_term_ptr *L)
{
if (term.pos == TERM.pos) return 0;
term_data t = term2data(term);
term_data T = term2data(TERM);
if (t.tag > T.tag) return 1;
if (t.tag < T.tag) return -1;
if (t.tag == 'd')
return term_alphaorder_cmp_vars(term,TERM,L);
if (t.tag == 'c') {
int result = name_cmp(t.split.name,T.split.name);
if (result) return result;
return type_cmp(t.type,T.type);
}
if (t.tag == 'e') {
int result = term_alphaorder_cmp_recursive(t.split.terms.v,T.split.terms.v,L);
if (result) return result;
return term_alphaorder_cmp_recursive(t.split.terms.x,T.split.terms.x,L);
}
know(t.tag == 'f');
int result = type_cmp(term2type(t.split.terms.v),term2type(T.split.terms.v));
if (result) return result;
num lenL = vector_term_ptr_len(L);
vector_term_ptr_append(L,t.split.terms.v);
vector_term_ptr_append(L,T.split.terms.v);
result = term_alphaorder_cmp_recursive(t.split.terms.x,T.split.terms.x,L);
vector_term_ptr_trunc(L,lenL);
return result;
}
// accumulates unique tyvars in result (not necessarily sorted)
// on top of any existing tyvars
static void term_tyvars_append(vector_type_ptr *result,term_ptr term)
{
term_data t = term2data(term);
if (t.tag == 'c' || t.tag == 'd') {
type_vars_append(result,t.type);
return;
}
know(t.tag == 'e' || t.tag == 'f');
term_tyvars_append(result,t.split.terms.v);
term_tyvars_append(result,t.split.terms.x);
// scanning type would be redundant for both e and f
// and scanning type by itself is insufficient
// so skip scanning type
}
static void term_tyvars(vector_type_ptr *result,term_ptr term)
{
vector_type_ptr_empty(result);
term_tyvars_append(result,term);
}
static int term_is_eqsymbol(term_ptr term)
{
const char *name;
if (!term_is_const(term,0,&name)) return 0;
return name_is(name,"=\n");
}
static int term_is_equality(term_ptr term,term_ptr *left,term_ptr *right)
{
term_ptr funterm,funfunterm;
if (!term_is_comb(term,0,&funterm,right)) return 0;
if (!term_is_comb(funterm,0,&funfunterm,left)) return 0;
if (!term_is_eqsymbol(funfunterm)) return 0;
return 1;
}
static int term_alphaorder_cmp(term_ptr term,term_ptr TERM)
{
static vector_term_ptr tmp;
know(vector_term_ptr_len(&tmp) == 0);
return term_alphaorder_cmp_recursive(term,TERM,&tmp);
}
static int term_alphaequivalent(term_ptr term,term_ptr TERM)
{
return term_alphaorder_cmp(term,TERM) == 0;
}
static void term_freevars_append(vector_term_ptr *result,term_ptr term)
{
num origlen = vector_term_ptr_len(result);
term_data t = term2data(term);
for (num i = 0;i < t.frees;++i) {
term_ptr v = vector_term_ptr_read(&termfrees_state,t.freepos+i);
int found = 0;
for (num j = 0;j < origlen;++j)
if (term_is(v,vector_term_ptr_read(result,j))) {
found = 1;
break;
}
if (!found)
vector_term_ptr_append(result,vector_term_ptr_read(&termfrees_state,t.freepos+i));
}
}
static void term_freevars(vector_term_ptr *result,term_ptr term)
{
vector_term_ptr_empty(result);
term_data t = term2data(term);
for (num i = 0;i < t.frees;++i)
vector_term_ptr_append(result,vector_term_ptr_read(&termfrees_state,t.freepos+i));
}
static int term_has_freevars(term_ptr term)
{
term_data t = term2data(term);
return t.frees > 0;
}
// 1 if v''' is a free variable in term
static int term_has_free(term_ptr term,term_ptr v,num primes)
{
type_ptr vtype;
const char *vname;
if (!term_is_var(v,&vtype,&vname)) return 0;
term_data t = term2data(term);
for (num i = 0;i < t.frees;++i) {
term_ptr w = vector_term_ptr_read(&termfrees_state,t.freepos+i);
type_ptr wtype;
const char *wname;
know(term_is_var(w,&wtype,&wname));
if (type_is(wtype,vtype))
if (nameprimes_is(wname,0,vname,primes))
return 1;
}
return 0;
}
static int vector_term_contains(vector_term_ptr *list,term_ptr term)
{
num i = vector_term_ptr_len(list);
while (i-- > 0)
if (term_is(term,vector_term_ptr_read(list,i)))
return 1;
return 0;
}
// later entries override earlier entries
// return term if not found
static term_ptr term_map_term(vector_term_ptr *from,vector_term_ptr *to,term_ptr term)
{
num i = vector_term_ptr_len(from);
while (i-- > 0)
if (term_is(term,vector_term_ptr_read(from,i)))
return vector_term_ptr_read(to,i);
return term;
}
// later entries override earlier entries
// return -1 if not found
static num term_map_num(vector_term_ptr *from,vector_num *to,term_ptr term)
{
num i = vector_term_ptr_len(from);
while (i-- > 0)
if (term_is(term,vector_term_ptr_read(from,i)))
return vector_num_read(to,i);
return -1;
}
static int term_subst_obvious_id(term_ptr term,vector_term_ptr *from)
{
term_data t = term2data(term);
for (num i = 0;i < t.frees;++i) {
term_ptr w = vector_term_ptr_read(&termfrees_state,t.freepos+i);
if (vector_term_contains(from,w)) return 0;
}
return 1;
}
// 1 if substituting from->to+primed in term gives TERM
// should match subst in fusion.ml (but algorithm is different)
// primed[j]!=0 implies primed[j]>=0 and to[j] is a variable
static int term_subst_is(term_ptr term,vector_term_ptr *from,vector_term_ptr *to,vector_num *primed,term_ptr TERM)
{
if (term_subst_obvious_id(term,from))
return term_is(term,TERM);
term_data t = term2data(term);
know(t.tag != 'c');
if (t.tag == 'd') {
term_ptr m = term_map_term(from,to,term);
num mprimes = term_map_num(from,primed,term);
know(mprimes >= 0);
if (mprimes == 0) return term_is(m,TERM);
// now m+mprimes is a variable
// want to check if same variable as TERM
type_ptr TERMtype;
const char *TERMname;
if (!term_is_var(TERM,&TERMtype,&TERMname)) return 0;
type_ptr mtype;
const char *mname;
know(term_is_var(m,&mtype,&mname));
if (!type_is(TERMtype,mtype)) return 0;
return nameprimes_is(TERMname,0,mname,mprimes);
}
term_data T = term2data(TERM);
if (T.tag != t.tag) return 0;
if (t.tag == 'e') {
if (!term_subst_is(t.split.terms.v,from,to,primed,T.split.terms.v)) return 0;
if (!term_subst_is(t.split.terms.x,from,to,primed,T.split.terms.x)) return 0;
return 1;
}
know(t.tag == 'f');
term_ptr v = t.split.terms.v;
term_ptr x = t.split.terms.x;
type_ptr vtype;
const char *vname;
know(term_is_var(v,&vtype,&vname));
num len = vector_term_ptr_len(from);
know(len == vector_term_ptr_len(to));
know(len == vector_num_len(primed));
for (num vprimes = 0;;++vprimes) {
if (vprimes >= CUTOFF) reject("too many primes");
// have v |-> x
// considering rewriting as subst(v) |-> subst(x)
// where subst replaces v with v'''
// where number of primes is vprimes
// and subst replaces other vars as per from->to
int ok = 1;
// goal: set ok to 0 if v''' has a problem
// original algorithm determines problem as follows:
// * first try vprimes = 0
// problem is then: some subst f->m with f!=v has f free in x and v free in m
// * if problem, move on to larger vprimes
// * for vprimes>0, define problem as:
// v''' free in origsubst(x)
// where origsubst is from->to ignoring v
// there are really three cases for the v''' problem:
// * if v is free in x: stays as v
// so no match for vprimes>0
// (and this also can be ignored for vprimes=0)
// * if f!=v is free in x and f->m:
// frees(origsubst(x)) includes frees(m)
// so problem if v''' free in m
// (which is also a test we want for vprimes=0)
// * if f!=v is free in x and f not mapped from->to:
// frees(origsubst(x)) includes f
// so problem if v''' free in f (i.e., v''' = f)
// in other words, for each f free in x:
// * if f=v: no problem
// * else if f->m: problem if v''' free in m
// * else: problem if v''' free in f
term_data xdata = term2data(x);
num freelen = xdata.frees;
num freepos = xdata.freepos;
for (num i = 0;i < freelen;++i) {
term_ptr f = vector_term_ptr_read(&termfrees_state,freepos+i);
if (term_is(f,v)) continue;
term_ptr m = term_map_term(from,to,f);
num mprimes = term_map_num(from,primed,f);
if (mprimes < 0) {
know(m.pos == f.pos); // not just term_is(m,f)
mprimes = 0;
}
// is v+vprimes free in m+mprimes?
if (mprimes == 0) {
if (!term_has_free(m,v,vprimes)) continue;
} else { // both v and m are now variables
know(mprimes > 0);
type_ptr mtype;
const char *mname;
know(term_is_var(m,&mtype,&mname));
if (!type_is(vtype,mtype)) continue;
if (!nameprimes_is(vname,vprimes,mname,mprimes)) continue;
}
ok = 0;
break;
}
if (ok) {
vector_term_ptr_append(from,v);
vector_term_ptr_append(to,v);
vector_num_append(primed,vprimes);
int result = term_subst_is(x,from,to,primed,T.split.terms.x);
vector_term_ptr_trunc(from,len);
vector_term_ptr_trunc(to,len);
vector_num_trunc(primed,len);
return result;
}
}
}
// 1 if substituting tyfrom->tyto and varfrom->varto in term gives TERM
// note: if variable is handled by varfrom->varto, ignore tyfrom->tyto
// should match inst in fusion.ml (but algorithm is different)
static int term_tyvar_subst_is_recursive(term_ptr term,vector_type_ptr *tyfrom,vector_type_ptr *tyto,vector_term_ptr *varfrom,vector_term_ptr *varto,term_ptr TERM)
{
term_data t = term2data(term);
term_data T = term2data(TERM);
if (t.tag != T.tag) return 0;
if (t.tag == 'd')
if (vector_term_contains(varfrom,term))
return term_is(term_map_term(varfrom,varto,term),TERM);
if (t.tag == 'c' || t.tag == 'd') {
if (!name_is(t.split.name,T.split.name)) return 0;
return type_subst_is(tyfrom,tyto,t.type,T.type);
}
if (t.tag == 'e') {
term_ptr termfun = t.split.terms.v;
term_ptr TERMfun = T.split.terms.v;
if (!term_tyvar_subst_is_recursive(termfun,tyfrom,tyto,varfrom,varto,TERMfun)) return 0;
term_ptr termpoint = t.split.terms.x;
term_ptr TERMpoint = T.split.terms.x;
return term_tyvar_subst_is_recursive(termpoint,tyfrom,tyto,varfrom,varto,TERMpoint);
}
num varlen = vector_term_ptr_len(varfrom);
know(varlen == vector_term_ptr_len(varto));
int result = 0;
term_ptr v = t.split.terms.v;
term_ptr tterm = t.split.terms.x;
type_ptr vtype;
const char *vname;
know(term_is_var(v,&vtype,&vname));
// do not want to rename v now
// so be careful to override v in varfrom lookups below
term_ptr V = T.split.terms.v;
term_ptr TTERM = T.split.terms.x;
type_ptr Vtype;
const char *Vname;
know(term_is_var(V,&Vtype,&Vname));
// variable capture at this level means:
// subst(v) matches subst(f) for some f free in tterm
// without f being v
// then have to rename v as v''' for some number of primes
term_data tdata = term2data(tterm);
num freelen = tdata.frees;
num freepos = tdata.freepos;
num wprimes;
for (wprimes = 0;;++wprimes) {
if (wprimes >= CUTOFF) reject("too many primes");
// considering v''' as replacement for v
// (or no replacement if wprimes == 0)
// does subst(v''') match subst(f) for some free f != v?
int collision = 0;
for (num i = 0;i < freelen;++i) {
term_ptr f = vector_term_ptr_read(&termfrees_state,freepos+i);
if (term_is(f,v)) continue;
// does subst(v''') match subst(f)?
if (vector_term_contains(varfrom,f)) {
term_ptr m = term_map_term(varfrom,varto,f);
// f is renamed as m
// now want to know:
// does subst(v''') match m?
type_ptr mtype;
const char *mname;
know(term_is_var(m,&mtype,&mname));
if (nameprimes_is(mname,0,vname,wprimes))
if (type_subst_is(tyfrom,tyto,vtype,mtype)) {
collision = 1;
break;
}
} else {
// f is not in varfrom, so just do tyfrom->tyto
type_ptr ftype;
const char *fname;
know(term_is_var(f,&ftype,&fname));
if (nameprimes_is(fname,0,vname,wprimes))
if (type_substboth_is(tyfrom,tyto,vtype,ftype)) {
collision = 1;
break;
}
}
}
if (!collision) break;
}
if (!nameprimes_is(Vname,0,vname,wprimes)) goto done;
if (!type_subst_is(tyfrom,tyto,vtype,Vtype)) goto done;
if (wprimes > 0) {
vector_term_ptr_append(varfrom,v);
vector_term_ptr_append(varto,V);
}
result = term_tyvar_subst_is_recursive(tterm,tyfrom,tyto,varfrom,varto,TTERM);
done:
vector_term_ptr_trunc(varfrom,varlen);
vector_term_ptr_trunc(varto,varlen);
return result;
}
static int term_tyvar_subst_is(term_ptr term,vector_type_ptr *from,vector_type_ptr *to,term_ptr TERM)
{
static vector_term_ptr varfrom;
static vector_term_ptr varto;
know(vector_term_ptr_len(&varfrom) == 0);
know(vector_term_ptr_len(&varto) == 0);
return term_tyvar_subst_is_recursive(term,from,to,&varfrom,&varto,TERM);
}
// ===== theorem operations
static num numthms;
static vector_term_ptr thmdata;
static vector_num thm2datapos;
static vector_term_ptr thm2conclusion;
// see whether thmdata[start:stop] exactly matches h
static int hypotheses_match(num start,num stop,vector_term_ptr *h)
{
if (vector_term_ptr_len(h) != stop-start) return 0;
for (num i = start;i < stop;++i) {
term_ptr hi = vector_term_ptr_read(h,i-start);
if (!term_is(hi,vector_term_ptr_read(&thmdata,i))) return 0;
}
return 1;
}
// extract hypotheses from thmdata[start:stop]
// skipping terms alpha-equivalent to skip if skip>=0
static void hypotheses_extract(vector_term_ptr *result,num start,num stop,term_ptr skip)
{
vector_term_ptr_empty(result);
// XXX speed: can usually speed up alpha test with first-pass equality test
// since we know thmdata[start:stop] are alpha-inequivalent
for (num i = start;i < stop;++i) {
term_ptr h = vector_term_ptr_read(&thmdata,i);
if (skip.pos >= 0 && term_alphaequivalent(h,skip)) continue;
vector_term_ptr_append(result,h);
}
}
// same as hypotheses_extract but taking theorem as input
static void hypotheses_extract_th(vector_term_ptr *result,num th,term_ptr skip)
{
num start = vector_num_read(&thm2datapos,th);
num stop = vector_num_read(&thm2datapos,th+1);
hypotheses_extract(result,start,stop,skip);
}
// merge modulo alpha-equivalence
static void hypotheses_merge(vector_term_ptr *result,vector_term_ptr *h,vector_term_ptr *H)
{
vector_term_ptr_empty(result);
num hlen = vector_term_ptr_len(h);
num Hlen = vector_term_ptr_len(H);
num i = 0;
num I = 0;
for (;;) {
if (i == hlen) {
while (I < Hlen) vector_term_ptr_append(result,vector_term_ptr_read(H,I++));
return;
}
if (I == Hlen) {
while (i < hlen) vector_term_ptr_append(result,vector_term_ptr_read(h,i++));
return;
}
term_ptr hi = vector_term_ptr_read(h,i);
term_ptr HI = vector_term_ptr_read(H,I);
int order = term_alphaorder_cmp(hi,HI);
vector_term_ptr_append(result,(order <= 0 ? hi : HI));
i += (order <= 0);
I += (order >= 0);
}
}
static int hypotheses_aremerged(num start,num stop,num th,num TH,term_ptr thskip,term_ptr THskip)
{
static vector_term_ptr h;
static vector_term_ptr H;
static vector_term_ptr result;
hypotheses_extract_th(&h,th,thskip);
hypotheses_extract_th(&H,TH,THskip);
hypotheses_merge(&result,&h,&H);
return hypotheses_match(start,stop,&result);
}
static int hypotheses_arecopied(num start,num stop,num th)
{
static vector_term_ptr h;
hypotheses_extract_th(&h,th,pos2term(-1));
return hypotheses_match(start,stop,&h);
}
// ===== name->num dictionaries
// XXX speed: maybe use faster associative array
typedef struct {
// for one->3, two->1, three->4, four->1:
vector_char names; // one\ntwo\nthree\nfour\n
vector_num index2pos; // 0 3 6 11
vector_num index2result; // 3 1 4 1
} dict;
static int dict_namematch(dict *d,const char *s,char split,num pos)
{
for (;;) {
char a = *s++;
char b = vector_char_read(&d->names,pos++);
if (a == split) return b == '\n';
if (b == '\n') return 0;
if (a != b) return 0;
}
}
static num dict_lookup(dict *d,const char *s,char split,int *flag)
{
num len = vector_num_len(&d->index2pos);
for (num i = 0;i < len;++i) {
num pos = vector_num_read(&d->index2pos,i);
if (dict_namematch(d,s,split,pos)) {
if (flag) *flag = 1;
return vector_num_read(&d->index2result,i);
}
}
if (flag) *flag = 0;
return -1;
}
static void dict_add(dict *d,const char *s,char split,num result)
{
vector_num_append(&d->index2result,result);
num pos = vector_char_len(&d->names);
vector_num_append(&d->index2pos,pos);
while (*s != split)
vector_char_append(&d->names,*s++);
vector_char_append(&d->names,'\n');
}
static dict absname2typedef_dict;
static num absname2typedef(const char *s) { return dict_lookup(&absname2typedef_dict,s,'\n',0); }
static dict repname2typedef_dict;
static num repname2typedef(const char *s) { return dict_lookup(&repname2typedef_dict,s,'\n',0); }
static dict app2arity_dict;
static num app2arity(const char *s)
{
if (name_is(s,"fun\n")) return 2;
if (name_is(s,"bool\n")) return 0;
if (name_is(s,"ind\n")) return 0;
return dict_lookup(&app2arity_dict,s,'\n',0);
}
// trying to match new_type in fusion.ml
static void app2arity_add(const char *s,char split,num arity)
{
if (name_is_withsplit("fun\n",s,split)) reject("colliding tyapp name");
if (name_is_withsplit("bool\n",s,split)) reject("colliding tyapp name");
if (name_is_withsplit("ind\n",s,split)) reject("colliding tyapp name");
if (dict_lookup(&app2arity_dict,s,split,0) >= 0) reject("colliding tyapp name");
dict_add(&app2arity_dict,s,split,arity);
}
static dict const2type_state;
static type_ptr const2type(const char *s) {
return pos2type(dict_lookup(&const2type_state,s,'\n',0));
}
static void reject_previous_constnames(const char *s,char split)
{
if (name_is_withsplit("=\n",s,split)) reject("const name =");
if (name_is_withsplit("@\n",s,split)) reject("const name @");
if (dict_lookup(&const2type_state,s,split,0) >= 0) reject("colliding const name");
if (dict_lookup(&absname2typedef_dict,s,split,0) >= 0) reject("colliding const name");
if (dict_lookup(&repname2typedef_dict,s,split,0) >= 0) reject("colliding const name");
}
static void const2type_add(const char *s,char split,type_ptr result)
{
reject_previous_constnames(s,split);
dict_add(&const2type_state,s,split,result.pos);
}
// ===== typedefs
static num numtypedefs;
static vector_char typedef2split;
static vector_num typedef2reptype;
static vector_num typedef2repprop;
static vector_num typedef2numtyvars;
static vector_num typedef2abstypename;
static vector_num typedef2absname;
static vector_num typedef2repname;
static vector_num typedef2tyvarnames;
// ===== type tags
static void tag_a(const char *s) // Tyvar
{
noteol(s);
type_data t;
t.name = s;
t.subtypes = -1;
t.subtypepos = -1;
t.hash = name_hash(s);
vector_type_data_append(&type_data_state,t);
}
static void tag_b(const char *s) // Tyapp
{
num arity = subid(&s,-1);
num hash = hash_mix(7152249725402530200+arity);
type_data t;
t.subtypes = arity;
t.subtypepos = vector_type_ptr_len(&type_subtype_state);
for (num i = 0;i < arity;++i) {
type_ptr subtype = pos2type(subid(&s,numtypes));
vector_type_ptr_append(&type_subtype_state,subtype);
hash = hash_mix(hash+type2hash(subtype));
}
noteol(s);
num expectedarity = app2arity(s);
if (expectedarity < 0) reject("undefined app name");
if (expectedarity != arity) reject("wrong number of app arguments");
t.name = s;
t.hash = hash_mix(hash+name_hash(s));
vector_type_data_append(&type_data_state,t);
}
// ===== term tags
static void tag_c(const char *s) // Const
{
type_ptr type = pos2type(subid(&s,numtypes));
noteol(s);
num hash = 1260898140613410013LL;
hash = hash_mix(hash+type2hash(type));
hash = hash_mix(hash+name_hash(s));
term_data t;
t.type = type;
t.hash = hash;
t.frees = 0;
t.freepos = 0;
t.tag = 'c';
t.split.name = s;
vector_term_data_append(&term_data_state,t);
if (name_is(s,"=\n")) {
if (!type_is_equality(type)) reject("non-equality type");
return;
}
if (name_is(s,"@\n")) {
if (!type_is_choice(type)) reject("non-choice type");
return;
}
type_ptr registeredtype = const2type(s);
if (registeredtype.pos >= 0) { // XXX
if (!type_some_subst_is(registeredtype,type)) reject("const type mismatch");
return;
}
// XXX simplicity: merge the absname/repname code segments
num registeredtypedef = absname2typedef(s);
if (registeredtypedef >= 0) {
type_ptr from,to;
if (!type_is_fun(type,&from,&to)) reject("non-function type with typedef name");
char split = vector_char_read(&typedef2split,registeredtypedef);
type_ptr reptype = pos2type(vector_num_read(&typedef2reptype,registeredtypedef));
num numtyvars = vector_num_read(&typedef2numtyvars,registeredtypedef);
const char *abstypename = in_buf+vector_num_read(&typedef2abstypename,registeredtypedef);
const char *absname = in_buf+vector_num_read(&typedef2absname,registeredtypedef);
const char *tyvarnames = in_buf+vector_num_read(&typedef2tyvarnames,registeredtypedef);
know(name_is_withsplit(s,absname,split));
// expecting: absname:reptype->abstype
// modulo substitution for tyvars
if (!type_is_appnamed(to,abstypename,split)) reject("typedef absname-abstype mismatch");
if (!type_tyvarnames_subst_is(reptype,from,to,numtyvars,tyvarnames,split)) reject("typedef absname-reptype mismatch");
return;
}
registeredtypedef = repname2typedef(s);
if (registeredtypedef >= 0) {
type_ptr from,to;
if (!type_is_fun(type,&from,&to)) reject("non-function type with typedef name");
char split = vector_char_read(&typedef2split,registeredtypedef);
type_ptr reptype = pos2type(vector_num_read(&typedef2reptype,registeredtypedef));
num numtyvars = vector_num_read(&typedef2numtyvars,registeredtypedef);
const char *abstypename = in_buf+vector_num_read(&typedef2abstypename,registeredtypedef);
const char *repname = in_buf+vector_num_read(&typedef2repname,registeredtypedef);
const char *tyvarnames = in_buf+vector_num_read(&typedef2tyvarnames,registeredtypedef);
know(name_is_withsplit(s,repname,split));
// expecting: repname:abstype->reptype
// modulo substitution for tyvars
if (!type_is_appnamed(from,abstypename,split)) reject("typedef repname-abstype mismatch");
if (!type_tyvarnames_subst_is(reptype,to,from,numtyvars,tyvarnames,split)) reject("typedef repname-reptype mismatch");
return;
}
reject("undefined constant");
}
static void tag_d(const char *s) // Var
{
type_ptr type = pos2type(subid(&s,numtypes));
noteol(s);
num hash = 5725918395758143510LL;
hash = hash_mix(hash+type2hash(type));
hash = hash_mix(hash+name_hash(s));
term_data t;
t.type = type;
t.hash = hash;
t.frees = 1;
t.freepos = vector_term_ptr_len(&termfrees_state);
t.tag = 'd';
t.split.name = s;
vector_term_ptr_append(&termfrees_state,pos2term(numterms));
vector_term_data_append(&term_data_state,t);
}
static void tag_e(const char *s) // Comb
{
type_ptr outputtype = pos2type(subid(&s,numtypes));
term_ptr funterm = pos2term(subid(&s,numterms));
term_ptr pointterm = pos2term(subid(&s,numterms));
eol(s);
num hash = 3679975592003923231LL;
hash = hash_mix(hash+term2hash(funterm));
hash = hash_mix(hash+term2hash(pointterm));
if (!type_is_funfromto(term2type(funterm),term2type(pointterm),outputtype)) reject("combination mismatch");
num pos,len;
if (!term_has_freevars(funterm)) {
// closed function; common case
term_data p = term2data(pointterm);
pos = p.freepos;
len = p.frees;
} else {
static vector_term_ptr frees;
term_freevars(&frees,funterm);
term_freevars_append(&frees,pointterm);
pos = vector_term_ptr_len(&termfrees_state);
len = vector_term_ptr_len(&frees);
for (num i = 0;i < len;++i)
vector_term_ptr_append(&termfrees_state,vector_term_ptr_read(&frees,i));
}
term_data t;
t.type = outputtype;
t.hash = hash;
t.frees = len;
t.freepos = pos;
t.tag = 'e';
t.split.terms.v = funterm;
t.split.terms.x = pointterm;
vector_term_data_append(&term_data_state,t);
}
static void tag_f(const char *s) // Abs
{
type_ptr outputtype = pos2type(subid(&s,numtypes));
term_ptr fromterm = pos2term(subid(&s,numterms));
term_ptr toterm = pos2term(subid(&s,numterms));
eol(s);
num hash = 4019844455831122549LL;
hash = hash_mix(hash+term2hash(fromterm));
hash = hash_mix(hash+term2hash(toterm));
if (!term_is_var(fromterm,0,0)) reject("non-variable lambda");
if (!type_is_funfromto(outputtype,term2type(fromterm),term2type(toterm))) reject("lambda mismatch");
term_data tt = term2data(toterm);
num pos = tt.freepos;
num len = tt.frees;
for (num i = 0;i < len;++i) {
term_ptr v = vector_term_ptr_read(&termfrees_state,pos+i);
if (term_is(fromterm,v)) {
num newpos = vector_term_ptr_len(&termfrees_state);
num newlen = 0;
for (num j = 0;j < len;++j)
if (j != i) {
vector_term_ptr_append(&termfrees_state,vector_term_ptr_read(&termfrees_state,pos+j));
++newlen;
}
pos = newpos;
len = newlen;
break;
}
}
term_data t;
t.type = outputtype;
t.hash = hash;
t.frees = len;
t.freepos = pos;
t.tag = 'f';
t.split.terms.v = fromterm;
t.split.terms.x = toterm;
vector_term_data_append(&term_data_state,t);
}
// ===== A: TYPE_DEFINITION
// (plus D for followup)
static void absname2typedef_add(const char *s,char split,num result)
{
reject_previous_constnames(s,split);
dict_add(&absname2typedef_dict,s,split,result);
}
static void repname2typedef_add(const char *s,char split,num result)
{
reject_previous_constnames(s,split);
dict_add(&repname2typedef_dict,s,split,result);
}
static vector_type_ptr tag_A_tyvars;
static void tag_A(const char *s)
{
type_ptr reptype = pos2type(subid(&s,numtypes));
term_ptr repprop = pos2term(subid(&s,numterms));
num th = subid(&s,numthms);
noteol(s);
int state = 0;
char split = 0;
const char *abstypename = 0;
const char *absname = 0;
const char *repname = 0;
const char *tyvarnames = 0;
for (;*s != '\n';++s)
switch(state) {
case 0: split = *s; ++state; break;
case 1: abstypename = s; ++state; // fall through
case 2: if (*s == split) ++state; break;
case 3: absname = s; ++state; // fall through
case 4: if (*s == split) ++state; break;
case 5: repname = s; ++state; // fall through
case 6: if (*s == split) { ++state; tyvarnames = s+1; }
}
if (state != 7) reject("TYPE_DEFINITION: misformatted");
if (split != ']') reject("TYPE_DEFINITION: refusing non-bracket");
know(abstypename);
know(absname);
know(repname);
know(tyvarnames);
num numtyvarnames = 0;
for (s = tyvarnames;*s != '\n';++s)
if (*s == split)
++numtyvarnames;
if (s[-1] != split) reject("TYPE_DEFINITION: partial final component");
num thstart = vector_num_read(&thm2datapos,th);
num thstop = vector_num_read(&thm2datapos,th+1);
if (thstart != thstop) reject("TYPE_DEFINITION: input theorem has hypotheses");
term_ptr thconclusion = vector_term_ptr_read(&thm2conclusion,th);
term_ptr reppropcheck;
term_ptr reppoint;
if (!term_is_comb(thconclusion,0,&reppropcheck,&reppoint)) reject("TYPE_DEFINITION: input theorem is not a combination");
if (!term_is(repprop,reppropcheck)) reject("TYPE_DEFINITION: repprop mismatch");
if (!type_is(reptype,term2type(reppoint))) reject("TYPE_DEFINITION: reptype mismatch");
if (term_has_freevars(repprop)) reject("TYPE_DEFINITION: free variables in repprop");
term_tyvars(&tag_A_tyvars,repprop);
if (vector_type_ptr_len(&tag_A_tyvars) != numtyvarnames) reject("TYPE_DEFINITION: wrong number of tyvars");
const char *tyvarname = tyvarnames;
num prevpos = -1;
for (s = tyvarnames;*s != '\n';++s)
if (*s == split) {
num pos;
for (pos = 0;pos < numtyvarnames;++pos) {
type_ptr tyvar = vector_type_ptr_read(&tag_A_tyvars,pos);
if (type_is_tyvarnamed(tyvar,tyvarname,split)) break;
}
if (pos >= numtyvarnames) reject("TYPE_DEFINITION: tyvar not in repprop");
if (prevpos >= 0) {
type_ptr tyvar = vector_type_ptr_read(&tag_A_tyvars,pos);
type_ptr prevtyvar = vector_type_ptr_read(&tag_A_tyvars,prevpos);
if (type_cmp(tyvar,prevtyvar) != 1) reject("TYPE_DEFINITION: tyvars not in increasing order");
}
prevpos = pos;
tyvarname = s+1;
}
num typedefpos = vector_num_len(&typedef2reptype);
app2arity_add(abstypename,split,numtyvarnames);
absname2typedef_add(absname,split,typedefpos);
repname2typedef_add(repname,split,typedefpos);
vector_num_append(&typedef2reptype,reptype.pos);
vector_num_append(&typedef2repprop,repprop.pos);
vector_num_append(&typedef2numtyvars,numtyvarnames);
vector_num_append(&typedef2abstypename,abstypename-in_buf);
vector_num_append(&typedef2absname,absname-in_buf);
vector_num_append(&typedef2repname,repname-in_buf);
vector_num_append(&typedef2tyvarnames,tyvarnames-in_buf);
vector_char_append(&typedef2split,split);
}
static void finish_A(num hypstart,num hypstop,term_ptr conclusion)
{
if (hypstop != hypstart) reject("TYPE_DEFINITION: hypotheses");
num typedefpos = vector_num_len(&typedef2reptype)-1;
know(typedefpos >= 0);
know(typedefpos == vector_num_len(&typedef2numtyvars)-1);
know(typedefpos == vector_num_len(&typedef2abstypename)-1);
know(typedefpos == vector_num_len(&typedef2absname)-1);
know(typedefpos == vector_num_len(&typedef2repname)-1);
know(typedefpos == vector_num_len(&typedef2tyvarnames)-1);
know(typedefpos == vector_char_len(&typedef2split)-1);
type_ptr reptype = pos2type(vector_num_read(&typedef2reptype,typedefpos));
num numtyvars = vector_num_read(&typedef2numtyvars,typedefpos);
const char *abstypename = in_buf+vector_num_read(&typedef2abstypename,typedefpos);
const char *absname = in_buf+vector_num_read(&typedef2absname,typedefpos);
const char *repname = in_buf+vector_num_read(&typedef2repname,typedefpos);
const char *tyvarnames = in_buf+vector_num_read(&typedef2tyvarnames,typedefpos);
char split = vector_char_read(&typedef2split,typedefpos);
term_ptr left,right;
if (!term_is_equality(conclusion,&left,&right)) reject("TYPE_DEFINITION: conclusion has operation mismatch");
type_ptr abstype;
const char *name;
if (!term_is_var(right,&abstype,&name)) reject("TYPE_DEFINITION: right side of conclusion is not variable");
if (!name_is(name,"a\n")) reject("TYPE_DEFINITION: refusing non-a variable name in conclusion");
// now have: left = a; a:abstype
term_ptr funterm;
term_ptr pointterm;
if (!term_is_comb(left,0,&funterm,&pointterm)) reject("TYPE_DEFINITION: left side of conclusion is not combination");
// now have: funterm(pointterm) = a; a:abstype
term_ptr pointfunterm;
term_ptr pointpointterm;
if (!term_is_comb(pointterm,0,&pointfunterm,&pointpointterm)) reject("TYPE_DEFINITION: left side of conclusion is not evaluation at combination");
// now have: funterm(pointfunterm(pointpointterm)) = a; a:abstype
if (!term_is(pointpointterm,right)) reject("TYPE_DEFINITION: variable mismatch");
// now have: funterm(pointfunterm(a)) = a; a:abstype
type_ptr funtype;
const char *funname;
if (!term_is_const(funterm,&funtype,&funname)) reject("TYPE_DEFINITION: outer function is not constant");
if (!name_is_withsplit(funname,absname,split)) reject("TYPE_DEFINITION: absname mismatch");
// now have: absname(pointfunterm(a)) = a; absname:funtype; a:abstype
type_ptr pointfuntype;
const char *pointfunname;
if (!term_is_const(pointfunterm,&pointfuntype,&pointfunname)) reject("TYPE_DEFINITION: inner function is not constant");
if (!name_is_withsplit(pointfunname,repname,split)) reject("TYPE_DEFINITION: repname mismatch");
// now have: absname(repname(a)) = a; absname:funtype; repname:pointfuntype; a:abstype
know(type_is_funfromto(funtype,reptype,abstype));
know(type_is_funfromto(pointfuntype,abstype,reptype));
// now have: absname(repname(a)) = a; absname:reptype->abstype; repname:abstype->reptype; a:abstype
if (!type_is_abstype(abstype,abstypename,tyvarnames,numtyvars,split)) reject("TYPE_DEFINITION: abstype mismatch");
}
static num tag_D_pos;
static void tag_D(const char *s)
{
tag_D_pos = subid(&s,numtypedefs);
eol(s);
}
static void finish_D(num hypstart,num hypstop,term_ptr conclusion)
{
if (hypstop != hypstart) reject("TYPE_DEFINITION followup: hypotheses");
num typedefpos = tag_D_pos;
type_ptr reptype = pos2type(vector_num_read(&typedef2reptype,typedefpos));
term_ptr repprop = pos2term(vector_num_read(&typedef2repprop,typedefpos));
num numtyvars = vector_num_read(&typedef2numtyvars,typedefpos);
const char *abstypename = in_buf+vector_num_read(&typedef2abstypename,typedefpos);
const char *absname = in_buf+vector_num_read(&typedef2absname,typedefpos);
const char *repname = in_buf+vector_num_read(&typedef2repname,typedefpos);
const char *tyvarnames = in_buf+vector_num_read(&typedef2tyvarnames,typedefpos);
char split = vector_char_read(&typedef2split,typedefpos);
term_ptr left,right;
if (!term_is_equality(conclusion,&left,&right)) reject("TYPE_DEFINITION followup: conclusion has operation mismatch");
term_ptr funterm,pointterm;
if (!term_is_comb(left,0,&funterm,&pointterm)) reject("TYPE_DEFINITION followup: left side of conclusion is not combination");
// now have: funterm(pointterm) = right
if (!term_is(funterm,repprop)) reject("TYPE_DEFINITION followup: left side of conclusion is not repprop combination");
// now have: repterm(pointterm) = right
type_ptr reptypecheck;
const char *name;
if (!term_is_var(pointterm,&reptypecheck,&name)) reject("TYPE_DEFINITION followup: left side of conclusion is not repprop of variable");
if (!name_is(name,"r\n")) reject("TYPE_DEFINITION followup: refusing non-r variable name in conclusion");
if (!type_is(reptypecheck,reptype)) reject("TYPE_DEFINITION followup: reptype mismatch");
// now have: repterm(r) = right; r:reptype
term_ptr rightleft,rightright;
if (!term_is_equality(right,&rightleft,&rightright)) reject("TYPE_DEFINITION followup: second-level operation mismatch");
// now have: repterm(r) = (rightleft = rightright); r:reptype
if (!term_is(rightright,pointterm)) reject("TYPE_DEFINITION followup: variable mismatch");
// now have: repterm(r) = (rightleft = r); r:reptype
term_ptr rightfun,rightpoint;
if (!term_is_comb(rightleft,0,&rightfun,&rightpoint)) reject("TYPE_DEFINITION followup: second level is not combination");
// now have: repterm(r) = (rightfun(rightpoint) = r); r:reptype
term_ptr rightpointfun,rightpointpoint;
if (!term_is_comb(rightpoint,0,&rightpointfun,&rightpointpoint)) reject("TYPE_DEFINITION followup: third level is not combination");
// now have: repterm(r) = (rightfun(rightpointfun(rightpointpoint)) = r); r:reptype
if (!term_is(rightpointpoint,pointterm)) reject("TYPE_DEFINITION followup: bottom-level variable mismatch");
// now have: repterm(r) = (rightfun(rightpointfun(r)) = r); r:reptype
type_ptr rightfuntype;
const char *rightfunname;
if (!term_is_const(rightfun,&rightfuntype,&rightfunname)) reject("TYPE_DEFINITION followup: outer function is not constant");
if (!name_is_withsplit(rightfunname,repname,split)) reject("TYPE_DEFINITION followup: repname mismatch");
// now have: repterm(r) = (repname(rightpointfun(r)) = r); r:reptype; repname:rightfuntype
type_ptr rightpointfuntype;
const char *rightpointfunname;
if (!term_is_const(rightpointfun,&rightpointfuntype,&rightpointfunname)) reject("TYPE_DEFINITION followup: inner function is not constant");
if (!name_is_withsplit(rightpointfunname,absname,split)) reject("TYPE_DEFINITION followup: absname mismatch");
// now have: repterm(r) = (repname(absname(r)) = r); r:reptype; repname:rightfuntype; absname:rightpointfuntype
type_ptr abstype;
type_ptr rightfunto;
know(type_is_fun(rightfuntype,&abstype,&rightfunto));
know(type_is(rightfunto,reptype));
know(type_is_funfromto(rightpointfuntype,reptype,abstype));
// now have: repterm(r) = (repname(absname(r)) = r); r:reptype; repname:abstype->reptype; absname:reptype->abstype
if (!type_is_abstype(abstype,abstypename,tyvarnames,numtyvars,split)) reject("TYPE_DEFINITION followup: abstype mismatch");
}
// ==== B: BETA
// input: (x|->y)(x)
// output: (x|->y)(x) = y
static term_ptr tag_B_xyx;
static term_ptr tag_B_y;
static void tag_B(const char *s)
{
term_ptr term = pos2term(subid(&s,numterms));
eol(s);
term_ptr funterm,pointterm;
if (!term_is_comb(term,0,&funterm,&pointterm)) reject("BETA: operation mismatch");
// now have: funterm(pointterm)
if (!term_is_var(pointterm,0,0)) reject("BETA: combination is not with variable");
// redundant given abs restrictions below, but keep for clarity
term_ptr fromterm,toterm;
if (!term_is_abs(funterm,0,&fromterm,&toterm)) reject("BETA: combination is not of abstraction");
// now have: (fromterm|->toterm)(pointterm)
if (!term_is(fromterm,pointterm)) reject("BETA: combination is not of same variable");
// now have: (fromterm|->toterm)(fromterm)
tag_B_xyx = term;
tag_B_y = toterm;
}
static void finish_B(num hypstart,num hypstop,term_ptr conclusion)
{
if (hypstop != hypstart) reject("BETA: hypotheses");
term_ptr left,right;
if (!term_is_equality(conclusion,&left,&right)) reject("BETA: operation mismatch");
if (!term_is(left,tag_B_xyx)) reject("BETA: left-side mismatch");
if (!term_is(right,tag_B_y)) reject("BETA: right-side mismatch");
}
// ===== C: DEFINITION
static vector_type_ptr tag_C_tyvars;
static vector_type_ptr tag_C_tyvarsright;
static const char *tag_C_name;
static type_ptr tag_C_type;
static term_ptr tag_C_defn;
static void tag_C(const char *s)
{
term_ptr term = pos2term(subid(&s,numterms));
noteol(s);
term_ptr left,right;
if (!term_is_equality(term,&left,&right)) reject("DEFINITION: operation mismatch");
type_ptr type;
const char *name;
if (!term_is_var(left,&type,&name)) reject("DEFINITION: not a variable");
if (!name_is(name,s)) reject("DEFINITION: name mismatch");
if (term_has_freevars(right)) reject("DEFINITION: free variables on right side");
type_vars(&tag_C_tyvars,type);
term_tyvars(&tag_C_tyvarsright,right);
for (num i = 0;i < vector_type_ptr_len(&tag_C_tyvarsright);++i) {
type_ptr ty2 = vector_type_ptr_read(&tag_C_tyvarsright,i);
int found = 0;
for (num j = 0;j < vector_type_ptr_len(&tag_C_tyvars);++j) {
type_ptr ty = vector_type_ptr_read(&tag_C_tyvars,j);
if (type_is(ty,ty2)) {
found = 1;
break;
}
}
if (!found) reject("DEFINITION: type variables on right side not included in constant");
}
const2type_add(name,'\n',type);
tag_C_name = name;
tag_C_type = type;
tag_C_defn = right;
}
static void finish_C(num hypstart,num hypstop,term_ptr conclusion)
{
if (hypstop != hypstart) reject("DEFINITION: hypotheses");
term_ptr left,right;
if (!term_is_equality(conclusion,&left,&right)) reject("DEFINITION: operation mismatch");
// now have: left = right
type_ptr type;
const char *name;
if (!term_is_const(left,&type,&name)) reject("DEFINITION: left side is not constant");
if (!name_is(name,tag_C_name)) reject("DEFINITION: name mismatch");
if (!type_is(type,tag_C_type)) reject("DEFINITION: type mismatch");
// now have: Const(tag_C_name,tag_C_type) = right
if (!term_is(right,tag_C_defn)) reject("DEFINITION: right-side mismatch");
}
// ===== E: MK_COMB
// input: theorem thleft = thright
// input: theorem THleft = THright
// output: theorem thleft(THleft) = thright(THright)
static num tag_E_th;
static term_ptr tag_E_thleft;
static term_ptr tag_E_thright;
static num tag_E_TH;
static term_ptr tag_E_THleft;
static term_ptr tag_E_THright;
static void tag_E(const char *s)
{
num th = subid(&s,numthms);
num TH = subid(&s,numthms);
eol(s);
term_ptr thconclusion = vector_term_ptr_read(&thm2conclusion,th);
term_ptr THconclusion = vector_term_ptr_read(&thm2conclusion,TH);
term_ptr thleft,thright;
if (!term_is_equality(thconclusion,&thleft,&thright)) reject("MK_COMB: first theorem is not equality");
term_ptr THleft,THright;
if (!term_is_equality(THconclusion,&THleft,&THright)) reject("MK_COMB: second theorem is not equality");
type_ptr from;
if (!type_is_fun(term2type(thleft),&from,0)) reject("first MK_COMB: type is not function");
if (!type_is(term2type(THleft),from)) reject("MK_COMB: combination mismatch");
tag_E_th = th;
tag_E_thleft = thleft;
tag_E_thright = thright;
tag_E_TH = TH;
tag_E_THleft = THleft;
tag_E_THright = THright;
}
static void finish_E(num hypstart,num hypstop,term_ptr conclusion)
{
term_ptr left,right;
if (!term_is_equality(conclusion,&left,&right)) reject("MK_COMB: operation mismatch");
// now have: left = right
term_ptr leftfun,leftpoint;
if (!term_is_comb(left,0,&leftfun,&leftpoint)) reject("MK_COMB: left-side operation mismatch");
// now have: leftfun(leftpoint) = right
term_ptr rightfun,rightpoint;
if (!term_is_comb(right,0,&rightfun,&rightpoint)) reject("MK_COMB: right-side operation mismatch");
// now have: leftfun(leftpoint) = rightfun(rightpoint)
if (!term_is(leftfun,tag_E_thleft)) reject("MK_COMB: left-outer mismatch");
if (!term_is(leftpoint,tag_E_THleft)) reject("MK_COMB: left-inner mismatch");
if (!term_is(rightfun,tag_E_thright)) reject("MK_COMB: right-outer mismatch");
if (!term_is(rightpoint,tag_E_THright)) reject("MK_COMB: right-inner mismatch");
if (!hypotheses_aremerged(hypstart,hypstop,tag_E_th,tag_E_TH,pos2term(-1),pos2term(-1))) reject("MK_COMB: hypothesis mismatch");
}
// ===== F: ABS
// input: variable v
// input: theorem l = r
// output: (v|->l) = (v|->r)
static term_ptr tag_F_var;
static num tag_F_th;
static term_ptr tag_F_left;
static term_ptr tag_F_right;
static vector_term_ptr tag_F_free;
static void tag_F(const char *s)
{
term_ptr var = pos2term(subid(&s,numterms));
num th = subid(&s,numthms);
eol(s);
if (!term_is_var(var,0,0)) reject("ABS: first input is not a variable");
term_ptr thconclusion = vector_term_ptr_read(&thm2conclusion,th);
term_ptr left,right;
if (!term_is_equality(thconclusion,&left,&right)) reject("ABS: second input is not an equality");
num thstart = vector_num_read(&thm2datapos,th);
num thstop = vector_num_read(&thm2datapos,th+1);
for (num i = thstart;i < thstop;++i) {
term_ptr h = vector_term_ptr_read(&thmdata,i);
term_freevars(&tag_F_free,h);
for (num j = 0;j < vector_term_ptr_len(&tag_F_free);++j)
if (term_is(var,vector_term_ptr_read(&tag_F_free,j)))
reject("ABS variable is free in hypothesis");
}
tag_F_var = var;
tag_F_th = th;
tag_F_left = left;
tag_F_right = right;
}
static void finish_F(num hypstart,num hypstop,term_ptr conclusion)
{
term_ptr left,right;
if (!term_is_equality(conclusion,&left,&right)) reject("ABS: operation mismatch");
// now have: left = right
term_ptr leftv,leftt;
if (!term_is_abs(left,0,&leftv,&leftt)) reject("ABS: left-side operation mismatch");
// now have: (leftv|->leftt) = right
term_ptr rightv,rightt;
if (!term_is_abs(right,0,&rightv,&rightt)) reject("ABS: right-side operation mismatch");
// now have: (leftv|->leftt) = (rightv|->rightt)
if (!term_is(leftv,tag_F_var)) reject("ABS: left-side variable mismatch");
if (!term_is(rightv,tag_F_var)) reject("ABS: right-side variable mismatch");
if (!term_is(leftt,tag_F_left)) reject("ABS: left-side output mismatch");
if (!term_is(rightt,tag_F_right)) reject("ABS: right-side output mismatch");
// now have: (tag_F_var|->tag_F_left) = (tag_F_var|->tag_F_right)
if (!hypotheses_arecopied(hypstart,hypstop,tag_F_th)) reject("ABS: hypothesis mismatch");
}
// ===== P: EQ_MP
// input: theorem L = R
// input: theorem L (modulo alpha-equivalence)
// output: theorem R
static term_ptr tag_P_right;
static num tag_P_th;
static num tag_P_TH;
static void tag_P(const char *s)
{
num th = subid(&s,numthms);
num TH = subid(&s,numthms);
eol(s);
term_ptr thconclusion = vector_term_ptr_read(&thm2conclusion,th);
term_ptr THconclusion = vector_term_ptr_read(&thm2conclusion,TH);
term_ptr left,right;
if (!term_is_equality(thconclusion,&left,&right)) reject("EQ_MP: operation mismatch");
if (!term_alphaequivalent(left,THconclusion)) reject("EQ_MP: left-side mismatch");
tag_P_th = th;
tag_P_TH = TH;
tag_P_right = right;
}
static void finish_P(num hypstart,num hypstop,term_ptr conclusion)
{
if (!term_is(conclusion,tag_P_right)) reject("EQ_MP: conclusion mismatch");
if (!hypotheses_aremerged(hypstart,hypstop,tag_P_th,tag_P_TH,pos2term(-1),pos2term(-1))) reject("EQ_MP: hypothesis mismatch");
}
// ===== R: REFL
static term_ptr tag_R_term;
static void tag_R(const char *s)
{
tag_R_term = pos2term(subid(&s,numterms));
eol(s);
}
static void finish_R(num hypstart,num hypstop,term_ptr conclusion)
{
if (hypstop != hypstart) reject("REFL: hypotheses");
term_ptr left,right;
if (!term_is_equality(conclusion,&left,&right)) reject("REFL: conclusion mismatch");
if (!term_is(left,tag_R_term)) reject("REFL: left-side mismatch");
if (!term_is(right,tag_R_term)) reject("REFL: right-side mismatch");
}
// ===== S: INST
static num tag_S_th;
static vector_term_ptr tag_S_from;
static vector_term_ptr tag_S_to;
static vector_num tag_S_primed;
static void tag_S(const char *s)
{
tag_S_th = subid(&s,numthms);
vector_term_ptr_empty(&tag_S_from);
vector_term_ptr_empty(&tag_S_to);
vector_num_empty(&tag_S_primed);
for (;;) {
if (*s == '\n') break;
term_ptr from = pos2term(subid(&s,numterms));
if (*s == '\n') reject("INST: odd number of term arguments");
term_ptr to = pos2term(subid(&s,numterms));
type_ptr fromtype;
if (!term_is_var(from,&fromtype,0)) reject("INST: substituting for non-variable (note: S th from to, not S th to from)");
if (!type_is(fromtype,term2type(to))) reject("INST: type mismatch");
for (num i = 0;i < vector_term_ptr_len(&tag_S_from);++i)
if (term_is(from,vector_term_ptr_read(&tag_S_from,i)))
goto skip;
vector_term_ptr_append(&tag_S_from,from);
vector_term_ptr_append(&tag_S_to,to);
vector_num_append(&tag_S_primed,0);
skip: ;
}
}
static void finish_S(num hypstart,num hypstop,term_ptr conclusion)
{
num th = tag_S_th;
term_ptr thconclusion = vector_term_ptr_read(&thm2conclusion,th);
if (!term_subst_is(thconclusion,&tag_S_from,&tag_S_to,&tag_S_primed,conclusion))
reject("INST: conclusion mismatch");
num thstart = vector_num_read(&thm2datapos,th);
num thstop = vector_num_read(&thm2datapos,th+1);
static vector_num hypused;
vector_num_empty(&hypused);
// XXX speed: maybe better to compute the map and sort
// XXX completeness: also need this in case of alpha squeeze
for (num i = thstart;i < thstop;++i) {
term_ptr oldh = vector_term_ptr_read(&thmdata,i);
int found = 0;
for (num j = hypstart;j < hypstop;++j) {
term_ptr newh = vector_term_ptr_read(&thmdata,j);
if (term_subst_is(oldh,&tag_S_from,&tag_S_to,&tag_S_primed,newh)) {
vector_num_write(&hypused,j-hypstart,1);
found = 1;
break;
}
}
if (!found) reject("INST: hypothesis mismatch (maybe alpha squeeze?)");
}
if (vector_num_len(&hypused) != hypstop-hypstart) reject("INST: extra hypotheses");
for (num j = hypstart;j < hypstop;++j)
if (vector_num_read(&hypused,j-hypstart) != 1) reject("INST: extra hypotheses");
}
// ===== T: INST_TYPE
static num tag_T_th;
static vector_type_ptr tag_T_from;
static vector_type_ptr tag_T_to;
static void tag_T(const char *s)
{
tag_T_th = subid(&s,numthms);
vector_type_ptr_empty(&tag_T_from);
vector_type_ptr_empty(&tag_T_to);
for (;;) {
if (*s == '\n') break;
type_ptr from = pos2type(subid(&s,numtypes));
if (*s == '\n') reject("INST_TYPE: odd number of type arguments");
type_ptr to = pos2type(subid(&s,numtypes));
if (!type_is_tyvar(from)) reject("INST_TYPE: substituting for non-tyvar (note: T th from to, not T th to from)");
for (num i = 0;i < vector_type_ptr_len(&tag_T_from);++i)
if (type_is(from,vector_type_ptr_read(&tag_T_from,i)))
goto skip;
vector_type_ptr_append(&tag_T_from,from);
vector_type_ptr_append(&tag_T_to,to);
skip: ;
}
}
static void finish_T(num hypstart,num hypstop,term_ptr conclusion)
{
num th = tag_T_th;
term_ptr thconclusion = vector_term_ptr_read(&thm2conclusion,th);
if (!term_tyvar_subst_is(thconclusion,&tag_T_from,&tag_T_to,conclusion))
reject("INST_TYPE: conclusion mismatch");
num thstart = vector_num_read(&thm2datapos,th);
num thstop = vector_num_read(&thm2datapos,th+1);
static vector_num hypused;
vector_num_empty(&hypused);
// XXX speed: maybe better to compute the map and sort
// XXX completeness: also need this in case of alpha squeeze
for (num i = thstart;i < thstop;++i) {
term_ptr oldh = vector_term_ptr_read(&thmdata,i);
int found = 0;
for (num j = hypstart;j < hypstop;++j) {
term_ptr newh = vector_term_ptr_read(&thmdata,j);
if (term_tyvar_subst_is(oldh,&tag_T_from,&tag_T_to,newh)) {
vector_num_write(&hypused,j-hypstart,1);
found = 1;
break;
}
}
if (!found) reject("INST_TYPE: hypothesis mismatch (maybe alpha squeeze?)");
}
if (vector_num_len(&hypused) != hypstop-hypstart) reject("INST_TYPE: extra hypotheses");
for (num j = hypstart;j < hypstop;++j)
if (vector_num_read(&hypused,j-hypstart) != 1) reject("INST_TYPE: extra hypotheses");
}
// ===== U: ASSUME
static term_ptr tag_U_term;
static void tag_U(const char *s)
{
term_ptr term = pos2term(subid(&s,numterms));
eol(s);
if (!type_is_bool(term2type(term))) reject("ASSUME: non-bool input");
tag_U_term = term;
}
static void finish_U(num hypstart,num hypstop,term_ptr conclusion)
{
if (!term_is(conclusion,tag_U_term)) reject("ASSUME: wrong conclusion");
if (hypstop-hypstart != 1) reject("ASSUME: wrong number of hypotheses");
term_ptr h = vector_term_ptr_read(&thmdata,hypstart);
if (!term_is(h,tag_U_term)) reject("ASSUME: wrong hypothesis");
}
// ===== V: TRANS
static num tag_V_th;
static num tag_V_TH;
static term_ptr tag_V_left;
static term_ptr tag_V_right;
static void tag_V(const char *s)
{
num th = subid(&s,numthms);
num TH = subid(&s,numthms);
eol(s);
term_ptr thconclusion = vector_term_ptr_read(&thm2conclusion,th);
term_ptr THconclusion = vector_term_ptr_read(&thm2conclusion,TH);
term_ptr thleft,thright;
if (!term_is_equality(thconclusion,&thleft,&thright)) reject("TRANS: first operation mismatch");
term_ptr THleft,THright;
if (!term_is_equality(THconclusion,&THleft,&THright)) reject("TRANS: second operation mismatch");
if (!term_alphaequivalent(thright,THleft)) reject("TRANS: input mismatch");
tag_V_th = th;
tag_V_TH = TH;
tag_V_left = thleft;
tag_V_right = THright;
}
static void finish_V(num hypstart,num hypstop,term_ptr conclusion)
{
term_ptr left,right;
if (!term_is_equality(conclusion,&left,&right)) reject("TRANS: output operation mismatch");
if (!term_is(left,tag_V_left)) reject("TRANS: output left-side mismatch");
if (!term_is(right,tag_V_right)) reject("TRANS: output right-side mismatch");
if (!hypotheses_aremerged(hypstart,hypstop,tag_V_th,tag_V_TH,pos2term(-1),pos2term(-1))) reject("TRANS: hypothesis mismatch");
}
// ===== X: AXIOM
static term_ptr tag_X_term;
static void tag_X(const char *s)
{
term_ptr term = pos2term(subid(&s,numterms));
eol(s);
if (!type_is_bool(term2type(term))) reject("AXIOM: non-bool input");
tag_X_term = term;
}
static void finish_X(num hypstart,num hypstop,term_ptr conclusion)
{
if (hypstop != hypstart) reject("AXIOM: hypotheses");
if (!term_is(conclusion,tag_X_term)) reject("AXIOM: wrong conclusion");
}
// ===== Z: DEDUCT_ANTISYM_RULE
// if q entails p and p entails q then p = q
static num tag_Z_th;
static num tag_Z_TH;
static void tag_Z(const char *s)
{
tag_Z_th = subid(&s,numthms);
tag_Z_TH = subid(&s,numthms);
eol(s);
}
static void finish_Z(num hypstart,num hypstop,term_ptr conclusion)
{
num th = tag_Z_th;
num TH = tag_Z_TH;
term_ptr left,right;
if (!term_is_equality(conclusion,&left,&right)) reject("DEDUCT_ANTISYM_RULE: operation mismatch");
if (!term_is(left,vector_term_ptr_read(&thm2conclusion,th))) reject("DEDUCT_ANTISYM_RULE: left-side mismatch");
if (!term_is(right,vector_term_ptr_read(&thm2conclusion,TH))) reject("DEDUCT_ANTISYM_RULE: right-side mismatch");
if (!hypotheses_aremerged(hypstart,hypstop,tag_Z_th,tag_Z_TH,right,left)) reject("DEDUCT_ANTISYM_RULE: hypothesis mismatch");
}
// ===== theorems
static char lastinftag;
static void tag_t(const char *s)
{
know(vector_term_ptr_len(&thm2conclusion) == numthms);
num hypstart = vector_term_ptr_len(&thmdata);
if (*s == '\n') reject("theorem with no conclusion");
term_ptr z = pos2term(subid(&s,numterms));
num numargs = 1;
while (*s != '\n') {
vector_term_ptr_append(&thmdata,z);
z = pos2term(subid(&s,numterms));
++numargs;
}
vector_term_ptr_append(&thm2conclusion,z);
know(vector_term_ptr_len(&thm2conclusion) == numthms+1);
for (num i = hypstart;i+1 < vector_term_ptr_len(&thmdata);++i) {
term_ptr hthis = vector_term_ptr_read(&thmdata,i);
term_ptr hnext = vector_term_ptr_read(&thmdata,i+1);
if (term_alphaorder_cmp(hthis,hnext) != -1)
reject("refusing out-of-order hypotheses");
}
void (*finish)(num,num,term_ptr);
switch(lastinftag) {
case 'A': finish = finish_A; break;
case 'B': finish = finish_B; break;
case 'C': finish = finish_C; break;
case 'D': finish = finish_D; break;
case 'E': finish = finish_E; break;
case 'F': finish = finish_F; break;
case 'P': finish = finish_P; break;
case 'R': finish = finish_R; break;
case 'S': finish = finish_S; break;
case 'T': finish = finish_T; break;
case 'U': finish = finish_U; break;
case 'V': finish = finish_V; break;
case 'X': finish = finish_X; break;
case 'Z': finish = finish_Z; break;
default:
reject("theorem without preceding inference");
}
finish(hypstart,vector_term_ptr_len(&thmdata),z);
}
// ===== tags not relevant to logic; just check topology
static num numinfs;
static num numpt;
static void tag_slash(const char *s)
{
subid(&s,numthms);
noteol(s);
}
static void tag_comma(const char *s)
{
subid(&s,numthms);
subid(&s,numinfs);
if (*s != '\n') subid(&s,numpt);
if (*s != '\n') subid(&s,numpt);
eol(s);
}
// ===== dispatcher
static void handleline(num start,num stop)
{
know(0 <= start);
know(start <= stop);
know(stop < in_bytes);
know(in_buf[stop] == '\n');
++curline;
if (stop <= start) {
fprintf(stderr,"blank line %lld prohibited\n",curline);
exit(100);
}
char tag = in_buf[start];
const char *s = in_buf+start+1;
switch(tag) {
case 'a': tag_a(s); break;
case 'b': tag_b(s); break;
case 'c': tag_c(s); break;
case 'd': tag_d(s); break;
case 'e': tag_e(s); break;
case 'f': tag_f(s); break;
case 't': tag_t(s); break;
case 'A': tag_A(s); break;
case 'B': tag_B(s); break;
case 'C': tag_C(s); break;
case 'D': tag_D(s); break;
case 'E': tag_E(s); break;
case 'F': tag_F(s); break;
case 'P': tag_P(s); break;
case 'R': tag_R(s); break;
case 'S': tag_S(s); break;
case 'T': tag_T(s); break;
case 'U': tag_U(s); break;
case 'V': tag_V(s); break;
case 'X': tag_X(s); break;
case 'Z': tag_Z(s); break;
case '/': tag_slash(s); break;
case ',': tag_comma(s); break;
case ';': break;
default:
fprintf(stderr,"line %lld: unrecognized tag %c\n",curline,tag);
exit(100);
}
switch(tag) {
case 'a': case 'b':
++numtypes;
break;
case 'c': case 'd': case 'e': case 'f':
++numterms;
break;
case 't':
++numthms;
vector_num_append(&thm2datapos,vector_term_ptr_len(&thmdata));
break;
case 'A': case 'B': case 'C': case 'D':
case 'E': case 'F': case 'P': case 'R':
case 'S': case 'T': case 'U': case 'V':
case 'X': case 'Z':
if (tag == 'A') ++numtypedefs;
++numinfs;
lastinftag = tag;
break;
case ',': case ';':
++numpt;
break;
case '/':
break;
default:
fprintf(stderr,"line %lld: unrecognized tag %c\n",curline,tag);
exit(100);
}
}
// ===== overall driver
static void verify(void)
{
if (in_bytes < 0) {
fprintf(stderr,"internal error: negative length\n");
exit(100);
}
if (in_bytes > CUTOFF) {
fprintf(stderr,"refusing to handle more than %lld bytes\n",CUTOFF);
exit(100);
}
vector_num_append(&thm2datapos,0);
num start = 0;
for (num i = 0;i < in_bytes;++i) {
char c = in_buf[i];
if (c == '\n') {
if (start) handleline(start,i);
start = i+1;
continue;
}
if (c < 32 || c > 126) {
fprintf(stderr,"byte %d is not printable ASCII\n",(int) c);
exit(100);
}
}
if (start != in_bytes) reject("subsequent partial final line");
}
int main()
{
in_init();
if (in_bytes < 11 || memcmp(in_buf,"HOLTrace 1\n",11)) {
fprintf(stderr,"input does not start with HOLTrace 1\n");
exit(100);
}
verify();
fprintf(stderr,"verified %lld bytes, %lld lines, %lld types, %lld terms, %lld infs, %lld thms, %lld typedefs\n"
,in_bytes,curline
,numtypes
,numterms
,numinfs
,numthms
,numtypedefs
);
return 0;
}