hash_t obj_hash(obj_ptr obj)
{
switch (TYPE(obj))
{
case TYPE_INT:
case TYPE_BOOL:
return (hash_t) INT(obj);
case TYPE_SYMBOL:
return string_hash_imp(SYMBOL(obj));
case TYPE_STRING:
return string_hash(&STRING(obj));
case TYPE_CONS:
{
hash_t res = 0;
for (;;)
{
if (NTYPEP(obj, TYPE_CONS))
{
res += obj_hash(obj);
break;
}
res += obj_hash(CAR(obj));
obj = CDR(obj);
}
return res;
}
case TYPE_VEC:
return vec_hash(&obj->data.as_vec);
/* These types shouldn't be keys anyway ... */
case TYPE_FLOAT:
assert(TYPE(obj) != TYPE_FLOAT);
break;
case TYPE_MAP:
assert(TYPE(obj) != TYPE_MAP);
break;
case TYPE_CLOSURE:
assert(TYPE(obj) != TYPE_CLOSURE);
break;
case TYPE_PRIMITIVE:
assert(TYPE(obj) != TYPE_PRIMITIVE);
break;
case TYPE_ERROR:
assert(TYPE(obj) != TYPE_ERROR);
break;
case TYPE_PORT:
assert(TYPE(obj) != TYPE_PORT);
break;
}
return 0;
}
gdImagePtr get_gdImagePtr(LISP ptr)
{ gdImagePtr im;
if (NTYPEP(ptr,tc_gdimage))
err("not a gdImage",ptr);
if (!(im = (gdImagePtr) ptr->storage_as.string.data))
err("gd Image deallocated",ptr);
return(im);
}
gdFontPtr get_gdFontPtr(LISP ptr)
{ gdFontPtr fn;
if (NTYPEP(ptr,tc_gdfont))
err("not a gdFont",ptr);
if (!(fn = (gdFontPtr) ptr->storage_as.string.data))
err("gd Font deallocated",ptr);
return(fn);
}
gdPointPtr get_gdPointPtr(LISP ptr,long *n)
{ gdPointPtr pt;
if (NTYPEP(ptr,tc_gdpoint))
err("not a gdPoint",ptr);
if (!(pt = (gdPointPtr) ptr->storage_as.string.data))
err("gd point deallocated",ptr);
*n = ptr->storage_as.string.dim;
return(pt);
}
int obj_compare(obj_ptr left, obj_ptr right)
{
/* TODO
if (NUMP(left) && NUMP(right))
...
*/
if (TYPE(left) < TYPE(right))
return -1;
if (TYPE(left) > TYPE(right))
return 1;
switch (TYPE(left))
{
case TYPE_INT:
case TYPE_BOOL:
return _int_compare(INT(left), INT(right));
case TYPE_FLOAT:
return _float_compare(FLOAT(left), FLOAT(right), 0.00000001); /* TODO: Better epsilon? */
case TYPE_SYMBOL:
return strcmp(SYMBOL(left), SYMBOL(right));
case TYPE_STRING:
return string_compare(&STRING(left), &STRING(right));
case TYPE_CONS:
{
int res = 0;
for (;;)
{
if (NTYPEP(left, TYPE(right)))
return obj_compare(left, right);
if (NTYPEP(left, TYPE_CONS))
return obj_compare(left, right);
res = obj_compare(CAR(left), CAR(right));
if (res != 0)
return res;
left = CDR(left);
right = CDR(right);
}
assert(0); /* unreachable */
break;
}
case TYPE_VEC:
return vec_compare(&left->data.as_vec, &right->data.as_vec);
/* TODO */
case TYPE_MAP:
assert(TYPE(left) != TYPE_MAP);
break;
case TYPE_CLOSURE:
assert(TYPE(left) != TYPE_CLOSURE);
break;
case TYPE_PRIMITIVE:
assert(TYPE(left) != TYPE_PRIMITIVE);
break;
case TYPE_ERROR:
assert(TYPE(left) != TYPE_ERROR);
break;
case TYPE_PORT:
assert(TYPE(left) != TYPE_PORT);
break;
}
return 0;
}
