File : numerics.adb

with Reps.IO;
use Reps.IO;

package body Numerics is

  NumZero: constant Numeric := 0.0;
  NumTwo:  constant Numeric := 2.0;

  function Scal(K: Integer) return Numeric is
  begin
    return Numeric(K);
  end Scal;

  function Scal(R: Rep) return Numeric is
  begin
    return Numeric(R);
  end Scal;

  function Approx(N: Numeric) return Rep is
  begin
    return Rep(N);
  end Approx;

  function IsZero(S: Numeric) return Boolean is
  begin
    return S=NumZero;
  end IsZero;

  procedure SetZero(S: out Numeric) is
  begin
    S := NumZero;
  end SetZero;

  function Average(S,T: Numeric) return Numeric is
  begin
    return (S+T)/NumTwo;
  end Average;

  function Disk(R1,R2: Rep) return Numeric is
  begin
    return Numeric(R1+R2)/NumTwo;
  end Disk;

  function MaxNorm(S: Numeric) return Radius is
  begin
    return Radius(abs(S));
  end MaxNorm;

  function Contains(S,T: Numeric) return Boolean is
  begin
    return S=T;
  end Contains;

  procedure Mult(K: in Integer; S: in out Numeric) is
  begin
    S := Scal(K)*S;
  end Mult;

  procedure Prod(K: in Integer; S: in Numeric; T: out Numeric) is
  begin
    T := Scal(K)*S;
  end Prod;

  function "*"(K: Integer; S: Numeric) return Numeric is
  begin
    return Scal(K)*S;
  end "*";

  procedure MultAdd(K: in Integer; S: in Numeric; T: in out Numeric) is
  begin
    T := T+Scal(K)*S;
  end MultAdd;

  procedure Mult(R: in Rep; S: in out Numeric) is
  begin
    S := Numeric(R)*S;
  end Mult;

  procedure Prod(R: in Rep; S1: in Numeric; S2: out Numeric) is
  begin
    S2 := Numeric(R)*S1;
  end Prod;

  function "*"(R: Rep; S: Numeric) return Numeric is
  begin
    return Numeric(R)*S;
  end "*";

  procedure MultAdd(R: in Rep; S1: in Numeric; S2: in out Numeric) is
  begin
    S2 := S2+Numeric(R)*S1;
  end MultAdd;

  function "/"(S: Numeric; R: Rep) return Numeric is
  begin
    return S/Numeric(R);
  end "/";

  function ReturnTrue(S: Numeric) return Boolean is
  begin
    return True;
  end ReturnTrue;

  function ReturnZero(S: Numeric) return Numeric is
  begin
    return NumZero;
  end ReturnZero;

  function ReturnZero(R: Rep) return Numeric is
  begin
    return NumZero;
  end ReturnZero;

  function Identity(S: Numeric) return Numeric is
  begin
    return S;
  end Identity;

  procedure ZeroOut(S: in out Numeric) is
  begin
    S := NumZero;
  end ZeroOut;

---------------------------

  procedure Neg(S: in out Numeric) is
  begin
    S := -S;
  end Neg;

  procedure Neg(S: in Numeric; T: out Numeric) is
  begin
    T := -S;
  end Neg;

  procedure Add(S: in Numeric; T: in out Numeric) is
  begin
    T := S+T;
  end Add;

  procedure Sum(S,T: in Numeric; P: out Numeric) is
  begin
     P := S+T;
  end Sum;

  procedure Sub(S: in Numeric; T: in out Numeric) is
  begin
    T := T-S;
  end Sub;

  procedure Diff(S,T: in Numeric; P: out Numeric) is
  begin
    P := S-T;
  end Diff;

  procedure Mult(S: in Numeric; T: in out Numeric) is
  begin
    T := S*T;
  end Mult;

  procedure Prod(S,T: in Numeric; P: out Numeric) is
  begin
     P := S*T;
  end Prod;

  procedure MultAdd(S,T: in Numeric; P: in out Numeric) is
  begin
    P := P+S*T;
  end MultAdd;

  function Sqr(S: Numeric) return Numeric is
  begin
    return S*S;
  end Sqr;

  function Inv(S: Numeric) return Numeric is
  begin
    return Scal(One)/S;
  end Inv;

  procedure Div(S: in Numeric; T: in out Numeric) is
  begin
    T := T/S;
  end Div;

---------------------------

  procedure ShowType(S: in Numeric) is
  begin
    Show0("Scalar type is Numeric");
  end ShowType;

  procedure Show1(N: in String; S: in Numeric) is
  begin
    Show1(N,Rep(S));
  end Show1;

  procedure Show2(N: in String; S1,S2: in Numeric) is
  begin
    Show2(N,Rep(S1),Rep(S2));
  end Show2;

  procedure Get(F: in File_Type; S: out Numeric; Decimal: in Boolean := True) is
    R1: Rep;
  begin
    Get(F,R1,Decimal);
    S := Numeric(R1);
  end Get;

  procedure Put(F: in File_Type; S: in Numeric; Decimal: in Boolean := True) is
  begin
    Put(F,Rep(S),Decimal);
  end Put;

  procedure UpMultAdd(R1,R2: in Rep; R3: in out Rep) is
  begin
    raise Undefined;
  end UpMultAdd;

end Numerics;