--* From RMC%WATSON.vnet.ibm.com@yktvmv.watson.ibm.com  Wed May 25 14:59:10 1994
--* Received: from yktvmv-ob.watson.ibm.com by asharp.watson.ibm.com (AIX 3.2/UCB 5.64/930311)
--*           id AA16880; Wed, 25 May 1994 14:59:10 -0400
--* Received: from watson.vnet.ibm.com by yktvmv.watson.ibm.com (IBM VM SMTP V2R3)
--*    with BSMTP id 3309; Wed, 25 May 94 14:59:09 EDT
--* Received: from YKTVMV by watson.vnet.ibm.com with "VAGENT.V1.0"
--*           id <A.RMC.NOTE.VAGENT2.2401.May.25.14:59:08.-0400>
--*           for asbugs@watson; Wed, 25 May 94 14:59:09 -0400
--* Received: from YKTVMV by watson.vnet.ibm.com with "VAGENT.V1.0"
--*           id 2393; Wed, 25 May 1994 14:59:08 EDT
--* Received: from matteo.watson.ibm.com by yktvmv.watson.ibm.com (IBM VM SMTP V2R3)
--*    with TCP; Wed, 25 May 94 14:59:07 EDT
--* Received: by matteo.watson.ibm.com (AIX 3.2/UCB 5.64/920123)
--*           id AA16294; Wed, 25 May 1994 14:56:48 -0400
--* Date: Wed, 25 May 1994 14:56:48 -0400
--* From: rmc@matteo.watson.ibm.com
--* Message-Id: <9405251856.AA16294@matteo.watson.ibm.com>
--* To: asbugs@watson.ibm.com
--* Subject: [3] (I from I) ~= (I from I) [/home/rmc/as/RoundedRatio][35.0]

--@ Fixed  by:  SSD   Wed Nov 23 09:28:31 EST 1994 
--@ Tested by:  none 
--@ Summary:    Type inference bug fixes now prevent duplicate meanings from I. 


--
-- First new type: Rounded Rationals.  RMC 25/5/1994
--
-- Basic idea: use continued fractions to keep rationals short.
--

-- Lessons.
-- 1) Rep is a type (capitalizations indicate types).
--    RoundedRatio is also a type, by the convention.
--    rep, on the other hand, is a procedure to cast something
--    into its representation.

#include "aslib.as"


-- The parameter MAXDENOM ensures that denominators
-- are not too big.

RoundedRatio( I: IntegerNumberSystem, MAXDENOM: I):
         Join(OrderedRing, Field) with {
	        *:       (I, %) -> %;
        	/:       (I, I) -> %;
	        numer:   % -> I;
	        denom:   % -> I;
	        coerce:  I -> %;

--	     export from I;

  }

== add {
        Rep ==> Ratio I;

        import from Rep;

        default a, b: %;


        ratio(n: I, d: I): % == per (n/d);

	gcd(a: %, b: %): % == 1;
	(a: %) quo (b: %): % == a/b;
	(a: %) rem (b: %): % == 0;
	divide(a: %, b: %): (%, %) == (a/b, 0);
#if 0

        reduce(n:I, d:I): % == {
		g := gcd(n, d);
		ratio(n quo g, d quo g)
	}
        reduce(r: %): % == {
		g := gcd(numer r, denom r);
		ratio(numer r quo g, denom r quo g)
	}
        normalize(n:I, d:I): % == {
		d < 0 => ratio(-n,-d);
		ratio(n,d)
	}
        normalize!(r: Rep): % == {
		r.denom >= 0 => per r;
		r.numer := -r.numer;
		r.denom := -r.denom;
		per r
	}
#endif

	-- Public Part --
        numer(a: %): I == numer rep(a);
        denom(a: %): I == denom rep(a);

        apply(p: OutPort, z: %): OutPort ==
                p(rep(z));

        (a: %) =  (b: %): Boolean == rep(a) = rep(b);
        (a: %) ~= (b: %): Boolean == ~(a = b);
        (a: %) <  (b: %): Boolean == rep(a) <  rep(b);
        (a: %) <= (b: %): Boolean == rep(a) <= rep(b);
        (a: %) >  (b: %): Boolean == rep(a) >  rep(b);
        (a: %) >= (b: %): Boolean == rep(a) >= rep(b);
	max(a: %, b: %): %        == if a > b then a else b;
	min(a: %, b: %): %        == if a < b then a else b;

	sign     (a: %): %       == per(sign(rep(a)));
	abs      (a: %): %       == if negative? a then -a else a;
        zero?    (a: %): Boolean == zero?     rep a;
	negative?(a: %): Boolean == negative? rep a;
	positive?(a: %): Boolean == positive? rep a;
	
        coerce(n: I): % == per(n/1);

        trunc(alpha: Rep): I == {{
		alpha >= 0 => numer(alpha) quo denom(alpha);
		numer(alpha) quo denom(alpha) - 1;
		}
        }

	trunc(a:%):I == trunc(rep(a));

        inv(a: %): % == round( (denom a)/(numer a) );

        0: % == per(0);
        1: % == per(1);

	+(a: %): % == a;
        -(a: %): % == ratio(-numer a, denom a);

        (a: %) + (b: %): % == round( rep(a) + rep(b) );
        (a: %) - (b: %): % == a + (-b);

        (a: %) * (b: %):% == round( rep(a) * rep(b) );
        (n: I) * (b: %): % == round( n * rep(b) );
        (n: I) / (d: I): % == round( n/d ) ;
        (a: %) / (b: %): % == round( rep a / rep b );
        (a: %) \ (b: %): % == round( rep b / rep a );

        (alpha: %) ^ (n: Integer): % == {
		local a,c:%;
		local m:Integer;
		a := alpha;
		m := abs n;
		c := per 1;
		while m > 0 repeat {
			{ odd? m => {
				c := c * a;
				m := m - 1;
			            }
			a := a * a;
			m := m quo 2;
			}
		}
		c
	}

	round( x: Rep) : % == {
	  local alpha,p0,p1,p2,q0,q1,q2,tmp : I;
          local gamma,tmp: Rep;
	  local done : Boolean;
	
	  alpha := trunc(x);
	  gamma := x - (alpha::Rep);
	
	  p0 := 1; p1 := alpha;
	  q0 := 0; q1 := 1;
	
	  done := false;
	
	
	  while gamma ~= 0 and not done repeat {
	    tmp   := inv(gamma);
	    alpha := trunc(tmp);
	    gamma := tmp - (alpha::Rep);
	    p2 := alpha*p1 + p0;
	    q2 := alpha*q1 + q0;
	
	    done := q2 > MAXDENOM;
	    {not done => {
	      p0 := p1; p1 := p2;
	      q0 := q1; q1 := q2;
	      }
	    }
	  }
	per( p1/q1 )
	}


}


-- cd /home/rmc/as/
-- asharp -M2 -Mno-mactext -Mno-emax RoundedRatio
-- "RoundedRatio", line 89:         coerce(n: I): % == per(n/1);
--                          ...........................^
-- [L89 C28] (Error) (After Macro Expansion) 2 meanings for `1' in this context.
-- The possible types were:
-- 	  1: I from I
-- 	  1: I from I
--   The context requires an expression of type I.
-- Expanded expression was: 1
--
-- Lots of similar I from I error messages omitted.