* trouble with gnat generic dispatching
@ 1996-04-10 0:00 Yoav Tzruya
1996-04-10 0:00 ` Robert Dewar
0 siblings, 1 reply; 4+ messages in thread
From: Yoav Tzruya @ 1996-04-10 0:00 UTC (permalink / raw)
[-- Attachment #1: Type: text/plain, Size: 506 bytes --]
Here is an example of abstract sets implemented by both arrays and lists,
Gnat (3.01 - win95) seems to have problems dispatching the 'unit' call in the convert subprogram.
Another problem is that it needs to controlled types to be declared at the library level -
any ideas ?
I enclose the sources of 9 units:
abstract_sets - spec and body
array_sets - spec and body
list_sets - spec and body
convert - convert routine - here is the 'unit' error
try - a simple try program - problem with controlled types.
[-- Attachment #2: abstract_sets.ads --]
[-- Type: text/plain, Size: 2343 bytes --]
----------------------------------------------------------------------------
-- PACKAGE:
-- Abstract_Sets
-- AUTHOR:
-- Yoav Tzruya
-- EXPRTED TYPES:
-- Set - A generic (on set_element) controlled set of elements
-- EXPORTED PROCEDURES:
-- Empty - return an empty set
-- Unit - return a set of one element
-- Union - unify two sets into one (no duplicates of course)
-- Intersection - the intersection of two sets.
-- Take - take an arbitrary element out of the set.
-- to_string - represent the set by a string of chars.
-- EXPORTED EXCEPTIONS:
-- set_is_empty_exception - may be raised by the Take procedure when
-- trying to take an element out of the empty set.
----------------------------------------------------------------------------
-- ** SPECIFICATION IMPORTS **
with Ada.Finalization;
generic
-- the generic element of the set
type Set_Element is private;
-- a function to convert one element to a string
with function to_string (
element_arg : in set_element )
return string;
package Abstract_Sets is
-- ** EXPORTED EXCEPTIONS **
set_is_empty_exception : exception;
-- ** EXPORTED TYPES **
type Set is abstract new Ada.Finalization.Controlled with private;
-- ** EXPORTED SUBPROGRAMS **
function Empty
return Set is abstract;
-- empty set
function Unit (
Element : in Set_Element)
return Set is abstract;
-- build set with 1 element
function Union (
Left : in Set;
Right : in Set)
return Set is abstract;
function Intersection (
Left : in Set;
Right : in Set)
return Set is abstract;
procedure Take (
From : in out Set;
Element : out Set_Element)
is abstract;
function to_string (
set_arg : in set'class)
return string;
private
type Set is abstract new Ada.Finalization.Controlled with null record;
end Abstract_Sets;
[-- Attachment #3: abstract_sets.adb --]
[-- Type: text/plain, Size: 1390 bytes --]
-----------------------------------------------------------------------------
-- PACKAGE BODY:
-- Abstract_Sets
-- AUTHOR:
-- Yoav Tzruya
-- IMPLEMENTATION NOTES:
-- - the to_string function turns an element into a string using
-- the unbounded string type.
----------------------------------------------------------------------------
-- ** BODY IMPORTS **
with Ada.Strings.Unbounded;
package body abstract_sets
is
function to_string (
set_arg : in set'class)
return string
is
copied_set : set'class := set_arg;
str : Ada.Strings.Unbounded.Unbounded_String :=
Ada.Strings.Unbounded.Null_Unbounded_String;
elem : set_element;
use Ada.Strings.Unbounded; -- to enable operator visibilty , in order
-- to clarify program.
begin -- to_string
str := str & "{";
while true
loop
Take(
from => copied_set,
element => elem);
str := str & to_string(elem);
end loop;
return ""; -- just to acoid warning about program error
exception
when set_is_empty_exception =>
str := str & "}";
return Ada.Strings.Unbounded.To_String(str);
end to_string;
end abstract_sets;
[-- Attachment #4: array_sets.ads --]
[-- Type: text/plain, Size: 2647 bytes --]
-----------------------------------------------------------------------------
-- PACKAGE:
-- Array_Sets
-- AUTHOR:
-- Yoav Tzruya
-- EXPORTED TYPES:
-- Set - derived from absrtact_sets.set - a set implemented by
-- size changing array (dynamically allocated)
-- EXPORTED PROCEDURES:
-- (see abstract_sets.ads)
-- EXPORTED EXCEPTIONS:
-- (see abstract_sets.ads)
-----------------------------------------------------------------------------
-- ** SPECIFICATION IMPORTS **
with Abstract_Sets;
generic
-- the type of element in the set
type Set_Element is private;
-- a function to convert one element to a string
with function to_string (
element_arg : in set_element )
return string;
-- an abstract set of elements
with package abstract_set_handling is new
abstract_sets(set_element=> set_element,to_string=> to_string);
package Array_Sets is
-- ** EXPORTED EXCEPTIONS **
set_is_empty_exception : exception renames
abstract_set_handling.set_is_empty_exception;
-- ** EXPORTED TYPES **
type Set is new Abstract_Set_Handling.set with private;
-- ** EXPORTED SUBPROGRAMS **
function Empty
return Set;
-- empty set
function Unit (
Element : in Set_Element)
return Set;
-- build set with 1 element
function Union (
Left : in Set;
Right : in Set)
return Set;
function Intersection (
Left : in Set;
Right : in Set)
return Set;
procedure Take (
From : in out Set;
Element : out Set_Element);
-- may raise the following exceptions :
-- o set_is_empty_exception
function to_String (
Set_arg : in Set)
return String;
private
procedure Adjust (Object : in out Set);
procedure Finalize (Object : in out Set);
type Element_Array is array (integer range <>) of Set_Element;
type Access_Element_Array is access Element_Array;
type Set is
new Abstract_Set_Handling.Set with
record
Elements : Access_Element_Array := null;
end record;
end Array_Sets;
[-- Attachment #5: array_sets.adb --]
[-- Type: text/plain, Size: 9551 bytes --]
-----------------------------------------------------------------------------
-- PACKAGE BODY:
-- Array_Sets
-- AUTHOR:
-- Yoav Tzruya
-- IMPLEMENTATION NOTES:
-- The set here is implemented by array of elements - dynamically sized
-- to fit the needs of the set.
-- I use a controlled type to be in charge of the memory allocation for
-- the instantiations of this type.
-----------------------------------------------------------------------------
-- ** BODY IMPORTS **
with Ada.Unchecked_Deallocation;
package body Array_Sets is
type Set_Ptr is access Set;
-- ** INTERNAL SUBPROGRAMS **
-- Discard an unused array of elements
Procedure Discard is
new Ada.Unchecked_Deallocation (
Object => Element_Array,
Name => Access_Element_Array);
-- check if an element exist in a (slice of) array
function In_Array (
element_arg : in Set_Element;
element_array_arg : in Element_Array;
last_arg : in integer)
return boolean
is
begin -- In_Array
for i in element_array_arg'first .. last_arg
loop
if element_array_arg(i) = element_arg
then
return true;
end if;
end loop;
return false;
end In_Array;
-- check if element is in the set
function In_Set (
element_arg : in Set_Element;
set_arg : in Set)
return boolean
is
begin -- In_Set
if set_arg.elements = null
then
return false;
end if;
return In_Array (
element_arg => element_arg,
element_array_arg => set_arg.elements.all,
last_arg => set_arg.elements.all'last);
end In_Set;
function Build_Set (
element_array_arg : in element_array;
num_of_elements_arg : in integer)
return Set
is
returned_set : Set_Ptr;
begin
if num_of_elements_arg = 0
then
return Empty;
else
returned_set := new Set;
returned_set.elements := new element_array(1 .. num_of_elements_arg);
returned_set.elements.all(returned_set.elements.all'range) :=
element_array_arg (element_array_arg'first ..
element_array_arg'first+num_of_elements_arg-1);
return returned_set.all;
end if;
end Build_Set;
-- return the number of elements in a set
function number_of_elements (
set_arg : in Set)
return integer
is
begin -- number_of_elements
if set_arg.elements = null
then
return 0;
else
return set_arg.elements.all'length;
end if;
end number_of_elements;
-- ** EXPORTED SUBPROGRAMS **
function Empty
return Set
is
returned_set : set_ptr := new Set;
begin -- Empty
returned_set.all := (
Abstract_Set_Handling.Set with
elements => null);
return returned_set.all;
end Empty;
function Unit (
Element : in Set_Element)
return Set
is
returned_set : Set_ptr := new Set;
begin -- Unit
returned_set.all := (
Abstract_Set_Handling.Set with
elements => new element_array (1 .. 1));
returned_set.elements.all := (others => element);
return returned_set.all;
end Unit;
function Union (
Left : in Set;
Right : in Set)
return Set
is
actual_number_of_elements : integer := 0;
storing_array : element_array(1 ..
number_of_elements(Left)+
number_of_elements(Right));
begin -- Union
if Left.elements /= null
then
actual_number_of_elements := number_of_elements(Left);
storing_array (1 .. actual_number_of_elements) :=
Left.elements.all (Left.elements.all'range);
if Right.elements /= null
then
for i in Right.elements.all'range
loop
if not In_Array (
element_arg =>
Right.elements.all(i),
element_array_arg => storing_array,
last_arg => actual_number_of_elements)
then
actual_number_of_elements := actual_number_of_elements + 1;
storing_array (actual_number_of_elements) :=
Right.elements.all(i);
end if;
end loop;
end if;
elsif Right.elements /= null
then
actual_number_of_elements := number_of_elements(Right);
storing_array (1 .. actual_number_of_elements) :=
Right.elements.all (Right.elements.all'range);
end if;
return Build_Set (
num_of_elements_arg => actual_number_of_elements,
element_array_arg => storing_array);
end Union;
function Intersection (
Left : in Set;
Right : in Set)
return Set
is
max_number_of_elements : constant integer :=
integer'min(
number_of_elements(Left),
number_of_elements(Right));
actual_number_of_elements : integer := 0;
storing_array : element_array(1 .. max_number_of_elements);
returned_set : Set_ptr := new Set;
begin -- Intersection
if Left.elements /= null and
Right.elements /= null
then
for i in Left.elements.all'range
loop
if In_Set (
set_arg => Right,
element_arg => Left.elements.all(i))
then
actual_number_of_elements :=
actual_number_of_elements + 1;
storing_array(actual_number_of_elements) :=
Left.elements.all(i);
end if;
end loop;
end if;
return Build_Set (
num_of_elements_arg => actual_number_of_elements,
element_array_arg => storing_array);
end Intersection;
procedure Take (
From : in out Set;
Element : out Set_Element)
is
old_elements : access_element_array := From.elements;
begin -- Take
if From.elements = null
then
raise set_is_empty_exception;
else
Element := From.elements.all(old_elements.all'last);
if old_elements.all'length=1
then
From.elements := null;
else
From.elements := new element_array (
old_elements.all'first ..
old_elements.all'last - 1);
From.elements.all(From.elements.all'range) :=
old_elements.all (old_elements.all'first ..
old_elements.all'last - 1);
end if;
end if;
end Take;
function to_String (
set_arg : in Set)
return String
is
begin -- to_String
return Abstract_Set_Handling.to_String (
set_arg => set_arg);
end to_String;
procedure Adjust (Object : in out Set)
is
old_elements : access_element_array;
begin -- Adjust
if Object.elements = null
then
return;
end if;
old_elements := Object.elements;
Object.elements := new Element_Array (old_elements.all'range);
Object.elements.all (Object.elements.all'range) :=
old_elements.all(old_elements.all'range);
end Adjust;
procedure Finalize (Object : in out Set)
is
begin -- Finalize
discard (object.elements);
end Finalize;
end Array_Sets;
[-- Attachment #6: convert.ads --]
[-- Type: text/plain, Size: 267 bytes --]
with abstract_sets;
generic
with package abstract_set_handling is new abstract_sets(<>);
use abstract_set_handling; -- to enable spec as in class
procedure convert (
from : in set'class;
to : out set'class);
[-- Attachment #7: convert.adb --]
[-- Type: text/plain, Size: 577 bytes --]
procedure convert (
from : in set'class;
to : out set'class)
is
temp : set'class := from;
elem : set_element;
begin -- convert
to := empty;
while temp /= empty
loop
take(
from => temp,
element => elem);
-- gnat bug here-not knowing how to dispatch the unit routine
to:=union(
left => to,
right => unit(element => elem));
end loop;
end convert;
[-- Attachment #8: list_sets.ads --]
[-- Type: text/plain, Size: 2625 bytes --]
-----------------------------------------------------------------------------
-- PACKAGE:
-- List_Sets
-- AUTHOR:
-- Yoav Tzruya
-- EXPORTED TYPES:
-- Set - derived from absrtact_sets.set - a set implemented by
-- a dynamic list and controlled by finailize and adjust
-- EXPORTED PROCEDURES:
-- (see abstract_sets.ads)
-- EXPORTED EXCEPTIONS:
-- (see abstract_sets.ads)
-----------------------------------------------------------------------------
-- ** SPECIFICATION IMPORTS **
with Abstract_Sets;
generic
type Set_Element is private;
-- a function to convert one element to a string
with function to_string (
element_arg : in set_element )
return string;
-- an abstract set of elements
with package abstract_set_handling is new
abstract_sets(set_element=> set_element,to_string=> to_string);
package List_Sets is
-- ** EXPORTED EXCEPTIONS **
set_is_empty_exception : exception renames abstract_set_handling.set_is_empty_exception;
-- ** EXPORTED TYPES **
type Set is new Abstract_Set_Handling.set with private;
-- ** EXPORTED SUBPROGRAMS **
function Empty
return Set;
-- empty set
function Unit (
Element : in Set_Element)
return Set;
-- build set with 1 element
function Union (
Left : in Set;
Right : in Set)
return Set;
function Intersection (
Left : in Set;
Right : in Set)
return Set;
procedure Take (
From : in out Set;
Element : out Set_Element);
-- may raise the following exceptions :
-- o set_is_empty_exception
function to_String (
Set_arg : in Set)
return String;
private
procedure Adjust (Object : in out Set);
procedure Finalize (Object : in out Set);
type node;
type access_node is access node;
type node is
record
next : access_node := null;
elem : set_element;
end record;
type Set is
new Abstract_Set_Handling.Set with
record
head : access_node;
end record;
end List_Sets;
[-- Attachment #9: list_sets.adb --]
[-- Type: text/plain, Size: 6978 bytes --]
-----------------------------------------------------------------------------
-- PACKAGE BODY:
-- List_Sets
-- AUTHOR:
-- Yoav Tzruya
-- IMPLEMENTATION NOTES:
-- The set here is implemented by a dynamic list of elements.
-- I use a controlled type to be in charge of the memory allocation for
-- the instantiations of this type.
-----------------------------------------------------------------------------
-- ** BODY IMPORTS **
with Ada.Unchecked_Deallocation;
package body List_Sets is
type Set_Ptr is access Set;
-- ** INTERNAL SUBPROGRAMS **
-- discard obsolete node
Procedure Discard is
new Ada.Unchecked_Deallocation (
Object => node,
Name => Access_node);
-- check if element is in set
function In_Set (
element_arg : in Set_Element;
set_arg : in Set)
return boolean
is
next : access_node;
begin -- In_Set
if set_arg.head = null
then
return false;
else
next := set_arg.head;
while next /= null
loop
if next.elem = element_arg
then
return true;
else
next := next.next;
end if;
end loop;
return false;
end if;
end In_Set;
-- add an element to the set
procedure Add_to_Set (
set_arg : in out Set;
element_arg : in Set_Element)
is
new_node : access_node := new Node;
begin -- Add_to_Set
new_node.all := (
next => null,
elem => element_arg);
if set_arg.head = null
then
set_arg.head := new_node;
else
new_node.next := set_arg.head;
set_arg.head := new_node;
end if;
end Add_to_Set;
-- ** EXPORTED SUBPROGRAMS **
function Empty
return Set
is
returned_set : set_ptr := new Set;
begin -- Empty
returned_set.all := (
Abstract_Set_Handling.Set with
head => null);
return returned_set.all;
end Empty;
function Unit (
Element : in Set_Element)
return Set
is
returned_set : Set_ptr := new Set;
begin -- Unit
returned_set.all := Empty;
Add_to_Set (
element_arg => Element,
set_arg => returned_set.all);
return returned_set.all;
end Unit;
function Union (
Left : in Set;
Right : in Set)
return Set
is
returned_set : Set_Ptr := new Set;
node_ptr : access_node;
begin -- Union
returned_set.all := Empty;
if Left.head /= null
then
node_ptr := Left.head;
while node_ptr /= null
loop
add_to_set (
set_arg => returned_set.all,
element_arg => node_ptr.elem);
node_ptr := node_ptr.next;
end loop;
end if;
if Right.head /= null
then
node_ptr := Right.head;
while node_ptr /= null
loop
if not in_set (
element_arg => node_ptr.elem,
set_arg => returned_set.all)
then
add_to_set (
element_arg => node_ptr.elem,
set_arg => returned_set.all);
end if;
node_ptr:=node_ptr.next;
end loop;
end if;
return returned_set.all;
end Union;
function Intersection (
Left : in Set;
Right : in Set)
return Set
is
returned_set : set_ptr := new Set;
node_ptr : access_node;
begin -- Intersection
returned_set.all := Empty;
if Left.head /= null and
Right.head /= null
then
node_ptr := Left.head;
while node_ptr /= null
loop
if In_Set (
set_arg => Right,
element_arg => node_ptr.elem)
then
Add_to_Set(
set_arg => returned_set.all,
element_arg => node_ptr.elem);
end if;
node_ptr := node_ptr.next;
end loop;
end if;
return returned_set.all;
end Intersection;
procedure Take (
From : in out Set;
Element : out Set_Element)
is
begin -- Take
if From.head = null
then
raise set_is_empty_exception;
else
Element := From.head.elem;
from.head := from.head.next;
end if;
end Take;
function to_String (
set_arg : in Set)
return String
is
begin -- to_String
return Abstract_Set_Handling.to_String (
set_arg => set_arg);
end to_String;
procedure Adjust (Object : in out Set)
is
old_head : access_node;
begin -- Adjust
if Object.head = null
then
return;
end if;
old_head := Object.head;
object.head := null;
while old_head /= null
loop
add_to_set (
set_arg => Object,
element_arg => old_head.elem);
old_head := old_head.next;
end loop;
end Adjust;
procedure Finalize (Object : in out Set)
is
discarded_node,
node_ptr : access_node;
begin -- Finalize
node_ptr := Object.head;
while node_ptr /= null
loop
discarded_node := node_ptr;
node_ptr := node_ptr.next;
Discard(discarded_node);
end loop;
end Finalize;
end List_Sets;
[-- Attachment #10: try.adb --]
[-- Type: text/plain, Size: 2905 bytes --]
with ada.numerics.discrete_random;
with ada.text_io;
with array_sets;
with list_sets;
with abstract_sets;
with Ada.Strings.Unbounded;
procedure try
is
function to_string (i : integer)
return string
is
begin -- to_string
return integer'image(i);
end to_string;
package abstract_integer_sets is new abstract_sets (set_element => integer,to_string => to_string);
package integer_array_sets is new Array_sets (
abstract_set_handling => abstract_integer_sets,
to_string => to_string,
set_element => integer);
package integer_list_sets is new List_sets (
abstract_set_handling => abstract_integer_sets,
to_string => to_string,
set_element => integer);
subtype int_1_10 is integer range 1 .. 10;
package int_random is new ada.numerics.discrete_random (
result_subtype => int_1_10);
gen : int_random.generator;
set1,set2,set3 : integer_array_sets.set;
setl1,setl2,setl3 : integer_list_sets.set;
i : integer;
begin -- try
int_random.reset(gen);
set1 := integer_array_sets.Empty;
set2 := integer_array_sets.Empty;
for j in 1..10
loop
set1 := integer_array_sets.union(Left => set1, Right => integer_array_sets.unit(int_random.random(gen)));
set2 := integer_array_sets.union(Left => set2, Right => integer_array_sets.unit(int_random.random(gen)));
end loop;
ada.text_io.put_line(
integer_array_sets.to_string(set1));
ada.text_io.put_line(
integer_array_sets.to_string(set2));
ada.text_io.put_line(
integer_array_sets.to_string(integer_array_sets.union(set1,set2)));
ada.text_io.put_line(
integer_array_sets.to_string(integer_array_sets.intersection(set1,set2)));
setl1 := integer_list_sets.Empty;
setl2 := integer_list_sets.Empty;
for j in 1..10
loop
setl1 := integer_list_sets.union(Left => setl1, Right => integer_list_sets.unit(int_random.random(gen)));
setl2 := integer_list_sets.union(Left => setl2, Right => integer_list_sets.unit(int_random.random(gen)));
end loop;
ada.text_io.put_line(
integer_list_sets.to_string(setl1));
ada.text_io.put_line(
integer_list_sets.to_string(setl2));
ada.text_io.put_line(
integer_list_sets.to_string(integer_list_sets.union(setl1,setl2)));
ada.text_io.put_line(
integer_list_sets.to_string(integer_list_sets.intersection(setl1,setl2)));
end;
^ permalink raw reply [flat|nested] 4+ messages in thread* Re: trouble with gnat generic dispatching
1996-04-10 0:00 trouble with gnat generic dispatching Yoav Tzruya
@ 1996-04-10 0:00 ` Robert Dewar
1996-04-10 0:00 ` David Weller
1996-04-13 0:00 ` Yoav Tzruya
0 siblings, 2 replies; 4+ messages in thread
From: Robert Dewar @ 1996-04-10 0:00 UTC (permalink / raw)
Yoav posted a large program and one problem mentioned is that controlled
types can only be declared at the library level. THis is correct, GNAT
is giving you a correct diagnostic. Controlled types are tagged types,
and tagged types must be extended at the same level as their parents.
As for the other "problem", no idea! Please post short concise examples,
CLA is not the place to post large chunks of code and ask "what's wrong?"
You might also want to follow the GNAT directions and send GNAT
questions to report@gnat.com, although there too, you need to make
an effort to provide a concise example of your question rather than
just dumping your whole program!
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: trouble with gnat generic dispatching
1996-04-10 0:00 ` Robert Dewar
@ 1996-04-10 0:00 ` David Weller
1996-04-13 0:00 ` Yoav Tzruya
1 sibling, 0 replies; 4+ messages in thread
From: David Weller @ 1996-04-10 0:00 UTC (permalink / raw)
In article <dewar.829137107@schonberg>, Robert Dewar <dewar@cs.nyu.edu> wrote:
>Yoav posted a large program and one problem mentioned is that controlled
>types can only be declared at the library level. THis is correct, GNAT
>is giving you a correct diagnostic. Controlled types are tagged types,
>and tagged types must be extended at the same level as their parents.
>
If everybody is patient until Friday, you'll be able to see how it
should be done, controlled types and all. I'll have the Queues form of
the Booch Components ready for wide public beta, which covers LOTS of
tricks about doing OO programming.
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: trouble with gnat generic dispatching
1996-04-10 0:00 ` Robert Dewar
1996-04-10 0:00 ` David Weller
@ 1996-04-13 0:00 ` Yoav Tzruya
1 sibling, 0 replies; 4+ messages in thread
From: Yoav Tzruya @ 1996-04-13 0:00 UTC (permalink / raw)
[-- Attachment #1: Type: text/plain, Size: 1482 bytes --]
Robert Dewar wrote:
>
> Yoav posted a large program and one problem mentioned is that controlled
> types can only be declared at the library level. THis is correct, GNAT
> is giving you a correct diagnostic. Controlled types are tagged types,
> and tagged types must be extended at the same level as their parents.
>
> As for the other "problem", no idea! Please post short concise examples,
> CLA is not the place to post large chunks of code and ask "what's wrong?"
>
> You might also want to follow the GNAT directions and send GNAT
> questions to report@gnat.com, although there too, you need to make
> an effort to provide a concise example of your question rather than
> just dumping your whole program!
I've taken Robert's reply into consideration and since he gave me the answer for the controlled problem
I now post a small spec-only example for the compile time error of gnat regarding dispatching of abstract
routine.
in the following example , I try to define an ADT , set, which can be implemented in various ways
and a routine , convert, to convert between two such implementations.
The problem is that gnat does not know how to dispatch the 'unit' function call in 'convert' body.
any ideas ?
I guess the problem is that the signature of the routine (except the returned type) does not contain
any derivation of the set class.
But I think that the compiler can deduce which routine to call by the type expected by the unit routine
to return .
So here it is...
[-- Attachment #2: abstract_sets.ads --]
[-- Type: text/plain, Size: 1989 bytes --]
----------------------------------------------------------------------------
-- PACKAGE:
-- Abstract_Sets
-- AUTHOR:
-- Yoav Tzruya
-- EXPRTED TYPES:
-- Set - A generic (on set_element) controlled set of elements
-- EXPORTED PROCEDURES:
-- Empty - return an empty set
-- Unit - return a set of one element
-- Union - unify two sets into one (no duplicates of course)
-- Intersection - the intersection of two sets.
-- Take - take an arbitrary element out of the set.
-- EXPORTED EXCEPTIONS:
-- set_is_empty_exception - may be raised by the Take procedure when
-- trying to take an element out of the empty set.
----------------------------------------------------------------------------
-- ** SPECIFICATION IMPORTS **
with Ada.Finalization;
generic
-- the generic element of the set
type Set_Element is private;
package Abstract_Sets is
-- ** EXPORTED EXCEPTIONS **
set_is_empty_exception : exception;
-- ** EXPORTED TYPES **
type Set is abstract new Ada.Finalization.Controlled with private;
-- ** EXPORTED SUBPROGRAMS **
function Empty
return Set is abstract;
-- empty set
function Unit (
Element : in Set_Element)
return Set is abstract;
-- build set with 1 element
function Union (
Left : in Set;
Right : in Set)
return Set is abstract;
function Intersection (
Left : in Set;
Right : in Set)
return Set is abstract;
procedure Take (
From : in out Set;
Element : out Set_Element)
is abstract;
private
type Set is abstract new Ada.Finalization.Controlled with null record;
end Abstract_Sets;
[-- Attachment #3: convert.ads --]
[-- Type: text/plain, Size: 267 bytes --]
with abstract_sets;
generic
with package abstract_set_handling is new abstract_sets(<>);
use abstract_set_handling; -- to enable spec as in class
procedure convert (
from : in set'class;
to : out set'class);
[-- Attachment #4: convert.adb --]
[-- Type: text/plain, Size: 599 bytes --]
procedure convert (
from : in set'class;
to : out set'class)
is
temp : set'class := from;
elem : set_element;
begin -- convert
to := empty;
while temp /= empty
loop
take(
from => temp,
element => elem);
-- gnat bug here-not knowing how to dispatch the unit routine
to:=union(
left => to,
right => abstract_set_handling.unit(element => elem));
end loop;
end convert;
^ permalink raw reply [flat|nested] 4+ messages in thread
end of thread, other threads:[~1996-04-13 0:00 UTC | newest]
Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
1996-04-10 0:00 trouble with gnat generic dispatching Yoav Tzruya
1996-04-10 0:00 ` Robert Dewar
1996-04-10 0:00 ` David Weller
1996-04-13 0:00 ` Yoav Tzruya
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox