-- Less_Trivial_Trie - Provide a less trivial trie type that allows for reclaiming the trie storage.
-- Copyright (C) 2022,2024 Prince Trippy <programmer@verisimilitudes.net>.

-- This program is free software: you can redistribute it and/or modify it under the terms of the
-- GNU Affero General Public License version 3 as published by the Free Software Foundation.

-- This program 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 Affero General Public License for more details.

-- You should have received a copy of the GNU Affero General Public License along with this program.
-- If not, see <http://www.gnu.org/licenses/>.

with Unchecked_Deallocation;

package body Less_Trivial_Trie is
   procedure Kill is new Unchecked_Deallocation(Object => Node, Name => Link);

   procedure Finalize (Object : in out Node) is
   begin
      for I in Object.Past'Range loop
         if Object.Past(I) /= null then
            Kill(Object.Past(I));
         end if;
      end loop;
   end Finalize;

   procedure Initialize (Object : in out Root) is
   begin
      Object.Tree := new Node;
   end Initialize;

   procedure Finalize (Object : in out Root) is
   begin
      Kill(Object.Tree);
   end Finalize;

   protected body Trie is
      procedure Take (Path : in Input_Type) is -- The Node.Back field exists for this one procedure.
         T : Link;

         procedure Trim (A : in out Link) is -- I want to make another, public Trim procedure later.
            B : Boolean := True;
            T : Link;
         begin
            for I in A.all.Past'Range loop -- This can be simplified with the sparse representation.
              if A.all.Past(I) /= null then
                 B := False;
              end if;
           end loop;
           if B then
              T := A.all.Back;
              Kill(A); -- An optimized version would prune the greatest empty branch simultaneously.
              if T /= null then
                 Trim(T);
              end if;
           end if;
         end Trim;
      begin
         T := Trie.Sift(Path);
         if T /= null then
            T.all.Just := False;
            Trim(T);
         end if;
      end Take;

      procedure Give (Path : in Input_Type; What : in Stored_Type) is
         T : Link := Trie.Tree.Tree;
      begin
         for I in Path'Range loop
            if T.all.Past(Path(I)) = null then
               T.all.Past(Path(I)) := new Node; -- It's a shame how ``others => <>'' is in Ada 2005.
               T.all.Past(Path(I)).all.Back := T;
            end if;
            T := T.all.Past(Path(I));
         end loop;
         T.all.Just := True;
         T.all.Here := What;
      end Give;

      function Find (Path : in Input_Type) return Both is
         T : Link := Trie.Sift(Path);
      begin
         if T /= null and then T.all.Just then
            return (Seen => True, What => T.all.Here);
         else
            return (Seen => False);
         end if;
      end Find;

      function Sift (Path : in Input_Type) return Link is
         T : Link := Trie.Tree.Tree;
      begin
         for I in Path'Range loop
            T := T.all.Past(Path(I));
            if T = null then return null; end if;
         end loop;
         return T;
      end Sift;
   end Trie;

   procedure Take (Path : in Input_Type; Tree : in out Trie) is
   begin
      Tree.Take(Path);
   end Take;

   procedure Give (Path : in Input_Type; Tree : in out Trie; What : in Stored_Type) is
   begin
      Tree.Give(Path, What);
   end Give;

   procedure Find (Path : in Input_Type; Tree : in Trie; Seen : out Boolean;
                                                         Unto : out Stored_Type) is
      T : Both := Tree.Find(Path);
   begin
      case T.Seen is
         when True => Seen := True; Unto := T.What;
         when False => Seen := False;
      end case;
   end Find;
end Less_Trivial_Trie;
.