Ada Home
June 16, 1997
© by Samuel Mize, Team Ada
copyright notice at end of text
smize@imagin.net
If you need a variable number of parameters which are all of the same type, you can simply use an unconstrained array of such objects. Note that you can have several unconstrained array parameters; you are not limited to one unknown-length list at the end of the parameter list. For example:
type Int_Array is array (Positive range <>) of integer;
procedure Printf_Integers (Integers: Int_Array);
If you need parameters of mixed type, you can define a record type with a variant part that accomodates the different types the procedure might process. For instance:
package C_Style_Output is
type Arg_Class_Type is (An_Integer, A_Float, A_String);
type String_Access is access all String;
-- default defined so these can reside in an array
type Print_Argument (Arg_Class: Arg_Class_Type := An_Integer) is
record
case Arg_Class is
when An_Integer =>
I: integer;
when A_Float =>
F: float;
when A_String =>
S: String_Access;
end case;
end record;
type Print_Argument_Array is array (Positive range <>)
of Print_Argument;
procedure Printf (Format: String;
Print_Args: Print_Argument_Array);
end C_Style_Output;
The call might look like:
declare
Greeting: aliased String := "Hi there!";
use C_Style_Output;
begin
Printf ("%s %i %f\n",
( (A_String, Greeting'Unchecked_Access),
(An_Integer, 1776),
(A_Float, float (Some_Value))
));
end;
The call can be made more terse by providing functions that generate the Print_Argument objects. These are simple to code. In the example, package spec C_Style_Output, might contain:
function To_Print (I: Integer) return Print_Argument;
Or, if you prefer, you can overload unary "+" as an "identity" function for each type:
function "+" (Left: Integer) return Print_Argument; function "+" (Left: String_Access) return Print_Argument; function "+" (Left: Float) return Print_Argument;
The call will then look like:
Printf ("%s %i %f\n",
( + Greeting'Unchecked_Access,
+ 1776,
+ float (some_value) ) );
The Print_Argument type can be defined as a linked list type, with binary "+" overloaded to add an element to the list.
type Print_Argument_Record (Arg_Class: Arg_Class_Type) is
record
case
...
end record;
-- LIST ELEMENTS --
type Print_List_Element (Arg_Class: Arg_Class_Type);
type Print_List_Element_Access is access Print_List_Element;
type Print_List_Element (Arg_Class: Arg_Class_Type) is
record
Argument: Print_Argument_Record (Arg_Class);
Next: Print_List_Element_Access;
end record;
-- LIST --
type Print_List_Header is
record
Head, Tail: Print_List_Element_Access;
end record;
type Print_List is access Print_List_Header;
-- UNARY "+" (identity functions) - CREATE THE LIST --
function "+" (I: Integer) return Print_List;
function "+" (S: String) return Print_List;
function "+" (F: Float) return Print_List;
-- BINARY "+" - ADD TO LIST --
function "+" (Left: Print_List; I: Integer) return Print_List;
function "+" (Left: Print_List; S: String) return Print_List;
function "+" (Left: Print_List; F: Float) return Print_List;
-- VARIABLE-ARGUMENTS PROCEDURE --
procedure Printf (Format: String;
Print_Args: Print_List := null);
The unary "+" creates the list header and its first element. The body for one of the binary "+" functions would be:
function "+" (Left: Print_List; I: Integer)
return Print_List is
Tmp: Print_List_Element_Access
:= new Print_List_Element (An_Integer);
begin
Tmp.Argument.I := I;
if Left.Tail = null then
Left.Head := Tmp;
else
Left.Tail.Next := Tmp;
end if;
Left.Tail := Tmp;
return Left;
end "+";
The call would now look like:
Printf ("%s %i %f\n",
+ Greeting'Unchecked_Access + 1776 + float (some_value));
Print_List is defined as a pointer to provide a default "null" value for Print_Args, so this will now work:
Printf ("Hello, world!");
-- ^^ no Print_Args
To avoid memory leakage, the "+" and Printf subprograms can manage a pool of Print_List_Headers and Print_List_Elements.
Ada 95 provides for programming by extension. The most obvious use for this is object-oriented programming. However, it also supports many applications where later programmers will need to extend the functionality of existing code. "Printf" is one example. With tagged types:
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
package C_Style_Output is
-- BASIC LIST ELEMENT --
type Print_Argument_Record;
type Print_Argument is access all Print_Argument_Record'Class;
type Print_Argument_Record is tagged
record
Next: Print_Argument;
end record;
-- dispatching operation
function String_From
(Format: String; Argument: Print_Argument_Record)
return string;
-- LIST --
type Print_List_Element_Record;
type Print_List_Element is access Print_List_Element_Record;
type Print_List_Element_Record is
record
Argument: Print_Argument;
Next: Print_List_Element;
end record;
type Print_List_Record;
type Print_List is access Print_List_Record;
type Print_List_Record is
record
Head, Tail: Print_List_Element;
end record;
-- VAR-ARG PROCEDURE --
-- This walks the list, passing the %-delimited format and
-- the argument to String_From, which dispatches and returns
-- the appropriate string. Printf then prints that string.
procedure Printf (Format: string; List: Print_List := null);
-- EXTENSIONS OF BASIC LIST ELEMENT --
-- - - - - - - - - - -
type Print_Argument_Integer is new Print_Argument_Record with record
Arg: Integer;
end record;
-- dispatching operation
function String_From
(Format: String; Argument: Print_Argument_Integer)
return string;
-- creates a Print_List and Print_Argument_Integer
function "+" (Arg: Integer) return Print_List;
-- adds a Print_Argument_Integer to the end of the list
function "+" (Left: Print_List; Arg: Integer) return Print_List;
-- - - - - - - - - - -
type Print_Argument_Float is new Print_Argument_Record with record
Arg: Float;
end record;
-- dispatching operation
function String_From
(Format: string; Argument: Print_Argument_Float)
return string;
function "+" (Arg: Float) return Print_List;
function "+" (Left: Print_List; Arg: Float) return Print_List;
end C_Style_Output;
The user can simply with/use C_Style_Output, and call Printf as:
Printf ("%i %f\n", + Greeting + 1776 + float (some_value));
The advantage to this approach over the linked list of variant records appears when another type must be added. C_Style_Output does not need to be touched. Instead, another descendant of type Print_Argument is defined (this may be in a child package):
with Big_Record_Package;
package C_Style_Output.Big_Record is
-- Assume Big_Record is so large we want to avoid copying it.
-- The user will only be able to print aliased variables of
-- this type.
type Big_Record_Access is access all
Big_Record_Package.Big_Record;
type Print_Argument_Big_Record is new Print_Argument_Record
with record
Arg: Big_Record_Access;
end record;
-- dispatching operation
function String_From
(Format: String; Argument: Print_Argument_Big_Record)
return String;
function "+" (Arg: Big_Record_Access) return Print_List;
function "+" (Left: Print_List; Arg: Big_Record_Access)
return Print_List;
end C_Style_Output.Big_Record;
Printf DOES NOT NEED TO BE MODIFIED. Now the user can with/use C_Style_Output and C_Style_Output.Big_Record, and make calls like:
Printf ( "%i %b\n",
+ 1776 + My_Big_Record'Unchecked_Access );
Copyright © 1997 Samuel Mize. Permission granted to copy the entire text including this notice, to quote entire sections with attribution, and to use code from (or derived from) the examples herein without limit.
| Do you want to share ideas or tricks about elegant Ada answers to common objections or false claims? |
Page last modified: 1997-06-16