------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 1995 by International Computer Science Institute            --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute  and/or modify it under the terms of the GNU Library General --
-- Public  License (LGPL)  as published  by the  Free  Software  Foundation; --
-- either version 2 of the license, or (at your option) any later version.   --
-- This  library  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/LGPL 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>  <--------------

-- fortran.sa: FORTRAN interface classes
-- author: Boris Vaysman

abstract class $F_NUMBER{NTP} < $NIL, $STR, $IS_EQ is
   zero:NTP;
   plus(n:NTP): SAME;
   minus(n:NTP):SAME;
   times(n:NTP): SAME;
   div(n:NTP): SAME;
end;

abstract class $F_SCALAR < $STR, $IS_EQ is
end;

immutable class F_INTEGER < $F_NUMBER{F_INTEGER}, $F_SCALAR  is
   -- FORTRAN INTEGER*4 type (built in type)
   include COMPARABLE;
   
   create(x:INT):F_INTEGER is
      builtin F_INTEGER_CREATE_INT;
   end;

   int:INT is
      -- A Sather integer version of self
      builtin F_INTEGER_INT;
   end;
   
   str:STR is
      return int.str;
   end;
   
   zero:SAME is builtin F_INTEGER_ZERO; end;
   plus(i:SAME):SAME is builtin F_INTEGER_PLUS; end;
   minus(i:SAME):SAME is builtin F_INTEGER_MINUS; end;      
   times(i:SAME):SAME is builtin F_INTEGER_TIMES; end;         
   div(i:SAME):SAME is builtin F_INTEGER_DIV; end;  
   is_eq(i:SAME):BOOL is builtin F_INTEGER_IS_EQ; end;
   is_lt(i:SAME):BOOL is builtin F_INTEGER_IS_LT; end;
   
   nil:SAME is
      -- let Sather handle this (we are confused by the philosophical
      -- impilations of nil vs void vs unitialized vs zero
      return #(INT::nil);
   end;
   
   is_nil:BOOL is
      return int.is_nil;
   end;
end;

immutable class F_REAL <  $F_NUMBER{F_REAL}, $F_SCALAR is
   -- FORTRAN REAL type (built in type)
   include COMPARABLE;
   
   create(x:FLT):F_REAL is
      builtin F_REAL_CREATE_FLT;
   end;

   flt:FLT is
      -- A Sather FLT version of self
      builtin F_REAL_FLT;
   end;
   
   str:STR is
      return flt.str;
   end;
   zero:SAME is builtin F_REAL_ZERO; end;
   plus(i:SAME):SAME is builtin F_REAL_PLUS; end;
   minus(i:SAME):SAME is builtin F_REAL_MINUS; end;      
   times(i:SAME):SAME is builtin F_REAL_TIMES; end;         
   div(i:SAME):SAME is builtin F_REAL_DIV; end;  
   is_eq(i:SAME):BOOL is builtin F_REAL_IS_EQ; end;
   is_lt(i:SAME):BOOL is builtin F_REAL_IS_LT; end;
   
   nil:SAME is
      -- let Sather handle this (we are confused by the philosophical
      -- impilations of nil vs void vs unitialized vs zero
      return #(FLT::nil);
   end;   
   
   is_nil:BOOL is
      return flt.is_nil;
   end;
end;


immutable class F_LOGICAL < $F_SCALAR is
   -- FORTRAN LOGICAL type (built in type)
   include COMPARABLE;
   
   create(x:BOOL):F_LOGICAL is
      builtin F_LOGICAL_CREATE_BOOL;
   end;

   bool:BOOL is
      -- A Sather BOOL version of self
      builtin F_LOGICAL_BOOL;
   end;
   
   str:STR is
      return bool.str;
   end;
   
   not:SAME is builtin F_LOGICAL_NOT; end;
   is_eq(b:SAME):BOOL is builtin F_LOGICAL_IS_EQ; end;
   f_or(b:SAME):SAME is builtin F_LOGICAL_OR; end;
   f_and(b:SAME):SAME is builtin F_LOGICAL_AND; end;   

end;

immutable class F_DOUBLE < $F_NUMBER{F_DOUBLE}, $F_SCALAR is
   -- FORTRAN LOGICAL type (built in type)
   include COMPARABLE;
   
   create(x:FLTD):F_DOUBLE is
      builtin F_DOUBLE_CREATE_FLTD;
   end;

   fltd:FLTD is
      -- A Sather FLTD version of self
      builtin F_DOUBLE_FLTD;
   end;
   
   str:STR is
      return fltd.str;
   end;
   
   zero:SAME is builtin F_DOUBLE_ZERO; end;
   plus(i:SAME):SAME is builtin F_DOUBLE_PLUS; end;
   minus(i:SAME):SAME is builtin F_DOUBLE_MINUS; end;      
   times(i:SAME):SAME is builtin F_DOUBLE_TIMES; end;         
   div(i:SAME):SAME is builtin F_DOUBLE_DIV; end;  
   is_eq(i:SAME):BOOL is builtin F_DOUBLE_IS_EQ; end;
   is_lt(i:SAME):BOOL is builtin F_DOUBLE_IS_LT; end;
   
   nil:SAME is
      -- let Sather handle this (we are confused by the philosophical
      -- impilations of nil vs void vs unitialized vs zero
      return #(FLTD::nil);
   end;   
   
   is_nil:BOOL is
      return fltd.is_nil;
   end;   
end;

immutable class F_CHARACTER < $F_SCALAR is
   -- FORTRAN CHARACTER*1 type (built in type)
   include COMPARABLE;
   
   create(x:CHAR):SAME is
      builtin F_CHARACTER_CREATE_CHAR;
   end;
   
   char:CHAR is
      builtin F_CHARACTER_CHAR;
   end;
   
   str:STR is
      return char.str;
   end;
   
   zero:SAME is builtin F_CHARACTER_ZERO; end;

   is_eq(i:SAME):BOOL is builtin F_CHARACTER_IS_EQ; end;
   is_lt(i:SAME):BOOL is builtin F_CHARACTER_IS_LT; end;
   
end;

class F_STRING  is
   -- FORTRAN CHARACTER*N type (built in type)
   address:EXT_OB is
      -- pointer to F_CHARACTER string      
      builtin F_STRING_ADDRESS;
   end;
   
   size:INT is
      -- length of the string
      builtin F_STRING_SIZE;
   end;

   create(x:CHAR):SAME is
      builtin F_STRING_CREATE_CHAR;
   end;
   
   create(x:STR):SAME is
      -- CHARACTER*N
      builtin F_STRING_CREATE_STR;
   end;   

   create(n:INT):SAME is
      builtin F_STRING_CREATE_INT;
   end;
   
   str:STR is
      s:STR;
      s := STR::create_from_memory_area(address, size);
      return s;
   end;
   
end;


immutable class F_COMPLEX < $F_NUMBER{F_COMPLEX}, $F_SCALAR is
   -- FORTRAN COMPLEX type (built in type)
   include COMPARABLE;
   
   re:F_REAL is
      builtin F_COMPLEX_READ_RE;
   end;
   
   re(x:F_REAL) is
      builtin F_COMPLEX_WRITE_RE;
   end;   
   
   im:F_REAL is
      builtin F_COMPLEX_READ_IM;
   end;
   
   im(x:F_REAL) is
      builtin F_COMPLEX_WRITE_IM;
   end;   
   
   create(x:CPX):SAME is
      r:SAME;
      r.re(#F_REAL(x.re));
      r.im(#F_REAL(x.im));   
      return r;
   end;

   create(re:F_REAL, im:F_REAL):SAME is
      r:SAME;
      r.re(re);
      r.im(im);   
      return r;
   end;
   
   create(re:FLT, im:FLT):SAME is
      r:SAME;
      r.re(#(re));
      r.im(#(im));
      return r;
   end;
   
   create(fc:F_COMPLEX):SAME is
      r:SAME;
      r := fc;
      return r;
   end;   
	
   cpx:CPX is
      -- A Sather CPX version of self
      return #CPX(re.flt, im.flt);
   end;
   
   str:STR is
      return cpx.str;
   end;
   
   zero:SAME is builtin F_COMPLEX_ZERO; end;
   plus(c:SAME):SAME is 
      return #(re+c.re,im+c.im);
   end;

   minus(c:SAME):SAME is
      -- The difference of self and `c'.
      return #(re-c.re,im-c.im) 
   end;       
   
   times(c:SAME):SAME is 
      return #(re*c.re-im*c.im, re*c.im+im*c.re) 
   end;

   div(c:SAME):SAME is 
      -- The ratio of self and `c'.
      return #(cpx/c.cpx);
   end;
   
   is_eq(c: SAME): BOOL is return re=c.re and im=c.im end;
   
   nil:SAME is
      -- let Sather handle this (we are confused by the philosophical
      -- impilations of nil vs void vs unitialized vs zero
      return #F_COMPLEX(FLT::nil, FLT::nil);
   end;   
   
   is_nil:BOOL is
      return cpx.is_nil;
   end;   
end;

immutable class F_DOUBLE_COMPLEX < $F_NUMBER{F_DOUBLE_COMPLEX}, $F_SCALAR is
   -- FORTRAN DOUBLE COMPLEX type (built in type)
   include COMPARABLE;
   
   re:F_DOUBLE is
      builtin F_COMPLEX_READ_RE;
   end;
   
   re(x:F_DOUBLE) is
      builtin F_COMPLEX_WRITE_RE;
   end;   
   
   im:F_DOUBLE is
      builtin F_COMPLEX_READ_IM;
   end;
   
   im(x:F_DOUBLE) is
      builtin F_COMPLEX_WRITE_IM;
   end;   
   
   create(x:CPXD):SAME is
      r:SAME;
      r.re(#F_DOUBLE(x.re));
      r.im(#F_DOUBLE(x.im));   
      return r;
   end;

   create(re:F_DOUBLE, im:F_DOUBLE):SAME is
      r:SAME;
      r.re(re);
      r.im(im);   
      return r;
   end;
   
   create(fc:F_DOUBLE_COMPLEX):SAME is
      r:SAME;
      r := fc;
      return r;
   end;   
	
   create(re:FLTD, im:FLTD):SAME is
      r:SAME;
      r.re(#(re));
      r.im(#(im));
      return r;
   end;
   
   cpxd:CPXD is
      -- A Sather CPX version of self
      return #CPXD(re.fltd, im.fltd);
   end;
   
   str:STR is
      return cpxd.str;
   end;
   
   zero:SAME is builtin F_DOUBLE_COMPLEX_ZERO; end;
   plus(c:SAME):SAME is 
      return #(re+c.re,im+c.im);
   end;

   minus(c:SAME):SAME is
      -- The difference of self and `c'.
      return #(re-c.re,im-c.im) 
   end;       
   
   times(c:SAME):SAME is 
      return #(re*c.re-im*c.im, re*c.im+im*c.re) 
   end;

   div(fc:SAME):SAME is 
      -- The ratio of self and `c'.
      return #F_DOUBLE_COMPLEX(cpxd/fc.cpxd);
   end;
   
   is_eq(c: SAME): BOOL is return re=c.re and im=c.im end;   
   
   nil:SAME is
      -- let Sather handle this (we are confused by the philosophical
      -- impilations of nil vs void vs unitialized vs zero
      return #(FLTD::nil, FLTD::nil);
   end;   
   
   is_nil:BOOL is
      return cpxd.is_nil;
   end;   
end;


class F_HANDLER is
   -- objects if this class are passed to subroutines with alternate
   -- return statements that expect FORTRAN *label as arguments
   -- i.e. CALL FOO(I,*100)
   set_handler(h:ROUT) is
      builtin F_HANDLER_SET_HANDLER;
   end;

   create(h: ROUT):SAME is
      res:SAME;
      res.set_handler(h);
      return res;
   end;
   
   invoke_handler is
      builtin F_HANDLER_INVOKE_HANDLER;
   end;
end;

   

class F_ARRAY{T<$F_SCALAR} is
   -- Fortran array class
   -- create routines for various possible instantiations
   -- A very unexpectedly easy solution to a pretty tough problem
   -- How do you ensure that F_ARRAY{T} is created from a correponding
   -- Sather array: F_ARRAY{F_INTEGER} | ARRAY{INT}
   -- Specifying this constraint for the creations seems to be
   -- extremely difficult (if at all possible) using the Sather
   -- type system alone. Fortunately, we can just list all
   -- possibilities, and when the class is instantiated with the
   -- proper fortran type, only one creation becomes legal as
   -- there will exist only one create signature returning SAME.
   -- All attempts to call create with the wrong signature are
   -- intersepted by the compiler since "wrong" create returns
   -- something other than SAME.
   create(size:INT):SAME is
      -- a new one dimensional fortran array
      builtin F_ARRAY_CREATE_INT;
   end;
   
   -- create from arrays 
   create(a:ARRAY{INT}):F_ARRAY{F_INTEGER} is
      builtin F_ARRAY_CREATE_AREF;
   end;

   create(a:ARRAY{BOOL}):F_ARRAY{F_LOGICAL} is
      builtin F_ARRAY_CREATE_AREF;
   end;

   create(a:ARRAY{FLT}):F_ARRAY{F_REAL} is
      builtin F_ARRAY_CREATE_AREF;
   end;

   create(a:ARRAY{FLTD}):F_ARRAY{F_DOUBLE} is
      builtin F_ARRAY_CREATE_AREF;
   end;

   create(a:ARRAY{CHAR}):F_ARRAY{F_CHARACTER} is
      builtin F_ARRAY_CREATE_AREF;
   end;

   create(a:ARRAY{CPX}):F_ARRAY{F_COMPLEX} is
      builtin F_ARRAY_CREATE_AREF;
   end;

   create(a:ARRAY{CPXD}):F_ARRAY{F_DOUBLE_COMPLEX} is
      builtin F_ARRAY_CREATE_AREF;
   end;

   -- create from vectors
   create(v:VEC):F_ARRAY{F_REAL} is
      builtin F_ARRAY_CREATE_AREF;
   end;
   
   create(v:VECD):F_ARRAY{F_DOUBLE} is
      builtin F_ARRAY_CREATE_AREF;
   end;   

   create(v:VECCPX):F_ARRAY{F_COMPLEX} is
      builtin F_ARRAY_CREATE_AREF;
   end;   
   
   create(v:VECCPXD):F_ARRAY{F_DOUBLE_COMPLEX} is
      builtin F_ARRAY_CREATE_AREF;
   end;      

   aget(ind:INT):T 
   -- the element if self with index `ind'. Built-in
      pre ~void(self) is
      builtin F_ARRAY_AGET;
   end;
   
   aset(ind:INT, val:T)
   -- Set the element of self with index `ind' to `val'. Built-in. 
      pre ~void(self) is 
      builtin F_ARRAY_ASET;
   end;   
end;

class F_ARRAY2{T<$F_SCALAR} is
   create(d1,d2:INT):SAME is
       -- A new two-dimensional array with dimensions `d1 x d2'
      builtin F_ARRAY2_CREATE_INT_INT;
   end;
   
   create(a:ARRAY2{INT}):F_ARRAY2{F_INTEGER} is
      builtin F_ARRAY2_CREATE_ARRAY2;
   end;

   create(a:ARRAY2{BOOL}):F_ARRAY2{F_LOGICAL} is
      builtin F_ARRAY2_CREATE_ARRAY2;
   end;

   create(a:ARRAY2{FLT}):F_ARRAY2{F_REAL} is
      builtin F_ARRAY2_CREATE_ARRAY2;
   end;

   create(a:ARRAY2{FLTD}):F_ARRAY2{F_DOUBLE} is
      builtin F_ARRAY2_CREATE_ARRAY2;
   end;

   create(a:ARRAY2{CHAR}):F_ARRAY2{F_CHARACTER} is
      builtin F_ARRAY2_CREATE_ARRAY2;
   end;

   create(a:ARRAY2{CPX}):F_ARRAY2{F_COMPLEX} is
      builtin F_ARRAY2_CREATE_ARRAY2;
   end;

   create(a:ARRAY2{CPXD}):F_ARRAY2{F_DOUBLE_COMPLEX} is
      builtin F_ARRAY2_CREATE_ARRAY2;
   end;   
   
   create(a:MAT):F_ARRAY2{F_REAL} is
      builtin F_ARRAY2_CREATE_MAT;
   end;
end;

class F_ARRAY3{T<$F_SCALAR} is
      create(d1,d2,d3:INT):SAME is
       -- A three-dimensional array with dimensions `d1 x d2 x d3'
      builtin F_ARRAY3_CREATE_INT_INT_INT;
   end;
   
   create(a:ARRAY3{INT}):F_ARRAY3{F_INTEGER} is
      builtin F_ARRAY3_CREATE_ARRAY3;
   end;

   create(a:ARRAY3{BOOL}):F_ARRAY3{F_LOGICAL} is
      builtin F_ARRAY3_CREATE_ARRAY3;
   end;

   create(a:ARRAY3{FLT}):F_ARRAY3{F_REAL} is
      builtin F_ARRAY3_CREATE_ARRAY3;
   end;

   create(a:ARRAY3{FLTD}):F_ARRAY3{F_DOUBLE} is
      builtin F_ARRAY3_CREATE_ARRAY3;
   end;

   create(a:ARRAY3{CHAR}):F_ARRAY3{F_CHARACTER} is
      builtin F_ARRAY3_CREATE_ARRAY3;
   end;

   create(a:ARRAY3{CPX}):F_ARRAY3{F_COMPLEX} is
      builtin F_ARRAY3_CREATE_ARRAY3;
   end;

   create(a:ARRAY3{CPXD}):F_ARRAY3{F_DOUBLE_COMPLEX} is
      builtin F_ARRAY3_CREATE_ARRAY3;
   end;
end;





