1-- PSL - Simplify expressions 2-- Copyright (C) 2002-2016 Tristan Gingold 3-- 4-- This program is free software: you can redistribute it and/or modify 5-- it under the terms of the GNU General Public License as published by 6-- the Free Software Foundation, either version 2 of the License, or 7-- (at your option) any later version. 8-- 9-- This program is distributed in the hope that it will be useful, 10-- but WITHOUT ANY WARRANTY; without even the implied warranty of 11-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12-- GNU General Public License for more details. 13-- 14-- You should have received a copy of the GNU General Public License 15-- along with this program. If not, see <gnu.org/licenses>. 16 17with Ada.Text_IO; 18with PSL.Types; use PSL.Types; 19with PSL.Prints; 20with Types; use Types; 21 22package body PSL.CSE is 23 function Is_X_And_Not_X (A, B : Node) return Boolean is 24 begin 25 return (Get_Kind (A) = N_Not_Bool 26 and then Get_Boolean (A) = B) 27 or else (Get_Kind (B) = N_Not_Bool 28 and then Get_Boolean (B) = A); 29 end Is_X_And_Not_X; 30 31 type Hash_Table_Type is array (Uns32 range 0 .. 128) of Node; 32 Hash_Table : Hash_Table_Type := (others => Null_Node); 33 34 function Compute_Hash (L, R : Node; Op : Uns32) return Uns32 35 is 36 begin 37 return Shift_Left (Get_Hash (L), 12) 38 xor Shift_Left (Get_Hash (R), 2) 39 xor Op; 40 end Compute_Hash; 41 42 function Compute_Hash (L: Node; Op : Uns32) return Uns32 43 is 44 begin 45 return Shift_Left (Get_Hash (L), 2) xor Op; 46 end Compute_Hash; 47 48 procedure Dump_Hash_Table (Level : Natural := 0) 49 is 50 use Ada.Text_IO; 51 Cnt : Natural; 52 Total : Natural; 53 N : Node; 54 begin 55 Total := 0; 56 for I in Hash_Table_Type'Range loop 57 Cnt := 0; 58 N := Hash_Table (I); 59 while N /= Null_Node loop 60 Cnt := Cnt + 1; 61 N := Get_Hash_Link (N); 62 end loop; 63 Put_Line ("Hash_table(" & Uns32'Image (I) 64 & "):" & Natural'Image (Cnt)); 65 Total := Total + Cnt; 66 if Level > 0 then 67 Cnt := 0; 68 N := Hash_Table (I); 69 while N /= Null_Node loop 70 Put (Uns32'Image (Get_Hash (N))); 71 if Level > 1 then 72 Put (": "); 73 PSL.Prints.Dump_Expr (N); 74 New_Line; 75 end if; 76 Cnt := Cnt + 1; 77 N := Get_Hash_Link (N); 78 end loop; 79 if Level = 1 and then Cnt > 0 then 80 New_Line; 81 end if; 82 end if; 83 end loop; 84 Put_Line ("Total:" & Natural'Image (Total)); 85 end Dump_Hash_Table; 86 87 function Build_Bool_And (L, R : Node) return Node 88 is 89 R1 : Node; 90 Res : Node; 91 Hash : Uns32; 92 Head, H : Node; 93 begin 94 if L = True_Node then 95 return R; 96 elsif R = True_Node then 97 return L; 98 elsif L = False_Node or else R = False_Node then 99 return False_Node; 100 elsif L = R then 101 return L; 102 elsif Is_X_And_Not_X (L, R) then 103 return False_Node; 104 end if; 105 106 -- More simple optimizations. 107 if Get_Kind (R) = N_And_Bool then 108 R1 := Get_Left (R); 109 if L = R1 then 110 return R; 111 elsif Is_X_And_Not_X (L, R1) then 112 return False_Node; 113 end if; 114 end if; 115 116 Hash := Compute_Hash (L, R, 2); 117 Head := Hash_Table (Hash mod Hash_Table'Length); 118 H := Head; 119 while H /= Null_Node loop 120 if Get_Hash (H) = Hash 121 and then Get_Kind (H) = N_And_Bool 122 and then Get_Left (H) = L 123 and then Get_Right (H) = R 124 then 125 return H; 126 end if; 127 H := Get_Hash_Link (H); 128 end loop; 129 130 Res := Create_Node (N_And_Bool); 131 Set_Left (Res, L); 132 Set_Right (Res, R); 133 Copy_Location (Res, L); 134 Set_Hash_Link (Res, Head); 135 Set_Hash (Res, Hash); 136 Hash_Table (Hash mod Hash_Table'Length) := Res; 137 return Res; 138 end Build_Bool_And; 139 140 function Build_Bool_Or (L, R : Node) return Node 141 is 142 Res : Node; 143 Hash : Uns32; 144 Head, H : Node; 145 begin 146 if L = True_Node then 147 return L; 148 elsif R = True_Node then 149 return R; 150 elsif L = False_Node then 151 return R; 152 elsif R = False_Node then 153 return L; 154 elsif L = R then 155 return L; 156 elsif Is_X_And_Not_X (L, R) then 157 return True_Node; 158 end if; 159 160 Hash := Compute_Hash (L, R, 3); 161 Head := Hash_Table (Hash mod Hash_Table'Length); 162 H := Head; 163 while H /= Null_Node loop 164 if Get_Hash (H) = Hash 165 and then Get_Kind (H) = N_Or_Bool 166 and then Get_Left (H) = L 167 and then Get_Right (H) = R 168 then 169 return H; 170 end if; 171 H := Get_Hash_Link (H); 172 end loop; 173 174 Res := Create_Node (N_Or_Bool); 175 Set_Left (Res, L); 176 Set_Right (Res, R); 177 Copy_Location (Res, L); 178 Set_Hash_Link (Res, Head); 179 Set_Hash (Res, Hash); 180 Hash_Table (Hash mod Hash_Table'Length) := Res; 181 return Res; 182 end Build_Bool_Or; 183 184 function Build_Bool_Not (N : Node) return Node is 185 Res : Node; 186 Hash : Uns32; 187 Head : Node; 188 H : Node; 189 begin 190 if N = True_Node then 191 return False_Node; 192 elsif N = False_Node then 193 return True_Node; 194 elsif Get_Kind (N) = N_Not_Bool then 195 return Get_Boolean (N); 196 end if; 197 198 -- Find in hash table. 199 Hash := Compute_Hash (N, 1); 200 Head := Hash_Table (Hash mod Hash_Table'Length); 201 H := Head; 202 while H /= Null_Node loop 203 if Get_Hash (H) = Hash 204 and then Get_Kind (H) = N_Not_Bool 205 and then Get_Boolean (H) = N 206 then 207 return H; 208 end if; 209 H := Get_Hash_Link (H); 210 end loop; 211 212 Res := Create_Node (N_Not_Bool); 213 Set_Boolean (Res, N); 214 Copy_Location (Res, N); 215 Set_Hash_Link (Res, Head); 216 Set_Hash (Res, Hash); 217 Hash_Table (Hash mod Hash_Table'Length) := Res; 218 219 return Res; 220 end Build_Bool_Not; 221end PSL.CSE; 222