uint32_t get_hash(V v)
{
int t = getType(v);
if (t == T_STR)
{
return need_hash(v);
}
else if (t == T_NUM)
{
return (uint32_t)toNumber(v);
}
else if (t == T_PAIR)
{
return get_hash(toFirst(v)) + get_hash(toSecond(v));
}
else if (t == T_FRAC)
{
return toNumerator(v) ^ toDenominator(v);
}
else
{
return (unsigned long)v >> 4;
/* This discards 4 bits.
* The reason is that allocated addresses are usually
* aligned to some extent.
* It might get rid of some entropy, though the original
* amount was probably low enough already.
* If you have a better solution, please share.
*/
}
}
V new_pair(V first, V second)
{
V t = make_new_value(T_PAIR, true, sizeof(V) * 2);
toFirst(t) = first;
toSecond(t) = second;
return t;
}
bool persist_collect_(V original, HashMap *hm)
{
int type = getType(original);
HashMap *hmv;
Bucket *b;
int i;
if (type == T_SCOPE || type == T_FUNC || type == T_CFUNC)
{
return false;
}
if (get_hashmap(hm, original) != NULL)
{
return true;
}
set_hashmap(hm, original, intToV(-pair_ordinal(original)-1));
switch(type)
{
case T_STR:
case T_IDENT:
case T_NUM:
case T_FRAC:
break;
case T_LIST:
for (i = 0; i < toStack(original)->used; i++)
{
if (!persist_collect_(toStack(original)->nodes[i], hm))
{
return false;
}
}
break;
case T_DICT:
hmv = toHashMap(original);
if (hmv->map != NULL)
{
for (i = 0; i < hmv->size; i++)
{
b = hmv->map[i];
while(b != NULL)
{
if (!persist_collect_(b->key, hm) ||!persist_collect_(b->value, hm))
{
return false;
}
b = b->next;
}
}
}
break;
case T_PAIR:
if (!persist_collect_(toFirst(original), hm) || !persist_collect_(toSecond(original), hm))
return false;
break;
}
return true;
}
long int pair_ordinal(V p)
{
if (getType(p) != T_PAIR)
{
return 0;
}
int o1 = pair_ordinal(toFirst(p));
int o2 = pair_ordinal(toSecond(p));
return (o1 > o2 ? o1 : o2) + 1;
}
void write_object(FILE *file, V obj, HashMap *hm)
{
int t = getType(obj);
union double_or_uint64_t num;
ITreeNode *id = NULL;
NewString *s = NULL;
Stack *st;
HashMap *hmv;
int8_t n8;
uint8_t l8;
int32_t n32;
uint32_t l32;
int64_t n64;
uint64_t l64;
int i;
Bucket *b;
char type = t;
switch (t)
{
case T_NUM:
if (canBeSmallInt(obj))
type |= TYPE_SHORT;
break;
case T_IDENT:
id = toIdent(obj);
if (id->length < 256)
type |= TYPE_SHORT;
break;
case T_STR:
s = toNewString(obj);
if (s->size < 256)
type |= TYPE_SHORT;
break;
case T_FRAC:
if (toNumerator(obj) < 128 && toNumerator(obj) >= -128 &&
toDenominator(obj) < 256)
type |= TYPE_SHORT;
break;
}
fwrite(&type, 1, 1, file);
switch (t)
{
case T_IDENT:
if (type & TYPE_SHORT)
{
l8 = id->length;
fwrite(&l8, 1, 1, file);
}
else
{
l32 = id->length;
l32 = htonl(l32);
fwrite(&l32, 4, 1, file);
}
fwrite(&id->data, id->length, 1, file);
break;
case T_STR:
if (type & TYPE_SHORT)
{
l8 = s->size;
fwrite(&l8, 1, 1, file);
}
else
{
l32 = s->size;
l32 = htonl(l32);
fwrite(&l32, 4, 1, file);
}
fwrite(s->text, s->size, 1, file);
break;
case T_NUM:
if (type & TYPE_SHORT)
{
n32 = toInt(obj);
n32 = htonl(n32);
fwrite(((char*)&n32) + 1, 3, 1, file);
}
else
{
num.d = toNumber(obj);
num.i = htonll(num.i);
fwrite(&num, 8, 1, file);
}
break;
case T_FRAC:
if (type & TYPE_SHORT)
{
n8 = toNumerator(obj);
fwrite(&n8, 1, 1, file);
l8 = toDenominator(obj);
fwrite(&l8, 1, 1, file);
}
else
{
n64 = toNumerator(obj);
n64 = htonl(n64);
fwrite(&n64, 8, 1, file);
l64 = toDenominator(obj);
l64 = htonl(l64);
fwrite(&l64, 8, 1, file);
}
break;
case T_PAIR:
write_ref(file, toFirst(obj), hm);
write_ref(file, toSecond(obj), hm);
break;
case T_LIST:
st = toStack(obj);
l32 = st->used;
l32 = htonl(l32);
fwrite(&l32, 4, 1, file);
for (i = 0; i < st->used; i++)
{
write_ref(file, st->nodes[i], hm);
}
break;
case T_DICT:
hmv = toHashMap(obj);
l32 = hmv->used;
l32 = htonl(l32);
fwrite(&l32, 4, 1, file);
if (hmv->map != NULL)
{
for (i = 0; i < hmv->size; i++)
{
b = hmv->map[i];
while(b != NULL)
{
write_ref(file, b->key, hm);
write_ref(file, b->value, hm);
b = b->next;
}
}
}
break;
}
}
