diff options
Diffstat (limited to 'src/grt/grt-avls.adb')
| -rw-r--r-- | src/grt/grt-avls.adb | 249 |
1 files changed, 249 insertions, 0 deletions
diff --git a/src/grt/grt-avls.adb b/src/grt/grt-avls.adb new file mode 100644 index 0000000..7f13ed3 --- /dev/null +++ b/src/grt/grt-avls.adb @@ -0,0 +1,249 @@ +-- GHDL Run Time (GRT) - binary balanced tree. +-- Copyright (C) 2002 - 2014 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GCC; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +-- +-- As a special exception, if other files instantiate generics from this +-- unit, or you link this unit with other files to produce an executable, +-- this unit does not by itself cause the resulting executable to be +-- covered by the GNU General Public License. This exception does not +-- however invalidate any other reasons why the executable file might be +-- covered by the GNU Public License. +with Grt.Errors; use Grt.Errors; + +package body Grt.Avls is + function Get_Height (Tree: AVL_Tree; N : AVL_Nid) return Ghdl_I32 is + begin + if N = AVL_Nil then + return 0; + else + return Tree (N).Height; + end if; + end Get_Height; + + procedure Check_AVL (Tree : AVL_Tree; N : AVL_Nid) + is + L, R : AVL_Nid; + Lh, Rh : Ghdl_I32; + H : Ghdl_I32; + begin + if N = AVL_Nil then + return; + end if; + L := Tree (N).Left; + R := Tree (N).Right; + H := Get_Height (Tree, N); + if L = AVL_Nil and R = AVL_Nil then + if Get_Height (Tree, N) /= 1 then + Internal_Error ("check_AVL(1)"); + end if; + return; + elsif L = AVL_Nil then + Check_AVL (Tree, R); + if H /= Get_Height (Tree, R) + 1 or H > 2 then + Internal_Error ("check_AVL(2)"); + end if; + elsif R = AVL_Nil then + Check_AVL (Tree, L); + if H /= Get_Height (Tree, L) + 1 or H > 2 then + Internal_Error ("check_AVL(3)"); + end if; + else + Check_AVL (Tree, L); + Check_AVL (Tree, R); + Lh := Get_Height (Tree, L); + Rh := Get_Height (Tree, R); + if Ghdl_I32'Max (Lh, Rh) + 1 /= H then + Internal_Error ("check_AVL(4)"); + end if; + if Rh - Lh > 1 or Rh - Lh < -1 then + Internal_Error ("check_AVL(5)"); + end if; + end if; + end Check_AVL; + + procedure Compute_Height (Tree : in out AVL_Tree; N : AVL_Nid) + is + begin + Tree (N).Height := + Ghdl_I32'Max (Get_Height (Tree, Tree (N).Left), + Get_Height (Tree, Tree (N).Right)) + 1; + end Compute_Height; + + procedure Simple_Rotate_Right (Tree : in out AVL_Tree; N : AVL_Nid) + is + R : AVL_Nid; + V : AVL_Value; + begin + -- Rotate nodes. + R := Tree (N).Right; + Tree (N).Right := Tree (R).Right; + Tree (R).Right := Tree (R).Left; + Tree (R).Left := Tree (N).Left; + Tree (N).Left := R; + -- Swap vals. + V := Tree (N).Val; + Tree (N).Val := Tree (R).Val; + Tree (R).Val := V; + -- Adjust bal. + Compute_Height (Tree, R); + Compute_Height (Tree, N); + end Simple_Rotate_Right; + + procedure Simple_Rotate_Left (Tree : in out AVL_Tree; N : AVL_Nid) + is + L : AVL_Nid; + V : AVL_Value; + begin + L := Tree (N).Left; + Tree (N).Left := Tree (L).Left; + Tree (L).Left := Tree (L).Right; + Tree (L).Right := Tree (N).Right; + Tree (N).Right := L; + V := Tree (N).Val; + Tree (N).Val := Tree (L).Val; + Tree (L).Val := V; + Compute_Height (Tree, L); + Compute_Height (Tree, N); + end Simple_Rotate_Left; + + procedure Double_Rotate_Right (Tree : in out AVL_Tree; N : AVL_Nid) + is + R : AVL_Nid; + begin + R := Tree (N).Right; + Simple_Rotate_Left (Tree, R); + Simple_Rotate_Right (Tree, N); + end Double_Rotate_Right; + + procedure Double_Rotate_Left (Tree : in out AVL_Tree; N : AVL_Nid) + is + L : AVL_Nid; + begin + L := Tree (N).Left; + Simple_Rotate_Right (Tree, L); + Simple_Rotate_Left (Tree, N); + end Double_Rotate_Left; + + procedure Insert (Tree : in out AVL_Tree; + Cmp : AVL_Compare_Func; + Val : AVL_Nid; + N : AVL_Nid; + Res : out AVL_Nid) + is + Diff : Integer; + Op_Ch, Ch : AVL_Nid; + begin + Diff := Cmp.all (Tree (Val).Val, Tree (N).Val); + if Diff = 0 then + Res := N; + return; + end if; + if Diff < 0 then + if Tree (N).Left = AVL_Nil then + Tree (N).Left := Val; + Compute_Height (Tree, N); + -- N is balanced. + Res := Val; + else + Ch := Tree (N).Left; + Op_Ch := Tree (N).Right; + Insert (Tree, Cmp, Val, Ch, Res); + if Res /= Val then + return; + end if; + if Get_Height (Tree, Ch) - Get_Height (Tree, Op_Ch) = 2 then + -- Rotate + if Get_Height (Tree, Tree (Ch).Left) + > Get_Height (Tree, Tree (Ch).Right) + then + Simple_Rotate_Left (Tree, N); + else + Double_Rotate_Left (Tree, N); + end if; + else + Compute_Height (Tree, N); + end if; + end if; + else + if Tree (N).Right = AVL_Nil then + Tree (N).Right := Val; + Compute_Height (Tree, N); + -- N is balanced. + Res := Val; + else + Ch := Tree (N).Right; + Op_Ch := Tree (N).Left; + Insert (Tree, Cmp, Val, Ch, Res); + if Res /= Val then + return; + end if; + if Get_Height (Tree, Ch) - Get_Height (Tree, Op_Ch) = 2 then + -- Rotate + if Get_Height (Tree, Tree (Ch).Right) + > Get_Height (Tree, Tree (Ch).Left) + then + Simple_Rotate_Right (Tree, N); + else + Double_Rotate_Right (Tree, N); + end if; + else + Compute_Height (Tree, N); + end if; + end if; + end if; + end Insert; + + procedure Get_Node (Tree : in out AVL_Tree; + Cmp : AVL_Compare_Func; + N : AVL_Nid; + Res : out AVL_Nid) + is + begin + if Tree'First /= AVL_Root or N /= Tree'Last then + Internal_Error ("avls.get_node"); + end if; + Insert (Tree, Cmp, N, AVL_Root, Res); + Check_AVL (Tree, AVL_Root); + end Get_Node; + + function Find_Node (Tree : AVL_Tree; + Cmp : AVL_Compare_Func; + Val : AVL_Value) return AVL_Nid + is + N : AVL_Nid; + Diff : Integer; + begin + N := AVL_Root; + if Tree'Last < AVL_Root then + return AVL_Nil; + end if; + loop + Diff := Cmp.all (Val, Tree (N).Val); + if Diff = 0 then + return N; + end if; + if Diff < 0 then + N := Tree (N).Left; + else + N := Tree (N).Right; + end if; + if N = AVL_Nil then + return AVL_Nil; + end if; + end loop; + end Find_Node; +end Grt.Avls; |