From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.5-pre1 (2020-06-20) on ip-172-31-74-118.ec2.internal X-Spam-Level: X-Spam-Status: No, score=-0.9 required=3.0 tests=BAYES_00,FORGED_GMAIL_RCVD, FREEMAIL_FROM,T_FILL_THIS_FORM_SHORT autolearn=no autolearn_force=no version=3.4.5-pre1 X-Received: by 2002:aed:398a:: with SMTP id m10mr17979117qte.143.1600379272281; Thu, 17 Sep 2020 14:47:52 -0700 (PDT) X-Received: by 2002:ac8:319d:: with SMTP id h29mr28617061qte.32.1600379272087; Thu, 17 Sep 2020 14:47:52 -0700 (PDT) Path: eternal-september.org!reader02.eternal-september.org!feeder.eternal-september.org!aioe.org!peer03.ams4!peer.am4.highwinds-media.com!peer03.iad!feed-me.highwinds-media.com!news.highwinds-media.com!news-out.google.com!nntp.google.com!postnews.google.com!google-groups.googlegroups.com!not-for-mail Newsgroups: comp.lang.ada Date: Thu, 17 Sep 2020 14:47:51 -0700 (PDT) In-Reply-To: Complaints-To: groups-abuse@google.com Injection-Info: google-groups.googlegroups.com; posting-host=146.5.17.100; posting-account=lJ3JNwoAAAAQfH3VV9vttJLkThaxtTfC NNTP-Posting-Host: 146.5.17.100 References: User-Agent: G2/1.0 MIME-Version: 1.0 Message-ID: Subject: Re: Visibility issue From: Shark8 Injection-Date: Thu, 17 Sep 2020 21:47:52 +0000 Content-Type: text/plain; charset="UTF-8" X-Received-Bytes: 7094 X-Received-Body-CRC: 2368952796 Xref: reader02.eternal-september.org comp.lang.ada:60187 List-Id: On Friday, September 11, 2020 at 4:37:29 AM UTC-6, Daniel wrote: > Hello, > I want to use a tagged type as a link to communicate users of a library, in the way to make one part visible to them and also to hide some content that is only needed for the implementing of the library. Here's how that's normally achieved; I've compiled the following but haven't written a testbed/driver: -- Daniel.ads Package Daniel with Pure is -- Base Interface which all API objects implement. Type Abstract_Base is interface; -- All common methods. Function As_String(Object : Abstract_Base) return String is abstract; -- All Classwide methods. Function Print( Object : Abstract_Base'Class ) return String; -- The Callback type. Type Callback is access procedure(Item : in out Abstract_Base'Class); Private -- The classwide "Print" returns the given object's As_String result. Function Print( Object : Abstract_Base'Class ) return String is (Object.As_String); End Daniel; ----------------------------------------------- -- Daniel-Implementation.ads With Ada.Finalization, Ada.Strings.Equal_Case_Insensitive, Ada.Strings.Less_Case_Insensitive, Ada.Containers.Indefinite_Ordered_Maps; Private Package Daniel.Implementation with Preelaborate is -- Fwd decl. Type Implementation_Base(Name_Length : Positive) is tagged private; -- Implementation_Base and its descendents have a Name, that is within the -- private-portion of the implementation and therefore we need an accessor. -- Note: Name is unique and case-insensitive. Function Get_Name(Object: Implementation_Base'Class) Return String; -- Given a name, this retrieves the object; raises constraint-error if that -- name is not associated with an object. Function Make (Name : String) return Implementation_Base'Class; Function Create(Name : String) return Implementation_Base; Function "="(Left, Right : Implementation_Base) return Boolean; Private -- Full decl. Note, also, that this is hidden from the API package. Type Implementation_Base(Name_Length : Positive) is new Ada.Finalization.Controlled with record Name : String(1..Name_Length); End record; -- Finalization; this will remove the registered Name from the object-map. overriding procedure Finalize (Object : in out Implementation_Base); -- Instantiate the package mapping Names to Objects. Package Name_Map is new Ada.Containers.Indefinite_Ordered_Maps( Key_Type => String, Element_Type => Implementation_Base'Class, "<" => Ada.Strings.Less_Case_Insensitive, "=" => "=" ); -- This is the map that associates objects and their names. Core_Map : Name_Map.Map; End Daniel.Implementation; ------------------------------------------------ -- Daniel-API.ads Private With Daniel.Implementation; Private Package Daniel.API with Preelaborate is -- The base API-visable type. Type API_Base(<>) is new Abstract_Base with private; -- Creation functions. Function Create(Name : String) return API_Base; Function Create(Name : String; Op : Callback) return API_Base; -- Interface functions. Function As_String (Object : API_Base) return String; Procedure Execute (Object : in out API_Base); Private -- We derive from implementation's base, and add a discriminant for the -- callback and another fata-field. Type API_Base( CBK : Callback; Length : Positive ) is new Daniel.Implementation.Implementation_Base( Name_Length => Length ) and Abstract_Base with record A_1 : Character := 'C'; end record; -- We raise an exception when there is no callback given. Function Create(Name : String) return API_Base is (raise Program_Error with "Callback MUST be specified."); -- Finally, we construct an object from a call to implementation's create -- and fill-in the missing information using an "extension aggrigate". Function Create(Name : String; Op : Callback) return API_Base is (Implementation.Create(Name) with CBK => Op, Length => Name'Length, others => <>); End Daniel.API; ------------------------------------------------------------------------------ -- Daniel-Implementation.adb with Ada.Exceptions, Ada.Finalization; use Ada.Finalization; Package Body Daniel.Implementation is Function "=" (Left, Right : String) return Boolean renames Ada.Strings.Equal_Case_Insensitive; Function Get_Name(Object: Implementation_Base'Class) Return String is (Object.Name); Function Make(Name : String) return Implementation_Base'Class is Begin Return Core_Map(Name); Exception when PE : Program_Error => raise Constraint_Error with Ada.Exceptions.Exception_Message(PE); End Make; Function "="(Left, Right : Implementation_Base) return boolean is (Left.Name = Right.Name); Function Create(Name : String) return Implementation_Base is begin Return Result : Constant Implementation_Base := (Controlled with Name_Length => Name'Length, Name => Name) do Core_Map.Include(New_Item => Result, Key => Name); end return; end Create; Procedure Finalize(Object : in out Implementation_Base) is Begin Core_Map.Delete( Object.Name ); End Finalize; End Daniel.Implementation; ------------------------------------------------------ -- Daniel-API.adb Package Body Daniel.API is Procedure Execute (Object : in out API_Base) is Begin Object.CBK.All(Object); End Execute; Function As_String (Object : in API_Base) return String is Begin Return '(' & Object.Get_Name & ", " & Object.A_1 & ')'; End As_String; End Daniel.API;