/* File: pattern_match.c Author: John van Groningen */ #define DEBUG_OUTPUT 0 #if defined (applec) || defined (__MWERKS__) || defined (__MRC__) # define __ppc__ #endif #include #include "compiledefines.h" #include "types.t" #include "syntaxtr.t" #include "pattern_match.h" #include "buildtree.h" #include "comsupport.h" #include "statesgen.h" #include "settings.h" #include "codegen_types.h" #define for_l(v,l,n) for(v=(l);v!=NULL;v=v->n) static void error_in_function (char *m) { ErrorInCompiler ("",m,""); } #if DEBUG_OUTPUT char *node_id_name (NodeId node_id) { static char node_id_name_s[65]; if (node_id->nid_ident!=NULL && node_id->nid_ident->ident_name!=NULL) return node_id->nid_ident->ident_name; else { sprintf (node_id_name_s,"i_%lx",(long)node_id); return node_id_name_s; } } #endif static NodeP new_switch_node (NodeIdP node_id,NodeP case_node,StateP state_p,NodeS ***root_l) { NodeP switch_node; switch_node=CompAllocType (NodeS); switch_node->node_kind=SwitchNode; switch_node->node_node_id=node_id; switch_node->node_arity=1; switch_node->node_arguments=NewArgument (case_node); switch_node->node_state=*state_p; #if DEBUG_OUTPUT printf ("dec %s %d\n",node_id_name (node_id),node_id->nid_refcount); #endif --node_id->nid_refcount; **root_l=switch_node; *root_l=&case_node->node_arguments->arg_node; return switch_node; } static NodeP new_case_node (SymbolP symbol,int symbol_arity,NodeP node,NodeDefP **def_l #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS ,StrictNodeIdP **strict_node_ids_l #endif ) { NodeP case_node; case_node=CompAllocType (NodeS); case_node->node_kind=CaseNode; case_node->node_symbol=symbol; case_node->node_arity=symbol_arity; case_node->node_arguments=NewArgument (node); #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS case_node->node_su.su_u.u_case=CompAllocType (CaseNodeContentsS); case_node->node_strict_node_ids=NULL; #endif case_node->node_node_id_ref_counts=NULL; case_node->node_node_defs=**def_l; **def_l=NULL; *def_l=&case_node->node_node_defs; #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS case_node->node_strict_node_ids=**strict_node_ids_l; **strict_node_ids_l=NULL; *strict_node_ids_l=&case_node->node_strict_node_ids; #endif return case_node; } struct root_and_defs_l { NodeP ** root_l; NodeDefP ** def_l; #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS StrictNodeIdP **strict_node_ids_l; NodeDefP ** end_lhs_defs_l; #endif }; struct root_and_defs { NodeP root; NodeDefP defs; #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS StrictNodeIdP strict_node_ids; #endif }; #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS static void add_new_lhs_node_id_to_lhs_node_defs (NodeIdP node_id_p,struct root_and_defs_l *root_and_defs_lp) { NodeDefP new_node_def_p; new_node_def_p=CompAllocType (NodeDefS); new_node_def_p->def_id=node_id_p; new_node_def_p->def_mark=0; new_node_def_p->def_node=node_id_p->nid_node; **root_and_defs_lp->end_lhs_defs_l=new_node_def_p; *root_and_defs_lp->end_lhs_defs_l=&new_node_def_p->def_next; } #endif static NodeP new_switch_and_case_node (NodeIdP node_id,StateP state_p,SymbolP symbol,int symbol_arity,struct root_and_defs_l *root_and_defs_lp) { NodeP case_node_p; case_node_p=new_case_node (symbol,symbol_arity,**root_and_defs_lp->root_l,root_and_defs_lp->def_l #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS ,root_and_defs_lp->strict_node_ids_l #endif ); return new_switch_node (node_id,case_node_p,state_p,root_and_defs_lp->root_l); } static NodeP new_default_node (NodeP node,NodeDefP node_defs #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS ,StrictNodeIdP strict_node_ids #endif ) { NodeP default_node; default_node=CompAllocType (NodeS); default_node->node_kind=DefaultNode; default_node->node_node_defs=node_defs; default_node->node_arity=1; default_node->node_arguments=NewArgument (node); #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS default_node->node_su.su_u.u_case=CompAllocType (CaseNodeContentsS); default_node->node_strict_node_ids=strict_node_ids; #endif default_node->node_node_id_ref_counts=NULL; return default_node; } static NodeP new_push_node (Symbol symbol,int arity,ArgP arguments) { NodeP push_node; push_node=CompAllocType (NodeS); push_node->node_kind=PushNode; push_node->node_arity=arity; push_node->node_arguments=arguments; push_node->node_record_symbol=symbol; push_node->node_number=0; /* if !=0 then unique */ return push_node; } static NodeP new_guard_node (NodeP if_node,NodeP node,NodeDefP node_defs #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS ,StrictNodeIdP strict_node_ids #endif ) { NodeP guard_node; ArgP arg1,arg2; guard_node=CompAllocType (NodeS); guard_node->node_kind=GuardNode; guard_node->node_node_defs=node_defs; guard_node->node_arity=2; #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS guard_node->node_guard_strict_node_ids=strict_node_ids; #endif arg1=NewArgument (if_node); arg2=NewArgument (node); guard_node->node_arguments=arg1; arg1->arg_next=arg2; return guard_node; } static void transform_normal_pattern_node (NodeP node,StateP state_p,NodeIdP node_id,struct root_and_defs_l *root_and_defs_lp); static void transform_pattern_arguments (SymbolP symbol,ArgP arguments,int arity,NodeIdP node_id,struct root_and_defs_l *root_and_defs_lp) { NodeP push_node; NodeIdListElementP *last_node_id_p; ArgP arg,arg1,arg2; arg2=NewArgument (**root_and_defs_lp->root_l); arg1=NewArgument (NULL); arg1->arg_next=arg2; push_node=new_push_node (symbol,arity,arg1); **root_and_defs_lp->root_l=push_node; *root_and_defs_lp->root_l=&arg2->arg_node; last_node_id_p=&push_node->node_node_ids; for_l (arg,arguments,arg_next){ NodeIdP argument_node_id; NodeP node; node=arg->arg_node; if (node->node_kind==NormalNode){ argument_node_id=NewNodeId (NULL); argument_node_id->nid_refcount=-1; argument_node_id->nid_lhs_state_p_=&arg->arg_state; transform_normal_pattern_node (node,&arg->arg_state,argument_node_id,root_and_defs_lp); } else { #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS NodeP argument_node_id_node; argument_node_id=node->node_node_id; argument_node_id->nid_lhs_state_p_=&arg->arg_state; argument_node_id_node=argument_node_id->nid_node; if (argument_node_id_node){ argument_node_id->nid_node=NULL; transform_normal_pattern_node (argument_node_id_node,&arg->arg_state,argument_node_id,root_and_defs_lp); } #else argument_node_id=node->node_node_id; if (argument_node_id->nid_node) transform_normal_pattern_node (argument_node_id->nid_node,&arg->arg_state,argument_node_id,root_and_defs_lp); #endif } #ifndef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS argument_node_id->nid_state_=arg->arg_state; #endif *last_node_id_p=CompAllocType (NodeIdListElementS); (*last_node_id_p)->nidl_node_id=argument_node_id; last_node_id_p=&(*last_node_id_p)->nidl_next; } *last_node_id_p=NULL; arg1->arg_node=NewNodeIdNode (node_id); } static void transform_normal_pattern_node (NodeP node,StateP state_p,NodeIdP node_id,struct root_and_defs_l *root_and_defs_lp) { SymbolP symbol; NodeP switch_node,case_node; NodeP **root_l; NodeDefP **def_l; symbol=node->node_symbol; root_l=root_and_defs_lp->root_l; def_l=root_and_defs_lp->def_l; switch (symbol->symb_kind){ case definition: case_node=new_case_node (symbol,node->node_arity,**root_l,def_l #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS ,root_and_defs_lp->strict_node_ids_l #endif ); switch_node=new_switch_node (node_id,case_node,state_p,root_l); if (node->node_arity>0) transform_pattern_arguments (symbol,node->node_arguments,node->node_arity,node_id,root_and_defs_lp); return; case cons_symb: case_node=new_case_node (symbol,2,**root_l,def_l #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS ,root_and_defs_lp->strict_node_ids_l #endif ); switch_node=new_switch_node (node_id,case_node,state_p,root_l); transform_pattern_arguments (symbol,node->node_arguments,2,node_id,root_and_defs_lp); return; case nil_symb: case_node=new_case_node (symbol,0,**root_l,def_l #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS ,root_and_defs_lp->strict_node_ids_l #endif ); switch_node=new_switch_node (node_id,case_node,state_p,root_l); return; case tuple_symb: case_node=new_case_node (symbol,node->node_arity,**root_l,def_l #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS ,root_and_defs_lp->strict_node_ids_l #endif ); switch_node=new_switch_node (node_id,case_node,state_p,root_l); transform_pattern_arguments (symbol,node->node_arguments,node->node_arity,node_id,root_and_defs_lp); return; case apply_symb: case if_symb: error_in_function ("transform_normal_pattern_node"); return; case string_denot: case_node=new_case_node (symbol,0,**root_l,def_l #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS ,root_and_defs_lp->strict_node_ids_l #endif ); switch_node=new_switch_node (node_id,case_node,state_p,root_l); return; default: if (symbol->symb_kind < Nr_Of_Basic_Types) error_in_function ("transform_normal_pattern_node"); else { #ifndef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS if (state_p->state_object==BasicSymbolStates [symbol->symb_kind].state_object){ #endif case_node=new_case_node (symbol,0,**root_l,def_l #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS ,root_and_defs_lp->strict_node_ids_l #endif ); switch_node=new_switch_node (node_id,case_node,state_p,root_l); return; #ifndef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS } else if (state_p->state_object==UnknownObj # if ABSTRACT_OBJECT || state_p->state_object==AbstractObj # endif ){ case_node=new_case_node (symbol,0,**root_l,def_l #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS ,root_and_defs_lp->strict_node_ids_l #endif ); switch_node=new_switch_node (node_id,case_node,state_p,root_l); return; } else error_in_function ("transform_normal_pattern_node"); #endif } } } NodeIdRefCountListP new_node_id_ref_count (NodeIdRefCountListP node_id_ref_count_list,NodeIdP node_id,int ref_count) { NodeIdRefCountListP new_node_id_ref_count_elem; new_node_id_ref_count_elem=CompAllocType (NodeIdRefCountListS); new_node_id_ref_count_elem->nrcl_next=node_id_ref_count_list; new_node_id_ref_count_elem->nrcl_node_id=node_id; new_node_id_ref_count_elem->nrcl_ref_count=ref_count; return new_node_id_ref_count_elem; } static NodeIdRefCountListP *insert_new_node_id_ref_count (NodeIdRefCountListP *node_id_ref_count_p,NodeIdP node_id,int ref_count) { NodeIdRefCountListP node_id_ref_count_elem; node_id_ref_count_elem=new_node_id_ref_count (NULL,node_id,ref_count); *node_id_ref_count_p=node_id_ref_count_elem; return &node_id_ref_count_elem->nrcl_next; } static void remove_aliases_from_node_and_node_definitions (NodeP node_p,NodeDefP node_defs #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS ,StrictNodeIdP strict_node_ids #endif ); static void remove_aliases_from_node (NodeP node) { switch (node->node_kind){ case NodeIdNode: { NodeIdP node_id; node_id=node->node_node_id; if (node_id->nid_mark & NID_ALIAS_MASK) node->node_node_id=node_id->nid_forward_node_id; return; } case NormalNode: case UpdateNode: { ArgP arg; for_l (arg,node->node_arguments,arg_next) remove_aliases_from_node (arg->arg_node); return; } case SelectorNode: case MatchNode: remove_aliases_from_node (node->node_arguments->arg_node); return; case IfNode: { ArgP cond_arg,then_arg; cond_arg=node->node_arguments; then_arg=cond_arg->arg_next; remove_aliases_from_node_and_node_definitions (then_arg->arg_node,node->node_then_node_defs #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS ,node->node_then_strict_node_ids #endif ); remove_aliases_from_node_and_node_definitions (then_arg->arg_next->arg_node,node->node_else_node_defs #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS ,node->node_else_strict_node_ids #endif ); remove_aliases_from_node (cond_arg->arg_node); return; } case PushNode: { NodeIdP node_id; ArgP arguments; arguments=node->node_arguments; node_id=arguments->arg_node->node_node_id; if (node_id->nid_mark & NID_ALIAS_MASK) arguments->arg_node->node_node_id=node_id->nid_forward_node_id; remove_aliases_from_node (arguments->arg_next->arg_node); return; } case SwitchNode: { NodeIdP node_id; node_id=node->node_node_id; if (node_id->nid_mark & NID_ALIAS_MASK) node->node_node_id=node_id->nid_forward_node_id; remove_aliases_from_node (node->node_arguments->arg_node); return; } case CaseNode: case DefaultNode: remove_aliases_from_node_and_node_definitions (node->node_arguments->arg_node,node->node_node_defs #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS ,node->node_strict_node_ids #endif ); return; case TupleSelectorsNode: remove_aliases_from_node (node->node_node); return; default: error_in_function ("remove_aliases_from_node"); } } static void remove_aliases_from_node_and_node_definitions (NodeP node_p,NodeDefP node_defs #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS ,StrictNodeIdP strict_node_ids #endif ) { NodeDefP node_def; remove_aliases_from_node (node_p); for_l (node_def,node_defs,def_next) if (node_def->def_node) remove_aliases_from_node (node_def->def_node); #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS { StrictNodeIdP strict_node_id_p; for_l (strict_node_id_p,strict_node_ids,snid_next){ NodeIdP node_id; node_id=strict_node_id_p->snid_node_id; if (node_id->nid_mark & NID_ALIAS_MASK) strict_node_id_p->snid_node_id=node_id->nid_forward_node_id; } } #endif } #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS static void transform_tuple_or_record_pattern_node (NodeP node,StateP state_p,NodeIdP node_id,struct root_and_defs_l *root_and_defs_lp); static void transform_tuple_or_record_pattern_arguments (SymbolP symbol,ArgP arguments,int arity,NodeIdP node_id,struct root_and_defs_l *root_and_defs_lp) { NodeP push_node; NodeIdListElementP *last_node_id_p; ArgP arg,arg1,arg2; arg2=NewArgument (**root_and_defs_lp->root_l); arg1=NewArgument (NULL); arg1->arg_next=arg2; push_node=new_push_node (symbol,arity,arg1); **root_and_defs_lp->root_l=push_node; *root_and_defs_lp->root_l=&arg2->arg_node; last_node_id_p=&push_node->node_node_ids; for_l (arg,arguments,arg_next){ NodeIdP argument_node_id; NodeP node; node=arg->arg_node; if (node->node_kind==NormalNode){ argument_node_id=NewNodeId (NULL); argument_node_id->nid_refcount=-1; argument_node_id->nid_lhs_state_p_=&arg->arg_state; arg->arg_node=NewNodeIdNode (argument_node_id); if (node->node_symbol->symb_kind==tuple_symb || (node->node_symbol->symb_kind==definition && node->node_symbol->symb_def->sdef_kind==RECORDTYPE)){ argument_node_id->nid_node=node; #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS add_new_lhs_node_id_to_lhs_node_defs (argument_node_id,root_and_defs_lp); #endif transform_tuple_or_record_pattern_node (node,&arg->arg_state,argument_node_id,root_and_defs_lp); } else transform_normal_pattern_node (node,&arg->arg_state,argument_node_id,root_and_defs_lp); } else { argument_node_id=node->node_node_id; if (argument_node_id->nid_node){ SymbolP argument_node_id_node_symbol; argument_node_id_node_symbol=argument_node_id->nid_node->node_symbol; if (argument_node_id_node_symbol->symb_kind==tuple_symb || (argument_node_id_node_symbol->symb_kind==definition && argument_node_id_node_symbol->symb_def->sdef_kind==RECORDTYPE)){ #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS add_new_lhs_node_id_to_lhs_node_defs (argument_node_id,root_and_defs_lp); #endif transform_tuple_or_record_pattern_node (argument_node_id->nid_node,&arg->arg_state,argument_node_id,root_and_defs_lp); } else { NodeP argument_node_id_node; argument_node_id_node=argument_node_id->nid_node; argument_node_id->nid_node=NULL; transform_normal_pattern_node (argument_node_id_node,&arg->arg_state,argument_node_id,root_and_defs_lp); } } } argument_node_id->nid_state_=arg->arg_state; *last_node_id_p=CompAllocType (NodeIdListElementS); (*last_node_id_p)->nidl_node_id=argument_node_id; last_node_id_p=&(*last_node_id_p)->nidl_next; } *last_node_id_p=NULL; arg1->arg_node=NewNodeIdNode (node_id); } static void transform_tuple_or_record_pattern_node (NodeP node,StateP state_p,NodeIdP node_id,struct root_and_defs_l *root_and_defs_lp) { NodeP switch_node; switch_node=new_switch_and_case_node (node_id,state_p,node->node_symbol,node->node_arity,root_and_defs_lp); transform_tuple_or_record_pattern_arguments (node->node_symbol,node->node_arguments,node->node_arity,node_id,root_and_defs_lp); } static void insert_push_node (SymbolP symbol,ArgP arguments,int arity,NodeIdP node_id,NodeP **root_l) { NodeP push_node; NodeIdListElementP *last_node_id_p; ArgP arg,arg1,arg2; arg2=NewArgument (**root_l); arg1=NewArgument (NULL); arg1->arg_next=arg2; push_node=new_push_node (symbol,arity,arg1); **root_l=push_node; *root_l=&arg2->arg_node; last_node_id_p=&push_node->node_node_ids; for_l (arg,arguments,arg_next){ NodeIdP argument_node_id; NodeP node; node=arg->arg_node; argument_node_id=node->node_node_id; argument_node_id->nid_state_=arg->arg_state; *last_node_id_p=CompAllocType (NodeIdListElementS); (*last_node_id_p)->nidl_node_id=argument_node_id; last_node_id_p=&(*last_node_id_p)->nidl_next; } *last_node_id_p=NULL; arg1->arg_node=NewNodeIdNode (node_id); } #endif static void transform_argument (ArgP arg_p,struct root_and_defs_l *root_and_defs_lp) { NodeP node; node=arg_p->arg_node; switch (node->node_kind){ case NormalNode: #ifndef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS if (arg_p->arg_state.state_type==TupleState || arg_p->arg_state.state_type==RecordState){ ArgP arg; for_l (arg,node->node_arguments,arg_next) transform_argument (arg,root_and_defs_lp); } else #endif { NodeIdP node_id; node_id=NewNodeId (NULL); node_id->nid_refcount=-1; node_id->nid_lhs_state_p_=&arg_p->arg_state; #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS if (node->node_symbol->symb_kind==tuple_symb || (node->node_symbol->symb_kind==definition && node->node_symbol->symb_def->sdef_kind==RECORDTYPE)) { node_id->nid_node=node; #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS add_new_lhs_node_id_to_lhs_node_defs (node_id,root_and_defs_lp); #endif transform_tuple_or_record_pattern_node (node,&arg_p->arg_state,node_id,root_and_defs_lp); } else #endif transform_normal_pattern_node (node,&arg_p->arg_state,node_id,root_and_defs_lp); #ifndef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS node_id->nid_state_=arg_p->arg_state; #endif arg_p->arg_node=NewNodeIdNode (node_id); } break; case NodeIdNode: { NodeIdP node_id; node_id=node->node_node_id; if (node_id->nid_node!=NULL){ #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS SymbolP node_id_nid_node_symbol; node_id_nid_node_symbol=node_id->nid_node->node_symbol; if (node_id_nid_node_symbol->symb_kind==tuple_symb || (node_id_nid_node_symbol->symb_kind==definition && node_id_nid_node_symbol->symb_def->sdef_kind==RECORDTYPE)) { # ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS add_new_lhs_node_id_to_lhs_node_defs (node_id,root_and_defs_lp); # endif transform_tuple_or_record_pattern_node (node_id->nid_node,&arg_p->arg_state,node_id,root_and_defs_lp); return; } #else if (arg_p->arg_state.state_type==TupleState || arg_p->arg_state.state_type==RecordState){ ArgP arg; for_l (arg,node_id->nid_node->node_arguments,arg_next) transform_argument (arg,root_and_defs_lp); } else #endif { transform_normal_pattern_node (node_id->nid_node,&arg_p->arg_state,node_id,root_and_defs_lp); node_id->nid_node=NULL; } } #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS node_id->nid_lhs_state_p_=&arg_p->arg_state; #else node_id->nid_state_=arg_p->arg_state; #endif break; } default: error_in_function ("transform_argument"); } } #if 0 # include "dbprint.h" #endif static void transform_and_merge_argument (ArgP arg_p,ArgP first_alt_arg_p,struct root_and_defs_l *root_and_defs_lp, NodeIdRefCountListP **node_id_ref_count_list_h) { NodeP node; node=arg_p->arg_node; switch (node->node_kind){ case NormalNode: #ifndef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS if (arg_p->arg_state.state_type==TupleState || arg_p->arg_state.state_type==RecordState){ ArgP tuple_arg_p,first_alt_tuple_arg_p; tuple_arg_p=node->node_arguments; if (first_alt_arg_p->arg_node->node_kind==NodeIdNode){ NodeIdP first_alt_node_id; first_alt_node_id=first_alt_arg_p->arg_node->node_node_id; #if 1 /* added 9-4-1999 */ *node_id_ref_count_list_h = insert_new_node_id_ref_count (*node_id_ref_count_list_h,first_alt_node_id,-1); #endif if (first_alt_node_id->nid_node==NULL){ first_alt_node_id->nid_node=node; for (; tuple_arg_p!=NULL; tuple_arg_p=tuple_arg_p->arg_next) transform_argument (tuple_arg_p,root_and_defs_lp); return; } else first_alt_tuple_arg_p=first_alt_node_id->nid_node->node_arguments; } else first_alt_tuple_arg_p=first_alt_arg_p->arg_node->node_arguments; for (; tuple_arg_p!=NULL; tuple_arg_p=tuple_arg_p->arg_next,first_alt_tuple_arg_p=first_alt_tuple_arg_p->arg_next) transform_and_merge_argument (tuple_arg_p,first_alt_tuple_arg_p,root_and_defs_lp,node_id_ref_count_list_h); } else #endif { NodeIdP first_alt_node_id; first_alt_node_id=first_alt_arg_p->arg_node->node_node_id; #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS if (node->node_symbol->symb_kind==tuple_symb || (node->node_symbol->symb_kind==definition && node->node_symbol->symb_def->sdef_kind==RECORDTYPE)) { if (first_alt_node_id->nid_node!=NULL){ ArgP tuple_arg_p,first_alt_tuple_arg_p; NodeP switch_node; switch_node=new_switch_and_case_node (first_alt_node_id,&arg_p->arg_state,node->node_symbol,node->node_arity,root_and_defs_lp); tuple_arg_p=node->node_arguments; first_alt_tuple_arg_p=first_alt_node_id->nid_node->node_arguments; insert_push_node (node->node_symbol,first_alt_tuple_arg_p,node->node_arity,first_alt_node_id,root_and_defs_lp->root_l); for (; tuple_arg_p!=NULL; tuple_arg_p=tuple_arg_p->arg_next,first_alt_tuple_arg_p=first_alt_tuple_arg_p->arg_next) transform_and_merge_argument (tuple_arg_p,first_alt_tuple_arg_p,root_and_defs_lp,node_id_ref_count_list_h); } else { first_alt_node_id->nid_node=node; #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS add_new_lhs_node_id_to_lhs_node_defs (first_alt_node_id,root_and_defs_lp); #endif transform_tuple_or_record_pattern_node (node,&arg_p->arg_state,first_alt_node_id,root_and_defs_lp); } } else #endif { transform_normal_pattern_node (node,&arg_p->arg_state,first_alt_node_id,root_and_defs_lp); #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS first_alt_node_id->nid_node=NULL; #endif } /* JVG: added 4-10-95 */ ++first_alt_node_id->nid_refcount; /* */ /* JVG: added 4 april 95 */ *node_id_ref_count_list_h = insert_new_node_id_ref_count (*node_id_ref_count_list_h,first_alt_node_id,-2); /* */ } return; case NodeIdNode: { NodeId node_id; node_id=node->node_node_id; #ifndef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS if (arg_p->arg_state.state_type==TupleState || arg_p->arg_state.state_type==RecordState){ if (node_id->nid_node==NULL){ if (first_alt_arg_p->arg_node->node_kind==NodeIdNode){ NodeId first_alt_node_id; first_alt_node_id=first_alt_arg_p->arg_node->node_node_id; # if 1 /* added 8-4-1999 */ *node_id_ref_count_list_h = insert_new_node_id_ref_count (*node_id_ref_count_list_h,first_alt_node_id,node_id->nid_refcount); # else first_alt_node_id->nid_refcount += node_id->nid_refcount+1; # endif node_id->nid_mark |= NID_ALIAS_MASK; node_id->nid_forward_node_id_=first_alt_node_id; } else { NodeP node; node=first_alt_arg_p->arg_node; node_id->nid_node=node; first_alt_arg_p->arg_node=arg_p->arg_node; # ifndef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS node_id->nid_state_=arg_p->arg_state; # endif } } else { ArgP tuple_arg_p,first_alt_tuple_arg_p; if (first_alt_arg_p->arg_node->node_kind==NodeIdNode){ NodeIdP first_alt_node_id; first_alt_node_id=first_alt_arg_p->arg_node->node_node_id; # if 1 /* added 20-4-1999 */ *node_id_ref_count_list_h = insert_new_node_id_ref_count (*node_id_ref_count_list_h,first_alt_node_id,node_id->nid_refcount); # else first_alt_node_id->nid_refcount += node_id->nid_refcount+1; # endif node_id->nid_mark |= NID_ALIAS_MASK; node_id->nid_forward_node_id_=first_alt_node_id; if (first_alt_node_id->nid_node==NULL){ ArgP tuple_arg_p; first_alt_node_id->nid_node=node_id->nid_node; tuple_arg_p=node_id->nid_node->node_arguments; for (; tuple_arg_p!=NULL; tuple_arg_p=tuple_arg_p->arg_next) transform_argument (tuple_arg_p,root_and_defs_lp); return; } else { tuple_arg_p=node_id->nid_node->node_arguments; first_alt_tuple_arg_p=first_alt_node_id->nid_node->node_arguments; } } else { tuple_arg_p=node_id->nid_node->node_arguments; first_alt_tuple_arg_p=first_alt_arg_p->arg_node->node_arguments; node_id->nid_node=first_alt_arg_p->arg_node; first_alt_arg_p->arg_node=arg_p->arg_node; # ifndef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS node_id->nid_state_=arg_p->arg_state; # endif } for (; tuple_arg_p!=NULL; tuple_arg_p=tuple_arg_p->arg_next,first_alt_tuple_arg_p=first_alt_tuple_arg_p->arg_next) transform_and_merge_argument (tuple_arg_p,first_alt_tuple_arg_p,root_and_defs_lp,node_id_ref_count_list_h); return; } } else #endif { NodeIdP first_alt_node_id; first_alt_node_id=first_alt_arg_p->arg_node->node_node_id; node_id->nid_mark |= NID_ALIAS_MASK; node_id->nid_forward_node_id_=first_alt_node_id; if (node_id->nid_node!=NULL){ #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS SymbolP node_id_nid_node_symbol; node_id_nid_node_symbol=node_id->nid_node->node_symbol; if (node_id_nid_node_symbol->symb_kind==tuple_symb || (node_id_nid_node_symbol->symb_kind==definition && node_id_nid_node_symbol->symb_def->sdef_kind==RECORDTYPE)) { if (first_alt_node_id->nid_node!=NULL){ ArgP tuple_arg_p,first_alt_tuple_arg_p; NodeP switch_node; switch_node=new_switch_and_case_node (first_alt_node_id,&arg_p->arg_state,first_alt_node_id->nid_node->node_symbol,first_alt_node_id->nid_node->node_arity,root_and_defs_lp); tuple_arg_p=node_id->nid_node->node_arguments; first_alt_tuple_arg_p=first_alt_node_id->nid_node->node_arguments; insert_push_node (first_alt_node_id->nid_node->node_symbol,first_alt_tuple_arg_p,first_alt_node_id->nid_node->node_arity,first_alt_node_id,root_and_defs_lp->root_l); for (; tuple_arg_p!=NULL; tuple_arg_p=tuple_arg_p->arg_next,first_alt_tuple_arg_p=first_alt_tuple_arg_p->arg_next) transform_and_merge_argument (tuple_arg_p,first_alt_tuple_arg_p,root_and_defs_lp,node_id_ref_count_list_h); } else { first_alt_node_id->nid_node=node_id->nid_node; #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS add_new_lhs_node_id_to_lhs_node_defs (first_alt_node_id,root_and_defs_lp); #endif transform_tuple_or_record_pattern_node (node_id->nid_node,&arg_p->arg_state,first_alt_node_id,root_and_defs_lp); } ++first_alt_node_id->nid_refcount; *node_id_ref_count_list_h = insert_new_node_id_ref_count (*node_id_ref_count_list_h,first_alt_node_id,node_id->nid_refcount-1); return; } else #endif { transform_normal_pattern_node (node_id->nid_node,&arg_p->arg_state,node_id,root_and_defs_lp); #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS first_alt_node_id->nid_node=NULL; #endif } } *node_id_ref_count_list_h = insert_new_node_id_ref_count (*node_id_ref_count_list_h,first_alt_node_id,node_id->nid_refcount); } return; } default: error_in_function ("transform_and_merge_argument"); } } static NodeIdRefCountListP copy_node_id_ref_count_list (NodeIdRefCountListP node_id_ref_count_list) { NodeIdRefCountListP node_id_ref_count_elem,new_node_id_ref_count_list,*new_node_id_ref_count_list_p; new_node_id_ref_count_list_p=&new_node_id_ref_count_list; for_l (node_id_ref_count_elem,node_id_ref_count_list,nrcl_next){ NodeIdRefCountListP new_node_id_ref_count_elem; NodeIdP node_id; node_id=node_id_ref_count_elem->nrcl_node_id; new_node_id_ref_count_elem=new_node_id_ref_count (NULL,node_id,node_id->nid_refcount); *new_node_id_ref_count_list_p=new_node_id_ref_count_elem; new_node_id_ref_count_list_p=&new_node_id_ref_count_elem->nrcl_next; #if DEBUG_OUTPUT printf ("copy %s %d %d ",node_id_name (node_id),node_id->nid_refcount,node_id_ref_count_elem->nrcl_ref_count); #endif node_id->nid_refcount += node_id_ref_count_elem->nrcl_ref_count+1; } #if DEBUG_OUTPUT printf ("\n"); #endif *new_node_id_ref_count_list_p=NULL; return new_node_id_ref_count_list; } static void increment_ref_counts_of_node_id_ref_count_list (NodeIdRefCountListP node_id_ref_count_list) { NodeIdRefCountListP node_id_ref_count_elem; for_l (node_id_ref_count_elem,node_id_ref_count_list,nrcl_next){ #if DEBUG_OUTPUT { NodeIdP node_id; node_id=node_id_ref_count_elem->nrcl_node_id; printf ("increment %s %d %d ",node_id_name (node_id),node_id->nid_refcount,node_id_ref_count_elem->nrcl_ref_count); } #endif node_id_ref_count_elem->nrcl_node_id->nid_refcount += node_id_ref_count_elem->nrcl_ref_count+1; } #if DEBUG_OUTPUT printf ("\n"); #endif } static void replace_global_ref_count_by_local_ref_count (NodeIdRefCountListP node_id_ref_count_list) { NodeIdRefCountListP node_id_ref_count_elem; for_l (node_id_ref_count_elem,node_id_ref_count_list,nrcl_next){ int local_ref_count; NodeIdP node_id; node_id=node_id_ref_count_elem->nrcl_node_id; local_ref_count=node_id_ref_count_elem->nrcl_ref_count; #if DEBUG_OUTPUT printf ("global_to_local %s %d %d ",node_id_name (node_id),node_id->nid_refcount,node_id_ref_count_elem->nrcl_ref_count); #endif node_id_ref_count_elem->nrcl_ref_count=node_id->nid_refcount - local_ref_count; node_id->nid_refcount = local_ref_count; } #if DEBUG_OUTPUT printf ("\n"); #endif } void set_local_reference_counts (NodeP case_node) { replace_global_ref_count_by_local_ref_count (case_node->node_node_id_ref_counts); } static void replace_local_ref_count_by_global_ref_count (NodeIdRefCountListP node_id_ref_count_list) { NodeIdRefCountListP node_id_ref_count_elem; for_l (node_id_ref_count_elem,node_id_ref_count_list,nrcl_next){ int local_ref_count; NodeIdP node_id; node_id=node_id_ref_count_elem->nrcl_node_id; local_ref_count=node_id->nid_refcount; #if DEBUG_OUTPUT printf ("local_to_global %s %d %d ",node_id_name (node_id),node_id->nid_refcount,node_id_ref_count_elem->nrcl_ref_count); #endif node_id->nid_refcount = local_ref_count + node_id_ref_count_elem->nrcl_ref_count; node_id_ref_count_elem->nrcl_ref_count=local_ref_count; } #if DEBUG_OUTPUT printf ("\n"); #endif } void set_global_reference_counts (NodeP case_node) { replace_local_ref_count_by_global_ref_count (case_node->node_node_id_ref_counts); } static NodeP merge_alternative_with_node (NodeP root,struct root_and_defs *root_and_defs_p,NodeIdRefCountListP node_id_ref_count_list); static void decrement_reference_count_of_switch_node_id (NodeIdP root_node_id,NodeIdRefCountListP node_id_ref_count_list) { NodeIdRefCountListP node_id_ref_count_elem; for_l (node_id_ref_count_elem,node_id_ref_count_list,nrcl_next) if (node_id_ref_count_elem->nrcl_node_id==root_node_id){ #if DEBUG_OUTPUT printf ("inc %s %d %d\n",node_id_name (root_node_id),root_node_id->nid_refcount,node_id_ref_count_elem->nrcl_ref_count); #endif ++node_id_ref_count_elem->nrcl_ref_count; break; } if (node_id_ref_count_elem==NULL){ /* possibly less efficient code if this happens */ } } static void merge_alternative_with_switch_node (NodeP root,struct root_and_defs *root_and_defs_p,NodeIdRefCountListP node_id_ref_count_list) { NodeP default_node,node; ArgP *arg_p,arg; node=root_and_defs_p->root; for (arg_p=&root->node_arguments; arg=*arg_p,arg!=NULL; arg_p=&arg->arg_next){ NodeP case_node; case_node=arg->arg_node; switch (case_node->node_kind){ case CaseNode: break; case DefaultNode: ++root->node_node_id->nid_refcount; replace_global_ref_count_by_local_ref_count (case_node->node_node_id_ref_counts); case_node->node_arguments->arg_node = merge_alternative_with_node (case_node->node_arguments->arg_node,root_and_defs_p,node_id_ref_count_list); replace_local_ref_count_by_global_ref_count (case_node->node_node_id_ref_counts); --root->node_node_id->nid_refcount; return; default: error_in_function ("merge_alternative_with_switch_node"); } } ++root->node_node_id->nid_refcount; default_node=new_default_node (node,root_and_defs_p->defs #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS ,root_and_defs_p->strict_node_ids #endif ); default_node->node_node_id_ref_counts= node_id_ref_count_list; if (root->node_arguments->arg_next==NULL) /* only one case or default ? */ root->node_arguments->arg_node->node_node_id_ref_counts=copy_node_id_ref_count_list (node_id_ref_count_list); else increment_ref_counts_of_node_id_ref_count_list (node_id_ref_count_list); *arg_p=NewArgument (default_node); remove_aliases_from_node_and_node_definitions (root_and_defs_p->root,root_and_defs_p->defs #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS ,root_and_defs_p->strict_node_ids #endif ); --root->node_node_id->nid_refcount; } static void merge_switch_alternative_with_switch_node (NodeP root,struct root_and_defs *root_and_defs_p,NodeIdRefCountListP node_id_ref_count_list) { ArgP *arg_p,arg; NodeP case_node; for (arg_p=&root->node_arguments; arg=*arg_p,arg!=NULL; arg_p=&arg->arg_next){ NodeP case_arg_node; case_arg_node=arg->arg_node; switch (case_arg_node->node_kind){ case CaseNode: break; case DefaultNode: ++root->node_node_id->nid_refcount; replace_global_ref_count_by_local_ref_count (case_arg_node->node_node_id_ref_counts); case_arg_node->node_arguments->arg_node= merge_alternative_with_node (case_arg_node->node_arguments->arg_node,root_and_defs_p,node_id_ref_count_list); replace_local_ref_count_by_global_ref_count (case_arg_node->node_node_id_ref_counts); --root->node_node_id->nid_refcount; return; default: error_in_function ("merge_switch_alternative_with_switch_node"); } } case_node=root_and_defs_p->root->node_arguments->arg_node; for (arg_p=&root->node_arguments; arg=*arg_p,arg!=NULL; arg_p=&arg->arg_next){ NodeP case_arg_node; case_arg_node=arg->arg_node; switch (case_arg_node->node_kind){ case CaseNode: { struct root_and_defs case_root_and_defs; if (case_arg_node->node_arity!=case_node->node_arity) break; else { if (case_arg_node->node_symbol==case_node->node_symbol){ if (case_node->node_symbol->symb_kind==real_denot){ merge_alternative_with_switch_node (root,root_and_defs_p,node_id_ref_count_list); return; } } else { int symbol_kind; symbol_kind=case_node->node_symbol->symb_kind; if (symbol_kind==int_denot || symbol_kind==char_denot || symbol_kind==string_denot){ if (strcmp (case_arg_node->node_symbol->symb_int,case_node->node_symbol->symb_int)!=0) break; } else break; } } decrement_reference_count_of_switch_node_id (root->node_node_id,node_id_ref_count_list); ++root->node_node_id->nid_refcount; replace_global_ref_count_by_local_ref_count (case_arg_node->node_node_id_ref_counts); case_root_and_defs.root=case_node->node_arguments->arg_node; case_root_and_defs.defs=case_node->node_node_defs; #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS case_root_and_defs.strict_node_ids=case_node->node_strict_node_ids; #endif case_arg_node->node_arguments->arg_node = merge_alternative_with_node (case_arg_node->node_arguments->arg_node,&case_root_and_defs,node_id_ref_count_list); case_node->node_node_defs=NULL; #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS case_node->node_strict_node_ids=NULL; #endif replace_local_ref_count_by_global_ref_count (case_arg_node->node_node_id_ref_counts); --root->node_node_id->nid_refcount; return; } } } decrement_reference_count_of_switch_node_id (root->node_node_id,node_id_ref_count_list); ++root->node_node_id->nid_refcount; case_node->node_node_id_ref_counts= node_id_ref_count_list; if (root->node_arguments->arg_next==NULL) /* only one case or default ? */ root->node_arguments->arg_node->node_node_id_ref_counts=copy_node_id_ref_count_list (node_id_ref_count_list); else increment_ref_counts_of_node_id_ref_count_list (node_id_ref_count_list); *arg_p=NewArgument (case_node); remove_aliases_from_node_and_node_definitions (case_node,root_and_defs_p->defs #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS ,root_and_defs_p->strict_node_ids #endif ); --root->node_node_id->nid_refcount; } #define SEARCH_SWITCH 1 static NodeP merge_alternative_with_node (NodeP root,struct root_and_defs *root_and_defs_p,NodeIdRefCountListP node_id_ref_count_list) { NodeP node; node=root_and_defs_p->root; switch (root->node_kind){ case SwitchNode: { NodeIdP node_id; struct root_and_defs root_and_defs; if (node->node_kind!=SwitchNode){ merge_alternative_with_switch_node (root,root_and_defs_p,node_id_ref_count_list); return root; } root_and_defs=*root_and_defs_p; node_id=node->node_node_id; if (node_id->nid_mark & NID_ALIAS_MASK){ node_id=node_id->nid_forward_node_id; node->node_node_id=node_id; } #if SEARCH_SWITCH if (node_id!=root->node_node_id){ NodeP next_switch_node,*next_switch_node_p,case_node; NodeIdP next_node_id; next_switch_node=node; do { case_node=next_switch_node->node_arguments->arg_node; next_switch_node_p=&case_node->node_arguments->arg_node; next_switch_node=*next_switch_node_p; if (next_switch_node->node_kind==PushNode){ next_switch_node_p=&next_switch_node->node_arguments->arg_next->arg_node; next_switch_node=*next_switch_node_p; } if (next_switch_node->node_kind!=SwitchNode) break; next_node_id=next_switch_node->node_node_id; if (next_node_id->nid_mark & NID_ALIAS_MASK) next_node_id=next_node_id->nid_forward_node_id; } while (next_node_id!=root->node_node_id); if (next_switch_node->node_kind==SwitchNode && next_node_id==root->node_node_id){ NodeP next_case_node,*node_p; next_case_node=next_switch_node->node_arguments->arg_node; node_p=&next_case_node->node_arguments->arg_node; if ((*node_p)->node_kind==PushNode) node_p=&(*node_p)->node_arguments->arg_next->arg_node; if (next_case_node->node_node_defs!=NULL){ if (case_node->node_node_defs!=NULL) error_in_function ("merge_alternative_with_node"); case_node->node_node_defs=next_case_node->node_node_defs; next_case_node->node_node_defs=NULL; } # ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS if (next_case_node->node_strict_node_ids!=NULL){ if (case_node->node_strict_node_ids!=NULL) error_in_function ("merge_alternative_with_node"); case_node->node_strict_node_ids=next_case_node->node_strict_node_ids; next_case_node->node_strict_node_ids=NULL; } # endif *next_switch_node_p=*node_p; *node_p=node; node=next_switch_node; next_switch_node->node_node_id=next_node_id; node_id=next_node_id; } } #endif root_and_defs.root=node; if (node_id==root->node_node_id) merge_switch_alternative_with_switch_node (root,&root_and_defs,node_id_ref_count_list); else merge_alternative_with_switch_node (root,&root_and_defs,node_id_ref_count_list); return root; } case PushNode: { ArgP node_arguments,root_arguments; NodeIdP node_id; NodeIdListElementP root_node_id_list,node_id_list; struct root_and_defs root_and_defs; root_and_defs=*root_and_defs_p; node_arguments=node->node_arguments; root_arguments=root->node_arguments; if (node->node_kind!=PushNode) error_in_function ("merge_alternative_with_node"); node_id=node_arguments->arg_node->node_node_id; if (node_id->nid_mark & NID_ALIAS_MASK){ node_id=node_id->nid_forward_node_id; node_arguments->arg_node->node_node_id=node_id; } if (root_arguments->arg_node->node_node_id!=node_id) error_in_function ("merge_alternative_with_node"); root_node_id_list=root->node_node_ids; node_id_list=node->node_node_ids; while (root_node_id_list!=NULL){ NodeIdP node_id,root_node_id; root_node_id=root_node_id_list->nidl_node_id; node_id=node_id_list->nidl_node_id; if (node_id!=root_node_id){ node_id_ref_count_list=new_node_id_ref_count (node_id_ref_count_list,root_node_id,node_id->nid_refcount); node_id->nid_mark |= NID_ALIAS_MASK; node_id->nid_forward_node_id_=root_node_id; } root_node_id_list=root_node_id_list->nidl_next; node_id_list=node_id_list->nidl_next; } root_and_defs.root=node_arguments->arg_next->arg_node; root_arguments->arg_next->arg_node=merge_alternative_with_node (root_arguments->arg_next->arg_node,&root_and_defs,node_id_ref_count_list); return root; } case GuardNode: root->node_arguments->arg_next->arg_node=merge_alternative_with_node (root->node_arguments->arg_next->arg_node,root_and_defs_p,node_id_ref_count_list); return root; case IfNode: { NodeP else_node; else_node=root->node_arguments->arg_next->arg_next->arg_node; while (else_node->node_kind==IfNode) else_node=else_node->node_arguments->arg_next->arg_next->arg_node; if (else_node->node_kind==NormalNode && else_node->node_symbol->symb_kind==fail_symb){ NodeP guard_node; increment_ref_counts_of_node_id_ref_count_list (node_id_ref_count_list); guard_node=new_guard_node (root,root_and_defs_p->root,root_and_defs_p->defs #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS ,root_and_defs_p->strict_node_ids #endif ); remove_aliases_from_node_and_node_definitions (node,root_and_defs_p->defs #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS ,root_and_defs_p->strict_node_ids #endif ); return guard_node; } else break; } } StaticMessage (False, "%S", "pattern will never match", CurrentSymbol); return root; } static void merge_node_id_ref_count_lists (NodeIdRefCountListP *list1_p,NodeIdRefCountListP list2) { while (list2!=NULL){ NodeIdP node_id; NodeIdRefCountListP next_list2,list1; node_id=list2->nrcl_node_id; while (list1=*list1_p,list1!=NULL && list1->nrcl_node_id<=node_id) list1_p=&list1->nrcl_next; if (list1==NULL){ *list1_p=list2; return; } next_list2=list2->nrcl_next; *list1_p=list2; list2->nrcl_next=list1; list1_p=&list2->nrcl_next; list2=next_list2; } } static void sort_node_id_ref_count_lists (NodeIdRefCountListP *list_p) { NodeIdRefCountListP element1,element2,element3; element1=*list_p; if (element1==NULL) return; element2=element1->nrcl_next; if (element2==NULL) return; element3=element2->nrcl_next; if (element3==NULL){ if (element1->nrcl_node_id<=element2->nrcl_node_id) return; *list_p=element2; element2->nrcl_next=element1; element1->nrcl_next=NULL; } else { NodeIdRefCountListP list2,end_list1,end_list2; list2=element2; end_list1=element1; end_list2=element2; element1=element3; do { end_list1->nrcl_next=element1; end_list1=element1; element2=element1->nrcl_next; if (element2==NULL) break; end_list2->nrcl_next=element2; end_list2=element2; element1=element2->nrcl_next; } while (element1!=NULL); end_list1->nrcl_next=NULL; end_list2->nrcl_next=NULL; sort_node_id_ref_count_lists (list_p); sort_node_id_ref_count_lists (&list2); merge_node_id_ref_count_lists (list_p,list2); } } static void add_sorted_node_id_ref_count_list (NodeIdRefCountListP *node_id_ref_count_list1_p,NodeIdRefCountListP node_id_ref_count_list2) { NodeIdRefCountListP node_id_ref_count_list1; while (node_id_ref_count_list2!=NULL){ NodeIdP node_id; node_id=node_id_ref_count_list2->nrcl_node_id; while (node_id_ref_count_list1=*node_id_ref_count_list1_p,node_id_ref_count_list1!=NULL && node_id_ref_count_list1->nrcl_node_idnrcl_next; if (node_id_ref_count_list1!=NULL && node_id_ref_count_list1->nrcl_node_id==node_id){ #if DEBUG_OUTPUT printf ("add %s %d %d %d\n",node_id_name (node_id),node_id->nid_refcount,node_id_ref_count_list1->nrcl_ref_count,node_id_ref_count_list2->nrcl_ref_count); #endif node_id_ref_count_list1->nrcl_ref_count += node_id_ref_count_list2->nrcl_ref_count+1; node_id_ref_count_list1_p=&node_id_ref_count_list1->nrcl_next; } else { NodeIdRefCountListP new_node_id_ref_count_elem; #if DEBUG_OUTPUT printf ("addnew %s %d %d\n",node_id_name (node_id),node_id->nid_refcount,node_id_ref_count_list2->nrcl_ref_count); #endif new_node_id_ref_count_elem=new_node_id_ref_count (node_id_ref_count_list1,node_id_ref_count_list2->nrcl_node_id,node_id_ref_count_list2->nrcl_ref_count); *node_id_ref_count_list1_p=new_node_id_ref_count_elem; node_id_ref_count_list1_p=&new_node_id_ref_count_elem->nrcl_next; } node_id_ref_count_list2=node_id_ref_count_list2->nrcl_next; } } /* JVG added 16-2-2000 */ static void add_sorted_node_id_ref_count_list_for_case (NodeIdRefCountListP *node_id_ref_count_list1_p,NodeIdRefCountListP node_id_ref_count_list2) { NodeIdRefCountListP node_id_ref_count_list1; while (node_id_ref_count_list2!=NULL){ NodeIdP node_id; node_id=node_id_ref_count_list2->nrcl_node_id; while (node_id_ref_count_list1=*node_id_ref_count_list1_p,node_id_ref_count_list1!=NULL && node_id_ref_count_list1->nrcl_node_idnrcl_next; if (node_id_ref_count_list1!=NULL && node_id_ref_count_list1->nrcl_node_id==node_id){ #if DEBUG_OUTPUT printf ("add %s %d %d %d\n",node_id_name (node_id),node_id->nid_refcount,node_id_ref_count_list1->nrcl_ref_count,node_id_ref_count_list2->nrcl_ref_count); #endif node_id_ref_count_list1->nrcl_ref_count += node_id_ref_count_list2->nrcl_ref_count+1; node_id_ref_count_list1_p=&node_id_ref_count_list1->nrcl_next; } /* else do nothing*/ node_id_ref_count_list2=node_id_ref_count_list2->nrcl_next; } } /**/ /* static NodeIdRefCountListP merge_sorted_node_id_ref_count_lists (NodeIdRefCountListP node_id_ref_count_list1,NodeIdRefCountListP node_id_ref_count_list2) { NodeIdRefCountListP node_id_ref_count_list,*node_id_ref_count_list_p; node_id_ref_count_list_p=&node_id_ref_count_list; while (node_id_ref_count_list2!=NULL){ NodeIdP node_id; node_id=node_id_ref_count_list2->nrcl_node_id; while (node_id_ref_count_list1!=NULL && node_id_ref_count_list1->nrcl_node_idnrcl_node_id->nid_ident!=NULL && node_id_ref_count_list1->nrcl_node_id->nid_ident->ident_name!=NULL) node_id_name=node_id_ref_count_list1->nrcl_node_id->nid_ident->ident_name; printf ("from1 %s %d %d\n",node_id_name,node_id_ref_count_list1->nrcl_node_id->nid_refcount,node_id_ref_count_list1->nrcl_ref_count); } #endif new_node_id_ref_count_elem=new_node_id_ref_count (NULL,node_id_ref_count_list1->nrcl_node_id,node_id_ref_count_list1->nrcl_ref_count); *node_id_ref_count_list_p=new_node_id_ref_count_elem; node_id_ref_count_list_p=&new_node_id_ref_count_elem->nrcl_next; node_id_ref_count_list1=node_id_ref_count_list1->nrcl_next; } if (node_id_ref_count_list1!=NULL && node_id_ref_count_list1->nrcl_node_id==node_id){ NodeIdRefCountListP new_node_id_ref_count_elem; #if DEBUG_OUTPUT { char *node_id_name; node_id_name=""; if (node_id->nid_ident!=NULL && node_id->nid_ident->ident_name!=NULL) node_id_name=node_id->nid_ident->ident_name; printf ("combine %s %d %d\n",node_id_name,node_id_ref_count_list1->nrcl_node_id->nid_refcount,node_id_ref_count_list2->nrcl_ref_count); } #endif new_node_id_ref_count_elem=new_node_id_ref_count (NULL,node_id, node_id_ref_count_list1->nrcl_ref_count+node_id_ref_count_list2->nrcl_ref_count+1); *node_id_ref_count_list_p=new_node_id_ref_count_elem; node_id_ref_count_list_p=&new_node_id_ref_count_elem->nrcl_next; node_id_ref_count_list1=node_id_ref_count_list1->nrcl_next; } else { NodeIdRefCountListP new_node_id_ref_count_elem; #if DEBUG_OUTPUT { char *node_id_name; node_id_name=""; if (node_id_ref_count_list2->nrcl_node_id->nid_ident!=NULL && node_id_ref_count_list2->nrcl_node_id->nid_ident->ident_name!=NULL) node_id_name=node_id_ref_count_list2->nrcl_node_id->nid_ident->ident_name; printf ("from2 %s %d %d\n",node_id_name,node_id_ref_count_list2->nrcl_node_id->nid_refcount,node_id_ref_count_list2->nrcl_ref_count); } #endif new_node_id_ref_count_elem=new_node_id_ref_count (NULL,node_id_ref_count_list2->nrcl_node_id,node_id_ref_count_list2->nrcl_ref_count); *node_id_ref_count_list_p=new_node_id_ref_count_elem; node_id_ref_count_list_p=&new_node_id_ref_count_elem->nrcl_next; } node_id_ref_count_list2=node_id_ref_count_list2->nrcl_next; } while (node_id_ref_count_list1!=NULL){ NodeIdRefCountListP new_node_id_ref_count_elem; #if DEBUG_OUTPUT { char *node_id_name; node_id_name=""; if (node_id_ref_count_list1->nrcl_node_id->nid_ident!=NULL && node_id_ref_count_list1->nrcl_node_id->nid_ident->ident_name!=NULL) node_id_name=node_id_ref_count_list1->nrcl_node_id->nid_ident->ident_name; printf ("from1 %s %d %d\n",node_id_name,node_id_ref_count_list1->nrcl_node_id->nid_refcount,node_id_ref_count_list1->nrcl_ref_count); } #endif new_node_id_ref_count_elem=new_node_id_ref_count (NULL,node_id_ref_count_list1->nrcl_node_id,node_id_ref_count_list1->nrcl_ref_count); *node_id_ref_count_list_p=new_node_id_ref_count_elem; node_id_ref_count_list_p=&new_node_id_ref_count_elem->nrcl_next; node_id_ref_count_list1=node_id_ref_count_list1->nrcl_next; } *node_id_ref_count_list_p=NULL; return node_id_ref_count_list; } */ static NodeIdRefCountListP duplicate_node_id_ref_count_list (NodeIdRefCountListP node_id_ref_count_list) { NodeIdRefCountListP node_id_ref_count_elem,new_node_id_ref_count_list,*new_node_id_ref_count_list_p; new_node_id_ref_count_list_p=&new_node_id_ref_count_list; for (node_id_ref_count_elem=node_id_ref_count_list; node_id_ref_count_elem!=NULL; node_id_ref_count_elem=node_id_ref_count_elem->nrcl_next){ NodeIdRefCountListP new_node_id_ref_count_elem; new_node_id_ref_count_elem=new_node_id_ref_count (NULL,node_id_ref_count_elem->nrcl_node_id,node_id_ref_count_elem->nrcl_ref_count); #if DEBUG_OUTPUT printf ("duplicate %s %d %d\n",node_id_name (node_id_ref_count_elem->nrcl_node_id),node_id_ref_count_elem->nrcl_node_id->nid_refcount,node_id_ref_count_elem->nrcl_ref_count); #endif *new_node_id_ref_count_list_p=new_node_id_ref_count_elem; new_node_id_ref_count_list_p=&new_node_id_ref_count_elem->nrcl_next; } *new_node_id_ref_count_list_p=NULL; return new_node_id_ref_count_list; } #ifdef CLEAN2 extern int contains_fail (NodeP node_p); #endif static int determine_failing_cases_and_adjust_ref_counts (NodeP node,NodeIdRefCountListP *node_id_ref_count_list_p) { switch (node->node_kind){ case SwitchNode: { ArgP arg; int switch_may_fail,default_may_fail; int node_id_ref_count_list_sorted; node_id_ref_count_list_sorted=0; for (arg=node->node_arguments; arg!=NULL; arg=arg->arg_next) if (arg->arg_node->node_kind!=CaseNode) break; default_may_fail=1; if (arg!=NULL){ NodeP arg_node; arg_node=arg->arg_node; if (arg_node->node_kind!=DefaultNode) error_in_function ("determine_failing_cases_and_adjust_ref_counts"); default_may_fail=determine_failing_cases_and_adjust_ref_counts (arg_node->node_arguments->arg_node,node_id_ref_count_list_p); arg_node->node_number=default_may_fail; if (default_may_fail){ /* NodeP default_rhs_node; */ sort_node_id_ref_count_lists (&arg_node->node_node_id_ref_counts); if (!node_id_ref_count_list_sorted){ sort_node_id_ref_count_lists (node_id_ref_count_list_p); node_id_ref_count_list_sorted=1; } /* JVG: maybe incorrect, optimisation: find simple case which can not fail and set node_id_refcounts default_rhs_node=arg_node->node_arguments->arg_node; if (default_rhs_node->node_kind==PushNode) default_rhs_node=default_rhs_node->node_arguments->arg_next->arg_node; if (default_rhs_node->node_kind==SwitchNode && default_rhs_node->node_arguments->arg_next==NULL) default_rhs_node->node_arguments->arg_node->node_node_id_ref_counts = duplicate_node_id_ref_count_list (arg_node->node_node_id_ref_counts); */ add_sorted_node_id_ref_count_list (&arg_node->node_node_id_ref_counts,*node_id_ref_count_list_p); node_id_ref_count_list_p=&arg_node->node_node_id_ref_counts; /* arg_node->node_node_id_ref_counts=merge_sorted_node_id_ref_count_lists (arg_node->node_node_id_ref_counts,*node_id_ref_count_list_p); node_id_ref_count_list_p=&arg_node->node_node_id_ref_counts; */ } else node_id_ref_count_list_p=&arg_node->node_node_id_ref_counts; } switch_may_fail=1; /* to do: if non failing case for every constructor, default not reachable */ #if 1 /* added 8-4-1999 */ if (node->node_arguments->arg_next==NULL && node->node_arguments->arg_node->node_kind==CaseNode && (node->node_arguments->arg_node->node_symbol->symb_kind==tuple_symb || (node->node_arguments->arg_node->node_symbol->symb_kind==definition && node->node_arguments->arg_node->node_symbol->symb_def->sdef_kind==RECORDTYPE))) { int case_may_fail; NodeP arg_node; arg_node=node->node_arguments->arg_node; case_may_fail=determine_failing_cases_and_adjust_ref_counts (arg_node->node_arguments->arg_node,node_id_ref_count_list_p); arg_node->node_number=case_may_fail; switch_may_fail=case_may_fail; } else #endif for_l (arg,node->node_arguments,arg_next){ NodeP arg_node; arg_node=arg->arg_node; switch (arg_node->node_kind){ case CaseNode: { int case_may_fail; case_may_fail=determine_failing_cases_and_adjust_ref_counts (arg_node->node_arguments->arg_node,node_id_ref_count_list_p); if (case_may_fail && node->node_arguments->arg_next!=NULL){ /* NodeP case_rhs_node; */ sort_node_id_ref_count_lists (&arg_node->node_node_id_ref_counts); if (!node_id_ref_count_list_sorted){ sort_node_id_ref_count_lists (node_id_ref_count_list_p); node_id_ref_count_list_sorted=1; } /* JVG: maybe incorrect, optimisation: find simple case which can not fail and set node_id_refcounts case_rhs_node=arg_node->node_arguments->arg_node; if (case_rhs_node->node_kind==PushNode) case_rhs_node=case_rhs_node->node_arguments->arg_next->arg_node; if (case_rhs_node->node_kind==SwitchNode && case_rhs_node->node_arguments->arg_next==NULL) case_rhs_node->node_arguments->arg_node->node_node_id_ref_counts = duplicate_node_id_ref_count_list (arg_node->node_node_id_ref_counts); */ /* JVG changed 16-2-2000 add_sorted_node_id_ref_count_list (&arg_node->node_node_id_ref_counts,*node_id_ref_count_list_p); */ add_sorted_node_id_ref_count_list_for_case (&arg_node->node_node_id_ref_counts,*node_id_ref_count_list_p); /**/ /* arg_node->node_node_id_ref_counts= merge_sorted_node_id_ref_count_lists (arg_node->node_node_id_ref_counts,*node_id_ref_count_list_p); */ } arg_node->node_number=case_may_fail; break; } case DefaultNode: switch_may_fail=default_may_fail; break; default: error_in_function ("determine_failing_cases_and_adjust_ref_counts"); } } return switch_may_fail; } case PushNode: return determine_failing_cases_and_adjust_ref_counts (node->node_arguments->arg_next->arg_node,node_id_ref_count_list_p); case GuardNode: return determine_failing_cases_and_adjust_ref_counts (node->node_arguments->arg_next->arg_node,node_id_ref_count_list_p); case IfNode: #ifdef CLEAN2 return contains_fail (node); #else { NodeP else_node; else_node=node->node_arguments->arg_next->arg_next->arg_node; while (else_node->node_kind==IfNode) else_node=else_node->node_arguments->arg_next->arg_next->arg_node; return else_node->node_kind==NormalNode && else_node->node_symbol->symb_kind==fail_symb; } #endif default: return False; } } #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS void determine_failing_cases_and_adjust_ref_counts_of_rule (RuleAltP first_alt) { NodeIdRefCountListP node_id_ref_count_list; if (first_alt->alt_kind!=Contractum) return; node_id_ref_count_list=NULL; determine_failing_cases_and_adjust_ref_counts (first_alt->alt_rhs_root,&node_id_ref_count_list); # if 0 PrintRuleAlt (first_alt,4,StdOut); # endif } #endif #if 0 #include "dbprint.h" #endif void transform_patterns_to_case_and_guard_nodes (RuleAltP rule_alts) { RuleAltP rule_alt,first_alt; ArgP arg; struct root_and_defs_l root_and_defs_l; NodeP *node_p; NodeDefP *def_p; #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS StrictNodeIdP *strict_node_ids_p; NodeDefP *end_lhs_defs_p; #endif first_alt=rule_alts; if (first_alt->alt_kind!=Contractum) return; node_p=&first_alt->alt_rhs_root; def_p=&first_alt->alt_rhs_defs; #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS strict_node_ids_p=&first_alt->alt_strict_node_ids; end_lhs_defs_p=&first_alt->alt_lhs_defs; #endif root_and_defs_l.root_l=&node_p; root_and_defs_l.def_l=&def_p; #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS root_and_defs_l.strict_node_ids_l=&strict_node_ids_p; root_and_defs_l.end_lhs_defs_l=&end_lhs_defs_p; #endif for_l (arg,first_alt->alt_lhs_root->node_arguments,arg_next) transform_argument (arg,&root_and_defs_l); for_l (rule_alt,first_alt->alt_next,alt_next){ ArgP arg,first_alt_arg; NodeIdRefCountListP node_id_ref_count_list,*node_id_ref_count_list_p; struct root_and_defs root_and_defs; NodeP *node_p; NodeDefP *def_p; #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS StrictNodeIdP *strict_node_ids_p; #endif node_p=&rule_alt->alt_rhs_root; def_p=&rule_alt->alt_rhs_defs; #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS strict_node_ids_p=&rule_alt->alt_strict_node_ids; #endif arg=rule_alt->alt_lhs_root->node_arguments; first_alt_arg=first_alt->alt_lhs_root->node_arguments; node_id_ref_count_list=NULL; node_id_ref_count_list_p=&node_id_ref_count_list; root_and_defs_l.root_l=&node_p; root_and_defs_l.def_l=&def_p; #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS root_and_defs_l.strict_node_ids_l=&strict_node_ids_p; root_and_defs_l.end_lhs_defs_l=&end_lhs_defs_p; #endif for (; arg!=NULL; arg=arg->arg_next,first_alt_arg=first_alt_arg->arg_next) transform_and_merge_argument (arg,first_alt_arg,&root_and_defs_l,&node_id_ref_count_list_p); CurrentLine=rule_alt->alt_line; #if DEBUG_OUTPUT printf ("line %d\n",CurrentLine); #endif root_and_defs.root=rule_alt->alt_rhs_root; root_and_defs.defs=rule_alt->alt_rhs_defs; #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS root_and_defs.strict_node_ids=rule_alt->alt_strict_node_ids; #endif first_alt->alt_rhs_root=merge_alternative_with_node (first_alt->alt_rhs_root,&root_and_defs,node_id_ref_count_list); } #ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS *end_lhs_defs_p=NULL; #endif first_alt->alt_next=NULL; #if 0 PrintRuleAlt (first_alt,4,StdOut); #endif #ifndef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS { NodeIdRefCountListP node_id_ref_count_list; node_id_ref_count_list=NULL; determine_failing_cases_and_adjust_ref_counts (first_alt->alt_rhs_root,&node_id_ref_count_list); } # if 0 PrintRuleAlt (first_alt,4,StdOut); # endif #endif }