/* 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 {