Visitor pattern: Difference between revisions
Ada implementation with tagged types
m (→{{header|Wren}}: Changed to Wren S/H) |
(Ada implementation with tagged types) |
||
Line 35:
<br>
=={{header|Ada}}==
An Ada implementation of the Wikipedia Java example.
===Method 1: via Tagged Types (the object-oriented approach)===
Perhaps more packages than needed (7), which makes for quite a few files (specification + implementation). Only the `Visitors` files are long; the rest are much shorter.
<syntaxhighlight lang="ada">pragma Ada_2022;
package Base is
type Base_Record is abstract tagged null record;
end Base;
</syntaxhighlight>
<syntaxhighlight lang="ada">pragma Ada_2022;
limited with Base;
limited with Bodies;
limited with Cars;
limited with Engines;
limited with Wheels;
package Visitors is
type Visitor is abstract tagged null record;
procedure Visit_Base
(Self : Visitor; Dest : Base.Base_Record'Class) is null;
procedure Visit_Body (Self : Visitor; Dest : Bodies.Body_Record'Class);
procedure Visit_Car (Self : Visitor; Dest : Cars.Car_Record'Class);
procedure Visit_Engine (Self : Visitor; Dest : Engines.Engine_Record'Class);
procedure Visit_Wheel (Self : Visitor; Dest : Wheels.Wheel_Record'Class);
type Perform is new Visitor with null record;
type Print is new Visitor with null record;
overriding procedure Visit_Body
(Self : Perform; Dest : Bodies.Body_Record'Class);
overriding procedure Visit_Body
(Self : Print; Dest : Bodies.Body_Record'Class);
overriding procedure Visit_Car
(Self : Perform; Dest : Cars.Car_Record'Class);
overriding procedure Visit_Car (Self : Print; Dest : Cars.Car_Record'Class);
overriding procedure Visit_Engine
(Self : Perform; Dest : Engines.Engine_Record'Class);
overriding procedure Visit_Engine
(Self : Print; Dest : Engines.Engine_Record'Class);
overriding procedure Visit_Wheel
(Self : Perform; Dest : Wheels.Wheel_Record'Class);
overriding procedure Visit_Wheel
(Self : Print; Dest : Wheels.Wheel_Record'Class);
end Visitors;
</syntaxhighlight>
<syntaxhighlight lang="ada">pragma Ada_2022;
with Ada.Text_IO;
with Ada.Strings.Unbounded;
use all type Ada.Strings.Unbounded.Unbounded_String;
with Wheels;
package body Visitors is
package IO renames Ada.Text_IO;
procedure Visit_Body (Self : Visitor; Dest : Bodies.Body_Record'Class) is
begin
Self.Visit_Body (Dest);
end Visit_Body;
overriding procedure Visit_Body
(Self : Perform; Dest : Bodies.Body_Record'Class)
is
begin
IO.Put_Line ("Moving my Body");
end Visit_Body;
overriding procedure Visit_Body
(Self : Print; Dest : Bodies.Body_Record'Class)
is
begin
IO.Put_Line ("Visiting Body");
end Visit_Body;
procedure Visit_Car (Self : Visitor; Dest : Cars.Car_Record'Class) is
begin
Self.Visit_Car (Dest);
end Visit_Car;
overriding procedure Visit_Car
(Self : Perform; Dest : Cars.Car_Record'Class)
is
begin
IO.Put_Line ("Starting my car");
end Visit_Car;
overriding procedure Visit_Car (Self : Print; Dest : Cars.Car_Record'Class)
is
begin
IO.Put_Line ("Visiting Car");
end Visit_Car;
procedure Visit_Engine (Self : Visitor; Dest : Engines.Engine_Record'Class)
is
begin
Self.Visit_Engine (Dest);
end Visit_Engine;
overriding procedure Visit_Engine
(Self : Perform; Dest : Engines.Engine_Record'Class)
is
begin
IO.Put_Line ("Revving my Engine");
end Visit_Engine;
overriding procedure Visit_Engine
(Self : Print; Dest : Engines.Engine_Record'Class)
is
begin
IO.Put_Line ("Visiting Engine");
end Visit_Engine;
procedure Visit_Wheel (Self : Visitor; Dest : Wheels.Wheel_Record'Class) is
begin
Self.Visit_Wheel (Dest);
end Visit_Wheel;
overriding procedure Visit_Wheel
(Self : Perform; Dest : Wheels.Wheel_Record'Class)
is
begin
IO.Put_Line ("Rolling my " & To_String (Dest.Name) & " wheel");
end Visit_Wheel;
overriding procedure Visit_Wheel
(Self : Print; Dest : Wheels.Wheel_Record'Class)
is
begin
IO.Put_Line ("Visiting " & To_String (Dest.Name) & " wheel");
end Visit_Wheel;
end Visitors;
</syntaxhighlight>
<syntaxhighlight lang="ada">pragma Ada_2022;
with Base;
limited with Visitors;
package Bodies is
type Body_Record is new Base.Base_Record with private;
procedure Visit (Self : Body_Record; Visitor : Visitors.Visitor'Class);
private
type Body_Record is new Base.Base_Record with null record;
end Bodies;
</syntaxhighlight>
<syntaxhighlight lang="ada">pragma Ada_2022;
with Visitors;
package body Bodies is
procedure Visit (Self : Body_Record; Visitor : Visitors.Visitor'Class) is
begin
Visitor.Visit_Body (Self);
end Visit;
end Bodies;
</syntaxhighlight>
<syntaxhighlight lang="ada">pragma Ada_2022;
with Base;
with Bodies;
with Engines;
with Wheels;
limited with Visitors;
package Cars is
type Car_Record is new Base.Base_Record with private;
procedure Visit (Self : Car_Record; Visitor : Visitors.Visitor'Class);
function Initialize return Car_Record;
private
type Wheel_Array is array (1 .. 4) of Wheels.Wheel_Record;
type Car_Record is new Base.Base_Record with record
Bod : Bodies.Body_Record;
Eng : Engines.Engine_Record;
Whs : Wheel_Array;
end record;
end Cars;
</syntaxhighlight>
<syntaxhighlight lang="ada">pragma Ada_2022;
with Ada.Strings.Unbounded;
with Visitors;
package body Cars is
subtype Unbounded_String is Ada.Strings.Unbounded.Unbounded_String;
use all type Unbounded_String;
procedure Visit (Self : Car_Record; Visitor : Visitors.Visitor'Class) is
begin
Visitor.Visit_Car (Self);
Visitor.Visit_Body (Self.Bod);
Visitor.Visit_Engine (Self.Eng);
for Wheel of Self.Whs loop
Visitor.Visit_Wheel (Wheel);
end loop;
end Visit;
function Initialize return Car_Record is
Result : Car_Record;
begin
Result.Whs :=
[Wheels.Initialize (To_Unbounded_String ("front left")),
Wheels.Initialize (To_Unbounded_String ("front right")),
Wheels.Initialize (To_Unbounded_String ("back left")),
Wheels.Initialize (To_Unbounded_String ("back right"))];
return Result;
end Initialize;
end Cars;
</syntaxhighlight>
<syntaxhighlight lang="ada">pragma Ada_2022;
with Base;
limited with Visitors;
package Engines is
type Engine_Record is new Base.Base_Record with private;
procedure Visit (Self : Engine_Record; Visitor : Visitors.Visitor'Class);
private
type Engine_Record is new Base.Base_Record with null record;
end Engines;
</syntaxhighlight>
<syntaxhighlight lang="ada">pragma Ada_2022;
with Visitors;
package body Engines is
procedure Visit (Self : Engine_Record; Visitor : Visitors.Visitor'Class) is
begin
Visitor.Visit_Engine (Self);
end Visit;
end Engines;
</syntaxhighlight>
<syntaxhighlight lang="ada">pragma Ada_2022;
with Ada.Strings.Unbounded;
with Base;
limited with Visitors;
package Wheels is
subtype Unbounded_String is Ada.Strings.Unbounded.Unbounded_String;
use all type Unbounded_String;
type Wheel_Record is new Base.Base_Record with private;
procedure Visit (Self : Wheel_Record; Visitor : Visitors.Visitor'Class);
function Initialize (Name : Unbounded_String) return Wheel_Record;
function Name (Me : Wheel_Record) return Unbounded_String;
private
type Wheel_Record is new Base.Base_Record with record
My_Name : Unbounded_String;
end record;
end Wheels;
</syntaxhighlight>
<syntaxhighlight lang="ada">pragma Ada_2022;
with Visitors;
package body Wheels is
procedure Visit (Self : Wheel_Record; Visitor : Visitors.Visitor'Class) is
begin
Visitor.Visit_Wheel (Self);
end Visit;
function Initialize (Name : Unbounded_String) return Wheel_Record is
(My_Name => Name);
function Name (Me : Wheel_Record) return Unbounded_String is (Me.My_Name);
end Wheels;
</syntaxhighlight>
<syntaxhighlight lang="ada">pragma Ada_2022;
with Cars;
with Visitors;
procedure Visitor_Pattern is
Car : Cars.Car_Record := Cars.Initialize;
Performer : aliased Visitors.Perform;
Printer : aliased Visitors.Print;
begin
Car.Visit (Performer);
Car.Visit (Printer);
end Visitor_Pattern;
</syntaxhighlight>
===Method 2: Discriminated Types===
=={{header|Julia}}==
<syntaxhighlight lang="julia">abstract type CarElementVisitor end
|