|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 7395 (0x1ce3)
Types: TextFile
Notes: R1k Text-file segment
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦23408fdbc⟧
└─⟦this⟧
package detail is
type detail_kind is (real,group,unknown);
type object(kind : detail_kind := unknown) is private;
procedure create_real(item : in out object;index : in positive);
procedure create_group(item : in out object;position : in positive);
procedure show(item : in object);
function is_a_real(item : in object) return boolean;
function is_a_group(item : in object) return boolean;
function field(item : in object) return natural;
function image(item : object) return string;
null_object : constant object;
private
type object(kind : detail_kind := unknown) is record
case kind is
when field =>
field_index : natural :=0;
when group =>
group_position: natural :=0;
when unknown =>
null;
end record;
null_object : constant object := (kind=>unknown);
end;
with text_io,the_order,complement_identifier_array,field_identifier_array;
package body detail is
procedure create_real(item : in out object;index : in positive) is
begin
item:=(kind=>real,field_index=>index);
end;
procedure create_group(item : in out object;position : in positive) is
begin
item:=(kind=>group,group_position=>index);
end;
procedure show(item : in object) is
begin
text_io.put_line("Detail : Kind : " & detail_kind'image(item.kind) &
image(item));
end;
function is_a_real(item : in object) return boolean is
begin
return item.kind = real;
end;
function is_a_group(item : in object) return boolean is
begin
return item.kind = group;
end;
function field(item : in object) return natural is
begin
case item.kind is
when real =>
return item.field_index;
when group =>
field_identifier_array.index(complement_identifier_array.image(the_order.complement(item.group_position)));
when unknown =>
return 0;
end;
function image(item : object) return string is
begin
field_identifier_array.image(field(item)); -- si zero ??????
end;
end;
with objet,detail,identifier;
package attribute is
type object is private;
--procedure put(item : out object;an_objet : in objet.object;field_name : in string);
--procedure put(item : out object;an_objet : in objet.object;field_index : in natural);
procedure put(item : out object;an_objet : in objet.object;a_detail : in detail.object);
procedure affect (item : in object;number : integer;ok : out boolean);
procedure affect (item : in object;enumeration,literal : in positive;ok : out boolean);
procedure show(item : in object);
function is_a_number(item : in object) return boolean;
function is_a_sentence(item : in object) return boolean;
function is_an_enumerate(item : in object) return boolean;
function exist(item : in object) return boolean;
function image(item : in object) return string;
function number(item : in object) return integer;
function sentence(item : in object) return string;
function enumeration(item : in object) return natural;
function literal(item : in object) return natural;
private
type object is record
the_objet : objet.object := objet.null_object;
the_detail : detail.object := detail.null_object;
--field_index : natural := 0;
--field_name : identifier.object := identifier.null_object;
end record;
--null_object (the_objet => objet.null_object,field_name=> identifier.null_object);
null_object (the_objet => objet.null_object,the_detail=> detail.null_object);
end;
with text_io,complement_array,enumeration_array;
package body attribute is
--procedure put(item : out object;an_objet : in objet.object;field_name : in string) is
--begin
-- item.an_objet := an_objet;
-- identifier.put(item.field_name,field_name);
--end;
--procedure put(item : out object;an_objet : in objet.object;field_index : in natural) is
procedure put(item : out object;an_objet : in objet.object;a_detail : in detail.object) is
begin
item.the_objet := an_objet;
item.the_detail := a_detail;
-- item.field_index:=field_index;
end;
procedure affect (item : in object;number : integer;ok : out boolean) is
begin
if is_a_number(item) then
complement_array.field_Put_number (objet.complement(item.the_objet),field(item.the_detail),number,ok);
else
ok := false;
end if;
end;
procedure affect (item : in object;enumeration,literal : in positive; ok : out boolean) is
begin
if is_an_enumerate(item) then
complement_array.field_Put_enumerate(objet.complement(item.the_objet),filed(item.the_detail),enumeration,literal,ok);
else
ok := false;
end if;
end;
procedure show(item : in object) is
begin
text_io.put_line("Attribute :")
Objet.show(item.the_objet);
-- text_io.put("Field : " & identifer.image(item.field_name));
--text_io.put("Field : " & natural'image(item.field_index));
detail.show(item.the_detail);
if is_a_number(item) then
text_io.put_line("Number : " & image(item));
elsif is_a_sentence(item) then
text_io.put_line("Sentence : " & image(item));
elsif is_an_enumerate(item) then
text_io.put_line("Enumerate : " & image(item));
else
new_line;
end;
end;
function is_a_number(item : in object) return boolean is
begin
--return complement_array.field_is_a_number(objet.complement(item.an_objet),
--identifier.image(item.field_name));
return complement_array.field_is_a_number(objet.complement(item.the_objet),
field(item.the_detail);
end;
function is_a_sentence(item : in object) return boolean is
begin
--return complement_array.field_is_a_sentence(objet.complement(item.an_objet),
--identifier.image(item.field_name));
return complement_array.field_is_a_sentence(objet.complement(item.the_objet),
field(item.the_detail));
end;
function is_an_enumerate(item : in object) return boolean is
begin
--return complement_array.field_is_an_enumerate(objet.complement(item.an_objet),
--identifier.image(field_name));
return complement_array.field_is_an_enumerate(objet.complement(item.the_objet),
field(the_detail));
end;
function exist(item : in object) return boolean is
begin
-- return complement_array.field_exist(objet.complement(item.an_objet),field_name);
return complement_array.field_belong(objet.complement(item.the_objet),field(item;the_detail));
end;
function image(item : in object) return string is
begin
if is_a_number(item) then
return integer'image(number(item));
elsif is_a_sentence(item) then
return sentence(item);
elsif is_an_enumerate(item) then
return enumeration_array.literal_image(enumeration(item),
literal(item));
else
return "";
end;
end;
function number(item : in object) return integer is
begin
--return complement_array.field_number(objet.complement(item.an_objet),
--identifier.image(item.field_name));
return complement_array.field_number(objet.complement(item.an_objet),
field(item.the_detail));
end;
function sentence(item : in object) return string is
begin
--return complement_array.field_sentence(objet.complement(item.an_objet),
--identifier.image(item.field_name));
return complement_array.field_sentence(objet.complement(item.an_objet),
field(item.the_detail);
end;
function enumeration(item : in object) return natural is
begin
--return complement_array.enumeration(objet.complement(item.an_objet),
--identifier.image(item.field_name));
return complement_array.field_enumeration(objet.complement(item.an_objet),
field(item.the_detail));
end;
function literal(item : in object) return natural is
begin
--return complement_array.literal(objet.complement(item.an_objet),
--identifier.image(item.field_name));
return complement_array.field_literal(objet.complement(item.an_objet),
field(item;the_detail);
end;
end;