Commit aa38a5eb authored by John van Groningen's avatar John van Groningen
Browse files

add integers and rationals

parent a0f0ecb1
......@@ -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
......
......@@ -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);
......
......@@ -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);
......@@ -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);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment