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;
|
