diff options
| -rw-r--r-- | iirs_walk.adb | 96 | ||||
| -rw-r--r-- | iirs_walk.ads | 27 | ||||
| -rw-r--r-- | translate/gcc/dist-common.sh | 6 |
3 files changed, 128 insertions, 1 deletions
diff --git a/iirs_walk.adb b/iirs_walk.adb new file mode 100644 index 0000000..6cb5d3f --- /dev/null +++ b/iirs_walk.adb @@ -0,0 +1,96 @@ +package body Iirs_Walk is + function Walk_Chain (Chain : Iir; Cb : Walk_Cb) return Walk_Status + is + El : Iir; + Status : Walk_Status := Walk_Continue; + begin + El := Chain; + while El /= Null_Iir loop + Status := Cb.all (El); + exit when Status /= Walk_Continue; + El := Get_Chain (El); + end loop; + return Status; + end Walk_Chain; + + function Walk_Sequential_Stmt (Stmt : Iir; Cb : Walk_Cb) return Walk_Status; + + + function Walk_Sequential_Stmt_Chain (Chain : Iir; Cb : Walk_Cb) + return Walk_Status + is + El : Iir; + Status : Walk_Status := Walk_Continue; + begin + El := Chain; + while El /= Null_Iir loop + Status := Cb.all (El); + exit when Status /= Walk_Continue; + Status := Walk_Sequential_Stmt (El, Cb); + exit when Status /= Walk_Continue; + El := Get_Chain (El); + end loop; + return Status; + end Walk_Sequential_Stmt_Chain; + + function Walk_Sequential_Stmt (Stmt : Iir; Cb : Walk_Cb) return Walk_Status + is + Status : Walk_Status := Walk_Continue; + Chain : Iir; + begin + case Iir_Kinds_Sequential_Statement (Get_Kind (Stmt)) is + when Iir_Kind_Signal_Assignment_Statement + | Iir_Kind_Null_Statement + | Iir_Kind_Assertion_Statement + | Iir_Kind_Report_Statement + | Iir_Kind_Wait_Statement + | Iir_Kind_Return_Statement + | Iir_Kind_Procedure_Call_Statement + | Iir_Kind_Next_Statement + | Iir_Kind_Exit_Statement + | Iir_Kind_Variable_Assignment_Statement => + null; + when Iir_Kind_For_Loop_Statement + | Iir_Kind_While_Loop_Statement => + Status := Walk_Sequential_Stmt_Chain + (Get_Sequential_Statement_Chain (Stmt), Cb); + when Iir_Kind_Case_Statement => + Chain := Get_Case_Statement_Alternative_Chain (Stmt); + while Chain /= Null_Iir loop + Status := Walk_Sequential_Stmt_Chain + (Get_Associated (Chain), Cb); + exit when Status /= Walk_Continue; + Chain := Get_Chain (Chain); + end loop; + when Iir_Kind_If_Statement => + Chain := Stmt; + while Chain /= Null_Iir loop + Status := Walk_Sequential_Stmt_Chain + (Get_Sequential_Statement_Chain (Chain), Cb); + exit when Status /= Walk_Continue; + Chain := Get_Else_Clause (Chain); + end loop; + end case; + return Status; + end Walk_Sequential_Stmt; + + function Walk_Assignment_Target (Target : Iir; Cb : Walk_Cb) + return Walk_Status + is + Chain : Iir; + Status : Walk_Status := Walk_Continue; + begin + case Get_Kind (Target) is + when Iir_Kind_Aggregate => + Chain := Get_Association_Choices_Chain (Target); + while Chain /= Null_Iir loop + Status := Walk_Assignment_Target (Get_Associated (Chain), Cb); + exit when Status /= Walk_Continue; + Chain := Get_Chain (Chain); + end loop; + when others => + Status := Cb.all (Target); + end case; + return Status; + end Walk_Assignment_Target; +end Iirs_Walk; diff --git a/iirs_walk.ads b/iirs_walk.ads new file mode 100644 index 0000000..cfa6e96 --- /dev/null +++ b/iirs_walk.ads @@ -0,0 +1,27 @@ +with Iirs; use Iirs; + +package Iirs_Walk is + type Walk_Status is + ( + -- Continue to walk. + Walk_Continue, + + -- Stop walking in the subtree, continue in the parent tree. + Walk_Up, + + -- Abort the walk. + Walk_Abort); + + type Walk_Cb is access function (El : Iir) return Walk_Status; + + -- Walk on all elements of CHAIN. + function Walk_Chain (Chain : Iir; Cb : Walk_Cb) return Walk_Status; + + + function Walk_Assignment_Target (Target : Iir; Cb : Walk_Cb) + return Walk_Status; + + -- Walk on all stmts and sub-stmts of CHAIN. + function Walk_Sequential_Stmt_Chain (Chain : Iir; Cb : Walk_Cb) + return Walk_Status; +end Iirs_Walk; diff --git a/translate/gcc/dist-common.sh b/translate/gcc/dist-common.sh index e74ba92..cf2382e 100644 --- a/translate/gcc/dist-common.sh +++ b/translate/gcc/dist-common.sh @@ -43,6 +43,8 @@ iir_chains.ads iir_chains.adb iir_chain_handling.ads iir_chain_handling.adb +iirs_walk.ads +iirs_walk.adb std_names.adb std_names.ads disp_tree.adb @@ -87,7 +89,9 @@ ortho_front.adb translation.ads trans_decls.ads trans_be.ads -trans_be.adb" +trans_be.adb +trans_analyze.ads +trans_analyze.adb" ortho_files=" ortho_front.ads" |