Skip to content

Commit 7f7de7a

Browse files
committed
Add default body for some subprograms
and that to those that have identity-like type: A -> A. The default body is exactly that identity.
1 parent 5207ea8 commit 7f7de7a

File tree

3 files changed

+33
-2
lines changed

3 files changed

+33
-2
lines changed

gnat2goto/driver/goto_utils.adb

Lines changed: 19 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -141,6 +141,7 @@ package body GOTO_Utils is
141141

142142
procedure New_Subprogram_Symbol_Entry (Subprog_Name : Symbol_Id;
143143
Subprog_Type : Irep;
144+
Subprog_Body : Irep;
144145
A_Symbol_Table : in out Symbol_Table)
145146
is
146147
Subprog_Symbol : Symbol;
@@ -150,7 +151,7 @@ package body GOTO_Utils is
150151
Subprog_Symbol.PrettyName := Subprog_Name;
151152
Subprog_Symbol.SymType := Subprog_Type;
152153
Subprog_Symbol.Mode := Intern ("C");
153-
Subprog_Symbol.Value := Make_Nil (No_Location);
154+
Subprog_Symbol.Value := Subprog_Body;
154155

155156
A_Symbol_Table.Insert (Subprog_Name, Subprog_Symbol);
156157
end New_Subprogram_Symbol_Entry;
@@ -351,6 +352,23 @@ package body GOTO_Utils is
351352
A_Symbol_Table => A_Symbol_Table);
352353
end Build_Function;
353354

355+
function Build_Identity_Body (Parameters : Irep) return Irep
356+
is
357+
Parameter_List : constant Irep_List := Get_Parameter (Parameters);
358+
First_Cursor : constant List_Cursor := List_First (Parameter_List);
359+
Body_Block : constant Irep :=
360+
Make_Code_Block (Source_Location => No_Location,
361+
I_Type => Make_Nil_Type);
362+
begin
363+
pragma Assert (List_Has_Element (Parameter_List, First_Cursor));
364+
Append_Op (Body_Block,
365+
Make_Code_Return (Return_Value =>
366+
Param_Symbol (List_Element (Parameter_List, First_Cursor)),
367+
Source_Location => No_Location,
368+
I_Type => Make_Nil_Type));
369+
return Body_Block;
370+
end Build_Identity_Body;
371+
354372
function Build_Index_Constant (Value : Int; Source_Loc : Source_Ptr)
355373
return Irep
356374
is

gnat2goto/driver/goto_utils.ads

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -61,8 +61,10 @@ package GOTO_Utils is
6161

6262
procedure New_Subprogram_Symbol_Entry (Subprog_Name : Symbol_Id;
6363
Subprog_Type : Irep;
64+
Subprog_Body : Irep;
6465
A_Symbol_Table : in out Symbol_Table)
65-
with Pre => Kind (Subprog_Type) = I_Code_Type;
66+
with Pre => Kind (Subprog_Type) = I_Code_Type
67+
and Kind (Subprog_Body) = I_Code_Block;
6668
-- Insert the subprogram specification into the symbol table
6769

6870
procedure New_Type_Symbol_Entry (Type_Name : Symbol_Id; Type_Of_Type : Irep;
@@ -114,6 +116,10 @@ package GOTO_Utils is
114116
and then Kind (Func_Params) = I_Parameter_List
115117
and then Kind (FBody) in Class_Code);
116118

119+
function Build_Identity_Body (Parameters : Irep) return Irep
120+
with Pre => Kind (Parameters) = I_Parameter_List,
121+
Post => Kind (Build_Identity_Body'Result) = I_Code_Block;
122+
117123
function Build_Array_Size (Array_Comp : Irep) return Irep
118124
with Pre => Kind (Array_Comp) in Class_Expr,
119125
Post => Kind (Build_Array_Size'Result) = I_Op_Add;

gnat2goto/driver/tree_walk.adb

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5457,9 +5457,16 @@ package body Tree_Walk is
54575457
Do_Subprogram_Specification (N);
54585458
Subprog_Name : constant Symbol_Id :=
54595459
Intern (Unique_Name (Defining_Unit_Name (N)));
5460+
Default_Body : Irep := Make_Code_Block (Sloc (N));
54605461
begin
5462+
if List_Length (Parameter_Specifications (N)) = 1 and
5463+
not (Kind (Get_Return_Type (Subprog_Type)) = I_Void_Type)
5464+
then
5465+
Default_Body := Build_Identity_Body (Get_Parameters (Subprog_Type));
5466+
end if;
54615467
New_Subprogram_Symbol_Entry (Subprog_Name => Subprog_Name,
54625468
Subprog_Type => Subprog_Type,
5469+
Subprog_Body => Default_Body,
54635470
A_Symbol_Table => Global_Symbol_Table);
54645471
end Register_Subprogram_Specification;
54655472

0 commit comments

Comments
 (0)