call.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, 1994. 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. <----------
-- call5.sa: Representation of routine and iter calls.
-- $CALL_TP: Supertype of argument types in a call.
-- CALL_TP_VOID: The type of a "void" expression.
-- CALL_TP_CREATE: The type of an untyped creation expression.
-- CALL_TP_BOUND_CREATE: The type of an untyped bound creation expression.
-- CALL_TP_ARRAY: The type of an array creation expression.
-- CALL_TP_UNDERSCORE: The type of a bound underscore argument.
-- CALL_SIG: The type signature of a routine or iter call.
-- CALL_ARG: The call arguments (binds type and mode)
abstract class $CALL_TP
abstract class $CALL_TP is
-- Supertype of the possible types of an argument in a call.
-- This is either an actual type under $TP or CALL_TP_VOID for a
-- "void" argument, CALL_TP_CREATE for a creation expression without
-- a type, CALL_TP_BOUND_CREATE for an untyped bound creation expression,
-- CALL_TP_ARRAY for an array creation expression,
-- or CALL_TP_UNDERSCORE for an underscore argument in a bound
-- routine or iter.
str:STR; -- The string representation of self.
is_subtype(t:$TP):BOOL; -- True if self might be a legal
-- argument type for an argument whose declared type is `t'.
end; -- type $CALL_TP
class CALL_TP_VOID < $CALL_TP
class CALL_TP_VOID < $CALL_TP is
-- The type of the argument "void".
shared cache:SAME;
create:SAME is
-- The representative object.
if void(cache) then cache:=new end; return cache end;-- CALL_TP_VOID::cache CALL_TP_VOID::cache CALL_TP_VOID::cache
str:STR is
-- The string: "void".
return "void-expression" end;
is_subtype(t:$TP):BOOL
-- True.
pre ~void(t) is-- BOOL::not
return true end;
end; -- class CALL_TP_VOID
class CALL_TP_CREATE < $CALL_TP
class CALL_TP_CREATE < $CALL_TP is
-- The type of an untyped creation expression.
shared cache:SAME;
create:SAME is
-- The representative object.
if void(cache) then cache:=new end; -- CALL_TP_CREATE::cache CALL_TP_CREATE::cache
return cache end;-- CALL_TP_CREATE::cache
str:STR is
-- The string: "create".
return "create-expression" end;
is_subtype(t:$TP):BOOL
-- True if `t' is a reference, value type, or partial type.
-- pSather or a spread type
pre ~void(t) is-- BOOL::not
case t.kind
when TP_KIND::val_tp then return true-- TP_KIND::val_tp
when TP_KIND::ref_tp then return true-- TP_KIND::ref_tp
when TP_KIND::part_tp then return true-- TP_KIND::part_tp
when TP_KIND::abs_tp then return false-- TP_KIND::abs_tp
when TP_KIND::ext_c_tp then return false-- TP_KIND::ext_c_tp
when TP_KIND::ext_fortran_tp then return false -- TP_KIND::ext_fortran_tp
when TP_KIND::spr_tp then return true-- TP_KIND::spr_tp
when TP_KIND::rout_tp then return false-- TP_KIND::rout_tp
when TP_KIND::iter_tp then return false end end;-- TP_KIND::iter_tp
end; -- class CALL_TP_CREATE
class CALL_TP_BOUND_CREATE < $CALL_TP
class CALL_TP_BOUND_CREATE < $CALL_TP is
-- The type of an untyped bound creation expression.
shared cache:SAME;
create:SAME is
-- The representative object.
if void(cache) then cache:=new end; -- CALL_TP_BOUND_CREATE::cache CALL_TP_BOUND_CREATE::cache
return cache end;-- CALL_TP_BOUND_CREATE::cache
str:STR is
-- The string: "create".
return "bound-create-expression" end;
is_subtype(t:$TP):BOOL
-- True if `t' is rout_tp or iter_tp
pre ~void(t) is-- BOOL::not
case t.kind
when TP_KIND::val_tp then return false-- TP_KIND::val_tp
when TP_KIND::ref_tp then return false-- TP_KIND::ref_tp
when TP_KIND::part_tp then return false-- TP_KIND::part_tp
when TP_KIND::abs_tp then return false-- TP_KIND::abs_tp
when TP_KIND::ext_c_tp then return false-- TP_KIND::ext_c_tp
when TP_KIND::ext_fortran_tp then return false -- TP_KIND::ext_fortran_tp
when TP_KIND::spr_tp then return false-- TP_KIND::spr_tp
when TP_KIND::rout_tp then return true-- TP_KIND::rout_tp
when TP_KIND::iter_tp then return true end end;-- TP_KIND::iter_tp
end; -- class CALL_TP_BOUND_CREATE
class CALL_TP_ARRAY < $CALL_TP
class CALL_TP_ARRAY < $CALL_TP is
-- The type of an array creation expression.
shared cache:SAME;
create:SAME is
-- The representative object.
if void(cache) then cache:=new end; -- CALL_TP_ARRAY::cache CALL_TP_ARRAY::cache
return cache end;-- CALL_TP_ARRAY::cache
str:STR is
-- The string: "array".
return "array-expression" end;
is_subtype(t:$TP):BOOL is
-- True if `t' is ARRAY{T} for some T.
typecase t
when TP_CLASS then
return t.name=#IDENT("ARRAY")-- TP_CLASS::name IDENT::is_eq IDENT::create
else return false end end;
end; -- class CALL_TP_ARRAY
class CALL_TP_UNDERSCORE < $CALL_TP
class CALL_TP_UNDERSCORE < $CALL_TP is
-- The type of an underscore argument in a bound routine or iter
-- call and doesn't have a type specified.
attr tp:$TP; -- The type if one is specified.
create:SAME is
-- A new object.
return new end;
str:STR is
-- The string: "underscore" followed by ":TYPE" if a type is
-- present.
if void(tp) then return "underscore-expression" else-- CALL_TP_UNDERSCORE::tp
return "underscore-expression:" + tp.str end end;-- CALL_TP_UNDERSCORE::tp
is_subtype(t:$TP):BOOL
-- True if self may represent `t'.
pre ~void(t) is-- BOOL::not
if void(tp) then return true else -- CALL_TP_UNDERSCORE::tp
return tp.is_subtype(t) end end;-- CALL_TP_UNDERSCORE::tp
end; -- class CALL_TP_UNDERSCORE
class CALL_ARG
class CALL_ARG is
-- The type and mode of the call argument
attr tp: $CALL_TP; -- call arg type
attr mode: $MODE; -- call arg mode
is_eq(a: $OB):BOOL is
-- Changed equality
typecase a
when ARG then return is_eq(a)
else return false; end;
end;
is_neq(a: $OB):BOOL is return ~is_eq(a) end;
-- Changed equality
is_neq(a: ARG):BOOL is
return ~is_eq(a);
end;
is_eq(a: ARG):BOOL is
return a.tp = tp and mode = a.mode;
end;
str:STR is
return mode.str+tp.str;
end;
create(t:$CALL_TP): SAME is
-- The ``default'' constructor: mode is set to IN_MODE
res ::= new;
res.tp := t;-- CALL_ARG::tp
res.mode := #IN_MODE;-- CALL_ARG::mode IN_MODE::create
return res;
end;
create(t:$CALL_TP, m:$MODE): SAME is
res ::= new;
res.tp := t;-- CALL_ARG::tp
res.mode := m;-- CALL_ARG::mode
return res;
end;
end;
class CALL_SIG
class CALL_SIG is
-- The type signature of a routine or iter *call*. There are special
-- type objects for arguments which are void, untyped creation
-- expressions, array creation expressions, integer literals, or
-- floating point literals.
attr tp:$TP; -- The type on which the call is made.
attr name:IDENT; -- The name of the call.
attr args:ARRAY{CALL_ARG}; -- The argument types, if any.
attr has_ret:BOOL; -- True if the return value is used.
attr unknown_ret:BOOL; -- True if this is a bound routine
-- or iter call signature and we don't know whether there
-- is a return value or not.
prog:PROG is
-- The program in which this call appears.
return tp.prog end;-- CALL_SIG::tp
create:SAME is
-- An uninitialized call sig.
return new end;
str:STR is
-- The string representation of self. Uses no whitespace. Use
-- an underbar "_" for the return type if there is one, and
-- the special strings "void", "create", "array", and
-- "underscore" for call arguments whose type is inferred:
-- "FOO::foo!(outA,void,C,array):_".
-- If self is void, returns "void".
if void(self) then return "void" end;
s::=#FSTR + tp.str + "::" + name.str;-- FSTR::create CALL_SIG::tp FSTR::plus CALL_SIG::name IDENT::str
if ~void(args) then-- CALL_SIG::args BOOL::not
s:=s + '(';-- FSTR::plus
loop
arg ::= args.elt!;-- CALL_SIG::args ARRAY{1}::elt!
s:=s + ",".separate!(arg.mode.str+arg.tp.str);-- FSTR::plus STR::separate! CALL_ARG::mode STR::plus CALL_ARG::tp
end;
s:=s + ')' -- FSTR::plus
end;
if unknown_ret then s:=s + ":?" -- CALL_SIG::unknown_ret
elsif has_ret then s:=s + ":_" end;-- FSTR::plus CALL_SIG::has_ret FSTR::plus
return s.str end;-- FSTR::str
conforms_to(s:SIG):BOOL is
-- True if a call with signature self could be made on the routine
-- or iter described by `s'. They must:
-- 1) have the same name,
-- 2) have the same number of arguments,
-- 3) Both have or do not have a return value,
-- 4) The mode of each argument is the same
-- 5) for any in or once arguments, the type in self is the subtype
-- of the type in s;
-- for any `inout' arguments, the type in self is the same as in `s';
-- for any `out' arguments,the type in s is a subtype of the type in
-- self if it has one,
-- 6) the return type of self is a subtype of the return
-- type of `s' (why is this missing? Boris 4-22-96)
-- 7) Appear in the same type.
if void(self) or void(s) then return false end;
if tp/=s.tp then return false end;-- CALL_SIG::tp SIG::tp BOOL::not
if name/=s.name then return false end;-- CALL_SIG::name IDENT::is_eq SIG::name BOOL::not
if ~unknown_ret then-- CALL_SIG::unknown_ret BOOL::not
if has_ret then if void(s.ret) then return false end-- CALL_SIG::has_ret SIG::ret
elsif ~void(s.ret) then return false end end;-- SIG::ret BOOL::not
if args.size/=s.args.size then return false end;-- CALL_SIG::args ARRAY{1}::size INT::is_eq SIG::args ARRAY{1}::size BOOL::not
loop
car ::= args.elt!; sar ::= s.args.elt!;-- CALL_SIG::args ARRAY{1}::elt! SIG::args ARRAY{1}::elt!
if car.mode /= sar.mode then -- CALL_ARG::mode ARG::mode BOOL::not
-- Note that here we allow the mode for the once argument
-- to be omitted at the point of the call. If we decide
-- that it needs to be specified, we would need to always
-- return false here BV.
if (car.mode = MODES::in_mode) and -- CALL_ARG::mode MODES::in_mode
(sar.mode = MODES::once_mode) then-- ARG::mode MODES::once_mode
car.mode := sar.mode;-- CALL_ARG::mode ARG::mode
else
return false
end;
end
end;
loop
ca ::= args.elt!; sa ::= s.args.elt!;-- CALL_SIG::args ARRAY{1}::elt! SIG::args ARRAY{1}::elt!
call_tp::=ca.tp;-- CALL_ARG::tp
if sa.tp.is_bound then-- ARG::tp
typecase call_tp
when TP_CLASS then
if sa.tp /= call_tp then -- ARG::tp BOOL::not
prog.err("Dispatched bound routines/iters have not yet been implemented, formal and actual bound types have to be the same. "); -- CALL_SIG::prog PROG::err
end;
else
end;
end;
ca_mode ::= ca.mode ; sa_mode ::= sa.mode;-- CALL_ARG::mode ARG::mode
case sa_mode
when MODES::in_mode then-- MODES::in_mode
if ~ca.tp.is_subtype(sa.tp) then return false; end;-- CALL_ARG::tp ARG::tp BOOL::not
when MODES::out_mode then-- MODES::out_mode
if ~sa.tp.is_subtype(ca.tp) then return false; end;-- ARG::tp CALL_ARG::tp BOOL::not
when MODES::inout_mode then-- MODES::inout_mode
call_tp := ca.tp;-- CALL_ARG::tp
typecase call_tp
when CALL_TP_UNDERSCORE then
if ~void(call_tp.tp) then-- CALL_TP_UNDERSCORE::tp BOOL::not
if call_tp.tp /= sa.tp then -- CALL_TP_UNDERSCORE::tp ARG::tp BOOL::not
return false;
end;
end;
else
if sa.tp /= ca.tp then return false; end;-- ARG::tp CALL_ARG::tp BOOL::not
end;
when MODES::once_mode then-- MODES::once_mode
if ~ca.tp.is_subtype(sa.tp) then return false; end;-- CALL_ARG::tp ARG::tp BOOL::not
end;
end;
return true
end;
old_conforms_to(s:SIG):BOOL is
-- True if a call with signature self could be made on the routine
-- or iter described by `s'. They must:
-- 1) have the same name,
-- 2) have the same number of arguments,
-- 3) each call argument must conform to the corresponding
-- declared argument,
-- 4) both must have or not have a return value.
-- 5) Appear in the same type.
if name/=s.name then return false end;
if void(self) or void(s) then return false end;
if tp/=s.tp then return false end;
if ~unknown_ret then
if has_ret then if void(s.ret) then return false end
elsif ~void(s.ret) then return false end end;
if args.size/=s.args.size then return false end;
-- loop
-- if args.elt!.mode /=s.args.elt!.mode then
-- return false
-- end
-- end;
loop ca::=args.elt!; sa::=s.args.elt!;
if ~ca.tp.is_subtype(sa.tp) then return false end end;
return true end;
lookup(in_class:BOOL):SIG is
-- Lookup self and return the corresponding signature if there
-- is one. Print an error message if it is ambiguous or absent and
-- return void. Callers should set the err_loc. If `in_class'
-- is true, then consider both public and private routines,
-- otherwise just public ones.
st::=tp; -- The type the call is made on.-- CALL_SIG::tp
typecase st
when TP_CLASS then
if in_class then
return tp.impl.sig_for_internal_call(self);-- CALL_SIG::tp IMPL::sig_for_internal_call
else return tp.ifc.sig_for_call(self) end;-- CALL_SIG::tp IFC::sig_for_call
when TP_ROUT then
if name/=IDENT_BUILTIN::call_ident then-- CALL_SIG::name IDENT::is_eq IDENT_BUILTIN::call_ident BOOL::not
prog.err("Only `call' may be applied to a bound routine.");-- CALL_SIG::prog PROG::err
return void end;
if ~unknown_ret then-- CALL_SIG::unknown_ret BOOL::not
if has_ret and void(st.ret) then-- CALL_SIG::has_ret TP_ROUT::ret
prog.err("The bound routine " + st.str +-- CALL_SIG::prog PROG::err STR::plus TP_ROUT::str
" has no return value, but one is needed."); -- STR::plus
return void
elsif ~has_ret and ~void(st.ret) then-- CALL_SIG::has_ret BOOL::not TP_ROUT::ret BOOL::not
prog.err("The bound routine " + st.str +-- CALL_SIG::prog PROG::err STR::plus TP_ROUT::str
" has a return value, but it isn't used."); -- STR::plus
return void end end;
if st.args.size/=args.size then-- TP_ROUT::args ARRAY{1}::size CALL_SIG::args ARRAY{1}::size BOOL::not
prog.err("The call " + str +-- CALL_SIG::prog PROG::err CALL_SIG::str
" has the wrong number of args for " + st.str + ".");-- STR::plus STR::plus TP_ROUT::str STR::plus
return void end;
loop
arg::=args.elt!; br_arg::=st.args.elt!;-- CALL_SIG::args ARRAY{1}::elt! TP_ROUT::args ARRAY{1}::elt!
arg_mode::=arg.mode; br_arg_mode ::= br_arg.mode;-- CALL_ARG::mode ARG::mode
if arg_mode /= br_arg_mode then -- BOOL::not
boud_arg_mode_error(str, arg.tp.str, arg.mode.str,-- CALL_SIG::str CALL_ARG::tp CALL_ARG::mode
st.str, br_arg.tp.str, br_arg.mode.str);-- TP_ROUT::str ARG::tp ARG::mode
return void;
end;
case arg_mode
when MODES::in_mode then-- MODES::in_mode
if ~arg.tp.is_subtype(br_arg.tp) then-- CALL_ARG::tp ARG::tp BOOL::not
boud_arg_error(str, arg.tp.str, -- CALL_SIG::str CALL_ARG::tp
st.str, br_arg.tp.str); -- TP_ROUT::str ARG::tp
return void;
end
when MODES::out_mode then-- MODES::out_mode
if ~br_arg.tp.is_subtype(arg.tp) then-- ARG::tp CALL_ARG::tp BOOL::not
boud_arg_error(str, arg.tp.str, -- CALL_SIG::str CALL_ARG::tp
st.str, br_arg.tp.str); -- TP_ROUT::str ARG::tp
return void;
end;
when MODES::inout_mode then-- MODES::inout_mode
if br_arg.tp /= arg.tp then-- ARG::tp CALL_ARG::tp BOOL::not
boud_arg_error(str, arg.tp.str, -- CALL_SIG::str CALL_ARG::tp
st.str, br_arg.tp.str); -- TP_ROUT::str ARG::tp
return void;
end;
when MODES::once_mode then-- MODES::once_mode
if ~arg.tp.is_subtype(br_arg.tp) then-- CALL_ARG::tp ARG::tp BOOL::not
boud_arg_error(str, arg.tp.str, -- CALL_SIG::str CALL_ARG::tp
st.str, br_arg.tp.str); -- TP_ROUT::str ARG::tp
return void;
end;
end;
end;
return SIG::bound_routine_call(st)-- SIG::bound_routine_call
when TP_ITER then
if name/=IDENT_BUILTIN::call_bang_ident then-- CALL_SIG::name IDENT::is_eq IDENT_BUILTIN::call_bang_ident BOOL::not
prog.err("Only `call!' may be applied to a bound iter.");-- CALL_SIG::prog PROG::err
return void end;
if ~unknown_ret then-- CALL_SIG::unknown_ret BOOL::not
if has_ret and void(st.ret) then-- CALL_SIG::has_ret TP_ITER::ret
prog.err("The bound iter " + st.str +-- CALL_SIG::prog PROG::err STR::plus TP_ITER::str
" has no return value, but one is needed."); return void-- STR::plus
elsif ~has_ret and ~void(st.ret) then-- CALL_SIG::has_ret BOOL::not TP_ITER::ret BOOL::not
prog.err("The bound iter " + st.str +-- CALL_SIG::prog PROG::err STR::plus TP_ITER::str
" has a return value, but it isn't used."); -- STR::plus
return void end end;
if st.args.size/=args.size then-- TP_ITER::args ARRAY{1}::size CALL_SIG::args ARRAY{1}::size BOOL::not
prog.err("The call " + str + -- CALL_SIG::prog PROG::err CALL_SIG::str
" has the wrong number of args for " + st.str +".");-- STR::plus STR::plus TP_ITER::str STR::plus
return void end;
loop
arg::=args.elt!; br_arg::=st.args.elt!;-- CALL_SIG::args ARRAY{1}::elt! TP_ITER::args ARRAY{1}::elt!
arg_mode::=arg.mode; br_arg_mode ::= br_arg.mode;-- CALL_ARG::mode ARG::mode
if arg_mode /= br_arg_mode then -- BOOL::not
-- Note that here we allow the mode for the once argument
-- to be omitted at the point of the call. If we decide
-- that it needs to be specified, we would need to always
-- return false here BV.
if (arg_mode = MODES::in_mode) and -- MODES::in_mode
(br_arg_mode = MODES::once_mode) then-- MODES::once_mode
arg.mode := br_arg_mode;-- CALL_ARG::mode
else
boud_arg_mode_error(str, arg.tp.str, arg.mode.str,-- CALL_SIG::str CALL_ARG::tp CALL_ARG::mode
st.str, br_arg.tp.str, br_arg.mode.str);-- TP_ITER::str ARG::tp ARG::mode
return void;
end;
end;
case arg_mode
when MODES::in_mode then-- MODES::in_mode
if ~arg.tp.is_subtype(br_arg.tp) then-- CALL_ARG::tp ARG::tp BOOL::not
boud_arg_error(str, arg.tp.str, -- CALL_SIG::str CALL_ARG::tp
st.str, br_arg.tp.str); -- TP_ITER::str ARG::tp
return void;
end
when MODES::out_mode then-- MODES::out_mode
if ~br_arg.tp.is_subtype(arg.tp) then-- ARG::tp CALL_ARG::tp BOOL::not
boud_arg_error(str, arg.tp.str, -- CALL_SIG::str CALL_ARG::tp
st.str, br_arg.tp.str); -- TP_ITER::str ARG::tp
return void;
end;
when MODES::inout_mode then-- MODES::inout_mode
if br_arg.tp /= arg.tp then-- ARG::tp CALL_ARG::tp BOOL::not
boud_arg_error(str, arg.tp.str, -- CALL_SIG::str CALL_ARG::tp
st.str, br_arg.tp.str); -- TP_ITER::str ARG::tp
return void;
end;
when MODES::once_mode then-- MODES::once_mode
if ~arg.tp.is_subtype(br_arg.tp) then-- CALL_ARG::tp ARG::tp BOOL::not
boud_arg_error(str, arg.tp.str, -- CALL_SIG::str CALL_ARG::tp
st.str, br_arg.tp.str); -- TP_ITER::str ARG::tp
return void;
end;
end;
end;
return SIG::bound_iter_call(st);-- SIG::bound_iter_call
end;
end;
boud_arg_error(call, arg, br, br_arg :$STR) is
prog.err("The argument type " + arg + " in the call " +-- CALL_SIG::prog PROG::err STR::plus STR::plus
call + " doesn't conform to " + br_arg + -- STR::plus STR::plus STR::plus
" in the bound routine " + br + "."); -- STR::plus STR::plus STR::plus
end;
boud_arg_mode_error(call, arg, mode, br, br_arg, br_mode:$STR) is
prog.err("The argument mode " + mode + " " + arg + " in the call " +-- CALL_SIG::prog PROG::err STR::plus STR::plus STR::plus STR::plus
call + " doesn't conform to " + br_mode + " " + br_arg + -- STR::plus STR::plus STR::plus STR::plus STR::plus
" in the bound routine " + br + "."); -- STR::plus STR::plus STR::plus
end;
end; -- class CALL_SIG