Smart Pointers

In this article I discuss how to implement "smart pointers," which keep
track of how many references there are to an object, and automatically
return the object to storage when there are no more references.

The classic problem with pointer manipulation is that, without an
automatic garbage collector, you have to manually reclaim the memory.
The client of an abstraction that is implemented using heap has to
remember to explicitly call a Free or Clear operation to return the
object to storage.

The problem is especially pernicious in the presence of exceptions,
because you can jump right past the point where the memory is reclaimed.

The other issue is one of ownership: who is responsible for reclaiming
the memory designated by a pointer?  If there are multiple pointers to
an object, it's not always obvious who should free the memory.  Often,
the number of pointers to an object isn't even known, making it
difficult to determine whether the memory should in fact be deallocated.

An even worse problem is when a dangling reference occurs, and someone
refers to memory already deallocated.  This can easily corrupt the
system, causing segmentation faults, core dumps, and other undesirable
behavior.

Smart pointers overcome these problems by automating the work that
otherwise would need to be done manually.  Clients don't have to call an
operation to clean up an abstraction, nor do they have to worry about
unhandled exceptions, because the smart pointer does reclamation
automatically when the scope ends.

Dangling references aren't a problem anymore either, because a
reference-count ensures that the object doesn't get deallocated until
there are no more pointers left designating the object.

In C++, you can overload the dereference operator "->" so that a smart
pointer looks exactly a dumb pointer.  However, this not possible in
Ada, because selection via ".all" isn't really an operation.

We can do the next best thing by creating a thin wrapper around an
access type, and exporting operations to allow you to manipulate the
designated object.  Allocation and deallocation can be implemented using
your favorite memory management scheme.

Let's call this wrapper type a "handle."  Here's an example of how to
declare a handle type:

generic
   type Item_Type is limited private;
package Handles is

   type Handle_Type is private;

   function New_Item return Handle_Type;

   function Get_Item
     (Handle : Handle_Type) return Item_Type;

   type Item_Access is access all Item_Type;

   function Set_Item
     (Handle : Handle_Type) return Item_Access;
...
end Handles;


You use a handle object by calling the constructor New_Item (analogous
to calling allocator new), and then using Set_Item to return the
object:

package File_Handles is new Handles (File_Type);
...

  Handle : Handle_Type := New_Item;

  declare
    File : File_Type renames Set_Item (Handle).all;
  begin
    Open (File, In_File, "myfile.dat");


The handle abstraction is implemented using the technique I showed in my
post about collections of limited items, which featured a stack with
operations like this:

  function Get_Top (Stack : Stack_Type) return Item_Type;

  function Set_Top (Stack : Stack_Type) return Item_Access;

The handle operations do the same thing: Get_Item returns the value of
the object, and Set_Item returns a reference to the actual object.  (You
need Set_Item so that you can use the object as an actual parameter to
an operation that modifies the object.)

Ideally we want to minimize the syntactic overhead associated with
handle objects, because we're trying to mimic the syntax of access type
manipulation.

