----------------------------------------------------------------
-- Chapter 15 Access Types
----------------------------------------------------------------

----------------------------------------------------------------
-- 15.1 Access Types
----------------------------------------------------------------

----------------------------------------------------------------
-- 15.1.1 Access Type Declarations and Allocators
----------------------------------------------------------------

-- Page 479

type natural_ptr is access natural;

-- Page 480

variable count : natural_ptr;

-- Page 481

count := new natural;

count.all := 10;

if count.all = 0 then
  ...
end if;

count := new natural'(10);

type stimulus_record is record
    stimulus_time : time;
    stimulus_value : bit_vector(0 to 3);
  end record stimulus_record;

type stimulus_ptr is access stimulus_record;

-- Page 482

variable bus_stimulus : stimulus_ptr;

bus_stimulus := new stimulus_record'( 20 ns, B"0011" );

----------------------------------------------------------------
-- 15.1.2 Assignment and Equality of Access Values
----------------------------------------------------------------

-- Page 482

variable count1, count2 : natural_ptr;

count1 := new natural'(5);
count2 := new natural'(10);

count2 := count1;

count1.all := 20;

-- Page 483

count2 := count1;

count1 = count2

count1 := new natural'(30);
count2 := new natural'(30);

count1.all = count2.all

if count1 /= null then
  count1.all := count1.all + 1;
end if;

----------------------------------------------------------------
-- 15.1.3 Access Types for Records and Arrays
----------------------------------------------------------------

-- Page 484

type stimulus_record is record
    stimulus_time : time;
    stimulus_value : bit_vector(0 to 3);
  end record stimulus_record;

type stimulus_ptr is access stimulus_record;

variable bus_stimulus : stimulus_ptr;

type coordinate is array (1 to 3) of real;
type coordinate_ptr is access coordinate;

variable origin : coordinate_ptr := new coordinate'(0.0, 0.0, 0.0);

type time_array is array (positive range <>) of time;
variable activation_times : time_array(1 to 100);

-- Page 485

type time_array_ptr is access time_array;

variable activation_times : time_array_ptr;

activation_times := new time_array'(10 us, 15 us, 40 us);

activation_times := new time_array'( activation_times.all
                                     & time_array'(70 us, 100 us) );

activation_times := new time_array(1 to 10);

type RV is record
  v1 : bit_vector;
  v2 : time_vector;
end record RV;
type RV_ptr is access RV;
variable p : RV_ptr;

p := new RV_record(v1(0 to 23), v2(0 to 23));

-- Page 486

p := new RV_record'(v1 => "010", v2 => (2 ns, 4 ns, 6 ns));

----------------------------------------------------------------
-- 15.2 Linked Data Structures
----------------------------------------------------------------

-- Page 486

type value_cell is record
    value : bit_vector(0 to 3);
    next_cell : value_ptr;
  end record value_cell;

type value_ptr is access value_cell;

-- Page 487

type value_cell;

type value_ptr is access value_cell;

type value_cell is record
    value : bit_vector(0 to 3);
    next_cell : value_ptr;
  end record value_cell;

variable value_list : value_ptr;

if value_list /= null then
  ...  -- do something with the list
end if;

value_list := new value_cell'( B"1000", value_list );

value_list := new value_cell'( B"0010", value_list );

-- Page 488

value_list := new value_cell'( B"0000", value_list );

current_cell := value_list;
while current_cell /= null loop
  s <= current_cell.value;
  wait for 10 ns;
  current_cell := current_cell.next_cell;
end loop;

-- Page 489

current_cell := value_list;
while current_cell /= null
    and current_cell.value /= search_value loop
  current_cell := current_cell.next_cell;
end loop;
assert current_cell /= null
  report "search for value failed";

----------------------------------------------------------------
-- 15.2.1 Deallocation and Storage Management
----------------------------------------------------------------

-- Page 490

type T_ptr is access T;

procedure deallocate ( P : inout T_ptr );

-- Example 15.1, Page 491

