/* Insert into either mapExp2Atom or mapContext2Atom */
void
insert_map2 (FiniteMap map2, FileOffset exp, FileOffset atom
,unsigned char arity)
{
Info *info = (Info*)0;
info = FM_lookup(mapAtom2Info,(cast)atom);
if (info) {
Atom *fun;
fun = (Atom*)malloc(sizeof(Atom));
fun->atom = atom;
fun->arity = info->arity - arity;
FM_insert(map2,(cast)exp,(cast)fun);
}
}
/* item_sort() doesn't do any sorting at all. It folds one item of
* information into one of three new finite maps (globals,locals,constrs).
* The new maps are indexed by name rather than file position - if the
* name is new, a new entry is created; if it exists already, the counts
* are added together.
*/
int
item_sort (FileOffset node, item *it, void* dummy)
{
item *already;
switch (it->kind) {
case TopId:
already = FM_lookup(globals,(cast)it->name);
if (already) {
it->uses += already->uses;
it->pending += already->pending;
it->thunks += already->thunks;
} else
FM_insert(globals,(cast)it->name,(cast)it);
break;
case LocalId:
already = FM_lookup(locals,(cast)it->name);
if (already) {
it->uses += already->uses;
it->pending += already->pending;
it->thunks += already->thunks;
} else
FM_insert(locals, (cast)it->name,(cast)it);
break;
case Construct:
already = FM_lookup(constrs,(cast)it->name);
if (already) {
it->uses += already->uses;
it->pending += already->pending;
it->thunks += already->thunks;
} else
FM_insert(constrs,(cast)it->name,(cast)it);
break;
default: break;
}
return False;
}
defn*
map2_insert (FileOffset usage, FileOffset def, unsigned char ap)
{
item *it = (item*)NULL;
it = FM_lookup(map1,(cast)(uintptr_t)def);
if (it) {
defn *fn;
fn = (defn*)malloc(sizeof(defn));
fn->atom = def;
fn->arity = it->arity - ap;
fn->next = (defn*)0;
//if (strcmp(it->name,">=")==0)
// fprintf(stderr,"map2: %s at 0x%x (%d)\n",it->name,usage,it->uses);
FM_insert(map2,(cast)(uintptr_t)usage,(cast)fn);
return fn;
} else return (defn*)0;
}
void
map1_insert (FileOffset node, char* id, idkind k, unsigned char arity)
{
item *it = (item*)NULL;
it = FM_lookup(map1,(cast)(uintptr_t)node);
if (!it) {
it = (item*)malloc(sizeof(item));
it->name = id;
it->kind = k;
it->arity = arity;
it->uses = 0;
it->pending = 0;
it->thunks = 0;
it->thispos = node;
FM_insert(map1,(cast)(uintptr_t)node,(cast)it);
}
}
/* q_oneNode() moves the file pointer past a single node in the file.
* As a side-effect, if it finds an AtomVariable or AtomConstructor,
* it adds it to the global structure 'map1'. If it finds an ExpValueUse
* or ExpConstDef, it adds an entry in map2 from that usage to the relevant
* Atom in map1. If it finds an ExpApp or ExpConstUse, it instead looks
* up the Atom ptr in map2, then looks up that Atom in map1, and finally
* increments the usage counter. However, in the case where an ExpApp
* is undersaturated (discovered by comparing its arity with the arity
* stored in map2), rather than incrementing the usage counter, we
* instead need to add the address of the ExpApp to map2.
*/
void
q_oneNode (void)
{
char c; int err;
FileOffset node = q_position;
/*fprintf(stdout,"\n0x%x: ",position); fflush(stdout);*/
err = q_fread(&c,sizeof(char),1,HatFileSeq);
if (err!=1) return;
switch (lower5(c)) { /* lower 5 bits identify the TraceType */
case ExpApp:
if (hasSrcPos(c)) { q_readFO(); }
q_readFO(); /* skip parent */
{ unsigned char size, next, i;
FileOffset fun, result; defn *def; item *it;
result = q_readFO(); /* get result */
fun = q_readFO(); /* keep fun ptr */
q_fread(&size,sizeof(unsigned char),1,HatFileSeq); /* get arity */
for (i=0; i<size; i++) q_readFO(); /* skip args */
def = (defn*)FM_lookup(map2,(cast)(uintptr_t)fun);
if (def) {
defn *def2;
it = FM_lookup(map1,(cast)(uintptr_t)def->atom);
if (it) {
if (size>=def->arity) {
if (result==Entered) it->pending += 1;
else if (result==Unevaluated) it->thunks += 1;
else it->uses += 1;
} else if (size < def->arity)
def2 = map2_insert(node,def->atom,size);
} else {
fprintf(stderr,"unknown atom in fun at (ExpApp 0x%x)\n",node);
}
if (def->next) {
it = FM_lookup(map1,(cast)(uintptr_t)def->next->atom);
if (it) {
if (size>=def->next->arity) {
if (result==Entered) it->pending += 1;
else if (result==Unevaluated) it->thunks += 1;
else it->uses += 1;
} else if (size < def->next->arity) {
def2->next = (defn*)malloc(sizeof(defn));
def2->next->atom = def->next->atom;
def2->next->arity = def->next->arity - size;
def2->next->next = (defn*)0;
}
} else {
fprintf(stderr,"unknown atom in CAF fun at (ExpApp 0x%x)\n",node);
}
}
} else {
// fprintf(stderr,"unknown fun at (ExpApp 0x%x)\n",node);
}
} break;
case ExpValueApp:
if (hasSrcPos(c)) { q_readFO(); }
q_readFO(); /* skip parent */
{ unsigned char size, next, i;
FileOffset fun; defn *def; item *it;
fun = q_readFO(); /* fun ptr is an Atom ref */
q_fread(&size,sizeof(unsigned char),1,HatFileSeq); /* get arity */
for (i=0; i<size; i++) q_readFO(); /* skip args */
it = FM_lookup(map1,(cast)(uintptr_t)fun);
if (it) {
if (size>=it->arity) {
it->uses += 1;
HIDE(fprintf(stderr,"0x%x ExpValueApp: incrementing\n",node);)
} else if (size < it->arity) {
map2_insert(node,fun,size);
HIDE(fprintf(stderr,"0x%x ExpValueApp: partial app\n",node);)
}
} else {
