From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham autolearn_force=no version=3.4.4 X-Google-Language: ENGLISH,UTF8 Path: g2news2.google.com!news1.google.com!goblin1!goblin2!goblin.stu.neva.ru!feeder2.cambriumusenet.nl!feeder3.cambriumusenet.nl!feed.tweaknews.nl!193.141.40.65.MISMATCH!npeer.de.kpn-eurorings.net!npeer-ng0.de.kpn-eurorings.net!newsfeed.arcor.de!newsspool2.arcor-online.net!news.arcor.de.POSTED!not-for-mail Date: Thu, 29 Oct 2009 21:45:02 +0100 From: Georg Bauhaus User-Agent: Thunderbird 2.0.0.23 (Macintosh/20090812) MIME-Version: 1.0 Newsgroups: comp.lang.ada Subject: Re: Tagged type more type safe than access to subprogram ? References: <336a4300-9867-4caf-a8c2-4e75e262e694@l13g2000yqb.googlegroups.com> <1hw5s0lijncfx$.ts4hox0vmab3.dlg@40tude.net> In-Reply-To: <1hw5s0lijncfx$.ts4hox0vmab3.dlg@40tude.net> Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Message-ID: <4ae9fece$0$6590$9b4e6d93@newsspool3.arcor-online.net> Organization: Arcor NNTP-Posting-Date: 29 Oct 2009 21:45:02 CET NNTP-Posting-Host: aafbd911.newsspool3.arcor-online.net X-Trace: DXC=C:R\ZDFYa;\5TOT9_N5iZLh>_cHTX3j]Uc0B:DC][FT X-Complaints-To: usenet-abuse@arcor.de Xref: g2news2.google.com comp.lang.ada:8853 Date: 2009-10-29T21:45:02+01:00 List-Id: Dmitry A. Kazakov schrieb: > On Thu, 29 Oct 2009 04:00:29 -0700 (PDT), Hibou57 (Yannick Duchêne) wrote: > >> On 28 oct, 09:55, "Dmitry A. Kazakov" >> wrote: >>> An access to subprogram is a poor-man's closure. Let's ignore "access" part >>> and consider a pure downward closure (as it should have been in Ada). > >> “ As this should have been in Ada ” ? What were you to mean ? I've >> always though real closures are not possible with such structures as >> Ada provides, except at package level — which is especially the case >> when a package can have multiple instances... but only at package >> level. Isn't it ? > > I meant downward closures. [...] > BTW, in Ada 83, there waa no access to subprogram, so we used tasks instead > (where a subprogram had to be a non-generic parameter). Tagged types may come close to a solution sometimes. You make "function objects", like the ones found in Eiffel and, I think, some other languages. Make it have an Item primitive operation that returns the functions value at that point: package F is type Nums is range 1 .. 3_333; type Func_Of_1_Nums is abstract tagged private; function Item (F : Func_Of_1_Nums; X1 : Nums) return Nums is abstract; -- value of function at X1 type Func_Of_2_Nums is abstract tagged private; function Curry (F : Func_Of_2_Nums; First_Argument: Nums) return Func_Of_1_Nums'Class is abstract; function Item (F : Func_Of_2_Nums; X1, X2 : Nums) return Nums is abstract; -- value of function at (X1, X2) private type Func_Of_1_Nums is abstract tagged record null; -- ... others, e.g. a memoizing cache end record; type Func_Of_2_Nums is Abstract tagged record null; end record; end F; package F.Addition is type Adding_Function is new Func_Of_2_Nums with null record; overriding function Curry (F: Adding_Function; First_Argument: Nums) return Func_Of_1_Nums'Class; overriding function Item (F : Adding_Function; X1, X2: Nums) return Nums; end F.Addition; with F.Addition; use F; procedure Test_F is Sum : Addition.Adding_Function; Add_2 : constant Func_Of_1_Nums'Class := Addition.Curry (Sum, First_Argument => 2); Result : Nums; type List_Of_Nums is array (Positive range <>) of Nums; ---------------------------------------------- -- This is the important bit: can pass -- a "function object", To_Be_Applied, -- to Update_All ---------------------------------------------- procedure Update_All (To_Be_Applied : Func_Of_1_Nums'Class; Some_Numbers: in out List_Of_Nums) is separate; Three_Numbers : List_Of_Nums (1 .. 3) := (40, 664, 1064); begin Result := Sum.Item (X1 => 3, X2 => 2); pragma Assert (Result = 5); Result := Add_2.Item (X1 => 3); pragma Assert (Result = 5); Update_All (To_Be_Applied => Add_2, Some_Numbers => Three_Numbers); pragma Assert (Three_Numbers = (42, 666, 1066)); end Test_F; package body F.Addition is type Curried_Of_2 is new Func_Of_1_Nums with record X1 : Nums; end record; type Func_Of_1_Nums_Ref is access Func_Of_1_Nums'Class; overriding function Item (F: Curried_Of_2; X2 : Nums) return Nums is -- add F.X1 (which is bound after Curry-ing) begin return F.X1 + X2; end Item; function Curry (F: Adding_Function; First_Argument: Nums) return Func_Of_1_Nums'Class is Result : constant Func_Of_1_Nums_Ref := new Curried_Of_2'(X1 => First_Argument); begin return Result.all; end Curry; overriding function Item (F: Adding_Function; X1, X2: Nums) return Nums is -- sum begin return X1 + X2; end Item; end F.Addition; separate (Test_F) procedure Update_All (To_Be_Applied : Func_Of_1_Nums'Class; Some_Numbers: in out List_Of_Nums) is begin for K in Some_Numbers'Range loop Some_Numbers (K) := To_Be_Applied.Item (Some_Numbers (K)); end loop; end Update_All;