Skip to content

GitLab

Commit 9befde37 authored by John van Groningen's avatar John van Groningen
Browse files

compare record states when comparing strictness 

improve adding arguments to higher order functions
parent 2fc36d5b
Hide whitespace changes
Inline Side-by-side
backendC/CleanCompilerSources/statesgen.c
View file @ 9befde37
......@@ -96,6 +96,8 @@ int FirstStateIsStricter (StateS offered_state,StateS demanded_state)
return 1;
else if (offered_state.state_type==ArrayState && demanded_state.state_type==ArrayState)
return 1;
else if (offered_state.state_type==RecordState && demanded_state.state_type==RecordState)
return 1;
else
return 0;
}
......@@ -340,8 +342,6 @@ static void GenRecordState (SymbDef sdef)
SetRecordState (&sdef->sdef_record_state, sdef, sdef->sdef_cons_arity);
fieldstates=sdef->sdef_record_state.state_record_arguments;
/* rectype->type_constructors->cl_constructor->type_node_state = sdef->sdef_record_state; */
strict_record=0;
for_li (fields,i,rectype->type_fields,fl_next){
......@@ -395,7 +395,6 @@ static void GenRecordState (SymbDef sdef)
return;
else
StaticMessage (True, "%S", "%s cyclic strict field dependencies are not allowed", CurrentSymbol, sdef->sdef_ident->ident_name);
}
static void GenResultStatesOfLazyFields (SymbDef sdef)
......@@ -3318,8 +3317,6 @@ static int create_new_function_with_more_arguments (NodeP node_p,int determine_n
struct type_node *rhs_type_node_p;
SymbolP new_function_symbol;
SymbDef rule_sdef;
NodeP function_node_p2;
ArgP *arg_h;
int n_extra_function_arguments,n;
rule_sdef=function_symbol_p->symb_def;
......@@ -3348,33 +3345,47 @@ static int create_new_function_with_more_arguments (NodeP node_p,int determine_n
node_p->node_symbol=new_function_symbol;
} else
node_p->node_symbol=function_node_p->node_symbol;
function_node_p2=node_p->node_arguments->arg_node;
node_p->node_arguments=node_p->node_arguments->arg_next;
while (function_node_p2!=function_node_p){
ArgP second_arg_p;
second_arg_p=function_node_p2->node_arguments->arg_next;
second_arg_p->arg_next=node_p->node_arguments;
node_p->node_arguments=second_arg_p;
function_node_p2=function_node_p2->node_arguments->arg_node;
}
arg_h=&function_node_p->node_arguments;
while (*arg_h!=NULL)
arg_h=&(*arg_h)->arg_next;
*arg_h=node_p->node_arguments;
node_p->node_arguments=function_node_p->node_arguments;
node_p->node_arity=function_node_p->node_arity+n_extra_arguments;
return 1;
}
} else
return 0;
} else
return 0;
/* 26-6-2000: added DEFRULE and SYSRULE case */
} else if (function_symbol_p->symb_def->sdef_kind==DEFRULE || function_symbol_p->symb_def->sdef_kind==SYSRULE){
if (function_node_p->node_arity + n_extra_arguments <= function_symbol_p->symb_def->sdef_arity){
node_p->node_symbol=function_node_p->node_symbol;
} else
return 0;
} else
return 0;
{
NodeP function_node_p2;
ArgP *arg_h;
function_node_p2=node_p->node_arguments->arg_node;
node_p->node_arguments=node_p->node_arguments->arg_next;
while (function_node_p2!=function_node_p){
ArgP second_arg_p;
second_arg_p=function_node_p2->node_arguments->arg_next;
second_arg_p->arg_next=node_p->node_arguments;
node_p->node_arguments=second_arg_p;
function_node_p2=function_node_p2->node_arguments->arg_node;
}
arg_h=&function_node_p->node_arguments;
while (*arg_h!=NULL)
arg_h=&(*arg_h)->arg_next;
*arg_h=node_p->node_arguments;
node_p->node_arguments=function_node_p->node_arguments;
node_p->node_arity=function_node_p->node_arity+n_extra_arguments;
return 1;
}
} else if (function_symbol_p->symb_kind==if_symb && function_node_p->node_arity==3){
NodeP apply_node_p;
......@@ -3672,83 +3683,85 @@ static void CollectSharedAndAnnotatedNodesInRhs (NodeS **root_p,NodeDefS **defs_
while (root_node->node_kind==NormalNode &&
((root_node->node_symbol->symb_kind==apply_symb && create_new_function_with_more_arguments (root_node,0)) ||
(root_node->node_symbol->symb_kind==definition && root_node->node_symbol->symb_def->sdef_kind==IMPRULE)))
{
ImpRuleP imp_rule_p;
imp_rule_p=root_node->node_symbol->symb_def->sdef_rule;
if ((imp_rule_p->rule_mark & RULE_LAMBDA_FUNCTION_MASK) &&
root_node->node_symbol->symb_def->sdef_arity==root_node->node_arity &&
imp_rule_p->rule_alts->alt_next==NULL
# ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
&& ! (imp_rule_p->rule_alts->alt_rhs_root->node_kind==SwitchNode ||
imp_rule_p->rule_alts->alt_rhs_root->node_kind==GuardNode ||
imp_rule_p->rule_alts->alt_rhs_root->node_kind==IfNode)
# endif
)
{
ArgP call_arg_p,lhs_arg_p;
{
if (root_node->node_symbol->symb_def->sdef_kind==IMPRULE){
ImpRuleP imp_rule_p;
for_l (lhs_arg_p,imp_rule_p->rule_alts->alt_lhs_root->node_arguments,arg_next)
if (lhs_arg_p->arg_node->node_kind!=NodeIdNode ||
lhs_arg_p->arg_node->node_node_id->nid_refcount==-1 ||
lhs_arg_p->arg_node->node_node_id->nid_node!=NULL)
{
break;
}
imp_rule_p=root_node->node_symbol->symb_def->sdef_rule;
if (lhs_arg_p==NULL){
NodeP new_root_node;
/*
PrintRuleNode (root_node,False,StdOut);
FPrintF (StdOut,"\n");
PrintRuleAlt (imp_rule_p->rule_alts,StdOut);
*/
for_ll (call_arg_p,lhs_arg_p,root_node->node_arguments,imp_rule_p->rule_alts->alt_lhs_root->node_arguments,arg_next,arg_next){
NodeP call_node_p;
NodeIdP lhs_node_id_p,call_node_id_p;
lhs_node_id_p=lhs_arg_p->arg_node->node_node_id;
if ((imp_rule_p->rule_mark & RULE_LAMBDA_FUNCTION_MASK) &&
root_node->node_symbol->symb_def->sdef_arity==root_node->node_arity &&
imp_rule_p->rule_alts->alt_next==NULL
# ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
&& ! (imp_rule_p->rule_alts->alt_rhs_root->node_kind==SwitchNode ||
imp_rule_p->rule_alts->alt_rhs_root->node_kind==GuardNode ||
imp_rule_p->rule_alts->alt_rhs_root->node_kind==IfNode)
# endif
)
{
ArgP call_arg_p,lhs_arg_p;
for_l (lhs_arg_p,imp_rule_p->rule_alts->alt_lhs_root->node_arguments,arg_next)
if (lhs_arg_p->arg_node->node_kind!=NodeIdNode ||
lhs_arg_p->arg_node->node_node_id->nid_refcount==-1 ||
lhs_arg_p->arg_node->node_node_id->nid_node!=NULL)
{
break;
}
call_node_p=call_arg_p->arg_node;
if (call_node_p->node_kind==NodeIdNode)
call_node_id_p=call_node_p->node_node_id;
else {
NodeDefP new_node_def_p;
if (lhs_arg_p==NULL){
NodeP new_root_node;
/*
PrintRuleNode (root_node,False,StdOut);
FPrintF (StdOut,"\n");
PrintRuleAlt (imp_rule_p->rule_alts,StdOut);
*/
for_ll (call_arg_p,lhs_arg_p,root_node->node_arguments,imp_rule_p->rule_alts->alt_lhs_root->node_arguments,arg_next,arg_next){
NodeP call_node_p;
NodeIdP lhs_node_id_p,call_node_id_p;
call_node_id_p=NewNodeId (NULL);
call_node_id_p->nid_refcount=1;
call_node_id_p->nid_ref_count_copy_=1;
call_node_id_p->nid_exp_=NULL;
call_node_id_p->nid_node=call_node_p;
lhs_node_id_p=lhs_arg_p->arg_node->node_node_id;
call_node_p=call_arg_p->arg_node;
if (call_node_p->node_kind==NodeIdNode)
call_node_id_p=call_node_p->node_node_id;
else {
NodeDefP new_node_def_p;
call_node_id_p=NewNodeId (NULL);
call_node_id_p->nid_refcount=1;
call_node_id_p->nid_ref_count_copy_=1;
call_node_id_p->nid_exp_=NULL;
call_node_id_p->nid_node=call_node_p;
new_node_def_p = NewNodeDef (call_node_id_p,call_node_p);
new_node_def_p->def_next=*defs_p;
*defs_p=new_node_def_p;
}
new_node_def_p = NewNodeDef (call_node_id_p,call_node_p);
new_node_def_p->def_next=*defs_p;
*defs_p=new_node_def_p;
call_node_id_p->nid_mark &= ~SHARED_NODES_COLLECTED_MASK;
if (call_node_id_p->nid_refcount<0)
call_node_id_p->nid_refcount -= -2-lhs_node_id_p->nid_refcount;
else
call_node_id_p->nid_refcount += -2-lhs_node_id_p->nid_refcount;
lhs_node_id_p->nid_forward_node_id=call_node_id_p;
}
call_node_id_p->nid_mark &= ~SHARED_NODES_COLLECTED_MASK;
if (call_node_id_p->nid_refcount<0)
call_node_id_p->nid_refcount -= -2-lhs_node_id_p->nid_refcount;
else
call_node_id_p->nid_refcount += -2-lhs_node_id_p->nid_refcount;
lhs_node_id_p->nid_forward_node_id=call_node_id_p;
}
copy_rhs_node_defs_and_root (imp_rule_p->rule_alts,&new_root_node,defs_p);
copy_rhs_node_defs_and_root (imp_rule_p->rule_alts,&new_root_node,defs_p);
/*
PrintRuleNode (new_root_node,False,StdOut);
FPrintF (StdOut,"\n");
PrintNodeDefs (*defs_p,False,StdOut);
FPrintF (StdOut,"\n");
FPrintF (StdOut,"\n");
PrintRuleNode (new_root_node,False,StdOut);
FPrintF (StdOut,"\n");
PrintNodeDefs (*defs_p,False,StdOut);
FPrintF (StdOut,"\n");
FPrintF (StdOut,"\n");
*/
root_node=new_root_node;
*root_p=new_root_node;
continue;
root_node=new_root_node;
*root_p=new_root_node;
continue;
}
}
}
break;
......
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