add integers and rationals

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
 

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);

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);

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);