------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 1995 by International Computer Science Institute            --
-- This file is part of the GNU Sather package. It is free software; you may --
-- redistribute  and/or modify it under the terms of the  GNU General Public --
-- License (GPL)  as  published  by the  Free  Software  Foundation;  either --
-- version 2 of the license, or (at your option) any later version.          --
-- This  program  is distributed  in the  hope that it will  be  useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/GPL for more details.        --
-- The license text is also available from:  Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     --
-------------->  Please email comments to <bug-sather@gnu.org>  <--------------

-- test-param.sa: Test parametrized classes, bound routines
-- Author: Arno Jacobsen <jacobsen@icsi.berkeley.edu>

class TEST_BITERS is   -- Test of bound iters, also a few test of binding rout closures 

   include TEST;
   
   main is
      class_name("Test bound iters");

      d : ITER{once $BELT} : INT := bind(_.elt!);
      a ::= #ARR; 
      b ::= #MARR;
      c :$BELT; 
      
      c := a;       
      res : STR;
      loop
	 res := res + d.call!(c);
      end;
      test("Biter where self is abstract and unbound", res,"12345");
   
      res := "";
      eb :$BELT:= a;
      dd : ITER : INT := bind(eb.elt!);
      loop
	 res := res + dd.call!.str; 
      end;
      test("Biter where self is abstract and bound", res,"12345");
      
      res := "";
      loop
	 res := res + a.biter.call!.str;
      end;
      test("Biter as attribute of class", res,"12345");
   
      
      applyee :ITER:INT := bind(a.foo!(2));
      sq : ROUT{INT}:INT:= bind(square(_));
      
      res:="";
      loop
	 res:=res+a.apply!(applyee,sq).str;   
      end;
      test("Applying biter to bound function, returning the result",res,"49162536");
   
      
      bb : ITER : INT := bind(a.foo!(1));
      cc : ITER : INT;
      
      cc := a.ret_iter(bb);
      
      res := "";
      loop 5.times!; 
	 res := res + cc.call!;
      end;
      test("Calling a fct. with a biter argument that returns another biter which calls the first biter, or something like that.",res,"12345");

      oo ::= #ARR; 
      ab : ITER : INT := bind(oo.fooo!(0));
      ba : ITER : INT := bind(oo.fooo!(1));
      ca : ITER : INT;
      
      ca := oo.merge(ab,ba);
      res := "";
      loop 8.times!;
	 res := res + ca.call!.str;
      end;
      test("Merges two iters.",res,"01010101");
   
      
      t ::= #MARR;  
        
      b0 : ITER{once MARR, once INT,INT, once INT, INT, once INT} : INT := bind(_.foo!(_,_,_,_,_));
      b1 : ITER{once INT, INT, once INT, INT,once INT} : INT := bind(t.foo!(_,_,_,_,_));
      b2 : ITER{INT, once INT, INT, once INT} : INT := bind(t.foo!(1,_,_,_,_));
      b3 : ITER{once INT, INT, once INT} : INT := bind(t.foo!(1,1,_,_,_));
      b4 : ITER{INT, once INT} : INT := bind(t.foo!(1,1,1,_,_));
      b5 : ITER{once INT} : INT := bind(t.foo!(1,1,1,1,_));
      b6 : ITER : INT := bind(t.foo!(1,1,1,1,1));
      
      
      res := "";
      loop
	 res := res + b0.call!(t,0,0,0,0,0).str;
      end;
      test("Different comb. of arguments for biters: bnd/unbnd/hot/once",res,"000");
      
      res := "";
      loop
	 res := res+b1.call!(0,0,0,0,0).str;
      end;
      test("Different comb. of arguments for biters: bnd/unbnd/hot/once",res,"000");
      
      res := "";
      loop
	 res:=res+b2.call!(0,0,0,0).str;
      end;
      test("Different comb. of argunments for biters: bnd/unbnd/hot/once",res,"111");
      
      res := "";
      loop
	 res:=res+b3.call!(0,0,0).str;
      end;
      test("Different comb. of argunments for biters: bnd/unbnd/hot/once",res,"222");
      
   
      res := "";
      loop
	 res:=res+b4.call!(0,0).str;
      end;
      test("Different comb. of argunments for biters: bnd/unbnd/hot/once",res,"333");
      
      res := "";
      loop
	 res:=res+b5.call!(0).str;
      end;	
      test("Different comb. of argunments for biters: bnd/unbnd/hot/once",res,"444");

      res := "";
      loop
	 res:=res+b6.call!.str;
      end;
      test("Different comb. of argunments for biters: bnd/unbnd/hot/once",res,"555");
   
      bins; -- call more tests
      biter_biter_tests;  -- test binding iter closures
   
      bone_breaker; -- array of biters binding each other
      
      bin_counter; -- array of biters binding each other and doin some comp.
      -- test binding of rout closures
      insane;        
   end;

   pfoo(i : INT, j : INT, k: INT, l : INT) : INT is
      return 1+i+j+k+l;  -- 5
   end;
   
   pkoo(i : INT, j : INT, k: INT, l : INT, m : INT, n :INT) : INT is
      return 1+i+j+k+l+m+n;  -- 7;
   end;
	
   bone_breaker is
      a:ARRAY{ITER:INT}:=#(10);
      a[0]:=bind(counter!);
      loop
	 i::=1.upto!(a.size-1);
         a[i]:=bind(a[i-1].call!);
      end;
      res ::= "";
      loop 2.times!; res:= res +a[9].call!+a[8].call!+a[7].call!+a[6].call!+a[5].call!+a[4].call!+a[3].call!+a[2].call!+a[1].call!+a[0].call!; end;
      test("Binding iter closures, array of biters", res, "00000000001111111111");
   end;
   
   bin_counter is
      a:ARRAY{ITER:INT}:=#(10);
      a[0]:=bind(counter!);
      loop
	 i::=1.upto!(a.size-1);
         a[i]:=bind(double!(a[i-1]));
      end;

      res::="";
      loop 4.times!;
	 res := res + a[9].call!+a[8].call!+a[7].call!+a[6].call!+a[5].call!+a[4].call!
	       +a[3].call!+a[2].call!+a[1].call!+a[0].call!;
      end;
      test("Binding iter closures, impl of bin counter. ",res,"0000000000000000000100000000100000000011");
   end;
   
   counter!:INT is
      loop yield 0; yield 1; end;
   end;

   double!(once i:ITER:INT):INT is
      loop
         k::=i.call!;
         yield k;
	 yield k;
      end;
   end;
   
   insane is
      c ::= true;
      a : ROUT{INT,INT,INT} : INT;
      if c then
	 a := bind(pfoo(_,_,_,1));
      else
	 a := bind(pkoo(_,_,_,1,1,1));
      end;
      
      -- dyn binding, binding chains
      b ::= bind(a.call(1,1,_));
      d ::= bind(b.call(_));
      e ::= bind(d.call(1));
      
      -- binding chain and several args
      gg::=bind(bind(pfoo(_,_,_,1)).call(1,_,_)).call(1,1);
      
      -- self unbnd
      aga ::= bind(pfoo(_,_,_,1));
      
      baa : ROUT{ ROUT{INT,INT,INT} : INT, INT, INT}:INT;
      baa := bind(_.call(1,_,_));
      
      test("Binding rout closures, dyn. binding and binding chain.",e.call.str,"5");
      test("Binding rout closures, binding chain.",gg,"5");
      test("Binding rout closures, self unbnd.",baa.call(aga,1,1).str,"5");
   end;
   
   bins is
      -- binding of builtins
      a1 ::= bind(INT::for!(_));
      a2 :ITER{once INT,once INT}:INT := bind(_.for!(_));
      a3 ::= bind(INT::up!);
      a4 :ITER{once INT}:INT := bind(_.up!);
      a5 :ITER{once INT,once INT}:INT := bind(_.step!(3,_));
      aa ::=#AREF{INT}(3);
      a6 ::= bind(aa.aind!);
      
      a::= 0;
      loop 
	 a := a + a1.call!(2);
      end;
      test("Bindinding of builtin iters",a,"1");
      
      a:= 0;
      loop 
	 a := a + a2.call!(2,2);
      end;
      test("Bindinding of builtin iters",a,"5");
      
      a:= 0;
      loop 4.times!;
	 a := a + a3.call!;
      end;
      test("Bindinding of builtin iters",a,"6");
      
      a:= 0;
      loop 4.times!;
	 a := a + a4.call!(2);
      end;
      test("Bindinding of builtin iters",a,"14");
      
      a:= 0;
      loop 
	 a := a + a5.call!(2,2);
      end;
      test("Bindinding of builtin iters",a,"12");
      
      a:= 0;
      loop 
	 a := a + a6.call!;
      end;
      test("Bindinding of builtin iters",a,"3");
   end;
      
   -- used to test bound iters, apply!
   square(i:INT) : INT is
      return i*i;
   end;
   
   biter_biter_tests is
      cond ::= true;
      
      -- test dyn. binding
      a :ITER{INT,INT}:INT;
      if cond then
      	a := bind(foo!(1,_,_));
      else
      	a := bind(too!(1,_,_));
      end;
      b :ITER{INT}:INT:= bind(a.call!(1,_));
      
      
      -- testting all once
      c ::= bind(fool!(_,_,_));
      d :ITER{once INT, once INT, once INT}:INT:= bind(c.call!(_,_,_));

      
      -- testting all hot
      e ::= bind(foo!(_,_,_));
      f :ITER{INT, INT, INT}:INT:= bind(e.call!(_,_,_));

      -- mix hots and onces
      -- mega!(once i : INT, once j :INT, k : INT, once INT l, INT m) : INT is 
      g ::= bind(mega!(1,_,_,1,_));
      h ::= bind(g.call!(1,_,1));
           
      -- mix more once and hot
      i ::= bind(g.call!(1,_,_));
      j ::= bind(g.call!(_,1,_));
      k ::= bind(g.call!(_,_,1));
      
      -- chains of bindings
      ii::= bind(i.call!(1,_));
      iii::= bind(ii.call!(1));
      iiii::= bind(iii.call!);
      
      -- self from a diff class 
      ac ::= #A;
      l ::= bind(ac.foo!(_,_));
      m ::= bind(l.call!(1,2));
      
      -- self unbnd
      nn ::= bind(foo!(_,_,_));
      n :ITER{once ITER{INT,INT,INT}:INT,INT,INT,INT}:INT:= bind(_.call!(_,_,_));
      
      -- test self unbnd
      aga::= bind(foo!);
      bab :ITER{once ITER:INT}:INT := bind(_.call!);
    
      -- test self unbnd with once hot mix
      aga1::= bind(poo!(1,_,_));
      bab1 :ITER{once ITER{INT, once INT} : INT, INT, once INT}:INT := bind(_.call!(_,_));
      
      -- test different hot values
      bb1 ::= bind(bar!(1,_));
      bb2 ::= bind(bb1.call!(_));

      res::="";
      loop
	 res:=res+bab.call!(aga);
      end;
      test("Binding a closure with self unbound without other arg.",res,"12");
      
      res:="";
      loop
	 res:=res+n.call!(nn,1,1,1);
      end;
      test("Binding a closure with self unbound other bnd/unbdn args.",res,"3");
      
      res:="";
      loop
	 res:=res+m.call!;
      end;
      test("Binding a closure with self (first binding) from a separate class.",res,"12");
            
      res:="";
      loop
	 res:=res+iiii.call!;
      end;
      test("Binding a closure: I.e. a chaing of three closure bindings",res,"555");
            
      res:="";
      loop
	 res:=res+ii.call!(1);
      end;
      test("Binding a closure, simple test",res,"555");
                  
      res:="";
      loop
	 res:=res+iii.call!;
      end;
      test("Binding a closure, simple test.",res,"555");
            
      res:="";
      loop
	 res:=res+i.call!(1,1);
      end;
      test("Binding a closure  ",res,"555");
      
      res:="";
      loop
	 res:=res+j.call!(1,1);
      end;
      test("Binding a closure, mixed hot and once.  ",res,"555");
      
      res:="";
      loop
	 res:=res+k.call!(1,1);
      end;
      test("Binding a closure, mixed hot and once. ",res,"555");
      
      res:="";
      loop 
	 res:=res+b.call!(1); -- 3 with cond = true 
      end;
      test("Binding a closure, test of dyn. binding capability. ",res,"3");
      
      res:="";
      loop
	 res:=res+c.call!(1,1,1); -- 3 , 1, 1
      end;
      test("Binding a closure, all args once.",res,"311");
      
      res:="";
      loop
	 res:=res+c.call!(1,1,1); -- 3 , 1, 1
	 res:=res+c.call!(1,1,1); -- 3 , 1, 1
      end;
      test("Binding a closure, all args once, double call of same closure in loop.",res,"331111");
   
      res:="";
      loop
	 res:=res+f.call!(1,1,1); -- 3 
      end;
      test("Binding a closure, all args hots. ",res,"3");
   
      res:="";
      loop
	 res:=res+h.call!(1); -- 5 5 5 
      end;
      test("Binding a closure, very large number of args mixed modes.  ",res,"555");
   
      res:="";
      index ::= 1;
      loop
	 res:=res+bb2.call!(index); -- 2 3 4 5
	 index := index + 1;
      end;
      test("Binding a closure, exercise hots.",res,"2345");
      
      res:="";
      loop
	 res:=res+bab1.call!(aga1,2,3); -- 123
      end;
      test("Binding a closure with self unbound mix hot and once args.",res,"123");
      
   end;
   
   foo!(i : INT, j :INT, k : INT) : INT is 
      yield i + j + k;
   end;

   foo! : INT is yield 1; yield 2; end;
  
   too!(i : INT, j :INT, k : INT) : INT is 
      yield i + j + k + 1;
   end;
      
   fool!(once i : INT, once j :INT, once k : INT) : INT is 
      yield i + j + k;
      yield 1;
      yield 1;
   end;
   
   poo!(once i : INT, j :INT, once k : INT) : INT is 
      yield i;
      yield j;
      yield k;
   end;
   
   mega!(once i : INT, once j :INT, k : INT, once l : INT, m : INT) : INT is 
      yield i + j + k + l + m; 
      yield i + j + k + l + m; 
      yield i + j + k + l + m; 
   end;
      
   bar!(i : INT, j : INT) : INT is 
      loop 4.times!;
	 yield i + j;
      end;
   end;
   