cell_to_be_deleted := value_list;
value_list := value_list.next_cell;
deallocate(cell_to_be_deleted);

while value_list /= null loop
  cell_to_be_deleted := value_list;
  value_list := value_list.next_cell;
  deallocate(cell_to_be_deleted);
end loop;

----------------------------------------------------------------
-- 15.3 An Ordered-Dictionary ADT Using Access Types
----------------------------------------------------------------

-- Page 492

package dictionaries is
  generic ( type element_type;
            type key_type;
            function key_of ( E : element_type ) return key_type;
            function "<" ( L, R : key_type )
                         return boolean is <> );

  -- types provided by the package

  type dictionary_object;    -- private

  type dictionary_type is access dictionary_object;

  -- operations on dictionaries

  procedure initialize ( dictionary : inout dictionary_type );

  procedure lookup ( dictionary : in dictionary_type; 
                     lookup_key : in key_type;
                     element : out element_type;
                     found : out boolean );

  procedure search_and_insert
              ( dictionary : inout dictionary_type;
                element : in element_type;
                already_present : out boolean );

  procedure traverse
    generic   ( procedure action ( element : in element_type ) )
    parameter ( dictionary : in dictionary_type );

  -- private types: pretend these are not visible

  type dictionary_object is
    record
      element : element_type;
      left, right : dictionary_type;
    end record dictionary_object;

end package dictionaries;

-- Page 493

package test_pattern_dictionaries is new work.dictionaries
  generic map ( element_type => test_pattern_type,
                key_type => time,
                key_of => test_time_of );

package body dictionaries is

  procedure initialize ( dictionary : inout dictionary_type ) is
  begin
    if dictionary /= null then
      initialize ( dictionary.left );
      initialize ( dictionary.right );
      deallocate ( dictionary );
    end if;
  end function new_dictionary;

  procedure lookup ( dictionary : in dictionary_type;
                     lookup_key : in key_type;
                     element : out element_type;
                     found : out boolean ) is
    variable current : dictionary_type := dictionary;
  begin
    found := false;
    while current /= null loop
      if lookup_key < key_of ( current.element ) then
        current := current.left;
      elsif key_of ( current.element ) < lookup_key then
        current := current.right;
      else
        found := true;
        element := current.element;
        return;
      end if;
    end loop;
  end procedure lookup;

  procedure search_and_insert
              ( dictionary : inout dictionary_type;
                element : in element_type;
                already_present : out boolean ) is
  begin
    if dictionary = null then
      already_present := false;
      dictionary
        := new dictionary_object'( element => element,
                                   left => null, right => null );
    elsif key_of ( element ) < key_of ( dictionary.element ) then
      search_and_insert ( dictionary.left,
                          element, already_present );
    elsif key_of ( dictionary.element ) < key_of ( element ) then
      search_and_insert ( dictionary.right,
                          element, already_present );
    else
      already_present := true;
    end if;
  end procedure search_and_insert;

  procedure traverse
    generic   ( procedure action ( element : in element_type ) )
    parameter ( dictionary : in dictionary_type ) is
  begin
    if dictionary = null then
      return;
    end if;
    traverse ( dictionary.left );
    action   ( dictionary.element );
    traverse ( dictionary.right );
  end procedure traverse;

end package body dictionaries;

----------------------------------------------------------------
-- Exercises
----------------------------------------------------------------

-- Exercise 2

type real_ptr is access real;
variable r : real_ptr;
...
r := new real;
r := r + 1.0;

-- Exercise 3

type int_ptr is access integer;
variable a, b, c, d : int_ptr;
...
a := new integer'(1); b := new integer'(2);
c := new integer'(3); d := new integer'(4);
b := a; a := b;
c.all := d.all;

-- Exercise 6

type complex is record
re, im : real;
end record complex;
type complex_ptr is access complex;
variable x, y, z : complex_ptr;

-- Exercise 8

cell_to_be_deleted := value_list;
deallocate(cell_to_be_deleted);
value_list := value_list.next_cell;