remove and clean up some old files
This commit is contained in:
		
							parent
							
								
									07dfa697df
								
							
						
					
					
						commit
						6041c7b40e
					
				
							
								
								
									
										13
									
								
								FLOSSING
								
								
								
								
							
							
						
						
									
										13
									
								
								FLOSSING
								
								
								
								
							| 
						 | 
					@ -1,13 +0,0 @@
 | 
				
			||||||
Flossing is important to overall oral health.
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
Even by itself, flossing does a good job of cleaning teeth and gums,
 | 
					 | 
				
			||||||
and is the only way to clean below the gumline.
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
However it has an important secondary purpose as well. Most people assume
 | 
					 | 
				
			||||||
the point of brushing teeth is to scrub the teeth with bristles. This
 | 
					 | 
				
			||||||
is not fully true; the more significant purpose of brushing is to apply
 | 
					 | 
				
			||||||
fluoride to teeth. If you don't floss, food particles are left between
 | 
					 | 
				
			||||||
the teeth and gums, blocking fluoride from reaching tooth surfaces. It
 | 
					 | 
				
			||||||
is then as if you were not brushing at all. Even if no material is
 | 
					 | 
				
			||||||
visible between teeth, there is probably some there. Flossing can pull
 | 
					 | 
				
			||||||
a surprising amount of gunk from a mouth that appears totally clean.
 | 
					 | 
				
			||||||
| 
						 | 
					@ -1,59 +0,0 @@
 | 
				
			||||||
typedef struct {
 | 
					 | 
				
			||||||
    size_t n, maxsize;
 | 
					 | 
				
			||||||
    unsigned long *items;
 | 
					 | 
				
			||||||
} ltable_t;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
void ltable_init(ltable_t *t, size_t n)
 | 
					 | 
				
			||||||
{
 | 
					 | 
				
			||||||
    t->n = 0;
 | 
					 | 
				
			||||||
    t->maxsize = n;
 | 
					 | 
				
			||||||
    t->items = (unsigned long*)malloc(n * sizeof(unsigned long));
 | 
					 | 
				
			||||||
}
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
void ltable_clear(ltable_t *t)
 | 
					 | 
				
			||||||
{
 | 
					 | 
				
			||||||
    t->n = 0;
 | 
					 | 
				
			||||||
}
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
void ltable_insert(ltable_t *t, unsigned long item)
 | 
					 | 
				
			||||||
{
 | 
					 | 
				
			||||||
    unsigned long *p;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
    if (t->n == t->maxsize) {
 | 
					 | 
				
			||||||
        p = realloc(t->items, (t->maxsize*2)*sizeof(unsigned long));
 | 
					 | 
				
			||||||
        if (p == NULL) return;
 | 
					 | 
				
			||||||
        t->items = p;
 | 
					 | 
				
			||||||
        t->maxsize *= 2;
 | 
					 | 
				
			||||||
    }
 | 
					 | 
				
			||||||
    t->items[t->n++] = item;
 | 
					 | 
				
			||||||
}
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
#define LT_NOTFOUND ((int)-1)
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
int ltable_lookup(ltable_t *t, unsigned long item)
 | 
					 | 
				
			||||||
{
 | 
					 | 
				
			||||||
    int i;
 | 
					 | 
				
			||||||
    for(i=0; i < (int)t->n; i++)
 | 
					 | 
				
			||||||
        if (t->items[i] == item)
 | 
					 | 
				
			||||||
            return i;
 | 
					 | 
				
			||||||
    return LT_NOTFOUND;
 | 
					 | 
				
			||||||
}
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
void ltable_adjoin(ltable_t *t, unsigned long item)
 | 
					 | 
				
			||||||
{
 | 
					 | 
				
			||||||
    if (ltable_lookup(t, item) == LT_NOTFOUND)
 | 
					 | 
				
			||||||
        ltable_insert(t, item);
 | 
					 | 
				
			||||||
}
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
char *snprintf_gensym_id(char *nbuf, size_t n, u_int32_t g)
 | 
					 | 
				
			||||||
{
 | 
					 | 
				
			||||||
    size_t i=n-1;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
    nbuf[i--] = '\0';
 | 
					 | 
				
			||||||
    do {
 | 
					 | 
				
			||||||
        nbuf[i--] = '0' + g%10;
 | 
					 | 
				
			||||||
        g/=10;
 | 
					 | 
				
			||||||
    } while (g && i);
 | 
					 | 
				
			||||||
    nbuf[i] = 'g';
 | 
					 | 
				
			||||||
    return &nbuf[i];
 | 
					 | 
				
			||||||
}
 | 
					 | 
				
			||||||
