add iirs_walk

3 files changed, 128 insertions, 1 deletions

diff --git a/iirs_walk.adb b/iirs_walk.adb
new file mode 100644
index 000000000..6cb5d3f69
--- /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 000000000..cfa6e9637
--- /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 e74ba9281..cf2382e67 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"