DataMuseum.dk

top - metrics - 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⟧ 

TextFile

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