Language Change Specification Examples for Reflection API

LCS Number: LCS-2016-041
Version: 3
Date: 21-Mar-2017
Status: Approved

Code Examples

Generic length

-- determines the length of a discrete type
-- this is a utility method used in the examples
function length(tpe : subtype_mirror) return index_type is
  constant class : type_class := tpe.get_type_class;
begin
  case class is
    when class_enumeration => 
      return tpe.as_enumeration.length;
    when class_integer =>
      return tpe.as_integer.length;
    when others =>
      report type_class'image(class) & " doesn't have a length" severity failure;
  end case;
  return -1;
end;

Generic to_string

-- can create a string for any value
procedure use_to_string(variable v : some_type) is
  constant mirror : value_mirror := v'reflect;
begin
  report to_string(mirror);
end procedure;

function to_string(value : value_mirror) return string is
  constant dummy : string := "dummy";

  function to_string(value : array_value_mirror) return string is
    constant array_type : array_subtype_mirror := value.get_subtype;
    constant length : index_type := length(array_type.index_subtype(1));
  begin
    if array_type.dimensions /= 1 then
      -- not supported in this example
      report "only 1D arrays are supported" severity failure;
      return index_type'image(array_type.dimensions) & "D array";
    end if;
    return "(" & to_string(value, 0, length, "") & ")";
  end function;
  
  function to_string(value : array_value_mirror; field_idx, length : index_type; prefix : string) return string is
    constant index : index_vector := (0 => field_idx);
    
    constant element_str : string := to_string(value.get(index));
  begin
    if field_idx < length - 1 then
      return to_string(value, field_idx+1, length, prefix & element_str & ", ");
    elsif field_idx = length - 1 then
      return prefix & element_str;
    end if;
  end function;

  function to_string(value : record_value_mirror) return string is
  begin
    return "(" & to_string(value, 0, "") & ")";
  end function;
  
  function to_string(value : record_value_mirror; element_idx : index_type; prefix : string) return string is
    constant element_tpe : record_subtype_mirror := value.get_subtype;
    constant element_str : string := to_string(value.get(element_idx));
  begin
    if element_idx < element_tpe.length - 1 then
      return to_string(value, element_idx+1, prefix & element_str & ", ");
    elsif element_idx = element_tpe.length - 1 then
      return prefix & element_str;
    end if;
  end function;
  
  constant class : type_class := value.get_subtype.get_type_class;
begin
  case class is
    when class_integer =>
      return system_integer'image(value.as_integer.value);
    when class_floating =>
      return real'image(value.as_floating.value);
    when class_physical =>
      -- TODO
      null;
    when class_enumeration =>
      return value.as_enumeration.image;
    when class_record =>
      return to_string(value.as_record);
    when class_array =>
      return to_string(value.as_array);
    when class_access =>
      return "access type " & value.as_access.get_subtype.simple_name;
    when class_protected =>
      return "protected type";
    when class_file =>
      return "file type";
  end case;
  
  report "unreachable" severity failure;
  return dummy;
end function;

Flatten a multi-dimensional array

procedure use_flatten is
  type enum is (l1, l2);
  type foo is array (enum, natural range 0 to 2) of integer;

  constant foo_val : foo          := ((1, 2), (2, 3), (4, 5));
  constant foo_mir : value_mirror := foo_val'reflect;
begin
  report to_string(flatten(foo_mir.as_array));
end procedure;

