UNSAFE MODULE MPZ;

IMPORT MPNat, Ctypes, Word, Math, Text;

(* ----------- Internal Procedures -------------- *)

PROCEDURE IntToNat(READONLY x : T) : MPNat.T =
  BEGIN
    RETURN LOOPHOLE(ADR(x[FirstPosition(x)]),MPNat.T)
  END IntToNat;

PROCEDURE DigitValueInBase(c: CHAR; base: BaseT:=10): CHAR =
(* Converts the char "c" to the char format used by MPN *)
  VAR rc : CHAR;
  BEGIN
    IF (c>='0') AND (c<='9') THEN 
      rc:=VAL(ORD(c)-ORD('0'),CHAR);
    ELSIF (c>='a') AND (c<='z') THEN 
      rc:=VAL(ORD(c)-ORD('a')+10,CHAR);
    ELSIF (c>='A') AND (c<='Z') THEN 
      rc:=VAL(ORD(c)-ORD('A')+10,CHAR);
    ELSE
      RETURN '\n'
    END;

    IF ORD(rc) < base THEN 
      RETURN rc
    ELSE
      RETURN '\n'
    END
  END DigitValueInBase;

(* ----------- Exported Procedures -------------- *)

PROCEDURE FirstPosition(READONLY x : T) : CARDINAL =
  BEGIN
    RETURN FIRST(x)+1
  END FirstPosition;

PROCEDURE GetSize(READONLY x : T) : CARDINAL = 
  BEGIN
    RETURN NUMBER(x)-1
  END GetSize;

PROCEDURE NumDigits(READONLY x : T) : SizeT = 
  VAR s : CARDINAL; 
  BEGIN 
    IF IsZero(x) THEN 
      RETURN 1
    ELSE
      WITH
        xp=FirstPosition(x),
        xl=GetSize(x)
      DO
        s:=xl;
        WHILE x[s]=0 AND s > xp  DO s:=s-1 END;
        RETURN s
      END
    END
  END NumDigits;

PROCEDURE GetDigit(READONLY x : T; i: CARDINAL) : DigitT =
  BEGIN
    RETURN x[FirstPosition(x)+i-1]
  END GetDigit;

PROCEDURE SetDigit(VAR x : T; i: CARDINAL; v: DigitT) =
  BEGIN
    <* ASSERT i <= NUMBER(x) *>
    x[FirstPosition(x)+i-1]:=v
  END SetDigit;

PROCEDURE SetSign(VAR x : T; s: Sign) =
  (* sets the sign of the number represented by z. *)
  BEGIN
    x[FIRST(x)] := s+1
  END SetSign;

PROCEDURE GetSign(READONLY x : T) : Sign =
  BEGIN
    RETURN x[FIRST(x)]-1
  END GetSign;

PROCEDURE IsZero(READONLY x: T) : BOOLEAN = 
  BEGIN
    RETURN (GetSign(x) = MP_ZERO)
  END IsZero;

PROCEDURE Num_IsZero(READONLY x: T): BOOLEAN =
  VAR b : BOOLEAN:=TRUE;
      i : CARDINAL;
  BEGIN
    WITH
      xl= LAST(x),
      xp= FirstPosition(x)
    DO
      i:=xl;
      WHILE (i>=xp) AND b DO 
        IF x[i] # 0 THEN b:=FALSE END;
        i:=i-1
      END;
      RETURN b
    END
  END Num_IsZero;

PROCEDURE FillWithZero(VAR x: T; p,s: CARDINAL) =
  VAR i,lp : CARDINAL;
  BEGIN
    i:=p;
    lp:=p+s-1;
    IF lp > LAST(x) THEN lp:=LAST(x) END;
    WHILE i <= lp DO 
      x[i]:=0;
      INC(i)
    END
  END FillWithZero;

PROCEDURE CountLeadingZerosInDigit(d : DigitT) : NumDgt = 
  VAR numzeros : NumDgt;
      tp       : DigitT;
  BEGIN
    WITH
      (* Rotate(x,n) returns "i" bit equals "(i-n) MOD Word.Size" *) 
      msb = Word.Rotate(1,Word.Size-1)
    DO
      numzeros:=0;
      tp := d;
      WHILE (Word.And(tp,msb) = 0) AND (numzeros < Word.Size)  DO 
        tp:=Word.LeftShift(tp,1);
        numzeros:=numzeros+1
      END;
    END;
    RETURN numzeros
  END CountLeadingZerosInDigit;
  
PROCEDURE CountTrailingZerosInDigit(d: DigitT) : NumDgt = 
  VAR lsb,tp : DigitT;
      numzeros : NumDgt;
  BEGIN
    (* based on the "count_trailing_zeros" defined on line 1393 of "longlong.h" *)
    lsb := 1;
    numzeros:=0;
    tp := d;
    WHILE (Word.And(tp,lsb) = 0) AND (numzeros < Word.Size)  DO 
      tp:=Word.RightShift(tp,1);
      numzeros:=numzeros+1
    END;
    RETURN numzeros
  END CountTrailingZerosInDigit;