Get_Top and Set_Top made sense for stacks, because you want to advertise
which object is being selected or modified.  But for a handle, Get_Item
and Set_Item may be overkill (there's only one item), and you may wish
to shorten the names to

   function Get (Handle : Handle_Type) return Item_Type;

   function Set (Handle : Handle_Type) return Item_Access;

You may wish to use different names, to emphasize that Get returns a
value, and Set returns an object:

   function Val (Handle : Handle_Type) return Item_Type;

   function Ref (Handle : Handle_Type) return Item_Access;

Invoking a modifier like this:

     File : Handle_Type;
   begin
     ...
     Close (Ref (File).all);

isn't too much pain.

The full view of Handle_Type is implemented by extending Controlled with
an access object, that designates a node containing the item and a
reference count:

   type Node_Type;
   type Node_Access is access Node_Type;

   type Node_Type is
      limited record
         Item  : aliased Item_Type;
         Count : Natural;
         Next  : Node_Access;
      end record;

   type Handle_Type is
     new Ada.Finalization.Controlled with record
        Node : Node_Access;
     end record;

(The Next component of Node_Type is there for storage management only.)

If this implementation looks eerily like the implementation of our
reference-counted list, that's because it's basically the same.  A
handle object is like a list constrained to hold no more than one item.

As in our list example, Controlled operations Adjust and Finalize are
overridden to increment and decrement the reference count.  When the
count goes to zero, then Finalize also inserts the node at the front of
a free list.

What I did was to re-write the interpreter pattern to use Exp_Handles
everywhere instead of access types.  To give you an appreciation of how
things really do get simplified by this approach, let's compare some
before and after examples.

Replacing a Y expression everywhere with a not Z expression used to look
like this:

   declare
      Replacement : Boolean_Expression_Access :=
        New_Not (New_Var ('Z'));

      Rep_Exp : constant Boolean_Expression_Access :=
        Replace (Exp, 'Y', Replacement);
   begin
      Free (Exp);
      Free (Replacement);

      Exp := Rep_Exp;
   end;

The version implemented using handles looks like this:

   declare
      Replacement : constant Exp_Handle :=
        New_Not (New_Var ('Z'));
   begin
      Exp := Replace (+Exp, 'Y', Replacement);
   end;


Copying an and expression was a real pain, because you catch storage
error exceptions to prevent memory leaks:

   function Copy
     (Exp : access And_Expression)
      return Boolean_Expression_Access is

      L : Boolean_Expression_Access := Copy (Exp.L);
      R : Boolean_Expression_Access;
   begin
      begin
         R := Copy (Exp.R);
      exception
         when Storage_Error =>
            Free (L);
            raise;
      end;

      begin
         return New_And (L, R);
      exception
         when Storage_Error =>
            Free (L);
            Free (R);
            raise;
      end;
   end Copy;


We don't have to worry about that with the new version, because
reclaimation is handled for us automatically:

   function Copy
     (Exp : And_Exp) return Exp_Handle is
   begin
      return New_And (Copy (+Exp.L), Copy (+Exp.R));
   end;


You may have noticed the "+" operator applied to handle objects.  That's
actually an invokation of the selector that returns the value of the
handle (earlier called Get_Item, Get, and Val):

   type Exp_Handle is private;

   function "+" (Handle : Exp_Handle) return Bool_Exp'Class;

We're lucky in the interpreter example, because Eval, Copy, and Replace
are written as applicative functions that operate on and return values.
Therefore a client doesn't ever need expression objects.  We can convert
a handle to a value by using the identity operator "+", which has just
the low syntactic overhead we're looking for.

For example, the old version of Replace for variable expressions looked
like this:

      if Var.Name = Name then
         return Copy (Exp);
      else
         return Copy (Var);
      end if;

The new version looks like this:

      if Var.Name = Name then
         return Copy (+Exp);
      else
         return Copy (Var);
      end if;

There's not much difference -- just the addition of that little "+".

This is just what we want.  We get all the benefits of smart pointers,
with only a small amount of additional syntax.

Matt


The code below is in a format suitable for use with gnatchop.

--STX
with Bool_Exps.Storage;

package body Bool_Exps.And_Exps is

   package And_Exp_Storage is
     new Storage.Generic_Exp (And_Exp);


   function Eval
     (Exp     : And_Exp;
      Context : Exp_Context) return Boolean is

--      L : constant Boolean := Eval (+Exp.L, Context);
--      R : constant Boolean := Eval (+Exp.R, Context);
   begin
      return Eval (+Exp.L, Context) and Eval (+Exp.R, Context);
   end Eval;


   function New_And
     (L, R : Exp_Handle)
      return Exp_Handle is

      use And_Exp_Storage;

      Handle : constant Exp_Handle := New_Exp;

      Exp : And_Exp renames Set_Exp (Handle).all;
   begin
      Exp.L := L;
      Exp.R := R;

      return Handle;
   end New_And;


   function Copy
     (Exp : And_Exp)
      return Exp_Handle is

--      L : constant Exp_Handle := Copy (+Exp.L);
--      R : constant Exp_Handle := Copy (+Exp.R);
   begin
      return New_And (Copy (+Exp.L), Copy (+Exp.R));
   end;


   function Replace
     (Var  : And_Exp;
      Name : Var_Name;
      Exp  : Exp_Handle)
      return Exp_Handle is

--       L : constant Exp_Handle :=
--         Replace (+Var.L, Name, Exp);

--       R : constant Exp_Handle :=
--         Replace (+Var.R, Name, Exp);
   begin
      return New_And (Replace (+Var.L, Name, Exp),
                      Replace (+Var.R, Name, Exp));
   end;


   function Image (Exp : And_Exp) return String is
   begin
      return
        '(' &
        Image (+Exp.L) &
        " and " &
        Image (+Exp.R) &
        ')';
   end;


   procedure Finalize (Exp : access And_Exp) is
   begin
      Exp.L := Null_Handle;
      Exp.R := Null_Handle;
   end Finalize;


   procedure Do_Free (Exp : access And_Exp)
     renames And_Exp_Storage.Do_Free;

end Bool_Exps.And_Exps;
package Bool_Exps.And_Exps is

   pragma Preelaborate;


   type And_Exp is new Bool_Exp with private;


   function Eval
     (Exp     : And_Exp;
      Context : Exp_Context) return Boolean;

   function New_And
     (L, R : Exp_Handle)
      return Exp_Handle;

   function Copy
     (Exp : And_Exp)
      return Exp_Handle;

   function Replace
     (Var  : And_Exp;
      Name : Var_Name;
      Exp  : Exp_Handle)
      return Exp_Handle;

   function Image
     (Exp : And_Exp) return String;

private

   type And_Exp is
     new Bool_Exp with record
        L, R : Exp_Handle;
     end record;

   procedure Finalize (Exp : access And_Exp);

   procedure Do_Free (Exp : access And_Exp);

end Bool_Exps.And_Exps;

package body Bool_Exps.Const_Exps is

   type Const_Exp_Array is
      array (Boolean) of aliased Const_Exp;

   Const_Exps : Const_Exp_Array;



   function Eval
     (Exp     : Const_Exp;
      Context : Exp_Context) return Boolean is
   begin
      return Exp.Value;
   end;


   function New_Const
     (Value : Boolean) return Exp_Handle is
   begin
      Const_Exps (Value).Count := Const_Exps (Value).Count + 1;
      return (Controlled with Exp => Const_Exps (Value)'Access);
   end;


   function Copy
     (Exp : Const_Exp) return Exp_Handle is
   begin
      return New_Const (Exp.Value);
   end;


   function Replace
     (Var  : Const_Exp;
      Name : Var_Name;
      Exp  : Exp_Handle) return Exp_Handle is
   begin
      return Copy (Var);
   end;


   function Image
     (Exp : Const_Exp) return String is
   begin
      return Boolean'Image (Exp.Value);
   end;


begin

   for Value in Const_Exps'Range loop
      Const_Exps (Value).Value := Value;
      Const_Exps (Value).Count := 0;
   end loop;

end Bool_Exps.Const_Exps;
package Bool_Exps.Const_Exps is

   pragma Elaborate_Body;


   type Const_Exp is
     new Bool_Exp with private;


   function Eval
     (Exp     : Const_Exp;
      Context : Exp_Context)
      return Boolean;

   function New_Const
     (Value : Boolean)
      return Exp_Handle;

   function Copy
     (Exp : Const_Exp)
      return Exp_Handle;

   function Replace
     (Var  : Const_Exp;
      Name : Var_Name;
      Exp  : Exp_Handle)
      return Exp_Handle;

   function Image
     (Exp : Const_Exp)
      return String;

private

   type Const_Exp is
     new Bool_Exp with record
        Value : Boolean;
     end record;

end Bool_Exps.Const_Exps;
with Bool_Exps.Storage;

package body Bool_Exps.Not_Exps is

   package Not_Exp_Storage is
     new Storage.Generic_Exp (Not_Exp);


   function Eval
     (Exp     : Not_Exp;
      Context : Exp_Context) return Boolean is
   begin
      return not Eval (+Exp.R, Context);
   end;


   function New_Not
     (R : Exp_Handle) return Exp_Handle is

      use Not_Exp_Storage;

      Handle : constant Exp_Handle := New_Exp;

      Exp : Not_Exp renames Set_Exp (Handle).all;
   begin
      Exp.R := R;
      return Handle;
   end;


   function Copy
     (Exp : Not_Exp) return Exp_Handle is
   begin
      return New_Not (Copy (+Exp.R));
   end;


   function Replace
     (Var  : Not_Exp;
      Name : Var_Name;
      Exp  : Exp_Handle) return Exp_Handle is
   begin
      return New_Not (Replace (+Var.R, Name, Exp));
   end;


   function Image (Exp : Not_Exp) return String is
   begin
      return "not " & Image (+Exp.R);
   end;


   procedure Finalize (Exp : access Not_Exp) is
   begin
      Exp.R := Null_Handle;
   end Finalize;


   procedure Do_Free (Exp : access Not_Exp)
     renames Not_Exp_Storage.Do_Free;

end Bool_Exps.Not_Exps;
package Bool_Exps.Not_Exps is

   pragma Preelaborate;


   type Not_Exp is new Bool_Exp with private;


   function Eval
     (Exp     : Not_Exp;
      Context : Exp_Context) return Boolean;

   function New_Not
     (R : Exp_Handle) return Exp_Handle;

   function Copy
     (Exp : Not_Exp) return Exp_Handle;

   function Replace
     (Var  : Not_Exp;
      Name : Var_Name;
      Exp  : Exp_Handle) return Exp_Handle;

   function Image (Exp : Not_Exp) return String;

private

   type Not_Exp is
     new Bool_Exp with record
        R : Exp_Handle;
     end record;

   procedure Finalize (Exp : access Not_Exp);

   procedure Do_Free (Exp : access Not_Exp);

end Bool_Exps.Not_Exps;

with Bool_Exps.Storage;

package body Bool_Exps.Or_Exps is

   package Or_Exp_Storage is
     new Storage.Generic_Exp (Or_Exp);


   function Eval
     (Exp     : Or_Exp;
      Context : Exp_Context)
      return Boolean is

--       L : constant Boolean := Eval (+Exp.L, Context);
--       R : constant Boolean := Eval (+Exp.R, Context);
   begin
      return Eval (+Exp.L, Context) or Eval (+Exp.R, Context);
   end Eval;


   function New_Or
     (L, R : Exp_Handle)
      return Exp_Handle is

      use Or_Exp_Storage;

      Handle : constant Exp_Handle := New_Exp;

      Exp : Or_Exp renames Set_Exp (Handle).all;
   begin
      Exp.L := L;
      Exp.R := R;

      return Handle;
   end New_Or;


   function Copy
     (Exp : Or_Exp)
      return Exp_Handle is

--       L : constant Exp_Handle := Copy (+Exp.L);
--       R : constant Exp_Handle := Copy (+Exp.R);
   begin
      return New_Or (Copy (+Exp.L), Copy (+Exp.R));
   end;


   function Replace
     (Var  : Or_Exp;
      Name : Var_Name;
      Exp  : Exp_Handle)
      return Exp_Handle is

--       L : constant Exp_Handle := Replace (+Var.L, Name, Exp);
--       R : constant Exp_Handle := Replace (+Var.R, Name, Exp);
   begin
      return New_Or (Replace (+Var.L, Name, Exp),
                     Replace (+Var.R, Name, Exp));
   end;


   function Image
     (Exp : Or_Exp)
      return String is
   begin
      return
        '(' &
        Image (+Exp.L) &
        " or " &
        Image (+Exp.R) &
        ')';
   end;


   procedure Finalize
     (Exp : access Or_Exp) is
   begin
      Exp.L := Null_Handle;
      Exp.R := Null_Handle;
   end Finalize;


   procedure Do_Free
     (Exp : access Or_Exp) renames
     Or_Exp_Storage.Do_Free;

end Bool_Exps.Or_Exps;
package Bool_Exps.Or_Exps is

   pragma Preelaborate;


   type Or_Exp is
     new Bool_Exp with private;


   function Eval
     (Exp     : Or_Exp;
      Context : Exp_Context)
      return Boolean;

   function New_Or
     (L, R : Exp_Handle)
      return Exp_Handle;

   function Copy
     (Exp : Or_Exp)
     return Exp_Handle;

   function Replace
     (Var  : Or_Exp;
      Name : Var_Name;
      Exp  : Exp_Handle)
     return Exp_Handle;

   function Image
     (Exp : Or_Exp)
      return String;

private

   type Or_Exp is
     new Bool_Exp with record
        L, R : Exp_Handle;
     end record;

   procedure Finalize
     (Exp : access Or_Exp);

   procedure Do_Free
     (Exp : access Or_Exp);

end Bool_Exps.Or_Exps;

package body Bool_Exps.Storage is

   package body Generic_Exp is

      Free_List : Bool_Exp_Access;


      function New_Exp return Exp_Handle is

         Exp : Bool_Exp_Access;

      begin

         if Free_List = null then

            Exp := Bool_Exp_Access'(new Exp_Type);

         else

            Exp := Free_List;

            Free_List := Free_List.Next;
            Exp.Next := null;

         end if;

         Exp.Count := 1;

         return Exp_Handle'(Controlled with Exp);

      end New_Exp;


      function Set_Exp
        (Handle : Exp_Handle) return Exp_Type_Access is

         pragma Suppress (Tag_Check);
      begin
         return Exp_Type_Access (Handle.Exp);
      end;


      procedure Do_Free (Exp : access Exp_Type) is
      begin

         Finalize (Exp);

         Exp.Next := Free_List;
         Free_List := Bool_Exp_Access (Exp);

      end Do_Free;


   end Generic_Exp;

end Bool_Exps.Storage;
private package Bool_Exps.Storage is

   pragma Preelaborate;

   generic

      type Exp_Type is new Bool_Exp with private;

   package Generic_Exp is

      function New_Exp return Exp_Handle;

      type Exp_Type_Access is access all Exp_Type;

      for Exp_Type_Access'Storage_Size use 0;

      function Set_Exp
        (Handle : Exp_Handle) return Exp_Type_Access;

      procedure Do_Free (Exp : access Exp_Type);

   end Generic_Exp;

end Bool_Exps.Storage;
with Bool_Exps.Storage;

package body Bool_Exps.Var_Exps is

   package Var_Exp_Storage is
     new Storage.Generic_Exp (Var_Exp);


   function Eval
     (Exp     : Var_Exp;
      Context : Exp_Context)
      return Boolean is
   begin
      return Context.Vars (Exp.Name);
   end;


   function New_Var
     (Name : Var_Name)
      return Exp_Handle is

      use Var_Exp_Storage;

      Handle : constant Exp_Handle := New_Exp;

      Exp : Var_Exp renames Set_Exp (Handle).all;
   begin
      Exp.Name := Name;
      return Handle;
   end New_Var;


   function Copy
     (Exp : Var_Exp)
      return Exp_Handle is
   begin
      return New_Var (Exp.Name);
   end Copy;


   function Replace
     (Var  : Var_Exp;
      Name : Var_Name;
      Exp  : Exp_Handle)
      return Exp_Handle is
   begin
      if Var.Name = Name then
         return Copy (+Exp);
      else
         return Copy (Var);
      end if;
   end Replace;


   function Image
     (Exp : Var_Exp)
      return String is
   begin
      return Character'Image (Exp.Name) (2 .. 2);
   end;


   procedure Do_Free
     (Exp : access Var_Exp) renames
     Var_Exp_Storage.Do_Free;


end Bool_Exps.Var_Exps;
package Bool_Exps.Var_Exps is

   pragma Preelaborate;


   type Var_Exp is
     new Bool_Exp with private;

   type Var_Exp_Access is
      access all Var_Exp;

   function Eval
     (Exp     : Var_Exp;
      Context : Exp_Context)
      return Boolean;

   function New_Var
     (Name : Var_Name)
      return Exp_Handle;

   function Copy
     (Exp : Var_Exp)
      return Exp_Handle;

   function Replace
     (Var  : Var_Exp;
      Name : Var_Name;
      Exp  : Exp_Handle)
     return Exp_Handle;

   function Image
     (Exp : Var_Exp)
      return String;

private

   type Var_Exp is
     new Bool_Exp with record
        Name : Var_Name;
     end record;

   procedure Do_Free
     (Exp : access Var_Exp);

end Bool_Exps.Var_Exps;
package body Bool_Exps is

   procedure Finalize
     (Exp : access Bool_Exp) is
   begin
      null;
   end;

   procedure Do_Free
     (Exp : access Bool_Exp) is
   begin
      null;
   end;


   function "+" (Handle : Exp_Handle) return Bool_Exp'Class is
   begin
      pragma Assert (Handle.Exp /= null,
                     "trying to dereference null handle");

      return Handle.Exp.all;
   end;


   procedure Adjust (Handle : in out Exp_Handle) is
   begin
      if Handle.Exp /= null then

         Handle.Exp.Count := Handle.Exp.Count + 1;

      end if;
   end Adjust;


   procedure Finalize (Handle : in out Exp_Handle) is
   begin
      if Handle.Exp /= null then

         pragma Assert (Handle.Exp.Count > 0,
                        "trying to finalize handle with count = 0");

         Handle.Exp.Count := Handle.Exp.Count - 1;

         if Handle.Exp.Count = 0 then
            Do_Free (Handle.Exp);
         end if;

      end if;
   end Finalize;


   procedure Assign
     (Context : in out Exp_Context;
      Name    : in     Var_Name;
      Value   : in     Boolean) is
   begin
      Context.Vars (Name) := Value;
   end;


end Bool_Exps;
with Ada.Finalization;

package Bool_Exps is

   pragma Preelaborate;


   type Bool_Exp (<>) is
     abstract tagged limited private;


   type Exp_Handle is private;

   Null_Handle : constant Exp_Handle;

   function "+"
     (Handle : Exp_Handle) return Bool_Exp'Class;


   type Exp_Context is limited private;

   subtype Var_Name is Character range 'A' .. 'Z';

   procedure Assign
     (Context : in out Exp_Context;
      Name    : in     Var_Name;
      Value   : in     Boolean);


   function Eval
     (Exp     : in Bool_Exp;
      Context : in Exp_Context)
      return Boolean is abstract;

   function Copy
     (Exp : Bool_Exp)
      return Exp_Handle is abstract;

   function Replace
     (Var  : Bool_Exp;
      Name : Var_Name;
      Exp  : Exp_Handle)
     return Exp_Handle is abstract;

   function Image
     (Exp : Bool_Exp)
      return String is abstract;

private

   type Bool_Exp_Access is
      access all Bool_Exp'Class;

   type Bool_Exp is
     abstract tagged limited record
        Next  : Bool_Exp_Access;
        Count : Natural;
     end record;

   procedure Finalize
     (Exp : access Bool_Exp);

   procedure Do_Free
     (Exp : access Bool_Exp);


   type Exp_Handle is
     new Ada.Finalization.Controlled with record
        Exp : Bool_Exp_Access;
     end record;

   procedure Adjust (Handle : in out Exp_Handle);

   procedure Finalize (Handle : in out Exp_Handle);

   use Ada.Finalization;

   Null_Handle : constant Exp_Handle :=
     (Controlled with Exp => null);


   type Var_Name_Value_Map_Base is
      array (Character range <>) of Boolean;

   subtype Var_Name_Value_Map is
     Var_Name_Value_Map_Base (Var_Name);

   type Exp_Context is
      record
         Vars : Var_Name_Value_Map;
      end record;

end Bool_Exps;
package body Handles is

   type Node_Type is
      limited record
         Item  : aliased Item_Type;
         Count : Natural;
         Next  : Node_Access;
      end record;

   Free_List : Node_Access;


   function New_Item return Handle_Type is

      Node : Node_Access;

   begin

      if Free_List = null then

         Node := Node_Access'(new Node_Type);

      else

         Node := Free_List;
         Free_List := Free_List.Next;

         Node.Next := null;

      end if;

      Node.Count := 1;

      return (Controlled with Node);

   end New_Item;


   function Get_Item
     (Handle : Handle_Type) return Item_Type is
   begin
      return Handle.Node.Item;
   end;


   function Set_Item
     (Handle : Handle_Type) return Item_Access is
   begin
      return Handle.Node.Item'Access;
   end;


   procedure Adjust (Handle : in out Handle_Type) is
   begin
      Handle.Node.Count := Handle.Node.Count + 1;
   end Adjust;


   procedure Finalization (Handle : in out Handle_Type) is
   begin

      Handle.Node.Count := Handle.Node.Count - 1;

      if Handle.Node.Count = 0 then

         Handle.Node.Next := Free_List;
         Free_List := Handle.Node;

      end if;

   end Finalization;

end Handles;
with Ada.Finalization;

generic
   type Item_Type is limited private;
package Handles is

   type Handle_Type is private;

   Null_Handle : constant Handle_Type;

   type Item_Access is access all Item_Type;
   for Item_Access'Storage_Size use 0;

   function New_Item return Handle_Type;

   function Get_Item
     (Handle : Handle_Type) return Item_Type;

   function Set_Item
     (Handle : Handle_Type) return Item_Access;

private

   type Node_Type;
   type Node_Access is access Node_Type;

   type Handle_Type is
     new Ada.Finalization.Controlled with record
        Node : Node_Access;
     end record;

   procedure Adjust (Handle : in out Handle_Type);

   procedure Finalization (Handle : in out Handle_Type);

   use Ada.Finalization;

   Null_Handle : constant Handle_Type :=
     (Controlled with Node => null);

end Handles;




with Bool_Exps;            use Bool_Exps;
with Bool_Exps.Const_Exps; use Bool_Exps.Const_Exps;
with Bool_Exps.Var_Exps;   use Bool_Exps.Var_Exps;
with Bool_Exps.And_Exps;   use Bool_Exps.And_Exps;
with Bool_Exps.Or_Exps;    use Bool_Exps.Or_Exps;
with Bool_Exps.Not_Exps;   use Bool_Exps.Not_Exps;

with Ada.Text_IO;          use Ada.Text_IO;

procedure Test_Expression is

   Context : Exp_Context;

   True_Exp : constant Exp_Handle := New_Const (True);

   X_Exp : constant Exp_Handle := New_Var ('X');

   L_And : constant Exp_Handle :=
     New_And (True_Exp, X_Exp);

   Y_Exp : constant Exp_Handle := New_Var ('Y');

   R_And : constant Exp_Handle :=
     New_And (Y_Exp, New_Not (X_Exp));

   Exp : Exp_Handle := New_Or (L_And, R_And);

   package Boolean_IO is
     new Ada.Text_IO.Enumeration_IO (Boolean);

   use Boolean_IO;

begin

   New_Line;
   Put_Line ("Exp: " & Image (+Exp));
   New_Line;
   Put_Line ("  X     Y     Exp");

   for X_Value in Boolean loop

      Assign (Context, 'X', X_Value);

      for Y_Value in Boolean loop

         Assign (Context, 'Y', Y_Value);

         Put (X_Value, Width => 5); Put (" ");
         Put (Y_Value, Width => 5); Put ("  ");
         Put (Eval (+Exp, Context));
         New_Line;

      end loop;

   end loop;

   New_Line (2);

   declare
      Replacement : constant Exp_Handle :=
        New_Not (New_Var ('Z'));
   begin
      Exp := Replace (+Exp, 'Y', Replacement);
   end;

   Put_Line ("Exp: " & Image (+Exp));
   New_Line;
   Put_Line ("  X     Z     Exp");

   for X_Value in Boolean loop

      Assign (Context, 'X', X_Value);

      for Z_Value in Boolean loop

         Assign (Context, 'Z', Z_Value);

         Put (X_Value, Width => 5); Put (" ");
         Put (Z_Value, Width => 5); Put ("  ");
         Put (Eval (+Exp, Context));
         New_Line;

      end loop;

   end loop;

end Test_Expression;