|
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: 6724 (0x1a44)
Types: TextFile
Notes: R1k Text-file segment
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦a82543151⟧
└─⟦this⟧
with dynamic_Value;
package dynamic_node is
type Kinds is (Unknown, Value,Binary_Operator,Unary_Operator);
type Positions is (Left, Right, Center);
type Binary_Operators is (Addition, Subtraction, Division, Multiplication);
type Unary_Operators is (Plus, Minus);
type Object is private;
Object_Already_Exists : exception;
Object_Is_Not_Created : exception;
Object_Is_Not_Evaluated : exception;
Value_Does_Not_Exist_Or_Is_Not_Evaluated : exception;
There_Is_No_Argument_On_Value : exception;
procedure Create_Value (Obj : in out Object);
procedure Set_Value(Obj : in out Object; val : in Dynamic_Value.Object);
procedure Create_Unary_Operator (Obj : in out Object; Op : Unary_Operators);
procedure Create_Binary_Operator (Obj : in out Object; Op : Binary_Operators);
function Get_Kind(Obj: in Object) return Kinds;
procedure Set_Argument (Obj : in out Object;
Arg : in Object;
Where : Positions := Center);
function Get_Argument
(Obj : in Object; Where : Positions := Center) return Object;
function Get_Value(Obj: in object) return Dynamic_Value.object;
procedure Evaluate(obj : in object);
private
type Node(What:kinds:=Unknown);
type Object is access Node;
type Arguments is array (Positions range <>) of Object;
type Node (What : Kinds := Unknown) is
record
case What is
when Value =>
Value_Content: Dynamic_Value.Object;
when Binary_Operator =>
Binary_Op : Binary_Operators;
Binary_Arg : Arguments (Left .. Right);
Binary_Result : Dynamic_Value.object;
when Unary_Operator =>
Unary_Op : Unary_Operators;
Unary_Arg : Object;
Unary_Result : Dynamic_Value.Object;
when others =>
null;
end case;
end record;
end Dynamic_Node;
package body dynamic_node is
procedure Create_Value (Obj : in out Object) is
d_v : Dynamic_Value.Object;
begin
if (Obj=null) then
Obj:=new Node'(what=> Value, Value_Content => d_v);
else
raise Object_Already_Exists;
end if;
end Create_Value;
procedure Set_Value(Obj : in out Object; val : in Dynamic_Value.Object) is
begin
if (Dynamic_Value.Get_Kind(Val) = Dynamic_Value.Unknown)
then
raise Value_Does_Not_Exist_Or_Is_Not_Evaluated;
else
Obj.all.Value_Content:=val;
end if;
end Set_Value;
procedure Create_Unary_Operator (Obj : in out Object; Op : Unary_Operators) is
d_v : Dynamic_Value.Object;
begin
if (Obj=null) then
Obj:=new Node'(what=> Unary_Operator,
Unary_Op => Op,
Unary_Arg=> null,
Unary_result => d_v);
else
raise Object_Already_Exists;
end if;
end Create_Unary_Operator;
procedure Create_Binary_Operator (Obj : in out Object; Op : Binary_Operators) is
d_v : Dynamic_Value.Object;
begin
if (Obj=null) then
Obj:=new Node'(what=> Binary_Operator,
Binary_Op => Op,
Binary_Arg => (null,null),
Binary_Result => d_v);
else
raise Object_Already_Exists;
end if;
end Create_Binary_Operator;
function Get_Kind(Obj: in Object) return Kinds is
begin
return Obj.all.what;
end Get_Kind;
procedure Set_Argument (Obj : in out Object;
Arg : in Object;
Where : Positions := Center) is
begin
case Get_Kind(Obj) is
when Value => raise There_Is_No_Argument_On_Value;
when Unary_Operator => Obj.all.Unary_Arg:= Arg;
when Binary_Operator => Obj.all.Binary_Arg(Where):=Arg;
when Unknown => raise Object_Is_Not_Created;
end case;
end Set_Argument;
function Get_Argument(Obj : in Object; Where : Positions := Center) return Object is
begin
case Get_Kind(Obj) is
when Value => raise There_Is_No_Argument_On_Value;
when Unary_Operator => return Obj.all.Unary_Arg;
when Binary_Operator => return Obj.all.Binary_Arg(Where);
when Unknown => raise Object_Is_Not_Created;
end case;
end Get_Argument;
function Get_Value(Obj: in object) return Dynamic_Value.object is
begin
case Obj.all.what is
when Value =>
if (Dynamic_Value.Get_Kind(obj.all.value_Content) = Dynamic_Value.Unknown)
then raise Value_Does_Not_Exist_Or_Is_Not_Evaluated;
else return obj.all.Value_Content;
end if;
when Unary_Operator =>
if (Dynamic_Value.Get_Kind(obj.all.Unary_Result) = Dynamic_Value.Unknown)
then raise Value_Does_Not_Exist_Or_Is_Not_Evaluated;
else return obj.all.Unary_Result;
end if;
when Binary_Operator =>
if (Dynamic_Value.Get_Kind(obj.all.Binary_Result) = Dynamic_Value.Unknown)
then raise Value_Does_Not_Exist_Or_Is_Not_Evaluated;
else return obj.all.Binary_Result;
end if;
when others => raise Object_Is_Not_Created;
end case;
end Get_Value;
procedure Evaluate_Unary_Operator(obj : in object) is
begin
Evaluate(Get_Argument(obj));
case obj.all.Unary_op is
when plus =>
Dynamic_Value.Copy(Get_Value(Get_Argument(obj)),Obj.all.unary_Result);
when minus =>
Dynamic_Value.Change_Sign(Get_Value(Get_Argument(obj)),Obj.all.unary_Result);
end case;
end Evaluate_Unary_Operator;
procedure Evaluate_Binary_Operator(obj : in object) is
tempo1,tempo2:Dynamic_Value.Object;
begin
Evaluate(Get_Argument(obj,left));
Dynamic_Value.Copy(Get_Value(Get_Argument(obj,left)), tempo1);
Evaluate(Get_Argument(obj,right));
Dynamic_Value.Copy(Get_Value(Get_Argument(obj,right)), tempo2);
case obj.all.Binary_op is
when Addition =>
Dynamic_Value.Add (left =>tempo1, right => tempo2, result => obj.all.binary_result);
when Subtraction =>
Dynamic_Value.Substract (tempo1, tempo2, obj.all.binary_result);
when Division =>
Dynamic_Value.Divide (tempo1, tempo2, obj.all.binary_result);
when Multiplication =>
Dynamic_Value.Multiply (tempo1, tempo2, obj.all.binary_result);
end case;
end Evaluate_Binary_Operator;
procedure Evaluate(obj : in object) is
begin
case get_Kind(obj) is
when Value => null;
when Unary_operator => Evaluate_Unary_Operator(obj);
when Binary_operator => Evaluate_Binary_Operator(obj);
when Unknown => raise Object_Is_Not_Created;
end case;
end Evaluate;
end Dynamic_Node