function flatten(value : array_value_mirror) return integer_vector is
  procedure flatten(
    foo_arr_mir  : array_value_mirror;
    arr_type_mir : array_subtype_mirror;
    cur_dim      : index_type;
    dim_vec      : inout index_vector;
    ret          : out integer_vector
  ) is
    variable dim_type : subtype_mirror;
  begin
    if cur_dim < arr_type_mir.dimensions then
      dim_type := arr_type_mir.index_subtype(cur_dim);
      for j in 0 to length(dim_type) - 1 loop
        dim_vec(cur_dim) := j;
        flatten(foo_arr_mir, arr_type_mir, cur_dim + 1, dim_vec, ret);
      end loop;
    else
      dim_type := arr_type_mir.index_subtype(cur_dim);
      for j in 0 to length(dim_type) - 1 loop -- loop in the direction of one dimmension, e.g. X, Y, Z
        dim_vec(dim_vec'high)           := j;
        ret(integer(pos(arr_type_mir, dim_vec))) := integer_value(foo_arr_mir.get(dim_vec));
      end loop;
    end if;
  end procedure;
  
  function size(arr_type_mir : array_subtype_mirror) return integer is
    variable size     : positive_index_type := 1;
    variable dim_type : subtype_mirror;
  begin
    for i in 1 to arr_type_mir.dimensions loop
      dim_type := arr_type_mir.index_subtype(i);
      size     := size * length(dim_type);
    end loop;
    return integer(size);
  end function;

  function pos(
    arr_type_mir : array_subtype_mirror;
    dim_vec      : index_vector
  ) return index_type is
    variable pos      : index_type := 0;
    variable dim_type : subtype_mirror;
  begin
    for i in dim_vec'range loop
      dim_type := arr_type_mir.index_subtype(i);
      pos      := pos * length(dim_type) + dim_vec(i);
    end loop;
    return pos;
  end function;

  function integer_value(value : value_mirror) return integer is
    constant type_klass : type_class := value.get_subtype.get_type_class;
  begin
    if type_klass /= class_integer then
      report "Expected an integer type but got " & type_class'image(type_klass);
      return 0;
    end if;
    
    return integer(value.as_integer.value);
  end function;
  
  constant arr_type_mir : array_subtype_mirror := array_value_mirror.get_subtype;
  constant dimensions   : positive_index_type  := arr_type_mir.dimensions;

  variable dim_vec : index_vector(0 to dimensions - 1);
  variable ret     : integer_vector(0 to size(arr_type_mir) - 1);
begin
  flatten(value, arr_type_mir, 1, dim_vec, ret);
  return ret;
end function;

Randomize any

function randomize(value : subtype_mirror) return value_mirror is
  constant class : type_class := subtype_mirror.get_type_class;
  
  -- implementation not provided
  function random(\from\, \to\ : system_integer) return system_integer;
  function random(\from\, \to\ : real) return real;
  
  function randomize(tpe : enumeration_subtype_mirror) return value_mirror is
    constant low : system_integer := tpe.low.pos;
    constant high : system_integer := tpe.high.pos;
    constant idx : positive_index_type := positive_index_type(random(low, high)); 
  begin
    return tpe.value(idx).as_value_mirror;
  end function;
  
  function randomize(tpe : integer_subtype_mirror) return value_mirror is
    constant low : system_integer := tpe.low.value;
    constant high : system_integer := tpe.high.value;
  begin
    return tpe.value(random(low, high)).as_value_mirror;
  end function;
  
  function randomize(tpe : floating_subtype_mirror) return value_mirror is
    constant low : real := tpe.low.value;
    constant high : real := tpe.high.value;
  begin
    return tpe.value(random(low, high)).as_value_mirror;
  end function;
  
  
  function randomize(tpe : record_subtype_mirror) return value_mirror is
    constant new_value : record_value_mirror := tpe.create;
  begin
    for i in 0 to tpe.length -1 loop
      new_value.set(i, randomize(tpe.element_subtype(i)));
    end loop;
    return new_value.as_value_mirror;
  end function;
  
  function randomize(tpe : array_subtype_mirror) return value_mirror is
    constant length : index_type := length(tpe.index_subtype(1));
    constant new_value : array_value_mirror := tpe.create((0 => length));
    constant element_type : subtype_mirror := tpe.element_subtype;
  begin
    if tpe.dimensions /= 1 then
      report "Not yet supported" severity failure;
    end if;
    for i in 0 to length loop
      new_value.set((0 => i), randomize(element_type));
    end loop;
    return new_value.as_value_mirror;
  end function;
  
begin
  case class is
  when class_enumeration =>
    return randomize(value.as_enumeration);
  when class_integer =>
    return randomize(value.as_integer);
  when class_floating =>
    return randomize(value.as_floating);
  when class_record =>
    return randomize(value.as_record);
  when class_array =>
    return randomize(value.as_array);
  when class_physical =>
    -- TODO
    null;
  when class_access | class_protected | class_file =>
    -- can't randomize these
    report "Can't randomize access types & protected types" severity failure;
  end case;
end function;

Topic revision: r1 - 2017-04-02 - 12:04:23 - PatrickLehmann
 
Copyright © 2008-2024 by the contributing authors. All material on this collaboration platform is the property of the contributing authors.
Ideas, requests, problems regarding TWiki? Send feedback