aboutsummaryrefslogtreecommitdiff
path: root/backendC
diff options
context:
space:
mode:
Diffstat (limited to 'backendC')
-rw-r--r--backendC/CleanCompilerSources/codegen1.c254
-rw-r--r--backendC/CleanCompilerSources/codegen2.c63
-rw-r--r--backendC/CleanCompilerSources/codegen2.h5
-rw-r--r--backendC/CleanCompilerSources/codegen3.c14
4 files changed, 325 insertions, 11 deletions
diff --git a/backendC/CleanCompilerSources/codegen1.c b/backendC/CleanCompilerSources/codegen1.c
index bdffb6b..1d724b1 100644
--- a/backendC/CleanCompilerSources/codegen1.c
+++ b/backendC/CleanCompilerSources/codegen1.c
@@ -1298,7 +1298,20 @@ void GenerateCodeForConstructorsAndRecords (Symbol symbols)
ConstructorList alt;
for_l (alt,def->sdef_type->type_constructors,cl_next)
- GenerateConstructorDescriptorAndFunction (alt);
+ if (alt->cl_constructor->type_node_symbol->symb_def->sdef_arity!=0)
+ break;
+
+ if (alt==NULL){
+ int constructor_n;
+
+ constructor_n=0;
+ for_l (alt,def->sdef_type->type_constructors,cl_next){
+ GenConstructor0DescriptorAndExport (alt->cl_constructor->type_node_symbol->symb_def,constructor_n);
+ ++constructor_n;
+ }
+ } else
+ for_l (alt,def->sdef_type->type_constructors,cl_next)
+ GenerateConstructorDescriptorAndFunction (alt);
} else if (def->sdef_kind==RECORDTYPE){
FieldList fields;
int asize, bsize;
@@ -3231,6 +3244,21 @@ void set_local_reference_counts_and_add_free_node_ids (NodeP case_node,NodeIdLis
}
#endif
+static SymbDef sdef_of_function (NodeP node_p,int arity)
+{
+ if (node_p->node_kind==NormalNode && node_p->node_symbol->symb_kind==definition){
+ SymbDef sdef;
+
+ sdef=node_p->node_symbol->symb_def;
+ if ((sdef->sdef_kind==IMPRULE || sdef->sdef_kind==DEFRULE || sdef->sdef_kind==SYSRULE) &&
+ sdef->sdef_arity==arity && sdef->sdef_arfun==NoArrayFun)
+
+ return sdef;
+ }
+
+ return NULL;
+}
+
static int generate_code_for_switch_node (NodeP node,int asp,int bsp,struct esc *esc_p,StateP result_state_p,
SavedNidStateS **save_states_p,AbNodeIdsP ab_node_ids_p)
{
@@ -3313,6 +3341,9 @@ static int generate_code_for_switch_node (NodeP node,int asp,int bsp,struct esc
case_node=arg->arg_node;
+ if (case_node->node_kind==OverloadedCaseNode)
+ case_node=case_node->node_node;
+
node_id_ref_count_elem_h=&case_node->node_node_id_ref_counts;
while ((node_id_ref_count_elem_p=*node_id_ref_count_elem_h)!=NULL){
@@ -3480,6 +3511,49 @@ static int generate_code_for_switch_node (NodeP node,int asp,int bsp,struct esc
}
GenJmpTrue (&case_label);
break;
+ case integer_denot:
+ {
+ LabDef not_eq_z_label;
+
+ MakeLabel (&not_eq_z_label,"not_eq_z",new_not_eq_z_label_n,no_pref);
+ ++new_not_eq_z_label_n;
+
+ if (IsSimpleState (node->node_state)){
+ GenPushRArgs (asp-a_index,1,1);
+
+ GenJmpNotEqZ (symbol->symb_val,&not_eq_z_label);
+
+ GenPopA (1);
+ GenPopB (1);
+ GenJmp (&case_label);
+
+ GenLabelDefinition (&not_eq_z_label);
+
+ GenPopA (1);
+ GenPopB (1);
+ } else {
+ if (asp!=a_index)
+ GenPushA (asp-a_index);
+ if (bsp!=b_index)
+ GenPushB (bsp-b_index);
+
+ GenJmpNotEqZ (symbol->symb_val,&not_eq_z_label);
+
+ if (asp!=a_index)
+ GenPopA (1);
+ if (bsp!=b_index)
+ GenPopB (1);
+ GenJmp (&case_label);
+
+ GenLabelDefinition (&not_eq_z_label);
+
+ if (asp!=a_index)
+ GenPopA (1);
+ if (bsp!=b_index)
+ GenPopB (1);
+ }
+ break;
+ }
default:
if (symbol->symb_kind < Nr_Of_Predef_Types){
ObjectKind denot_type;
@@ -3515,6 +3589,179 @@ static int generate_code_for_switch_node (NodeP node,int asp,int bsp,struct esc
++NewLabelNr;
break;
}
+
+ case OverloadedCaseNode:
+ {
+ CodeGenNodeIdsS code_gen_node_ids;
+ LabDef case_label;
+ NodeP from_node_p,equal_node_p;
+ SymbDef from_sdef,equal_sdef;
+ StateS demanded_from_result_state;
+
+ symbol=case_node->node_node->node_symbol;
+ MakeLabel (&case_label,case_symb,NewLabelNr,no_pref);
+
+ code_gen_node_ids.saved_nid_state_l=save_states_p;
+ code_gen_node_ids.free_node_ids=ab_node_ids_p->free_node_ids;
+ code_gen_node_ids.moved_node_ids_l=NULL;
+ code_gen_node_ids.a_node_ids=ab_node_ids_p->a_node_ids;
+ code_gen_node_ids.b_node_ids=ab_node_ids_p->b_node_ids;
+ code_gen_node_ids.doesnt_fail=0;
+
+ equal_node_p=case_node->node_arguments->arg_node;
+ from_node_p=case_node->node_arguments->arg_next->arg_node;
+
+ equal_sdef = sdef_of_function (equal_node_p,2);
+ from_sdef = sdef_of_function (from_node_p,1);
+
+ if (equal_sdef==NULL)
+ demanded_from_result_state=LazyState;
+ else {
+ if (equal_sdef->sdef_kind==IMPRULE)
+ demanded_from_result_state=equal_sdef->sdef_rule->rule_state_p[1];
+ else
+ demanded_from_result_state=equal_sdef->sdef_rule_type->rule_type_state_p[1];
+ }
+
+ if (from_sdef!=NULL){
+ StateP state_p;
+ LabDef name;
+ StateS result_state;
+ int a_size,b_size;
+ ArgS arg;
+
+ if (from_sdef->sdef_kind==IMPRULE)
+ state_p=from_sdef->sdef_rule->rule_state_p;
+ else
+ state_p=from_sdef->sdef_rule_type->rule_type_state_p;
+
+ result_state=state_p[-1];
+
+ if (ExpectsResultNode (result_state))
+ GenCreate (-1);
+
+ if (state_p[0].state_type==SimpleState && state_p[0].state_kind==OnB)
+ PushBasic (state_p[0].state_object,symbol->symb_val);
+ else {
+ if (symbol->symb_kind==integer_denot){
+ GenPushZ (symbol->symb_val);
+ if (state_p[0].state_type!=RecordState){
+ LabDef record_lab;
+
+ ConvertSymbolToRLabel (&record_lab,BasicSymbolStates [integer_denot].state_record_symbol);
+ GenBuildR (&record_lab,1,1,0,0,True);
+ }
+ } else if (symbol->symb_kind==rational_denot){
+ push_rational (symbol);
+ if (state_p[0].state_type!=RecordState){
+ LabDef ratio_record_lab;
+
+ ConvertSymbolToKLabel (&ratio_record_lab,special_types[1]->sdef_type->type_constructors->cl_constructor->type_node_symbol->symb_def);
+ GenBuildR (&ratio_record_lab,2,0,0,0,True);
+ }
+ } else
+ BuildBasic (BasicSymbolStates [symbol->symb_kind].state_object,symbol->symb_val);
+ }
+
+ arg.arg_state=state_p[0];
+ arg.arg_next=NULL;
+
+ ConvertSymbolToLabel (&name,from_sdef);
+ CallFunction1 (&name,from_sdef,result_state,&arg,1);
+
+ DetermineSizeOfState (result_state,&a_size,&b_size);
+ asp+=a_size;
+ bsp+=b_size;
+ CoerceArgumentOnTopOfStack (&asp,&bsp,demanded_from_result_state,result_state,a_size,b_size);
+ } else {
+ asp += 1;
+
+ if (symbol->symb_kind==integer_denot){
+ LabDef record_lab;
+
+ GenPushZ (symbol->symb_val);
+ ConvertSymbolToRLabel (&record_lab,BasicSymbolStates [integer_denot].state_record_symbol);
+ GenBuildR (&record_lab,1,1,0,0,True);
+ } else if (symbol->symb_kind==rational_denot){
+ LabDef ratio_record_lab;
+
+ push_rational (symbol);
+
+ ConvertSymbolToKLabel (&ratio_record_lab,special_types[1]->sdef_type->type_constructors->cl_constructor->type_node_symbol->symb_def);
+
+ GenBuildR (&ratio_record_lab,2,0,0,0,True);
+ } else
+ BuildBasic (BasicSymbolStates [symbol->symb_kind].state_object,symbol->symb_val);
+
+ Build (from_node_p,&asp,&bsp,&code_gen_node_ids);
+
+ asp -= 1;
+ GenJsrAp (1);
+
+ if (equal_sdef!=NULL)
+ CoerceArgumentOnTopOfStack (&asp,&bsp,demanded_from_result_state,StrictState,1,0);
+ }
+
+ if (equal_sdef!=NULL){
+ StateP state_p;
+ LabDef name;
+ StateS result_state;
+ int a_size,b_size;
+ ArgS arg1,arg2;
+
+ if (equal_sdef->sdef_kind==IMPRULE)
+ state_p=equal_sdef->sdef_rule->rule_state_p;
+ else
+ state_p=equal_sdef->sdef_rule_type->rule_type_state_p;
+
+ arg2.arg_state=state_p[1];
+ arg2.arg_next=NULL;
+ arg1.arg_state=state_p[0];
+ arg1.arg_next=&arg2;
+
+ result_state=state_p[-1];
+
+ {
+ int arg_asp,arg_bsp;
+
+ arg_asp=asp;
+ arg_bsp=bsp;
+ CopyNodeIdArgument (arg1.arg_state,node_id,&arg_asp,&arg_bsp);
+ }
+
+ SubSizeOfState (arg2.arg_state,&asp,&bsp);
+
+ ConvertSymbolToLabel (&name,equal_sdef);
+ CallFunction1 (&name,equal_sdef,result_state,&arg1,2);
+
+ DetermineSizeOfState (result_state,&a_size,&b_size);
+ asp+=a_size;
+ bsp+=b_size;
+ CoerceArgumentOnTopOfStack (&asp,&bsp,BasicSymbolStates [bool_type],result_state,a_size,b_size);
+
+ bsp -= 1;
+ } else {
+ CopyNodeIdArgument (LazyState,node_id,&asp,&bsp);
+
+ Build (equal_node_p,&asp,&bsp,&code_gen_node_ids);
+
+ asp -= 2;
+ GenJsrAp (2);
+
+ PushBasicFromAOnB (BoolObj,0);
+ asp -= 1;
+ GenPopA (1);
+ }
+
+ ab_node_ids_p->free_node_ids=code_gen_node_ids.free_node_ids;
+ ab_node_ids_p->a_node_ids=code_gen_node_ids.a_node_ids;
+ ab_node_ids_p->b_node_ids=code_gen_node_ids.b_node_ids;
+
+ GenJmpTrue (&case_label);
+
+ ++NewLabelNr;
+ break;
+ }
case DefaultNode:
has_default=1;
break;
@@ -3572,6 +3819,9 @@ static int generate_code_for_switch_node (NodeP node,int asp,int bsp,struct esc
SavedNidStateP saved_node_id_states;
case_node=arg->arg_node;
+
+ if (case_node->node_kind==OverloadedCaseNode)
+ case_node=case_node->node_node;
MakeLabel (&case_label,case_symb,first_case_label_number,no_pref);
++first_case_label_number;
@@ -3684,7 +3934,7 @@ static void repl_overloaded_cons_arguments (NodeP node_p,int *asp_p,int *bsp_p,S
GenJsr (&apply_label);
GenOAStackLayout (1);
- GenReplArgs (2,2);
+ GenReplArgs (2,2);
}
#endif
diff --git a/backendC/CleanCompilerSources/codegen2.c b/backendC/CleanCompilerSources/codegen2.c
index 82c1d2d..8ca3c18 100644
--- a/backendC/CleanCompilerSources/codegen2.c
+++ b/backendC/CleanCompilerSources/codegen2.c
@@ -53,7 +53,7 @@ char notused_string[] = "notused";
SymbDef ApplyDef,IfDef;
-unsigned NewLabelNr;
+unsigned NewLabelNr,new_not_eq_z_label_n;
StateS StrictOnAState;
static StateS UnderEvalState,ProcIdState;
@@ -231,7 +231,7 @@ Coercions CoerceStateKind (StateKind dem_state_kind, StateKind off_state_kind)
{
if (dem_state_kind==Undefined)
error_in_function ("CoerceStateKind");
-
+
switch (off_state_kind){
case OnB:
if (dem_state_kind == OnB)
@@ -2128,15 +2128,13 @@ void cleanup_stack
}
}
-static void SubSizeOfState (StateS state,int *a_offset_p,int *b_offset_p);
-
static void SubSizeOfStates (int arity,States states,int *a_offset_p,int *b_offset_p)
{
for (; arity; arity--)
SubSizeOfState (states [arity-1],a_offset_p,b_offset_p);
}
-static void SubSizeOfState (StateS state,int *a_offset_p,int *b_offset_p)
+void SubSizeOfState (StateS state,int *a_offset_p,int *b_offset_p)
{
if (IsSimpleState (state)){
if (state.state_kind==OnB)
@@ -2348,7 +2346,7 @@ static void FillSymbol (Node node,SymbDef sdef,int *asp_p,int *bsp_p,NodeId upda
if (update_node_id==NULL && ExpectsResultNode (node->node_state)){
BuildArgsWithNewResultNode (node->node_arguments,asp_p,bsp_p,code_gen_node_ids_p,&a_size,&b_size);
-
+
*asp_p-=a_size;
*bsp_p-=b_size;
@@ -3008,12 +3006,27 @@ int simple_expression_without_node_ids (NodeP node_p)
}
#endif
+void push_rational (SymbolP symb)
+{
+ LabDef integer_record_lab;
+
+ ConvertSymbolToRLabel (&integer_record_lab,BasicSymbolStates [integer_denot].state_record_symbol);
+
+ GenPushZR (symb->symb_val);
+ GenBuildR (&integer_record_lab,1,1,1,1,False);
+ GenBuildR (&integer_record_lab,1,1,0+1,0,False);
+ GenPopB (2);
+ GenUpdateA (1,3);
+ GenUpdateA (0,2);
+ GenPopA (2);
+}
+
static void FillNormalNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_id,CodeGenNodeIdsP code_gen_node_ids_p)
{
Symbol symb;
symb = node->node_symbol;
-
+
switch (symb->symb_kind){
case definition:
FillSymbol (node,symb->symb_def,asp_p,bsp_p,update_node_id,code_gen_node_ids_p);
@@ -3210,7 +3223,7 @@ static void FillNormalNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_i
return;
case string_denot:
GenBuildString (symb->symb_val);
- *asp_p+=1;
+ *asp_p+=1;
if (IsSimpleState (node->node_state)){
if (update_node_id==NULL){
GenBuildh (&BasicDescriptors[ArrayObj],1);
@@ -3220,6 +3233,39 @@ static void FillNormalNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_i
}
}
return;
+ case integer_denot:
+ GenPushZ (symb->symb_val);
+ *asp_p+=1;
+ if (IsSimpleState (node->node_state)){
+ LabDef record_lab;
+
+ ConvertSymbolToRLabel (&record_lab,BasicSymbolStates [integer_denot].state_record_symbol);
+
+ if (update_node_id==NULL)
+ GenBuildR (&record_lab,1,1,0,0,True);
+ else {
+ GenFillR (&record_lab,1,1,*asp_p-update_node_id->nid_a_index,0,0,node->node_state.state_kind==SemiStrict ? ReleaseAndFill : NormalFill,True);
+ *asp_p-=1;
+ }
+ } else
+ *bsp_p+=1;
+ return;
+ case rational_denot:
+ {
+ LabDef ratio_record_lab;
+
+ push_rational (symb);
+
+ ConvertSymbolToKLabel (&ratio_record_lab,special_types[1]->sdef_type->type_constructors->cl_constructor->type_node_symbol->symb_def);
+
+ if (update_node_id==NULL){
+ GenBuildR (&ratio_record_lab,2,0,0,0,True);
+ *asp_p+=1;
+ } else {
+ GenFillR (&ratio_record_lab,2,0,*asp_p+2-update_node_id->nid_a_index,0,0,node->node_state.state_kind==SemiStrict ? ReleaseAndFill : NormalFill,True);
+ }
+ return;
+ }
default:
if (symb->symb_kind<Nr_Of_Basic_Types){
if (update_node_id==NULL){
@@ -6422,6 +6468,7 @@ void InitCoding (void)
int i;
NewLabelNr = 1;
+ new_not_eq_z_label_n=1;
SetUnaryState (& StrictOnAState, StrictOnA, UnknownObj);
SetUnaryState (& OnAState, OnA, UnknownObj);
SetUnaryState (& UnderEvalState, UnderEval, UnknownObj);
diff --git a/backendC/CleanCompilerSources/codegen2.h b/backendC/CleanCompilerSources/codegen2.h
index 39f0456..df2b29f 100644
--- a/backendC/CleanCompilerSources/codegen2.h
+++ b/backendC/CleanCompilerSources/codegen2.h
@@ -27,7 +27,7 @@ STRUCT (code_gen_node_ids,CodeGenNodeIds){
extern StateS OnAState;
extern LabDef BasicDescriptors [];
-extern unsigned NewLabelNr;
+extern unsigned NewLabelNr,new_not_eq_z_label_n;
extern Bool LazyTupleSelectors [];
extern int ObjectSizes [];
@@ -40,6 +40,7 @@ extern void ScanInlineFile (char *fname);
extern Bool EqualState (StateS st1, StateS st2);
extern void DetermineSizeOfArguments (ArgS *args,int *a_offset_p,int *b_offset_p);
+extern void SubSizeOfState (StateS state,int *a_offset_p,int *b_offset_p);
extern void BuildTuple (int aindex, int bindex, int asp, int bsp, int arity,
States argstates,int asize,int bsize,int rootindex,FillKind fkind,Bool newnode);
@@ -145,3 +146,5 @@ void FillNodeOnACycle (Node node,int *asp_p,int *bsp_p,NodeId update_node_id,Cod
#endif
void PushField (StateS recstate,int fieldnr,int offset,int *asp_p,int *bsp_p,int *a_size_p,int *b_size_p);
void ReplaceRecordByField (StateS recstate,int fieldnr,int *asp_p,int *bsp_p,int *a_size_p,int *b_size_p);
+
+void push_rational (SymbolP symb);
diff --git a/backendC/CleanCompilerSources/codegen3.c b/backendC/CleanCompilerSources/codegen3.c
index 8e88087..7a48e02 100644
--- a/backendC/CleanCompilerSources/codegen3.c
+++ b/backendC/CleanCompilerSources/codegen3.c
@@ -958,6 +958,20 @@ static void CodeNormalRootNode (Node root,NodeId rootid,int asp,int bsp,CodeGenN
GenBuildString (rootsymb->symb_val);
GenRtn (1, 0, OnAState);
return;
+ case integer_denot:
+ GenPopA (asp);
+ GenPopB (bsp);
+
+ GenPushZ (rootsymb->symb_val);
+ if (IsSimpleState (resultstate)){
+ LabDef record_lab;
+
+ ConvertSymbolToRLabel (&record_lab,BasicSymbolStates [integer_denot].state_record_symbol);
+ GenBuildR (&record_lab,1,1,0,0,True);
+ GenRtn (1,0,OnAState);
+ } else
+ GenRtn (1,1,resultstate);
+ return;
default:
if (rootsymb->symb_kind < Nr_Of_Basic_Types)
FillRhsRoot (&BasicDescriptors[rootsymb->symb_kind], root, asp, bsp,code_gen_node_ids_p);
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-15 13:45:20 +0000