Commit e0471228 authored by John van Groningen's avatar John van Groningen

tail recursion modulo cons for strict lists

parent bd025543
......@@ -860,7 +860,7 @@ static void CodeNormalRootNode (Node root,NodeId rootid,int asp,int bsp,CodeGenN
CodeRootSelection (root, rootid, asp, bsp,code_gen_node_ids_p,resultstate);
return;
case fail_symb:
#if CLEAN2
#ifdef CLEAN2
{
IdentS case_ident_s;
SymbDefS case_def_s;
......@@ -1343,21 +1343,10 @@ static Bool ExamineRootNodeOnACycle (NodeId rhsid,Node rhsroot,int *asp_p,StateS
#if TAIL_CALL_MODULO_CONS_OPTIMIZATION
extern int tail_call_modulo_cons;
static void generate_code_for_tail_call_modulo_cons (NodeP node_p,NodeId node_def_id,NodeP root_node,
#if STRICT_LISTS
NodeP fill_unique_node,
#else
NodeP push_node,
#endif
int asp,int bsp,struct code_gen_node_ids *code_gen_node_ids_p)
static void generate_code_for_tail_call_modulo_cons (NodeP node_p,NodeId node_def_id,NodeP root_node,NodeP push_node,int asp,int bsp,struct code_gen_node_ids *code_gen_node_ids_p)
{
LabDef name;
int a_size,b_size;
#if STRICT_LISTS
NodeP push_node;
push_node=fill_unique_node->node_node;
#endif
ConvertSymbolToLabel (&name,node_p->node_symbol->symb_def);
......@@ -1383,20 +1372,34 @@ static void generate_code_for_tail_call_modulo_cons (NodeP node_p,NodeId node_de
BuildArgs (root_node->node_arguments,&asp,&bsp,code_gen_node_ids_p);
if (root_node->node_symbol->symb_kind==cons_symb){
GenFillh (&cons_lab,root_node->node_arity,asp,ReleaseAndFill);
asp-=root_node->node_arity;
} else {
LabDef constructor_name;
#if STRICT_LISTS
if (root_node->node_symbol->symb_kind==cons_symb ? root_node->node_symbol->symb_head_strictness!=4 : !root_node->node_symbol->symb_def->sdef_strict_constructor){
#else
if (root_node->node_symbol->symb_kind==cons_symb || !root_node->node_symbol->symb_def->sdef_strict_constructor){
#endif
LabDef constructor_name,*constructor_name_p;
if (!root_node->node_symbol->symb_def->sdef_strict_constructor){
if (root_node->node_symbol->symb_kind==cons_symb)
constructor_name_p=&cons_lab;
else {
ConvertSymbolToConstructorDLabel (&constructor_name,root_node->node_symbol->symb_def);
GenFillh (&constructor_name,root_node->node_arity,asp,ReleaseAndFill);
constructor_name_p=&constructor_name;
}
GenFillh (constructor_name_p,root_node->node_arity,asp,ReleaseAndFill);
asp-=root_node->node_arity;
} else {
LabDef constructor_name,*constructor_name_p;
int asize,bsize;
#if STRICT_LISTS
if (root_node->node_symbol->symb_kind==cons_symb)
constructor_name_p=unboxed_cons_label (root_node->node_symbol);
else
#endif
{
ConvertSymbolToKLabel (&constructor_name,root_node->node_symbol->symb_def);
constructor_name_p=&constructor_name;
}
DetermineSizeOfArguments (root_node->node_arguments,&asize,&bsize);
......@@ -1450,13 +1453,13 @@ static void generate_code_for_tail_call_modulo_cons (NodeP node_p,NodeId node_de
bits[a_size+b_size]='\0';
GenPushA (asp-node_def_id->nid_a_index);
GenFill3R (&constructor_name,asize,bsize,asp+1,bits);
GenFill3R (constructor_name_p,asize,bsize,asp+1,bits);
} else
GenFillR (&constructor_name,asize,bsize,asp,0,0,ReleaseAndFill,True);
GenFillR (constructor_name_p,asize,bsize,asp,0,0,ReleaseAndFill,True);
asp-=asize;
bsp-=bsize;
}
}
if (tail_call_modulo_cons)
name.lab_post=2;
......@@ -2023,23 +2026,14 @@ int CodeRhsNodeDefs
if (node_p!=NULL){
NodeIdP node_def_id;
#if STRICT_LISTS
NodeP fill_unique_node;
fill_unique_node=NULL;
#else
NodeP push_node;
push_node=NULL;
#endif
node_def_id=last_node_def_p->def_id;
if (node_p->node_kind==FillUniqueNode){
#if STRICT_LISTS
fill_unique_node=node_p;
#else
push_node=node_p->node_node;
#endif
node_p=node_p->node_arguments->arg_node;
}
......@@ -2047,11 +2041,9 @@ int CodeRhsNodeDefs
*last_node_def_h=NULL;
CodeSharedNodeDefs (defs,NULL,&asp,&bsp,&code_gen_node_ids);
*last_node_def_h=last_node_def_p;
#if STRICT_LISTS
generate_code_for_tail_call_modulo_cons (node_p,node_def_id,root_node,fill_unique_node,asp,bsp,&code_gen_node_ids);
#else
generate_code_for_tail_call_modulo_cons (node_p,node_def_id,root_node,push_node,asp,bsp,&code_gen_node_ids);
#endif
while (moved_node_ids!=NULL){
moved_node_ids->mnid_node_id->nid_a_index_=moved_node_ids->mnid_a_stack_offset;
moved_node_ids=moved_node_ids->mnid_next;
......@@ -2064,23 +2056,13 @@ int CodeRhsNodeDefs
} else {
NodeP node_p;
NodeIdP node_id_p;
#if STRICT_LISTS
NodeP fill_unique_node_p;
fill_unique_node_p=NULL;
#else
NodeP push_node_p;
push_node_p=NULL;
#endif
node_p=arg_p2->arg_node;
if (node_p->node_kind==FillUniqueNode){
#if STRICT_LISTS
fill_unique_node_p=node_p->node_node;
#else
push_node_p=node_p->node_node;
#endif
node_p=node_p->node_arguments->arg_node;
}
......@@ -2095,11 +2077,8 @@ int CodeRhsNodeDefs
arg_p2->arg_node=NewNodeIdNode (node_id_p);
CodeSharedNodeDefs (defs,NULL,&asp,&bsp,&code_gen_node_ids);
#if STRICT_LISTS
generate_code_for_tail_call_modulo_cons (node_p,node_id_p,root_node,fill_unique_node_p,asp,bsp,&code_gen_node_ids);
#else
generate_code_for_tail_call_modulo_cons (node_p,node_id_p,root_node,push_node_p,asp,bsp,&code_gen_node_ids);
#endif
while (moved_node_ids!=NULL){
moved_node_ids->mnid_node_id->nid_a_index_=moved_node_ids->mnid_a_stack_offset;
moved_node_ids=moved_node_ids->mnid_next;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment