Каков наилучший способ для реализации чего-то похожего на интерфейс с Ada 95? - PullRequest
Новая
       62

Каков наилучший способ для реализации чего-то похожего на интерфейс с Ada 95?

0 голосов
/ 27 июня 2018

Я хочу реализовать что-то похожее на интерфейс с использованием Ada 95 (поэтому типичные интерфейсы OO недоступны). Я сделал это с помощью обобщений и набора «указатель на метод» в записи. Код ниже.

РЕДАКТИРОВАТЬ: Я знаю, что это можно сделать путем передачи подпрограмм в качестве формальных параметров в универсальный пакет, но я хотел бы избежать передачи слишком много параметров в него.

Я думаю, что должен быть гораздо лучший способ реализовать то, что я хочу, поэтому я хотел бы, если я прав, и, если это так, я хотел бы увидеть пример кода.

«Интерфейс» объявлен в универсальном пакете с именем Drivers. Там есть запись, которая должна содержать переменную универсального типа, которая представляет драйвер, и запись, которая содержит его операции:

drivers.ads 

generic 
    type T is private;
    type Error is private;
    NOT_IMPLEMENTED_CODE : Error;

package Drivers is

    type Driver is private;

    -- Need to declare these types because I compile with Ada 95.
    type ToStringPtr is access function(self : in T) return String;
    type ReadLinePtr is access procedure(self : in T; buffer : out String; err : out Error);

    type DriverOps is
    record
        to_string_op : ToStringPtr := null;
        read_line_op : ReadLinePtr := null;
    end record;

    function create_driver(underlying : T; ops : DriverOps) return Driver;

    function to_string(self : in Driver) return String;

    procedure read_line(self : in Driver; buffer : out String; err : out Error);


    private
        type Driver is
        record
            underlying : T;
            ops : DriverOps;
        end record;

end Drivers;

drivers.adb 

package body Drivers is

    function create_driver(underlying : T; ops : DriverOps) return Driver is
    begin
        return (underlying, ops);
    end create_driver;

    function to_string(self : in Driver) return String is
    begin
        if self.ops.to_string_op /= null then
            return self.ops.to_string_op(self.underlying);
        else
            return "";
        end if;
    end to_string;

    procedure read_line(self : in Driver; buffer : out String; err : out Error) is
    begin
        if self.ops.read_line_op /= null then
            self.ops.read_line_op(self.underlying, buffer, err);
        else
            err := NOT_IMPLEMENTED_CODE;
        end if;
    end read_line;

end Drivers;

main.adb 

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Strings.Fixed; 

with Drivers;

procedure main is

    type Error is (SUCCESS, NOT_IMPLEMENTED, UNKNOWN);

    type MyInt is new Integer;

    function to_string(self : in MyInt) return String is
    begin
        return Integer'Image( Integer(self) ); --'
    end to_string;

    procedure read_line(self : in MyInt; buffer : out String; err : out Error) is
    begin
        Ada.Strings.Fixed.Move(
            Target => buffer,
            Source => "Lets suppose we have read this from a device" & ASCII.LF,
            Pad => ASCII.NUL); 
        err := SUCCESS;
    end read_line;


    package IntDrivers is new Drivers(MyInt, Error, NOT_IMPLEMENTED);
    use IntDrivers;


    underlying : MyInt := 25;

    int_driver_ops : DriverOps := (
        to_string_op => to_string'access, --'
        read_line_op => read_line'access  --'
    );

    my_driver : Driver := create_driver(underlying, int_driver_ops);
    buffer : String(1..256) := (others => Character'Val(0)); --'
    err : Error := SUCCESS;
begin
    Put_Line(to_string(my_driver));

    read_line(my_driver, buffer, err);
    Put(buffer);
    Put_Line(Error'Image(err)); --'
end main;

Ответы [ 2 ]

0 голосов
/ 28 июня 2018

Интерфейс - это abstract tagged null record в Аде 95: 

package Abstract_Driver is

   type Instance is abstract tagged null record;
   subtype Class is Instance'Class; --' (defect syntax highlighter)

   function Image (Item : in Instance) return String is abstract;

   procedure Read_Line (Item   : in out Instance;
                        Buffer :    out String) is abstract;

end Abstract_Driver;

with Abstract_Driver;

package Text_IO_Driver is

   subtype Parent is Abstract_Driver.Instance;
   type Instance is new Parent with private;
   subtype Class is Instance'Class; --' (defect syntax highlighter)

   function Image (Item : in Instance) return String;

   Buffer_Too_Small : exception;

   procedure Read_Line (Item   : in out Instance;
                        Buffer :    out String);

private

   type Instance is new Parent with null record;

end Text_IO_Driver;

with Ada.Text_IO;

package body Text_IO_Driver is

   function Image (Item : in Instance) return String is
   begin
      return "Ada.Text_IO.Standard_Input";
   end Image;

   procedure Read_Line (Item   : in out Instance;
                        Buffer :    out String) is
      Last : Natural;
   begin
      Buffer := (Buffer'Range => ' '); --' (defect syntax highlighter)
      Ada.Text_IO.Get_Line (Item => Buffer,
                            Last => Last);
      if Last = Buffer'Last then --' (defect syntax highlighter)
         raise Buffer_Too_Small;
      end if;
   end Read_Line;

end Text_IO_Driver;
0 голосов
/ 27 июня 2018

Единственный известный мне вариант описан ниже и не может быть каноническим . Это не строго наследование интерфейса, но оно может направить вас в правильном направлении. Требуется использовать запись с тегом дискриминанта.

Хитрость заключается в том, чтобы определить 2 маркированных типа. Одним из них является ваше классическое определение класса, другое используется как наследование «интерфейса».

Затем вы можете манипулировать объектом, который предоставляет доступ к контракту интерфейса и контракту класса, используя дискриминанты. Объявление обоих в одном и том же пакете должно обеспечить вам полную видимость над частными частями, что будет подтверждено.

Короче говоря: 

type InterfaceX is abstract ....; -- abstract class and services

type ClassA is tagged ...; -- or is new ....
type Trick (component : ClassA) is new InterfaceX ...; -- this type gives you access to classA and interfaceX primitives

Объект Trick реализует ваш контракт InterfaceX.

Вам необходимо определить экземпляры / средства доступа к объекту ClassA или объекту Trick. Я думаю, что типы также должны быть ограничены.

Я всегда слышу, как люди называют этот «трюк Розена», думаю, его назвали в честь Ж.-П. Розен.

Может быть, вы найдете более точные ответы здесь http://www.adaic.org/resources/add_content/standards/95rat/rat95html/rat95-p2-4.html#6

...