diff options
Diffstat (limited to 'backendC')
| -rw-r--r-- | backendC/CleanCompilerSources/codegen1.c | 23 | ||||
| -rw-r--r-- | backendC/CleanCompilerSources/codegen2.c | 47 |
2 files changed, 66 insertions, 4 deletions
diff --git a/backendC/CleanCompilerSources/codegen1.c b/backendC/CleanCompilerSources/codegen1.c index 2ff6fe5..7e20ee0 100644 --- a/backendC/CleanCompilerSources/codegen1.c +++ b/backendC/CleanCompilerSources/codegen1.c @@ -2374,6 +2374,9 @@ SymbDef create_match_function (SymbolP constructor_symbol,int constructor_arity, if (strict_constructor){ struct arg **rhs_arg_p,*lhs_arg; StateP constructor_arg_state_p; +#if STRICT_LISTS + StateS head_and_tail_states[2]; +#endif lhs_function_arg=NewArgument (constructor_node); lhs_function_arg->arg_state=StrictState; @@ -2381,6 +2384,26 @@ SymbDef create_match_function (SymbolP constructor_symbol,int constructor_arity, rhs_root=NewNode (TupleSymbol,NULL,constructor_arity); rhs_arg_p=&rhs_root->node_arguments; +#if STRICT_LISTS + if (constructor_symbol->symb_kind==cons_symb && constructor_symbol->symb_head_strictness>1 || constructor_symbol->symb_tail_strictness){ + constructor_symbol->symb_def->sdef_constructor->cl_state_p; + + if (constructor_symbol->symb_head_strictness>1){ + if (constructor_symbol->symb_head_strictness==4) + head_and_tail_states[0]=*constructor_symbol->symb_state_p; + else + head_and_tail_states[0]=StrictState; + } else + head_and_tail_states[0]=LazyState; + + if (constructor_symbol->symb_tail_strictness) + head_and_tail_states[1]=StrictState; + else + head_and_tail_states[1]=LazyState; + + constructor_arg_state_p=head_and_tail_states; + } else +#endif constructor_arg_state_p=constructor_symbol->symb_def->sdef_constructor->cl_state_p; for_l (lhs_arg,constructor_node->node_arguments,arg_next){ diff --git a/backendC/CleanCompilerSources/codegen2.c b/backendC/CleanCompilerSources/codegen2.c index abac86a..00cc491 100644 --- a/backendC/CleanCompilerSources/codegen2.c +++ b/backendC/CleanCompilerSources/codegen2.c @@ -2754,7 +2754,7 @@ LabDef *unboxed_cons_label (SymbolP cons_symbol_p) if (cons_symbol_p->symb_unboxed_cons_state_p->state_type==SimpleState && BETWEEN (IntObj,FileObj,cons_symbol_p->symb_unboxed_cons_state_p->state_object)) return &unboxed_cons_labels[cons_symbol_p->symb_unboxed_cons_state_p->state_object-IntObj][cons_symbol_p->symb_tail_strictness]; else if (cons_symbol_p->symb_unboxed_cons_state_p->state_type==RecordState){ - unboxed_record_cons_lab.lab_mod=NULL; + unboxed_record_cons_lab.lab_mod=ExportLocalLabels ? CurrentModule : NULL; unboxed_record_cons_lab.lab_pref=cons_symbol_p->symb_tail_strictness ? "r_Cons#!" : "r_Cons#"; unboxed_record_cons_lab.lab_issymbol=False; unboxed_record_cons_lab.lab_name=cons_symbol_p->symb_unboxed_cons_state_p->state_record_symbol->sdef_ident->ident_name; @@ -3901,9 +3901,13 @@ void FillMatchNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_id,CodeGe } } - if (!symbol_arity_eq_one) + if (!symbol_arity_eq_one){ +#if STRICT_LISTS + if (symbol->symb_kind==cons_symb && symbol->symb_head_strictness>1 || symbol->symb_tail_strictness) + strict_constructor=1; +#endif new_match_sdef=create_match_function (symbol,node->node_arity,strict_constructor); - else + } else new_match_sdef=create_select_and_match_function (symbol,strict_constructor); ConvertSymbolToDandNLabel (&name,&codelab,new_match_sdef); @@ -4009,7 +4013,42 @@ void FillMatchNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_id,CodeGe *bsp_p += b_size; AdjustTuple (a_size,b_size,asp_p,bsp_p,arity,demanded_state_array,constructor_args_state_p,a_size,b_size); - } else { + } else +#if STRICT_LISTS + if (symbol->symb_kind==cons_symb && (symbol->symb_head_strictness>1 || symbol->symb_tail_strictness)){ + StateS head_and_tail_states[2]; + + if (symbol->symb_head_strictness>1){ + if (symbol->symb_head_strictness==4) + head_and_tail_states[0]=*symbol->symb_state_p; + else + head_and_tail_states[0]=StrictState; + } else + head_and_tail_states[0]=LazyState; + + if (symbol->symb_tail_strictness) + head_and_tail_states[1]=StrictState; + else + head_and_tail_states[1]=LazyState; + + if (symbol->symb_head_strictness==4){ + DetermineSizeOfState (head_and_tail_states[0],&a_size,&b_size); + ++a_size; + + GenReplRArgs (a_size,b_size); + *asp_p -= 1-a_size; + *bsp_p += b_size; + + AdjustTuple (a_size,b_size,asp_p,bsp_p,2,demanded_state_array,head_and_tail_states,a_size,b_size); + } else { + GenReplArgs (2,2); + *asp_p -= 1-2; + + AdjustTuple (2,0,asp_p,bsp_p,2,demanded_state_array,head_and_tail_states,2,0); + } + } else +#endif + { *asp_p-=1; UnpackTuple (*asp_p,asp_p,bsp_p,True,demanded_state_arity,demanded_state_array); } |