| 
						 | 
					@ -1,28 +0,0 @@
 | 
				
			||||||
; property lists. they really suck.
 | 
					 | 
				
			||||||
(setq *plists* nil)
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
(defun symbol-plist (sym)
 | 
					 | 
				
			||||||
  (cdr (or (assoc sym *plists*) '(()))))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
(defun set-symbol-plist (sym lst)
 | 
					 | 
				
			||||||
  (let ((p (assoc sym *plists*)))
 | 
					 | 
				
			||||||
    (if (null p)  ; sym has no plist yet
 | 
					 | 
				
			||||||
        (setq *plists* (cons (cons sym lst) *plists*))
 | 
					 | 
				
			||||||
      (rplacd p lst))))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
(defun get (sym prop)
 | 
					 | 
				
			||||||
  (let ((pl (symbol-plist sym)))
 | 
					 | 
				
			||||||
    (if pl
 | 
					 | 
				
			||||||
        (let ((pr (member prop pl)))
 | 
					 | 
				
			||||||
          (if pr (cadr pr) nil))
 | 
					 | 
				
			||||||
      nil)))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
(defun put (sym prop val)
 | 
					 | 
				
			||||||
  (let ((p (assoc sym *plists*)))
 | 
					 | 
				
			||||||
    (if (null p)  ; sym has no plist yet
 | 
					 | 
				
			||||||
        (setq *plists* (cons (list sym prop val) *plists*))
 | 
					 | 
				
			||||||
      (let ((pr (member prop p)))
 | 
					 | 
				
			||||||
        (if (null pr)  ; sym doesn't have this property yet
 | 
					 | 
				
			||||||
            (rplacd p (cons prop (cons val (cdr p))))
 | 
					 | 
				
			||||||
          (rplaca (cdr pr) val)))))
 | 
					 | 
				
			||||||
  val)
 | 
					 | 
				
			||||||
| 
						 | 
					@ -1,25 +0,0 @@
 | 
				
			||||||
(define (equal a b)
 | 
					 | 
				
			||||||
  (if (and (consp a) (consp b))
 | 
					 | 
				
			||||||
      (and (equal (car a) (car b))
 | 
					 | 
				
			||||||
           (equal (cdr a) (cdr b)))
 | 
					 | 
				
			||||||
    (eq a b)))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
; compare imposes an ordering on all values. yields -1 for a<b,
 | 
					 | 
				
			||||||
; 0 for a==b, and 1 for a>b. lists are compared up to the first
 | 
					 | 
				
			||||||
; point of difference.
 | 
					 | 
				
			||||||
(defun compare (a b)
 | 
					 | 
				
			||||||
  (cond ((eq a b) 0)
 | 
					 | 
				
			||||||
        ((or (atom a) (atom b)) (if (< a b) -1 1))
 | 
					 | 
				
			||||||
        (T (let ((c (compare (car a) (car b))))
 | 
					 | 
				
			||||||
             (if (not (eq c 0))
 | 
					 | 
				
			||||||
                 c
 | 
					 | 
				
			||||||
               (compare (cdr a) (cdr b)))))))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
(defun length (l)
 | 
					 | 
				
			||||||
  (if (null l) 0
 | 
					 | 
				
			||||||
    (+ 1 (length (cdr l)))))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
(define (assoc item lst)
 | 
					 | 
				
			||||||
  (cond ((atom lst) ())
 | 
					 | 
				
			||||||
        ((eq (caar lst) item) (car lst))
 | 
					 | 
				
			||||||
        (T (assoc item (cdr lst)))))
 | 
					 | 
				
			||||||
							
								
								
									
										303
									
								
								attic/trash.c
								
								
								
								
							
							
						
						
									
										303
									
								
								attic/trash.c
								
								
								
								
							| 
						 | 
					@ -1,303 +0,0 @@
 | 
				
			||||||
value_t prim_types[32];
 | 
					 | 
				
			||||||
value_t *prim_sym_addrs[] = {
 | 
					 | 
				
			||||||
    &int8sym,  &uint8sym,  &int16sym, &uint16sym, &int32sym, &uint32sym,
 | 
					 | 
				
			||||||
    &int64sym, &uint64sym, &charsym,  &ucharsym,  &shortsym, &ushortsym,
 | 
					 | 
				
			||||||
    &intsym,   &uintsym,   &longsym,  &ulongsym,
 | 
					 | 
				
			||||||
    &lispvaluesym };
 | 
					 | 
				
			||||||
#define N_PRIMSYMS (sizeof(prim_sym_addrs) / sizeof(value_t*))
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
static value_t cv_type(cvalue_t *cv)
 | 
					 | 
				
			||||||
{
 | 
					 | 
				
			||||||
    if (cv->flags.prim) {
 | 
					 | 
				
			||||||
        return prim_types[cv->flags.primtype];
 | 
					 | 
				
			||||||
    }
 | 
					 | 
				
			||||||
    return cv->type;
 | 
					 | 
				
			||||||
}
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
    double t0,t1;
 | 
					 | 
				
			||||||
    int i;
 | 
					 | 
				
			||||||
    int32_t i32;
 | 
					 | 
				
			||||||
    char s8;
 | 
					 | 
				
			||||||
    ulong_t c8=3;
 | 
					 | 
				
			||||||
    t0 = clock();  //0.058125017
 | 
					 | 
				
			||||||
    set_secret_symtag(ulongsym,TAG_UINT32);
 | 
					 | 
				
			||||||
    set_secret_symtag(int8sym,TAG_INT8);
 | 
					 | 
				
			||||||
    for(i=0; i < 8000000; i++) {
 | 
					 | 
				
			||||||
        cnvt_to_int32(&i32, &s8, int8sym);
 | 
					 | 
				
			||||||
        c8+=c8;
 | 
					 | 
				
			||||||
        s8+=s8;
 | 
					 | 
				
			||||||
    }
 | 
					 | 
				
			||||||
    t1 = clock();
 | 
					 | 
				
			||||||
    printf("%d. that took %.16f\n", i32, t1-t0);
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
#define int_converter(type)                                         \
 | 
					 | 
				
			||||||
static int cnvt_to_##type(type##_t *i, void *data, value_t type)    \
 | 
					 | 
				
			||||||
{                                                                   \
 | 
					 | 
				
			||||||
         if (type==int32sym)  *i = *(int32_t*)data;                 \
 | 
					 | 
				
			||||||
    else if (type==charsym)   *i = *(char*)data;                    \
 | 
					 | 
				
			||||||
    else if (type==ulongsym)  *i = *(ulong*)data;                   \
 | 
					 | 
				
			||||||
    else if (type==uint32sym) *i = *(uint32_t*)data;                \
 | 
					 | 
				
			||||||
    else if (type==int8sym)   *i = *(int8_t*)data;                  \
 | 
					 | 
				
			||||||
    else if (type==uint8sym)  *i = *(uint8_t*)data;                 \
 | 
					 | 
				
			||||||
    else if (type==int64sym)  *i = *(int64_t*)data;                 \
 | 
					 | 
				
			||||||
    else if (type==uint64sym) *i = *(uint64_t*)data;                \
 | 
					 | 
				
			||||||
    else if (type==wcharsym)  *i = *(wchar_t*)data;                 \
 | 
					 | 
				
			||||||
    else if (type==longsym)   *i = *(long*)data;                    \
 | 
					 | 
				
			||||||
    else if (type==int16sym)  *i = *(int16_t*)data;                 \
 | 
					 | 
				
			||||||
    else if (type==uint16sym) *i = *(uint16_t*)data;                \
 | 
					 | 
				
			||||||
    else                                                            \
 | 
					 | 
				
			||||||
        return 1;                                                   \
 | 
					 | 
				
			||||||
    return 0;                                                       \
 | 
					 | 
				
			||||||
}
 | 
					 | 
				
			||||||
int_converter(int32)
 | 
					 | 
				
			||||||
int_converter(uint32)
 | 
					 | 
				
			||||||
int_converter(int64)
 | 
					 | 
				
			||||||
int_converter(uint64)
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
#ifdef BITS64
 | 
					 | 
				
			||||||
#define cnvt_to_ulong(i,d,t) cnvt_to_uint64(i,d,t)
 | 
					 | 
				
			||||||
#else
 | 
					 | 
				
			||||||
#define cnvt_to_ulong(i,d,t) cnvt_to_uint32(i,d,t)
 | 
					 | 
				
			||||||
#endif
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
long intabs(long n)
 | 
					 | 
				
			||||||
{
 | 
					 | 
				
			||||||
    long s = n>>(NBITS-1);   // either -1 or 0
 | 
					 | 
				
			||||||
    return (n^s) - s;
 | 
					 | 
				
			||||||
}
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
value_t fl_inv(value_t b)
 | 
					 | 
				
			||||||
{
 | 
					 | 
				
			||||||
    int_t bi;
 | 
					 | 
				
			||||||
    int tb;
 | 
					 | 
				
			||||||
    void *bptr=NULL;
 | 
					 | 
				
			||||||
    cvalue_t *cv;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
    if (isfixnum(b)) {
 | 
					 | 
				
			||||||
        bi = numval(b);
 | 
					 | 
				
			||||||
        if (bi == 0)
 | 
					 | 
				
			||||||
            goto inv_error;
 | 
					 | 
				
			||||||
        else if (bi == 1)
 | 
					 | 
				
			||||||
            return fixnum(1);
 | 
					 | 
				
			||||||
        else if (bi == -1)
 | 
					 | 
				
			||||||
            return fixnum(-1);
 | 
					 | 
				
			||||||
        return fixnum(0);
 | 
					 | 
				
			||||||
    }
 | 
					 | 
				
			||||||
    else if (iscvalue(b)) {
 | 
					 | 
				
			||||||
        cv = (cvalue_t*)ptr(b);
 | 
					 | 
				
			||||||
        tb = cv_numtype(cv);
 | 
					 | 
				
			||||||
        if (tb <= T_DOUBLE)
 | 
					 | 
				
			||||||
            bptr = cv_data(cv);
 | 
					 | 
				
			||||||
    }
 | 
					 | 
				
			||||||
    if (bptr == NULL)
 | 
					 | 
				
			||||||
        type_error("/", "number", b);
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
    if (tb == T_FLOAT)
 | 
					 | 
				
			||||||
        return mk_double(1.0/(double)*(float*)bptr);
 | 
					 | 
				
			||||||
    if (tb == T_DOUBLE)
 | 
					 | 
				
			||||||
        return mk_double(1.0 / *(double*)bptr);
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
    if (tb == T_UINT64) {
 | 
					 | 
				
			||||||
        if (*(uint64_t*)bptr > 1)
 | 
					 | 
				
			||||||
            return fixnum(0);
 | 
					 | 
				
			||||||
        else if (*(uint64_t*)bptr == 1)
 | 
					 | 
				
			||||||
            return fixnum(1);
 | 
					 | 
				
			||||||
        goto inv_error;
 | 
					 | 
				
			||||||
    }
 | 
					 | 
				
			||||||
    int64_t b64  = conv_to_int64(bptr, tb);
 | 
					 | 
				
			||||||
    if (b64 == 0) goto inv_error;
 | 
					 | 
				
			||||||
    else if (b64 == 1) return fixnum(1);
 | 
					 | 
				
			||||||
    else if (b64 == -1) return fixnum(-1);
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
    return fixnum(0);
 | 
					 | 
				
			||||||
 inv_error:
 | 
					 | 
				
			||||||
    lerror(DivideError, "/: division by zero");
 | 
					 | 
				
			||||||
}
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
static void printstack(value_t *penv, uint32_t envsz)
 | 
					 | 
				
			||||||
{
 | 
					 | 
				
			||||||
    int i;
 | 
					 | 
				
			||||||
    printf("env=%d, size=%d\n", penv - &Stack[0], envsz);
 | 
					 | 
				
			||||||
    for(i=0; i < SP; i++) {
 | 
					 | 
				
			||||||
        printf("%d: ", i);
 | 
					 | 
				
			||||||
        print(stdout, Stack[i], 0);
 | 
					 | 
				
			||||||
        printf("\n");
 | 
					 | 
				
			||||||
    }
 | 
					 | 
				
			||||||
    printf("\n");
 | 
					 | 
				
			||||||
}
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
// unordered comparison
 | 
					 | 
				
			||||||
// not any faster than ordered comparison
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
// a is a fixnum, b is a cvalue
 | 
					 | 
				
			||||||
static value_t equal_num_cvalue(value_t a, value_t b)
 | 
					 | 
				
			||||||
{
 | 
					 | 
				
			||||||
    cvalue_t *bcv = (cvalue_t*)ptr(b);
 | 
					 | 
				
			||||||
    numerictype_t bt;
 | 
					 | 
				
			||||||
    if (valid_numtype(bt=cv_numtype(bcv))) {
 | 
					 | 
				
			||||||
        fixnum_t ia = numval(a);
 | 
					 | 
				
			||||||
        void *bptr = cv_data(bcv);
 | 
					 | 
				
			||||||
        if (cmp_eq(&ia, T_FIXNUM, bptr, bt))
 | 
					 | 
				
			||||||
            return fixnum(0);
 | 
					 | 
				
			||||||
    }
 | 
					 | 
				
			||||||
    return fixnum(1);
 | 
					 | 
				
			||||||
}
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
static value_t bounded_equal(value_t a, value_t b, int bound);
 | 
					 | 
				
			||||||
static value_t cyc_equal(value_t a, value_t b, ptrhash_t *table);
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
static value_t bounded_vector_equal(value_t a, value_t b, int bound)
 | 
					 | 
				
			||||||
{
 | 
					 | 
				
			||||||
    size_t la = vector_size(a);
 | 
					 | 
				
			||||||
    size_t lb = vector_size(b);
 | 
					 | 
				
			||||||
    if (la != lb) return fixnum(1);
 | 
					 | 
				
			||||||
    size_t i;
 | 
					 | 
				
			||||||
    for (i = 0; i < la; i++) {
 | 
					 | 
				
			||||||
        value_t d = bounded_equal(vector_elt(a,i), vector_elt(b,i), bound-1);
 | 
					 | 
				
			||||||
        if (d==NIL || numval(d)!=0) return d;
 | 
					 | 
				
			||||||
    }
 | 
					 | 
				
			||||||
    return fixnum(0);
 | 
					 | 
				
			||||||
}
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
static value_t bounded_equal(value_t a, value_t b, int bound)
 | 
					 | 
				
			||||||
{
 | 
					 | 
				
			||||||
    value_t d;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
 compare_top:
 | 
					 | 
				
			||||||
    if (a == b) return fixnum(0);
 | 
					 | 
				
			||||||
    if (bound <= 0)
 | 
					 | 
				
			||||||
        return NIL;
 | 
					 | 
				
			||||||
    int taga = tag(a);
 | 
					 | 
				
			||||||
    int tagb = cmptag(b);
 | 
					 | 
				
			||||||
    switch (taga) {
 | 
					 | 
				
			||||||
    case TAG_NUM :
 | 
					 | 
				
			||||||
    case TAG_NUM1:
 | 
					 | 
				
			||||||
        if (isfixnum(b)) {
 | 
					 | 
				
			||||||
            return fixnum(1);
 | 
					 | 
				
			||||||
        }
 | 
					 | 
				
			||||||
        if (iscvalue(b)) {
 | 
					 | 
				
			||||||
            return equal_num_cvalue(a, b);
 | 
					 | 
				
			||||||
        }
 | 
					 | 
				
			||||||
        return fixnum(1);
 | 
					 | 
				
			||||||
    case TAG_SYM:
 | 
					 | 
				
			||||||
        return fixnum(1);
 | 
					 | 
				
			||||||
    case TAG_VECTOR:
 | 
					 | 
				
			||||||
        if (isvector(b))
 | 
					 | 
				
			||||||
            return bounded_vector_equal(a, b, bound);
 | 
					 | 
				
			||||||
        break;
 | 
					 | 
				
			||||||
    case TAG_CVALUE:
 | 
					 | 
				
			||||||
        if (iscvalue(b)) {
 | 
					 | 
				
			||||||
            cvalue_t *acv=(cvalue_t*)ptr(a), *bcv=(cvalue_t*)ptr(b);
 | 
					 | 
				
			||||||
            numerictype_t at, bt;
 | 
					 | 
				
			||||||
            if (valid_numtype(at=cv_numtype(acv)) &&
 | 
					 | 
				
			||||||
                valid_numtype(bt=cv_numtype(bcv))) {
 | 
					 | 
				
			||||||
                void *aptr = cv_data(acv);
 | 
					 | 
				
			||||||
                void *bptr = cv_data(bcv);
 | 
					 | 
				
			||||||
                if (cmp_eq(aptr, at, bptr, bt))
 | 
					 | 
				
			||||||
                    return fixnum(0);
 | 
					 | 
				
			||||||
                return fixnum(1);
 | 
					 | 
				
			||||||
            }
 | 
					 | 
				
			||||||
            return cvalue_compare(a, b);
 | 
					 | 
				
			||||||
        }
 | 
					 | 
				
			||||||
        else if (isfixnum(b)) {
 | 
					 | 
				
			||||||
            return equal_num_cvalue(b, a);
 | 
					 | 
				
			||||||
        }
 | 
					 | 
				
			||||||
        break;
 | 
					 | 
				
			||||||
    case TAG_BUILTIN:
 | 
					 | 
				
			||||||
        return fixnum(1);
 | 
					 | 
				
			||||||
    case TAG_CONS:
 | 
					 | 
				
			||||||
        if (tagb != TAG_CONS) return fixnum(1);
 | 
					 | 
				
			||||||
        d = bounded_equal(car_(a), car_(b), bound-1);
 | 
					 | 
				
			||||||
        if (d==NIL || numval(d) != 0) return d;
 | 
					 | 
				
			||||||
        a = cdr_(a); b = cdr_(b);
 | 
					 | 
				
			||||||
        bound--;
 | 
					 | 
				
			||||||
        goto compare_top;
 | 
					 | 
				
			||||||
    }
 | 
					 | 
				
			||||||
    return fixnum(1);
 | 
					 | 
				
			||||||
}
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
static value_t cyc_vector_equal(value_t a, value_t b, ptrhash_t *table)
 | 
					 | 
				
			||||||
{
 | 
					 | 
				
			||||||
    size_t la = vector_size(a);
 | 
					 | 
				
			||||||
    size_t lb = vector_size(b);
 | 
					 | 
				
			||||||
    size_t i;
 | 
					 | 
				
			||||||
    value_t d, xa, xb, ca, cb;
 | 
					 | 
				
			||||||
    if (la != lb) return fixnum(1);
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
    // first try to prove them different with no recursion
 | 
					 | 
				
			||||||
    for (i = 0; i < la; i++) {
 | 
					 | 
				
			||||||
        xa = vector_elt(a,i);
 | 
					 | 
				
			||||||
        xb = vector_elt(b,i);
 | 
					 | 
				
			||||||
        if (leafp(xa) || leafp(xb)) {
 | 
					 | 
				
			||||||
            d = bounded_equal(xa, xb, 1);
 | 
					 | 
				
			||||||
            if (numval(d)!=0) return d;
 | 
					 | 
				
			||||||
        }
 | 
					 | 
				
			||||||
        else if (cmptag(xa) != cmptag(xb)) {
 | 
					 | 
				
			||||||
            return fixnum(1);
 | 
					 | 
				
			||||||
        }
 | 
					 | 
				
			||||||
    }
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
    ca = eq_class(table, a);
 | 
					 | 
				
			||||||
    cb = eq_class(table, b);
 | 
					 | 
				
			||||||
    if (ca!=NIL && ca==cb)
 | 
					 | 
				
			||||||
        return fixnum(0);
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
    eq_union(table, a, b, ca, cb);
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
    for (i = 0; i < la; i++) {
 | 
					 | 
				
			||||||
        xa = vector_elt(a,i);
 | 
					 | 
				
			||||||
        xb = vector_elt(b,i);
 | 
					 | 
				
			||||||
        if (!leafp(xa) && !leafp(xb)) {
 | 
					 | 
				
			||||||
            d = cyc_equal(xa, xb, table);
 | 
					 | 
				
			||||||
            if (numval(d)!=0) return d;
 | 
					 | 
				
			||||||
        }
 | 
					 | 
				
			||||||
    }
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
    return fixnum(0);
 | 
					 | 
				
			||||||
}
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
static value_t cyc_equal(value_t a, value_t b, ptrhash_t *table)
 | 
					 | 
				
			||||||
{
 | 
					 | 
				
			||||||
    if (a==b)
 | 
					 | 
				
			||||||
        return fixnum(0);
 | 
					 | 
				
			||||||
    if (iscons(a)) {
 | 
					 | 
				
			||||||
        if (iscons(b)) {
 | 
					 | 
				
			||||||
            value_t aa = car_(a); value_t da = cdr_(a);
 | 
					 | 
				
			||||||
            value_t ab = car_(b); value_t db = cdr_(b);
 | 
					 | 
				
			||||||
            int tagaa = cmptag(aa); int tagda = cmptag(da);
 | 
					 | 
				
			||||||
            int tagab = cmptag(ab); int tagdb = cmptag(db);
 | 
					 | 
				
			||||||
            value_t d, ca, cb;
 | 
					 | 
				
			||||||
            if (leafp(aa) || leafp(ab)) {
 | 
					 | 
				
			||||||
                d = bounded_equal(aa, ab, 1);
 | 
					 | 
				
			||||||
                if (numval(d)!=0) return d;
 | 
					 | 
				
			||||||
            }
 | 
					 | 
				
			||||||
            else if (tagaa != tagab)
 | 
					 | 
				
			||||||
                return fixnum(1);
 | 
					 | 
				
			||||||
            if (leafp(da) || leafp(db)) {
 | 
					 | 
				
			||||||
                d = bounded_equal(da, db, 1);
 | 
					 | 
				
			||||||
                if (numval(d)!=0) return d;
 | 
					 | 
				
			||||||
            }
 | 
					 | 
				
			||||||
            else if (tagda != tagdb)
 | 
					 | 
				
			||||||
                return fixnum(1);
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
            ca = eq_class(table, a);
 | 
					 | 
				
			||||||
            cb = eq_class(table, b);
 | 
					 | 
				
			||||||
            if (ca!=NIL && ca==cb)
 | 
					 | 
				
			||||||
                return fixnum(0);
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
            eq_union(table, a, b, ca, cb);
 | 
					 | 
				
			||||||
            d = cyc_equal(aa, ab, table);
 | 
					 | 
				
			||||||
            if (numval(d)!=0) return d;
 | 
					 | 
				
			||||||
            return cyc_equal(da, db, table);
 | 
					 | 
				
			||||||
        }
 | 
					 | 
				
			||||||
        else {
 | 
					 | 
				
			||||||
            return fixnum(1);
 | 
					 | 
				
			||||||
        }
 | 
					 | 
				
			||||||
    }
 | 
					 | 
				
			||||||
    else if (isvector(a) && isvector(b)) {
 | 
					 | 
				
			||||||
        return cyc_vector_equal(a, b, table);
 | 
					 | 
				
			||||||
    }
 | 
					 | 
				
			||||||
    return bounded_equal(a, b, 1);
 | 
					 | 
				
			||||||
}
 | 
					 | 
				
			||||||
							
								
								
									
										1448
									
								
								tiny/lisp2.c.bak
								
								
								
								
							
							
						
						
									
										1448
									
								
								tiny/lisp2.c.bak
								
								
								
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							
		Loading…
	
		Reference in New Issue