end; -- class TEST_BITERS


class A is 
   
   create : SAME is return new; end;
   
   foo!(once i : INT, j : INT) : INT is
      yield i;
      yield j;
   end;

end;





-------------------------------------------------------------------

-- the following is code needed for the test but contains no test runs.

abstract class $BELT is 

   elt! : INT;
   mem : INT;

end;

class ARR < $BELT is
   

   attr biter : ITER : INT;
   
   ------------------------------------------
   
   private attr a : ARRAY{INT};
   
   create : SAME is 
      
      n ::= new;
      n.a := #ARRAY{INT}(5);
      n.a := |1,2,3,4,5|;
      n.biter := bind(n.elt!);
      return n 
   end;
   
   ------------------------------------------
   
   elt! : INT is 
      loop
	 yield a.elt!;
      end;
   end;

   mem : INT is
      return a[3];
   end;
   
   ------------------------------------------
   
   foo!(i : INT):INT is
      -- yields successice integers starting from `i`
      l ::= i;
      loop 5.times!;
	 yield l;
	 l := l + 1;
      end;   
   end;
    
   ------------------------------------------
   
   apply!(once f:ITER:INT,once  fct : ROUT{INT}:INT) : INT is
      -- apply `fct` to stream 'f' and return result
      
      l ::= 0;
      loop 
	 yield fct.call(f.call!);
      end;
   end;
   
   ------------------------------------------
   
   emit!(once s2 : ITER:INT) : INT is
      
      loop
	 yield s2.call!;
      end
   end;
   
   ret_iter(s1 : ITER:INT) : ITER : INT is  
         
      res :ITER:INT:= bind(self.emit!(s1));
      return res;
   end;
   
   ------------------------------------------ 
   
   fooo!(once i : INT) : INT is    -- generates sequence of integers  
      loop
	 yield i;
      end;
   end;
   
   barr!(once i: INT):INT is  -- generates sequence of integers
      loop
	 yield i;
      end;
   end;

   mg!(once s1,once s2 : ITER:INT) : INT is
      -- merges two streams  

      loop
	 yield s1.call!;
	 yield s2.call!;
      end
   end;
   
   merge(s1, s2 : ITER:INT) : ITER : INT is  
   -- merges two stream and returns iter of merged streams
      
      res :ITER:INT:= bind(mg!(s1,s2));
      return res;
   end;
   
   ------------------------------------------
   
end;

class MARR < $BELT is
   
   private attr a : ARRAY{INT};
   
   create : SAME is 
      
      n ::= new;
      n.a := #ARRAY{INT}(5);
      n.a := |-1,-2,-3,-4,-5|;
      
      return n 
   end;
   
   elt! : INT is 
      loop
	 yield a.elt!;
      end;
   end;

   mem : INT is
      return a[0];
   end;
   
   foo!(once a:INT, b : INT,once  c : INT, d : INT,once  e : INT) : INT is
      l : INT := a + b + c + d + e; 
      loop 3.times!;
	 yield l;
      end;
   end;
   
end;


