with Globals, Roots;
use Globals;

pragma Elaborate_All (Globals,Roots);

package body Flts.Std is

  --- auxiliary

  procedure NOP(Dummy: in out LLFloat) is
    pragma Unreferenced(Dummy);
  begin
    null;
  end NOP;

  procedure NOP(Dummy: in out Flt) is
    pragma Unreferenced(Dummy);
  begin
    null;
  end NOP;

  procedure NOP(Dummy1: in Flt; Dummy2: in out LLFloat) is
    pragma Unreferenced(Dummy1,Dummy2);
  begin
    null;
  end NOP;

  function ReturnTrue(Dummy: LLFloat) return Boolean is
    pragma Unreferenced(Dummy);
  begin
    return True;
  end ReturnTrue;

  function ReturnTrue(Dummy: Flt) return Boolean is
    pragma Unreferenced(Dummy);
  begin
    return True;
  end ReturnTrue;

  function IsZero(S: LLFloat) return Boolean is
  begin
    return (S=RepZero);
  end IsZero;

  procedure SetZero(S: in out LLFloat) is
  begin
    S := RepZero;
  end SetZero;

  procedure SetZero(Dummy: in Flt; S: in out LLFloat) is
    pragma Unreferenced(Dummy);
  begin
    S := RepZero;
  end SetZero;

  procedure SetZero(Dummy: in LLFloat; S: in out LLFloat) is
    pragma Unreferenced(Dummy);
  begin
    S := RepZero;
  end SetZero;

  function ReturnZero(Dummy: LLFloat) return Flt is
    pragma Unreferenced(Dummy);
  begin
    return Zero;
  end ReturnZero;

  function ReturnZero(Dummy: Flt) return LLFloat is
    pragma Unreferenced(Dummy);
  begin
    return RepZero;
  end ReturnZero;

  function ReturnZero(Dummy: LLFloat) return LLFloat is
    pragma Unreferenced(Dummy);
  begin
    return RepZero;
  end ReturnZero;

  procedure Copy(S1: in LLFloat; S2: in out LLFloat) is
  begin
    S2 := S1;
  end Copy;

  function Copy(S: LLFloat) return LLFloat is
  begin
    return S;
  end Copy;

  function Approx(S: LLFloat) return Flt is
  begin
    return Flt(S);
  end Approx;

  function FirstArg(Q: Rational; Dummy: Flt) return LLFloat is
    pragma Unreferenced(Dummy);
  begin
    return LLFloat(LNum(Q))/LLFloat(LDen(Q));
  end FirstArg;

  function FirstArg(S: LLFloat; Dummy: Flt) return LLFloat is
    pragma Unreferenced(Dummy);
  begin
    return S;
  end FirstArg;

  procedure Between(S1,S2: in Flt; S3: in out LLFloat) is
  begin
    S3 := LLFloat(Half*(S1+S2));
  end Between;

  function Between(S1,S2: Flt) return LLFloat is
  begin
    return LLFloat(Half*(S1+S2));
  end Between;

  procedure Between(S1: in LLFloat; S2: in out LLFloat) is
  begin
    S2 := RepHalf*(S1+S2);
  end Between;

  function Between(S1,S2: LLFloat) return LLFloat is
  begin
    return RepHalf*(S1+S2);
  end Between;

  --- basic

  function Info(Dummy: LLFloat) return Scalar_Info is
    pragma Unreferenced(Dummy);
    I: Scalar_Info;
  begin
    I.RepType := "Std Float "; --- rest is default
    return I;
  end Info;

  procedure Swap(S1,S2: in out LLFloat) is
    S: constant LLFloat := S1;
  begin
    S1 := S2; S2 := S;
  end Swap;

  --- sets

  function Contains0(S: LLFloat) return Logical is
  begin
    if S=RepZero then return True; else return False; end if;
  end Contains0;

  function Contains(S1,S2: LLFloat) return Logical is
  begin
    if S1=S2 then return True; else return False; end if;
  end Contains;

  procedure Intersection(S1: in LLFloat; S2: in out LLFloat; Empty: out Logical) is
  begin
    if S1=S2 then
      Empty := False;
    else
      Between(S1,S2);
      Empty := True;
    end if;
  end Intersection;

  --- order

  function Sign(S: LLFloat) return Integer is
  begin
    if S>RepZero then return 1;
    elsif S<RepZero then return -1;
    else return 0; end if;
  end Sign;

  function Compare(R: Flt; S: LLFloat) return Integer is
  begin
    if LLFloat(R)>S then return 1;
    elsif LLFloat(R)<S then return -1;
    else return 0; end if;
  end Compare;

  function Compare(S1,S2: LLFloat) return Integer is
  begin
    if S1>S2 then return 1;
    elsif S1<S2 then return -1;
    else return 0; end if;
  end Compare;

  procedure Min(S1: in LLFloat; S2: in out LLFloat) is
  begin
    if S1<S2 then S2 := S1; end if;
  end Min;

  procedure Min(S1,S2: in LLFloat; S3: in out LLFloat) is
  begin
    S3 := Min(S1,S2);
  end Min;

  procedure Max(S1: in LLFloat; S2: in out LLFloat) is
  begin
    if S1>S2 then S2 := S1; end if;
  end Max;

  procedure Max(S1,S2: in LLFloat; S3: in out LLFloat) is
  begin
    S3 := Max(S1,S2);
  end Max;

  function LFloor(R: LLFloat) return LInt is
  begin
    if (R>LLast) or (R<LFirst) then raise Undefined; end if;
    return LInt(LLFloat'Floor(R));
  end LFloor;

  function LCeiling(R: LLFloat) return LInt is
  begin
    if (R>LLast) or (R<LFirst) then raise Undefined; end if;
    return LInt(LLFloat'Ceiling(R));
  end LCeiling;

  --- arithmetic

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

  procedure Neg(S1: in LLFloat; S2: in out LLFloat) is
  begin
    S2 := -S1;
  end Neg;

  procedure Add(I: in Integer; S: in out LLFloat) is
  begin
    S := S+LLFloat(I);
  end Add;

  procedure Add(S1: in LLFloat; S2: in out LLFloat) is
  begin
    S2 := S2+S1;
  end Add;

  procedure Sum(S1,S2: in LLFloat; S3: in out LLFloat) is
  begin
    S3 := S1+S2;
  end Sum;

  procedure Sub(S1: in LLFloat; S2: in out LLFloat) is
  begin
    S2 := S2-S1;
  end Sub;

  procedure Diff(S1,S2: in LLFloat; S3: in out LLFloat) is
  begin
    S3 := S1-S2;
  end Diff;

  function "*"(R: Flt; S: LLFloat) return LLFloat is
  begin
    return LLFloat(R)*S;
  end "*";

  procedure Mult(R: in Flt; S,Dummy: in out LLFloat) is
    pragma Unreferenced(Dummy);
  begin
    S := LLFloat(R)*S;
  end Mult;

  procedure Mult(R: in Flt; S: in out LLFloat) is
  begin
    S := LLFloat(R)*S;
  end Mult;

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

  procedure AddProd(R: in Flt; S1: in LLFloat; S2,Dummy: in out LLFloat) is
    pragma Unreferenced(Dummy);
  begin
    S2 := LLFloat(R)*S1+S2;
  end AddProd;

  procedure AddProd(R: in Flt; S1: in LLFloat; S2: in out LLFloat) is
  begin
    S2 := LLFloat(R)*S1+S2;
  end AddProd;

  procedure Mult(Q: in Rational; S: in out LLFloat) is
  begin
    S := S*(LLFloat(LNum(Q))/LLFloat(LDen(Q)));
  end Mult;

  procedure Mult(S1: in LLFloat; S2: in out LLFloat) is
  begin
    S2 := S1*S2;
  end Mult;

  procedure Prod(S1,S2: in LLFloat; S3: in out LLFloat) is
  begin
    S3 := S1*S2;
  end Prod;

  procedure AddProd(S1,S2: in LLFloat; S3,Dummy: in out LLFloat) is
    pragma Unreferenced (Dummy);
  begin
    S3 := S3+S1*S2;
  end AddProd;

  procedure AddProd(S1,S2: in LLFloat; S3: in out LLFloat) is
  begin
    S3 := S3+S1*S2;
  end AddProd;

  procedure SumProd(S1,S2,S3: in LLFloat; S4: in out LLFloat) is
  begin
    S4 := S3+S1*S2;
  end SumProd;

  procedure SubProd(S1,S2: in LLFloat; S3,Dummy: in out LLFloat) is
    pragma Unreferenced(Dummy);
  begin
    S3 := S3-S1*S2;
  end SubProd;

  procedure Div(R: in Flt; S,Dummy: in out LLFloat) is
    pragma Unreferenced(Dummy);
  begin
    S := S/LLFloat(R);
  end Div;

  procedure Div(R: in Flt; S: in out LLFloat) is
  begin
    S := S/LLFloat(R);
  end Div;

  procedure Quot(S1: in LLFloat; R: in Flt; S2: in out LLFloat) is
  begin
    S2 := S1/LLFloat(R);
  end Quot;

  function "/"(S: LLFloat; R: Flt) return LLFloat is
  begin
    return S/LLFloat(R);
  end "/";

  procedure Div(S1: in LLFloat; S2: in out LLFloat) is
  begin
    S2 := S2/S1;
  end Div;

  procedure Quot(S1,S2: in LLFloat; S3: in out LLFloat) is
  begin
    S3 := S1/S2;
  end Quot;

  procedure Inv(S1: in LLFloat; S2: in out LLFloat) is
  begin
    S2 := RepOne/S1;
  end Inv;

  function Inv(S: LLFloat) return LLFloat is
  begin
    return RepOne/S;
  end Inv;

  --- fun

  procedure Norm(S1: in LLFloat; S2: in out LLFloat) is
  begin
    S2 := abs(S1);
  end Norm;

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

  procedure Sqr(S: in out LLFloat) is
  begin
    S := S*S;
  end Sqr;

  procedure Sqr(S1: in LLFloat; S2: in out LLFloat) is
  begin
    S2 := S1*S1;
  end Sqr;

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

  procedure Sqrt(S1: in LLFloat; S2: in out LLFloat) is
  begin
    S2 := Sqrt(S1);
  end Sqrt;

  function Root(K: Positive; S: LLFloat) return LLFloat is
  begin
    if K>2 then
      return Exp(Log(S)/Flt(K));
    elsif K=2 then
      return Sqrt(S);
    else
      return S;
    end if;
  end Root;

  procedure Root(K: Positive; S1: in LLFloat; S2: in out LLFloat) is
  begin
    if K>2 then
      S2 := Exp(Log(S1)/Flt(K));
    elsif K=2 then
      S2 := Sqrt(S1);
    else
      S2 := S1;
    end if;
  end Root;

  procedure Exp(S1: in LLFloat; S2: in out LLFloat) is
  begin
    S2 := Exp(S1);
  end Exp;

  procedure Log(S1: in LLFloat; S2: in out LLFloat) is
  begin
    S2 := Log(S1);
  end Log;

  procedure ArcCos(S1: in LLFloat; S2: in out LLFloat) is
  begin
    S2 := ArcCos(S1);
  end ArcCos;

  procedure ArcSin(S1: in LLFloat; S2: in out LLFloat) is
  begin
    S2 := ArcSin(S1);
  end ArcSin;

  procedure Cos(S1: in LLFloat; S2: in out LLFloat) is
  begin
    S2 := Cos(S1);
  end Cos;

  procedure Sin(S1: in LLFloat; S2: in out LLFloat) is
  begin
    S2 := Sin(S1);
  end Sin;

  function Pi return LLFloat is
  begin
    return Ada.Numerics.Pi;
  end Pi;

  procedure Simple_Random(S: in out LLFloat) is
  begin
    S := LLFloat(Simple_Random);
  end Simple_Random;

  procedure IPower(I: in Integer; S1: in LLFloat; S2,Dummy: in out LLFloat) is
    pragma Unreferenced(Dummy);
  begin
    S2 := S1**I;
  end IPower;

  procedure QPower(Q: in Rational; S1: in LLFloat; S2: in out LLFloat) is
    N: constant Integer := INum(Q);
    D: constant Integer := IDen(Q);
  begin
    if N=0 then
      S2 := RepOne;
    elsif D>2 then
      S2 := Exp(Log(S1)*LLFloat(N)/LLFloat(D));
    elsif D=2 then
      S2 := Sqrt(S1**N);
    else                  --- D=1
      S2 := S1**N;
    end if;
  end QPower;

  --- conversion, io

  procedure Assign(I: in Integer; S: in out LLFloat) is
  begin
    S := LLFloat(I);
  end Assign;

  procedure Assign(Q: in Rational; S: in out LLFloat) is
  begin
    S := LLFloat(LNum(Q))/LLFloat(LDen(Q));
  end Assign;

  procedure Assign(R: in Flt; S: in out LLFloat) is
  begin
    S := LLFloat(R);
  end Assign;

  function Scal(I: Integer) return LLFloat is
  begin
    return LLFloat(I);
  end Scal;

  function Scal(Q: Rational) return LLFloat is
  begin
    return LLFloat(LNum(Q))/LLFloat(LDen(Q));
  end Scal;

  function Scal(R: Flt) return LLFloat is
  begin
    return LLFloat(R);
  end Scal;

  procedure ValDec(N: in String; R: in out LLFloat) is
  begin
    R := ValDec(N);
  end ValDec;

  procedure PutStd(S: in LLFloat; C,R: out LLFloat) is
  begin
    C := S;
    R := RepZero;
  end PutStd;

  procedure PutStd(S: in LLFloat; C,R,B: out LLFloat) is
  begin
    C := S;
    R := RepZero;
    B := RepZero;
  end PutStd;

  procedure GetStd(C,Dummy: in LLFloat; S: in out LLFloat) is
    pragma Unreferenced(Dummy);
  begin
    S := C;
  end GetStd;

  procedure GetStd(C,Dummy1,Dummy2: in LLFloat; S: in out LLFloat) is
    pragma Unreferenced(Dummy1,Dummy2);
  begin
    S := C;
  end GetStd;

  --- misc

  procedure Ceiling(S1: in LLFloat; S2: in out LLFloat) is
  begin
    S2 := Ceiling(S1);
  end Ceiling;

  function Ceiling(S1: Flt) return Flt is
  begin
    return Flt(Ceiling(LLFloat(S1)));
  end Ceiling;

  procedure Floor(S1: in LLFloat; S2: in out LLFloat) is
  begin
    S2 := Floor(S1);
  end Floor;

  function Floor(S1: Flt) return Flt is
  begin
    return Flt(Floor(LLFloat(S1)));
  end Floor;

  procedure Round(S1: in LLFloat; S2: in out LLFloat) is
  begin
    S2 := Round(S1);
  end Round;

  function Scaled(Eps: Flt) return Flt is
  begin
    return Scaled(Eps,LLFloat'Machine_Mantissa);
  end Scaled;

  function Epsilon(Eps: Flt) return Flt is
  begin
    return Epsilon(Eps,LLFloat'Machine_Mantissa);
  end Epsilon;

  procedure Set_Precision(Dummy: in Positive) is
    pragma Unreferenced(Dummy);
  begin
    null;
  end Set_Precision;

  function Set_Precision(Dummy: Positive) return Positive is
    pragma Unreferenced(Dummy);
  begin
    return LLFloat'Machine_Mantissa;
  end Set_Precision;

  procedure Set_Precision(Dummy1: in Positive; Dummy2: in LLFloat) is
    pragma Unreferenced(Dummy1,Dummy2);
  begin
    null;
  end Set_Precision;

  function Get_Precision(Dummy: LLFloat) return Positive is
    pragma Unreferenced(Dummy);
  begin
    return LLFloat'Machine_Mantissa;
  end Get_Precision;

  procedure Proper_Rounding is
  begin
    if A_Numeric_Mode /= null then A_Numeric_Mode.all; end if;
  end Proper_Rounding;

  procedure Proper_Rounding(Dummy: in LLFloat) is
    pragma Unreferenced(Dummy);
  begin
    if A_Numeric_Mode /= null then A_Numeric_Mode.all; end if;
  end Proper_Rounding;

  procedure Free_Cache(Dummy: in LLFloat) is
    pragma Unreferenced(Dummy);
  begin
    null;
  end Free_Cache;

  ---------------------------------------------------------------
  Primitive_Buffer: array (1 .. Primitive_Buffer_Size) of LLFloat;
  ---------------------------------------------------------------

  procedure Put_Numeric(N: in Positive; S: in Rep) is
  begin
    if N <= Primitive_Buffer_Size then
      Copy(S,Primitive_Buffer(N));
    else
      raise Sorry with "increase Primitive_Buffer_Size";
    end if;
  end Put_Numeric;

  procedure Get_Numeric(N: in Positive; S: in out Rep) is
  begin
    if N <= Primitive_Buffer_Size then
      Copy(Primitive_Buffer(N),S);
    else
      raise Sorry with "increase Primitive_Buffer_Size";
    end if;
  end Get_Numeric;

  --- package needs to see the body of Scal

  ----------------------------------------------
  ----------------------------------------------
  package SR is new Roots (Scalar => LLFloat);
  ----------------------------------------------
  ----------------------------------------------

  procedure Roots2(B,C: in LLFloat; U1,U2,V: in out LLFloat) is
  begin
    SR.NewtonRoots2(B,C,U1,U2,V,64);
  end Roots2;

  procedure Roots3(B,C,D: in LLFloat; U0,U1,U2,V: in out LLFloat) is
  begin
    SR.NewtonRoots3(B,C,D,U0,U1,U2,V,64);
  end Roots3;

end Flts.Std;