PROCEDURE CountLeastSignificantLimbZero(READONLY x: T) : NumDgt = 
  VAR i : NumDgt;
  BEGIN
    WITH
      xl= LAST(x),
      xp= FirstPosition(x)
    DO
      i:=xp;
      WHILE i <= xl AND x[i] = 0 DO 
        INC(i)
      END;
      IF i > xl THEN 
        RETURN xl-xp+1
      ELSE 
        RETURN i-xp
      END
    END
  END CountLeastSignificantLimbZero;

PROCEDURE ShiftDigit(d: DigitT; s: NumDgt) : DigitT = 
  BEGIN
    <* ASSERT ABS(s) <= Word.Size *> 
    IF s > 0 THEN 
      RETURN Word.RightShift(d,s)
    ELSE 
      RETURN Word.LeftShift(d,ABS(s))
    END;
  END ShiftDigit;

PROCEDURE Add(VAR z: T; READONLY x,y : T; xl,yl: SizeT) = 
  VAR c : DigitT;
  BEGIN
    <* ASSERT (xl >= yl) *>  
    (* we assumes that the caller has checked "Abs(x) >= Abs(y) if "xl = yl" *) 
    IF xl = 1 THEN 
      c := MPNat.Add_1(IntToNat(z),IntToNat(y),yl,GetDigit(x,xl))
    ELSIF yl = 1 THEN 
      c := MPNat.Add_1(IntToNat(z),IntToNat(x),xl,GetDigit(y,yl))
    ELSIF xl = yl THEN 
      c := MPNat.Add_n(IntToNat(z),IntToNat(x),IntToNat(y),xl)
    ELSE     
      c := MPNat.Add(IntToNat(z),IntToNat(x),xl,IntToNat(y),yl)
    END;
    SetDigit(z,xl+1,c)
  END Add;

PROCEDURE Sub(VAR z: T; READONLY x,y : T; xl,yl: SizeT) = 
  VAR c : DigitT;
  BEGIN
    <* ASSERT (xl >= yl) *>  
    IF yl = 1 THEN 
      c := MPNat.Sub_1(IntToNat(z),IntToNat(x),xl,GetDigit(y,yl))
    ELSIF xl = yl THEN 
      c := MPNat.Sub_n(IntToNat(z),IntToNat(x),IntToNat(y),xl)
    ELSE     
      c := MPNat.Sub(IntToNat(z),IntToNat(x),xl,IntToNat(y),yl)
    END;
  END Sub;

PROCEDURE Mult(VAR z: T; READONLY x,y : T; xl,yl: SizeT) = 
  VAR c : DigitT;
  BEGIN
    <* ASSERT (xl >= yl) *>  
    IF xl = yl THEN 
      MPNat.Mul_n(IntToNat(z),IntToNat(x),IntToNat(y),xl)
    ELSE
      IF xl = 1 THEN 
        c := MPNat.Mul_1(IntToNat(z),IntToNat(y),yl,GetDigit(x,xl));
        SetDigit(z,yl+1,c);  
      ELSIF yl = 1 THEN 
        c := MPNat.Mul_1(IntToNat(z),IntToNat(x),xl,GetDigit(y,yl));
        SetDigit(z,xl+1,c);  
      ELSE    
        c := MPNat.Mul(IntToNat(z),IntToNat(x),xl,IntToNat(y),yl);
      END; 
    END;
    SetSign(z,GetSign(x)*GetSign(y));
  END Mult;

PROCEDURE DivRem(VAR q,r : T; READONLY x,y : T; xl,yl: SizeT) : DigitT = 
  VAR c : DigitT;
  BEGIN
    <* ASSERT xl >= yl *>  
    IF yl = 1 THEN 
      c := MPNat.DivMod_1(IntToNat(q),IntToNat(x),xl,GetDigit(y,yl));
      SetDigit(r,yl,c);
      RETURN 0
    ELSE 
      c := MPNat.DivRem(IntToNat(q),0,IntToNat(x),xl,IntToNat(y),yl);
      (* "MPNat.DivRem" overwrites "x" with the remainder *)
      r:=x;
      RETURN c
    END;
  END DivRem;

PROCEDURE LShift(VAR z: T; READONLY x: T; xl: SizeT; d: CARDINAL) : SizeT =
  BEGIN
    RETURN MPNat.LShift(IntToNat(z),IntToNat(x),xl,d)
  END LShift;

PROCEDURE RShift(VAR z: T; READONLY x: T; xl: SizeT; d: CARDINAL) : SizeT =
  BEGIN
    RETURN MPNat.RShift(IntToNat(z),IntToNat(x),xl,d)
  END RShift;

PROCEDURE Comp(READONLY x,y : T; s: SizeT) : Sign =
  BEGIN
    RETURN MPNat.Cmp(IntToNat(x),IntToNat(y),s)
  END Comp;

PROCEDURE GCD(VAR z: T; READONLY x,y : T; xl,yl: SizeT) : SizeT = 
  VAR c : DigitT;
  BEGIN
    IF xl # 1 AND yl # 1 THEN 
     <* ASSERT xl <= yl *>  
      WITH s = MPNat.GCD(IntToNat(z),IntToNat(x),xl,IntToNat(y),yl) DO 
        SetSign(z,MP_POS);
        RETURN s
      END
    ELSE 
      IF xl = 1 THEN 
        c := MPNat.GCD_1(IntToNat(y),yl,GetDigit(x,xl));
      ELSIF yl = 1 THEN 
        c := MPNat.GCD_1(IntToNat(x),xl,GetDigit(y,yl));
      END;
      SetDigit(z,1,c);
      SetSign(z,MP_POS);
      RETURN 1
    END;
  END GCD;

PROCEDURE Sqrt(VAR z,r : T; READONLY x: T; xl: SizeT) : SizeT =
  BEGIN
    <* ASSERT GetSign(z) # MP_NEG  *> 
    RETURN MPNat.Sqrt(IntToNat(z),IntToNat(r),IntToNat(x),xl)       
  END Sqrt;

PROCEDURE IsPerfectSquare(READONLY x: T) : BOOLEAN =
  BEGIN
    IF GetSign(x) = MP_NEG THEN 
      RETURN FALSE 
    ELSE 
      RETURN (MPNat.PerfectSquare(IntToNat(x),GetSize(x)) # 0)
    END
  END IsPerfectSquare;

PROCEDURE ToString(READONLY x : T; base : BaseT:=10) : TEXT = 
CONST dig = ARRAY [0..15] OF TEXT {"0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F"};
  VAR str   : TEXT;
      sarr  : SizeT;
      xsign : Sign;
      xsize : SizeT;
      i     : CARDINAL;
      vstr  : UNTRACED REF ARRAY OF CHAR;  
  BEGIN
    <* ASSERT base >= 2 AND base <= 16 *> 
    
    xsize := GetSize(x);
    xsign := GetSign(x);
    IF (xsign = MP_ZERO) OR (xsize = 0) THEN RETURN "0" END;
    WITH
      (* computes the size that the string must have;
         MPN requires 3 extras positions  *)
         
      l2base= Math.log(2.0d0)/Math.log(FLOAT(base,LONGREAL)),
      MaxCharsPerLimb=CEILING(FLOAT(MPNat.BITS_PER_MP_LIMB,LONGREAL)*l2base),
      size_str = xsize*MaxCharsPerLimb+3
    DO 
      vstr:= NEW(UNTRACED REF ARRAY OF CHAR,size_str)
    END;
    WITH 
      arr = LOOPHOLE(ADR(vstr[0]),Ctypes.unsigned_char_star)
    DO
      sarr:=MPNat.getstr(arr,base,IntToNat(x),xsize); 
      str:="";
      FOR i:=0 TO sarr-1 DO 
        str:=str&dig[ORD(vstr[i])]
      END; 

      (* eliminates leading zeros in str *)
      WITH
        strlen = Text.Length(str)
      DO
        i:=0;
        WHILE (i<strlen) AND (Text.GetChar(str,i) = '0') DO i:=i+1 END;
        IF i=strlen THEN 
          str:="0" 
        ELSE
          str:=Text.Sub(str,i,strlen);
        END
      END;
      
      DISPOSE(vstr);
    END;
    IF xsign < 0 THEN str:="-"&str END;
    RETURN str
  END ToString;

PROCEDURE FromString(VAR z: T; str : TEXT; strlen : CARDINAL; base : BaseT:=10) = 
  TYPE pstrT = UNTRACED REF ARRAY OF CHAR;  
  VAR vstr  : pstrT;
      nr    : SizeT;
  BEGIN
    (* allocates an array of char overlapping str *)
    vstr:= NEW(pstrT,strlen);
    FOR i:=0 TO strlen-1 DO 
      vstr[i]:=DigitValueInBase(Text.GetChar(str,i),base)
    END;

    WITH
      arr  = LOOPHOLE(ADR(vstr[0]),Ctypes.unsigned_char_star)
    DO
      nr:=MPNat.setstr(IntToNat(z),arr,strlen,base)
    END; 
    
    DISPOSE(vstr);
  END FromString;

PROCEDURE Random(VAR z: T; zl: SizeT; s: Sign) = 
  BEGIN
    MPNat.random2(IntToNat(z),zl);
    IF Num_IsZero(z) THEN 
      SetSign(z,MP_ZERO)
    ELSE
      SetSign(z,s);
    END;
  END Random;

BEGIN
END MPZ.