fortran.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
---------------------------> Sather 1.1 source file <--------------------------
-- Copyright (C) International Computer Science Institute, 1995. COPYRIGHT --
-- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
-- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in --
-- the file "Doc/License" of the Sather distribution. The license is also --
-- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA. --
--------> Please email comments to sather-bugs@icsi.berkeley.edu. <----------
-- fortran.sa: FORTRAN interface classes
-- author: Boris Vaysman
abstract class $F_NUMBER{NTP} < $NIL, $STR, $IS_EQ
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
abstract class $F_SCALAR < $STR, $IS_EQ is
end;
immutable class F_INTEGER < $F_NUMBER{F_INTEGER}, $F_SCALAR
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
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
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
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
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
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
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
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
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}
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 constrained 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(a:ARRAY{INT}):F_ARRAY{F_INTEGER} is
builtin F_ARRAY_CREATE_ARRAY;
end;
create(a:ARRAY{BOOL}):F_ARRAY{F_LOGICAL} is
builtin F_ARRAY_CREATE_ARRAY;
end;
create(a:ARRAY{FLT}):F_ARRAY{F_REAL} is
builtin F_ARRAY_CREATE_ARRAY;
end;
create(a:ARRAY{FLTD}):F_ARRAY{F_DOUBLE} is
builtin F_ARRAY_CREATE_ARRAY;
end;
create(a:ARRAY{CHAR}):F_ARRAY{F_CHARACTER} is
builtin F_ARRAY_CREATE_ARRAY;
end;
create(a:ARRAY{CPX}):F_ARRAY{F_COMPLEX} is
builtin F_ARRAY_CREATE_ARRAY;
end;
create(a:ARRAY{CPXD}):F_ARRAY{F_DOUBLE_COMPLEX} is
builtin F_ARRAY_CREATE_ARRAY;
end;
end;
class F_ARRAY2{T<$F_SCALAR}
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}
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;