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-Thread: 103376,f0be8eebb2993001
X-Google-NewGroupId: yes
X-Google-Attributes: gida07f3367d7,domainid0,public,usenet
X-Google-Language: ENGLISH,ASCII
Path: 
 g2news2.google.com!news4.google.com!fu-berlin.de!news.belwue.de!LF.net!news.enyo.de!not-for-mail
From: Florian Weimer <fw@deneb.enyo.de>
Newsgroups: comp.lang.ada
Subject: Re: Ada 2012 : aliased parameters ?
Date: Tue, 29 Mar 2011 21:35:08 +0200
Message-ID: <87aagdhg9f.fsf@mid.deneb.enyo.de>
References: <op.vs1xo8puule2fv@index.ici>
	<8adad214-6381-4296-9097-878fbb517f6e@k7g2000yqj.googlegroups.com>
	<87lizxiy6c.fsf@mid.deneb.enyo.de>
	<ba29bed9-8624-4d13-b2ff-6a6bc979bd45@i4g2000pro.googlegroups.com>
Mime-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Content-Transfer-Encoding: 8bit
X-Trace: ruchba.enyo.de 1301427308 30962 172.17.135.6 (29 Mar 2011 19:35:08
 GMT)
X-Complaints-To: news@enyo.de
Cancel-Lock: sha1:93LypcEsMKZFmkhMN4tiK6dvi8k=
Xref: g2news2.google.com comp.lang.ada:19555
Date: 2011-03-29T21:35:08+02:00
List-Id: <comp.lang.ada>

* Shark8:

> On Mar 29, 12:22�pm, Florian Weimer <f...@deneb.enyo.de> wrote:
>>
>> I've written experimental code which depends on this, providing a
>> syntactically convenient and efficient form of variadic subprograms.
>
> Could you post an example thereof?

I think I already did, in a previous thread, but here's my example
code.  I don't know why Value'Size is so large.

with System;
with Ada.Finalization;

package Variadic is
   
   type Value is limited private;
   
   function "+" (V : Integer) return Value;
   function "+" (V : Long_Float) return Value;
   function "+" (V : String) return Value;
   
   type Argument_Array is array (Positive range <>) of Value;
   
   procedure Call (Target : String; Arguments : Argument_Array);
   
private
   
   type Value_Kind is (None, Integer_Kind, Float_Kind, String_Kind);
   
   type String_Holder is new Ada.Finalization.Limited_Controlled with record
     Pointer : System.Address;
     Length : Natural;
   end record;
   
   procedure Finalize (X : in out String_Holder);
   
   type Value_Internal (Kind : Value_Kind := None) is record
      case Kind is
	 when None =>
	    null;
	 when Integer_Kind =>
	    Integer_Value : Integer;
	 when Float_Kind =>
	    Float_Value : Long_Float;
	 when String_Kind =>
	    String_Value : String_Holder;
      end case;
   end record;
   
   type Value is limited record
      Internal : Value_Internal;
   end record;
   
end Variadic;

with Interfaces.C;
with Ada.Text_IO;

package body Variadic is
    
   function "+" (V : Integer) return Value is
   begin
      return (Internal => (Kind => Integer_Kind, Integer_Value => V));
   end "+";
     
   function "+" (V : Long_Float) return Value is
   begin
      return (Internal => (Kind => Float_Kind, Float_Value => V));
   end "+";
     
   function "+" (V : String) return Value is
      function C_Malloc (Size : Interfaces.C.Size_T) return System.Address;
      pragma Import (C, C_Malloc, "malloc");
      Pointer : constant System.Address := C_Malloc(V'Length);
      subtype Str is String (V'Range);
      S : Str;
      for S'Address use Pointer;
   begin
      S := V;
      return (Internal => (Kind => String_Kind, 
			   String_Value =>
			     (Ada.Finalization.Limited_Controlled with
				Pointer => Pointer,
			      Length => V'Length)));
   end "+";
   
   procedure Call (Target : String; Arguments : Argument_Array) is
      use Ada.Text_IO;
      
      package Integer_IO is new  Ada.Text_IO.Integer_IO (Integer);
      use Integer_IO;

      package Float_IO is new  Ada.Text_IO.Float_IO (Long_Float);
      use Float_IO;
      
   begin
      Put ("CALL: ");
      Put_Line (Target);
      for J in Arguments'Range loop
	 Put ("   ");
	 declare
	    Arg : Value_Internal renames Arguments (J).Internal;
	    
	 begin
	    case Arg.Kind is
	       when None =>
		  Put ("NONE");
	       when Integer_Kind =>
		  Put ("INTEGER ");
		  Put (Arg.Integer_Value);
	       when Float_Kind =>
		  Put ("FLOAT ");
		  Put (Arg.Float_Value);
	       when String_Kind =>
		  Put ("STRING ");
		  declare
		     subtype Str is String (1 .. Arg.String_Value.Length);
		     S : Str;
		     for S'Address use Arg.String_Value.Pointer;
		  begin
		     Put (S);
		  end;
	    end case;
	 end;
	 New_Line;
      end loop;
   end Call;
   
   procedure Finalize (X : in out String_Holder) is
      procedure C_Free (Ptr : System.address);
      pragma Import (C, C_Free, "free");
   begin
      C_Free (X.Pointer);
      X.Pointer := System.Null_Address;
   end Finalize;
   
end Variadic;

with Ada.Text_IO; use Ada.Text_IO;
with Variadic; use Variadic;

procedure Variadic_Test is
begin
   Put ("Value'Size: ");
   Put_Line (Integer'Image (Value'Size));
   Call ("Foo", (+ 1, + 2.0, + "3."));
end Variadic_Test;