home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sa104os2.zip / SATHR104.ZIP / SATHER / LIBRARY / INTI.SA < prev    next >
Text File  |  1995-02-05  |  17KB  |  486 lines
  1. -- Copyright (C) International Computer Science Institute, 1994.  COPYRIGHT  --
  2. -- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
  3. -- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in    --
  4. -- the file "Doc/License" of the Sather distribution.  The license is also   --
  5. -- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA.  --
  6. --------> Please email comments to "sather-bugs@icsi.berkeley.edu". <----------
  7.  
  8. ----------------------------------------------------------------------
  9. -- inti.sa: Implementation of arbitrary large integers. An integer x is
  10. -- represented by n digits to a base B:
  11. --
  12. --   x = sign * (x[n-1]*B^(n-1) + x[n-2]*B^(n-2) + ... + x[1]*B + x[0])
  13. --
  14. -- The n digits x[i] of x are hold in an array with asize >= n. The
  15. -- sign and n are encoded in a private feature len, with the following
  16. -- semantics:
  17. --   
  18. --   n = |len|, sign = sign(len)
  19. --   and the value 0 is represented by len = 0
  20. --
  21. -- The operations div (/) and mod (%) obey the following rules
  22. -- (euclidean definition):
  23. --
  24. --   x = (x/y)*y + x%y   and   0 <= x%y < |y|
  25. --
  26. -- All (non-private) methods are non-destructive, i.e. they do not
  27. -- modify their arguments. Thus, INTI behaves like a value class.
  28. --
  29. -- Author: Robert Griesemer (gri@icsi.berkeley.edu)
  30. -- Created: 20 Oct 1993 (Sather 0.2)
  31. -- Modified: 1 Jul 1994 (Sather 1.0), 27 Jul 1994
  32. --
  33. -- Copyright (C) 1993, International Computer Science Institute
  34. --
  35. -- COPYRIGHT NOTICE: This code is provided WITHOUT ANY WARRANTY
  36. -- and is subject to the terms of the SATHER LIBRARY GENERAL PUBLIC
  37. -- LICENSE contained in the file: sather/doc/license.txt of the
  38. -- Sather distribution. The license is also available from ICSI,
  39. -- 1947 Center St., Suite 600, Berkeley CA 94704, USA.
  40. ----------------------------------------------------------------------
  41.  
  42. class INTI < $IS_EQ{SAME}, $IS_LT{SAME}, $STR is
  43.    include AREF{INT};
  44.    private attr len: INT;
  45.    private const log2B := 15;
  46.    private const log10D := 4;
  47.    private const B := 2 ^ log2B; -- binary base
  48.    private const D := 10 ^ log10D; -- decimal base; D <= B must hold
  49.  
  50. -------------------------------------------------- private routines (self = void)
  51.  
  52.    private u_plus (x, y: SAME): SAME is
  53.       xl: INT := x.len.abs;
  54.       yl: INT := y.len.abs;
  55.       l: INT := xl.min(yl);
  56.       i: INT := 0;
  57.       c: INT := 0;
  58.       z: SAME;
  59.    --
  60.       z := new(xl.max(yl) + 1);
  61.       loop while!(i < l); c := c + x[i] + y[i]; z[i] := c%B; c := c/B; i := i+1 end;
  62.       loop while!(i < xl); c := c + x[i]; z[i] := c%B; c := c/B; i := i+1 end;
  63.       loop while!(i < yl); c := c + y[i]; z[i] := c%B; c := c/B; i := i+1 end;
  64.       if c /= 0 then z[i] := c; i := i+1 end;
  65.       z.len := i;
  66.       return z
  67.    end;
  68.  
  69.    private u_minus (x, y: SAME): SAME is
  70.       xl: INT := x.len.abs;
  71.       yl: INT := y.len.abs;
  72.       i: INT := 0;
  73.       c: INT := 0;
  74.       z: SAME;
  75.    --
  76.       z := new(xl);
  77.       loop while!(i < yl); c := c + x[i] - y[i]; z[i] := c%B; c := c/B; i := i+1 end;
  78.       loop while!(i < xl); c := c + x[i]; z[i] := c%B; c := c/B; i := i+1 end;
  79.       loop while!((i > 0) and (z[i-1] = 0)); i := i-1 end;
  80.       z.len := i;
  81.       return z
  82.    end;
  83.  
  84.    private u_times (x, y: SAME): SAME is
  85.       xl: INT := x.len.abs;
  86.       yl: INT := y.len.abs;
  87.       i, j, k, d, c: INT;
  88.    --
  89.       i := xl + yl; z: SAME := new(i);
  90.       loop while!(i > 0); i := i-1; z[i] := 0 end;
  91.       loop while!(i < xl); d := x[i];
  92.          if d /= 0 then j := 0; k := i; c := 0;
  93.             loop while!(j < yl); c := c + z[k] + d*y[j]; z[k] := c%B; c := c/B; j := j+1; k := k+1 end;
  94.             if c /= 0 then z[k] := c; k := k+1 end
  95.          end;
  96.          i := i+1
  97.       end;
  98.       z.len := k;
  99.       return z
  100.    end;
  101.  
  102.    private copy: SAME is
  103.       i: INT := len.abs;
  104.       z: SAME := new(i+1); z.len := len;
  105.       loop while!(i > 0); i := i-1; z[i] := [i] end;
  106.       return z
  107.    end;
  108.  
  109.    private u_div_mod (x, y: SAME): SAME is
  110.       xl: INT := x.len.abs;
  111.       yl: INT := y.len.abs;
  112.       i, j, k, c, d, q, y1, y2: INT;
  113.    --
  114.       x := x.copy;
  115.       if yl = 1 then
  116.          i := xl-1; c := 0; d := y[0];
  117.          loop while!(i >= 0); c := c*B + x[i]; x[i+1] := c/d; c := c%d; i := i-1 end;
  118.          x[0] := c
  119.       elsif xl >= yl then
  120.          x[xl] := 0; d := (B/2 - 1) / y[yl-1] + 1;
  121.          if d /= 1 then
  122.             y := y.copy; i := 0; c := 0;
  123.             loop while!(i < xl); c := c + d*x[i]; x[i] := c%B; c := c/B; i := i+1 end;
  124.             x[i] := c; i := 0; c := 0;
  125.             loop while!(i < yl); c := c + d*y[i]; y[i] := c%B; c := c/B; i := i+1 end;
  126.             assert c = 0
  127.          end;
  128.          y1 := y[yl-1]; y2 := y[yl-2]; i := xl;
  129.          loop while! (i >= yl);
  130.             if x[i] /= y1 then q := (x[i]*B + x[i-1]) / y1 else q := B-1 end;
  131.             loop while!(y2 * q > (x[i]*B + x[i-1] - y1*q)*B + x[i-2]); q := q-1 end;
  132.             j := i-yl; k := 0; c := 0;
  133.             loop while!(k < yl); c := c + x[j] - q*y[k]; x[j] := c%B; c := c/B; j := j+1; k := k+1 end;
  134.             if c+x[i] /= 0 then j := i-yl; k := 0; c := 0;
  135.                loop while!(k < yl); c := c + x[j] + y[k]; x[j] := c%B; c := c/B; j := j+1; k := k+1 end;
  136.                x[i] := q-1
  137.             else x[i] := q
  138.             end;
  139.             i := i-1
  140.          end;
  141.          if d /= 1 then i := yl; c := 0;
  142.             loop while!(i > 0); i := i-1; c := c*B + x[i]; x[i] := c/d; c := c%d end;
  143.          end
  144.       end;
  145.       return x
  146.    end;
  147.  
  148.    private get_u_div (x, y, q: SAME): SAME is
  149.       i: INT := x.len.abs;
  150.       yl: INT := y.len.abs;
  151.       loop while!((i >= yl) and (q[i] = 0)); i := i-1 end;
  152.       z: SAME := new(i-yl+1); z.len := i-yl+1;
  153.       loop while!(i >= yl); z[i-yl] := q[i]; i := i-1 end;
  154.       return z
  155.    end;
  156.  
  157.    private get_u_mod (x, y, q: SAME): SAME is
  158.       i: INT := x.len.abs.min(y.len.abs) - 1;
  159.       loop while!((i >= 0) and (q[i] = 0)); i := i-1 end;
  160.       z: SAME := new(i+1); z.len := i+1;
  161.       loop while!(i >= 0); z[i] := q[i]; i := i-1 end;
  162.       return z
  163.    end;
  164.  
  165.    private u_cmp (x, y: SAME): INT is
  166.       i: INT := x.len.abs;
  167.       j: INT := y.len.abs;
  168.       z: INT;
  169.       if (i = j) and (i /= 0) then i := i-1;
  170.          loop while!((i /= 0) and (x[i] = y[i])); i := i-1 end;
  171.          z := x[i] - y[i]
  172.       else z := i - j
  173.       end;
  174.       return z
  175.    end;
  176.  
  177.    private u_times_plus (x: SAME, y, c: INT): SAME
  178.    pre (0 <= y) and (y < B) and (0 <= c) and (c < B) is
  179.       xl: INT := x.len.abs;
  180.       i: INT := 0;
  181.       z: SAME := new(xl+1);
  182.       loop while!(i < xl); c := c + x[i]*y; z[i] := c%B; c := c/B; i := i+1 end;
  183.       if c /= 0 then z[i] := c; i := i+1 end;
  184.       z.len := i;
  185.       return z
  186.    end;
  187.  
  188.    private u_mod (x: SAME, d: INT): INT pre (1 <= d) and (d < B) is -- x /= 0; x will be modified
  189.       xl: INT := x.len.abs;
  190.       i: INT := xl;
  191.       c: INT := 0;
  192.       loop while!(i > 0); i := i-1; c := c*B + x[i]; x[i] := c/d; c := c%d end;
  193.       if x[xl-1] = 0 then x.len := xl-1 end;
  194.       return c
  195.    end;
  196.  
  197. -------------------------------------------------- binary arithmetics
  198.  
  199.    plus (y: SAME): SAME is
  200.       z: SAME;
  201.       if (len < 0) = (y.len < 0) then z := u_plus(self, y);
  202.       elsif u_cmp(self, y) < 0 then z := u_minus(y, self); z.len := -z.len
  203.       else z := u_minus(self, y);
  204.       end;
  205.       if len < 0 then z.len := -z.len end;
  206.       return z
  207.    end;
  208.  
  209.    minus (y: SAME): SAME is
  210.       z: SAME;
  211.       if (len < 0) /= (y.len < 0) then z := u_plus(self, y);
  212.       elsif u_cmp(self, y) < 0 then z := u_minus(y, self); z.len := -z.len
  213.       else z := u_minus(self, y);
  214.       end;
  215.       if len < 0 then z.len := -z.len end;
  216.       return z
  217.    end;
  218.  
  219.    times (y: SAME): SAME is
  220.       z: SAME;
  221.       if (len = 0) or (y.len = 0) then z := #SAME(0)
  222.       elsif (len.abs = 1) and (y.len.abs = 1) then z := #SAME([0] * y[0])
  223.       else
  224.          if len.abs < y.len.abs then z := u_times(self, y)
  225.          else z := u_times(y, self)
  226.          end
  227.       end;
  228.       if (len < 0) /= (y.len < 0) then z.len := -z.len end;
  229.       return z
  230.    end;
  231.  
  232.    div (y: SAME): SAME is
  233.       z: SAME;
  234.       if len.abs < y.len.abs then z := #SAME(0)
  235.       else
  236.          qr: SAME := u_div_mod(self, y);
  237.          z := get_u_div(self, y, qr);
  238.          if (len < 0) and (get_u_mod(self, y, qr).len /= 0) then z := u_times_plus(z, 1, 1) end;
  239.          if (len < 0) /= (y.len < 0) then z.len := -z.len end
  240.       end;
  241.       return z
  242.    end;
  243.  
  244.    mod (y: SAME): SAME is
  245.       z: SAME;
  246.       if len.abs < y.len.abs then z := self
  247.       else
  248.          z := get_u_mod(self, y, u_div_mod(self, y));
  249.          if (len < 0) and (z.len /= 0) then z := u_minus(y, z) end
  250.       end;
  251.       return z
  252.    end;
  253.  
  254.    pow (i: INT): SAME is
  255.    -- Returns self raised to the power i. Returns 1 for i < 0.
  256.    --
  257.       x ::= self; z ::= #SAME(1);
  258.       loop while!(i > 0);
  259.          -- z * x^i = self ^ i0
  260.          if i.is_odd then z := z*x end;
  261.          x := x.square; i := i/2
  262.       end;
  263.       return z
  264.    end;
  265.  
  266. -------------------------------------------------- binary relations
  267.  
  268.    cmp (y: SAME): INT is
  269.    -- Returns a value with the property x rel y = (x.cmp(y) rel 0),
  270.    -- where rel stands for one of the relations =, /=, <, <=, > or >=.
  271.    --
  272.       if (len < 0) /= (y.len < 0) then return len
  273.       elsif len < 0 then return u_cmp(y, self)
  274. --    else return u_cmp(self, y)                                                -- NLP
  275.       end; return u_cmp(self, y);                                               -- NLP
  276. --    end                                                                       -- NLP
  277.    end;
  278.  
  279.    is_eq(y: SAME): BOOL is return SYS::ob_eq(self, y) or (cmp(y) = 0) end;
  280.    is_neq(y: SAME): BOOL is return ~SYS::ob_eq(self, y) and (cmp(y) /= 0) end;
  281.    is_lt (y: SAME): BOOL is return cmp(y) < 0 end;
  282.    is_leq (y: SAME): BOOL is return cmp(y) <= 0 end;
  283.    is_gt (y: SAME): BOOL is return cmp(y) > 0 end;
  284.    is_geq (y: SAME): BOOL is return cmp(y) >= 0 end;
  285.  
  286. -------------------------------------------------- unary predicates
  287.  
  288.    is_even: BOOL is assert B.is_even; return (len = 0) or [0].is_even end;
  289.    is_odd: BOOL is assert B.is_even; return (len = 0) or [0].is_odd end;
  290.    is_pos: BOOL is return len > 0 end;
  291.    is_neg: BOOL is return len < 0 end;
  292.    is_zero: BOOL is return len = 0 end;
  293.  
  294. -------------------------------------------------- unary functions
  295.  
  296.    int: INT is
  297.       i ::= len.abs; z ::= 0;
  298.       loop while!(i > 0); i := i-1; z := z*B + [i] end;
  299.       if len < 0 then z := -z end;
  300.       return z
  301.    end;
  302.  
  303.    inti: INTI is return self end;
  304.  
  305.    abs: SAME is
  306.       if len < 0 then z ::= copy; z.len := -len; return z
  307. --    else return self                                                          -- NLP
  308.       end; return self;                                                         -- NLP
  309. --    end                                                                       -- NLP
  310.    end;
  311.  
  312.    negate: SAME is
  313.       if len /= 0 then z ::= copy; z.len := -len; return z
  314. --    else return self                                                          -- NLP
  315.       end; return self;                                                         -- NLP
  316. --    end                                                                       -- NLP
  317.    end;
  318.  
  319.    sign: INT is return len.sign end;
  320.    square: SAME is return self * self end;
  321.    cube: SAME is return self * self * self end;
  322.  
  323.    log2: INT is
  324.    -- Returns the largest n with 2^n <= self for self > 0 (logarithmus dualis).
  325.    --
  326.       assert len > 0;
  327.       return (len-1)*log2B + [len-1].highest_bit
  328.    end;
  329.  
  330.    sqrt: SAME is raise "INTI::sqrt: SAME not implemented" end;
  331.  
  332.    private mul (a, b: INT): SAME is
  333.       m: INT;
  334.       if a < b then m := (a+b)/2; return mul(a, m) * mul(m+1, b)
  335. --    else return #SAME(a)                                                      -- NLP
  336.       end; return #SAME(a);                                                     -- NLP
  337. --    end                                                                       -- NLP
  338.    end;
  339.  
  340.    factorial: SAME is return mul(1, self.int) end;
  341.  
  342. -------------------------------------------------- binary functions
  343.  
  344.    max (y: SAME): SAME is
  345. --    if cmp(y) > 0 then return self else return y end                          -- NLP
  346.       if cmp(y) > 0 then return self; end; return y;                            -- NLP
  347.    end;
  348.  
  349.    min (y: SAME): SAME is
  350. --    if cmp(y) < 0 then return self else return y end                          -- NLP
  351.       if cmp(y) < 0 then return self; end; return y;                            -- NLP
  352.    end;
  353.  
  354.    gcd (y: SAME): SAME post result.is_pos is
  355.    -- Returns the greatest common divisor of self and y.
  356.    -- The result is always > 0.
  357.    --
  358.       if y.len = 0 then return self.abs
  359. --    else return y.gcd(self % y)                                               -- NLP
  360.       end; return y.gcd(self % y);                                              -- NLP
  361. --    end                                                                       -- NLP
  362.    end;
  363.  
  364. -------------------------------------------------- output
  365.  
  366.    private append_int (s: FSTR, x, n: INT): FSTR pre x >= 0 is
  367.    -- Append a decimal version of x to s using at most n digits
  368.    -- (filled up with 0's) and return s.
  369.    --
  370.       i ::= s.length;
  371.       loop s := s + (x%10).digit_char; x := x/10; n := n-1; until!(x = 0) end;
  372.       loop while!(n > 0); s := s + '0'; n := n-1 end;
  373.       j ::= s.length-1;
  374.       loop while!(i < j); ch ::= s[i]; s[i] := s[j]; s[j] := ch; i := i+1; j := j-1 end;
  375.       return s
  376.    end;
  377.  
  378.    str_in (s: FSTR, n, b: INT, f: CHAR): FSTR pre b.is_bet(2, 16) is
  379.    -- Append a string representation of self to s using at least n digits
  380.    -- to the base b and return s. If less then n digits are used for the
  381.    -- representation of self (including its sign), the remaining left_most
  382.    -- positions are filled with character f.
  383.    --
  384.       x ::= copy; i ::= s.length;
  385.       loop s := s + u_mod(x, b).digit_char; n := n-1; until!(x.len = 0) end;
  386.       if self.len < 0 then s := s + '-'; n := n-1 end;
  387.       loop while!(n > 0); s := s + f; n := n-1 end;
  388.       j ::= s.length-1;
  389.       loop while!(i < j); ch ::= s[i]; s[i] := s[j]; s[j] := ch; i := i+1; j := j-1 end;
  390.       return s
  391.    end;
  392.  
  393.    str_in (s: FSTR): FSTR is
  394.    -- Append a decimal string version of self to s and return s.
  395.    --
  396.       if len = 0 then return s + '0'
  397. --    else                                                                      -- NLP
  398.       end;                                                                      -- NLP
  399.          if len < 0 then s := s + '-' end;
  400.          if len.abs = 1 then return [0].str_in(s)
  401. --       else                                                                   -- NLP
  402.          end;                                                                   -- NLP
  403.             -- compute output in reverse order in
  404.             -- chunks of log10D decimal digits
  405.             -- and append it in correct order to s
  406.             x ::= copy; -- working copy
  407.             d: FLIST{INT}; -- working buffer
  408.             loop d := d.push(u_mod(x, D)); until!(x.len = 0) end;
  409.             s := d.pop.str_in(s);
  410.             loop while!(d.size > 0); s := d.pop.str_in(s, log10D, 10, '0') end;
  411.             return s
  412. --       end                                                                    -- NLP
  413. --    end                                                                       -- NLP
  414.    end;
  415.  
  416.    private shared buf: FSTR; -- Buffer for string output.   
  417.    
  418.    str: STR is
  419.       -- A decimal string version of self.
  420.       buf.clear; buf := str_in(buf); return buf.str
  421.    end;
  422.    
  423.  
  424. -------------------------------------------------- object creation
  425.  
  426.    create (x: INT): SAME is
  427.    -- Creates an INTI of x.
  428.    --
  429.       z: SAME;
  430.       if x = INT::nil then -- prevent overflow
  431.          z := -(#INTI(2) ^ (INT::asize-1))
  432.       else
  433.          a ::= x.abs; i ::= 0;
  434.          z := new(a.highest_bit / log2B + 1);
  435.          loop while!(a /= 0); z[i] := a%B; a := a/B; i := i+1 end;
  436.          if x < 0 then z.len := -i else z.len := i end
  437.       end;
  438.       return z
  439.    end;
  440.  
  441.    create (s: STR, i: INT): SAME pre (0 <= i) and (i < s.length) is
  442.    -- Creates an INTI of its decimal string
  443.    -- representation in s starting at index i.
  444.    -- Returns 0i if no integer is found in s.
  445.    -- Syntax: [['-'] {digit}]
  446.    --
  447.       z ::= #SAME(0);
  448.       if s[i] = '-' then i := i+1 end;
  449.       d ::= 0; j ::= i;
  450.       loop while!((i < s.length) and s[i].is_digit);
  451.          d := d*10 + s[i].digit_value; i := i+1;
  452.          if i-j = log10D then z := u_times_plus(z, D, d); d := 0; j := i end
  453.       end;
  454.       if i-j > 0 then z := u_times_plus(z, 10^(i-j), d) end;
  455.       if s[0] = '-' then z.len := -z.len end;
  456.       return z
  457.    end;
  458.  
  459.    create (s: STR): SAME is
  460.       return #SAME(s, 0)
  461.    end;
  462.  
  463.    create (s: FSTR, i: INT): SAME pre (0 <= i) and (i < s.length) is
  464.    -- Creates an INTI of its decimal string
  465.    -- representation in s starting at index i.
  466.    -- Returns 0i if no integer is found in s.
  467.    -- Syntax: [['-'] {digit}]
  468.    --
  469.       z ::= #SAME(0);
  470.       if s[i] = '-' then i := i+1 end;
  471.       d ::= 0; j ::= i;
  472.       loop while!((i < s.length) and s[i].is_digit);
  473.          d := d*10 + s[i].digit_value; i := i+1;
  474.          if i-j = log10D then z := u_times_plus(z, D, d); d := 0; j := i end
  475.       end;
  476.       if i-j > 0 then z := u_times_plus(z, 10^(i-j), d) end;
  477.       if s[0] = '-' then z.len := -z.len end;
  478.       return z
  479.    end;
  480.  
  481.    create (s: FSTR): SAME is
  482.       return #SAME(s, 0)
  483.    end;
  484.  
  485. end
  486.