home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sa104os2.zip / SATHR104.ZIP / SATHER / LIBRARY / RAT.SA < prev    next >
Text File  |  1995-02-05  |  7KB  |  168 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. -- rat.sa: Implementation of rational numbers. A rational number is
  10. -- represented by two integers u and v (numerator and denominator)
  11. -- and always normalized, i.e. u.gcd(v) = 1 and v > 0.
  12. ----------------------------------------------------------------------
  13.  
  14. value class RAT < $IS_EQ{SAME}, $IS_LT{SAME}, $STR is
  15.    readonly attr u, v: INTI; -- numerator, denominator
  16.  
  17. -------------------------------------------------- object creation
  18.  
  19.    create (u: INTI): SAME is
  20.       r: SAME; return r.u(u).v(#INTI(1))
  21.    end;
  22.  
  23.    create (u: INT): SAME is
  24.       return create(#INTI(u))
  25.    end;
  26.  
  27.    create (u, v: INTI): SAME is
  28.       assert ~v.is_zero;
  29.       if u.is_zero then v := #INTI(1)
  30.       else g ::= u.gcd(v);
  31.          if v.is_neg then g := -g end;
  32.          u := u/g; v := v/g
  33.       end;
  34.       assert v.is_pos;
  35.       r: SAME; return r.u(u).v(v)
  36.    end;
  37.  
  38.    create (u, v: INT): SAME is
  39.       return create(#INTI(u), #INTI(v))
  40.    end;
  41.  
  42. -------------------------------------------------- binary arithmetics
  43.  
  44.    plus (y: SAME): SAME is return #SAME(u*y.v + v*y.u, v*y.v) end;
  45.    minus (y: SAME): SAME is return #SAME(u*y.v - v*y.u, v*y.v) end;
  46.    times (y: SAME): SAME is return #SAME(u*y.u, v*y.v) end;
  47.    div (y: SAME): SAME is assert ~y.u.is_zero; return #SAME(u*y.v, v*y.u) end;
  48.    mod (y: SAME): SAME is return self - #SAME((self/y).floor)*y end;
  49.  
  50.    pow (i: INT): SAME is
  51.    -- Returns self raised to the power i. Returns 1 for i < 0.
  52.    --
  53.       x ::= self; z ::= #SAME(1);
  54.       loop while!(i > 0);
  55.          -- z * x^i = self ^ i0
  56.          if i.is_odd then z := z*x end;
  57.          x := x.square; i := i/2
  58.       end;
  59.       return z
  60.    end;
  61.  
  62. -------------------------------------------------- binary relations
  63.  
  64.    is_eq (y: SAME): BOOL is return (u = y.u) and (v = y.v) end;
  65.    is_neq (y: SAME): BOOL is return (u /= y.u) or (v /= y.v) end;
  66.    is_lt (y: SAME): BOOL is return u*y.v < v*y.u end;
  67.    is_leq (y: SAME): BOOL is return u*y.v <= v*y.u end;
  68.    is_gt (y: SAME): BOOL is return u*y.v > v*y.u end;
  69.    is_geq (y: SAME): BOOL is return u*y.v >= v*y.u end;
  70.  
  71. -------------------------------------------------- unary predicates
  72.  
  73.    is_pos: BOOL is return u.is_pos end;
  74.    is_neg: BOOL is return u.is_neg end;
  75.    is_zero: BOOL is return u.is_zero end;
  76.    is_int: BOOL is return v = #INTI(1) end;
  77.  
  78. -------------------------------------------------- unary functions
  79.  
  80.    abs: SAME is r: SAME; return r.u(u.abs).v(v) end;
  81.    negate: SAME is r: SAME; return r.u(-u).v(v) end;
  82.    sign: INT is return u.sign end;
  83.    square: SAME is r: SAME; return r.u(u.square).v(v.square) end;
  84.    cube: SAME is r: SAME; return r.u(u.cube).v(v.cube) end;
  85.    floor: INTI is return u/v end;
  86.    ceiling: INTI is raise "RAT::ceiling not implemented" end;
  87.  
  88. -------------------------------------------------- miscellaneous
  89.  
  90.    float (n, b: INT): TUP{BOOL, INTI, INT, BOOL} pre (n > 0) and (b > 1) is
  91.    -- Returns the floating point number x = s * m * b^e that is
  92.    -- closest to self. x is returned in form of a 4-tupel (s, m, e, a).
  93.    -- n specifies the length of the mantissa m in no. of digits to the
  94.    -- base b. The mantissa is either 0 (self = 0) or normalized, i.e.
  95.    -- it holds: b^(n-1) <= mantissa < b^n. The sign s indicates a
  96.    -- negative number. The flag a indicates that x is accurate
  97.    -- (i.e. x = self). Rounding to the nearest is used; ties are
  98.    -- broken by rounding to even (IEEE rounding).
  99.    --
  100.    -- The implementation is essentialy AlgorithmM described by
  101.    -- W.D. Clinger in "How to Read Floating Point Numbers
  102.    -- Accurately", PLDI 1990 proceedings, p. 92-101.
  103.    --
  104.       if u.is_zero then return #(false, #INTI(0), 0, true)
  105. --    else                                                                      -- NLP
  106.       end;                                                                      -- NLP
  107.          beta ::= #INTI(b);
  108.          beta_n1 ::= beta^(n-1);
  109.          beta_n ::= beta_n1 * beta;
  110.          s ::= self.u.is_neg;
  111.          u ::= self.u.abs;
  112.          v ::= self.v; assert v.is_pos;
  113.          -- u/v = |self|
  114.          -- approximation for e
  115.          e ::= u.log2 - v.log2;
  116.          if b /= 2 then e := (e.flt / b.flt.log2).round.int end;
  117.          e := e-n;
  118.          if e < 0 then u := u * beta^(-e)
  119.          else v := v * beta^e
  120.          end;
  121.          -- normalize
  122.          -- (usually 0 or 1 iteration steps required)
  123.          m: INTI;
  124.          loop
  125.             -- u/v * b^e = |self|
  126.             m := u/v;
  127.             if m < beta_n1 then u := u*beta; e := e-1
  128.             elsif m >= beta_n then v := v*beta; e := e+1
  129.             else break!
  130.             end
  131.          end;
  132.          -- (u/v * b^e = |self|) & (b^(n-1) <= u/v < b^n)
  133.          -- conversion to float & rounding to nearest (IEEE)
  134.          r ::= u%v; v_r ::= v-r;
  135.          if (r > v_r) or ((r = v_r) and m.is_odd) then -- next float
  136.             m := m + #INTI(1);
  137.             if m = beta_n then m := beta_n1; e := e+1 end
  138.          end;
  139.          return #(s, m, e, r.is_zero)
  140. --    end                                                                       -- NLP
  141.    end;
  142.  
  143. -------------------------------------------------- output
  144.  
  145.    str: STR is
  146.    -- Returns a string representation of self in the form
  147.    -- u/v or u (if self.is_int).
  148.    --
  149.       if is_int then return u.str
  150. --    else return u.str + '/' + v.str                                           -- NLP
  151.       end; return u.str + '/' + v.str;                                          -- NLP
  152. --    end                                                                       -- NLP
  153.    end;
  154.  
  155.    str (n: INT): STR pre n > 0 is
  156.    -- Returns a string representation of self in decimal floating
  157.    -- point form [sign] digit '.' {digit} ['e' [sign] digit {digit}] where
  158.    -- n specifies the number of digits of the mantissa.
  159.    --
  160.       x ::= float(n, 10); s ::= "";
  161.       if x.t1 then s := s + '-' end;
  162.       s := s + x.t2.str; -- to be improved
  163.       if x.t3 /= 0 then s := s + 'e' + x.t3 end;
  164.       return s
  165.    end;
  166.  
  167. end
  168.