remove and clean up some old files

This commit is contained in:
Jeff Bezanson 2013-06-11 17:31:51 -04:00 committed by Lassi Kortela
parent 55750ca929
commit 8334039090
8 changed files with 0 additions and 1876 deletions

View File

@ -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.

View File

@ -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];
}

View File

@ -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)

View File

@ -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)))))

View File

@ -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);
}

File diff suppressed because it is too large Load Diff