sig.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. <----------
-- sig.sa: Routine and iter type signatures in the Sather compiler.
-- SIG: The type signature of a routine or iter.
-- SIG_TBL: Table of routine and iter signatures retrievable by name.
class SIG < $STR, $HASH
class SIG < $STR, $HASH is
-- The type signature of a routine or iter.
include COMPARABLE;
readonly attr tp:$TP; -- The type to which the signature belongs.
readonly attr name:IDENT; -- The name of the routine or iter.
readonly attr args:ARRAY{ARG}; -- Arguments, void if none.
readonly attr hot:ARRAY{BOOL}; -- True for "!" iter args, void if none.
readonly attr ret:$TP; -- Return type, void if none.
readonly attr str:STR; -- String representation
readonly attr returns_same:BOOL;-- True for abstract class routines
-- returning SAME. *H*
attr src_tparams: ARRAY{$TP}; -- Typeparameters in the original
-- declaration of the routine. Needed
-- in the backend.
-- this should go away
attr srcsig:SAME; -- The signature of this routine or iter
-- in the class it originally came from.
-- Only set after the function has been
-- optimized.
-- Table of unique SIGs (registration occurs on creation.)
readonly shared sigs:FMAP{STR,SIG};
is_builtin:BOOL is -- true for builtin iters and funcs.
if ~void(builtin_info) then return true; end;-- SIG::builtin_info BOOL::not
return (~void(srcsig) and srcsig/=self and srcsig.is_builtin);-- SIG::srcsig BOOL::not SIG::srcsig SIG::is_eq BOOL::not SIG::srcsig SIG::is_builtin
end;
attr builtin_info:CONFIG_ROUT; -- configuration info for builtin
private attr got_builtin_info:BOOL; -- see rout_sig for infos about
-- this field
attr is_forked:BOOL; -- Used by pSather
attr needs_import:BOOL; -- Used by pSather
attr needs_export:BOOL; -- used by pSather
attr am_created:BOOL; -- Whether AM form output has occured yet.
-- side effect processing:
private attr se_context:SE_CONTEXT; -- the side effects of this signature
get_se_context(prog:PROG):SE_CONTEXT is
if tp.is_abstract then-- SIG::tp
-- construct a signature union for this abstract signature
return SE_CONTEXT::get_abstract_union(prog,self);-- SE_CONTEXT::get_abstract_union
else
-- return what is here
return se_context;-- SIG::se_context
end;
end;
set_se_context(sec:SE_CONTEXT) is
assert sec.rsig = self;-- SE_CONTEXT::rsig SIG::is_eq
assert ~tp.is_abstract;-- SIG::tp BOOL::not
se_context := sec;-- SIG::se_context
end;
prog:PROG is
-- The program this signature belongs to.
return tp.prog end;-- SIG::tp
create(ntp:$TP,tparr:ARRAY{$TP},nname:IDENT,nargs:ARRAY{ARG},
nret:$TP,nsame:BOOL)
:SAME
is
r::=new;
r.tp:=ntp;-- SIG::tp
r.src_tparams := tparr;-- SIG::src_tparams
r.name:=nname;-- SIG::name
r.args:=nargs;-- SIG::args
r.ret:=nret;-- SIG::ret
r.returns_same:=nsame;-- SIG::returns_same
return r.make_unique;-- SIG::make_unique
end;
-- This will need to change when 1.1 once args are done (Boris)
create(ntp:$TP,tparr:ARRAY{$TP},nname:IDENT,nargs:ARRAY{ARG},
hot:ARRAY{BOOL},nret:$TP,nsame:BOOL):SAME
is
r::=new;
r.tp:=ntp;
r.src_tparams := tparr;
r.name:=nname;
r.args:=nargs;
r.ret:=nret;
r.hot:=hot;
r.returns_same:=nsame;
return r.make_unique;
end;
private make_unique:SAME is
if void(str) then compute_str; end;-- SIG::str SIG::compute_str
u::=sigs.get(str);-- SIG::sigs FMAP{2}::get SIG::str
if void(u) then
sigs:=sigs.insert(str,self);-- SIG::sigs SIG::sigs FMAP{2}::insert SIG::str
return self;
else
-- WARNING: the following lines have two different purposes:
-- 1. Sometimes we build a signature BEFORE we know that
-- it is a builtin. If this happens, it is NOT created
-- through rout_sig, but via a standard create call.
-- If this happens, got_builtin_info will still be false.
-- In this case, we will copy an eventuall builtin_info from
-- the new signature.
-- 2. If we include a builtin function and overwrite it
-- with another builtin function, we have to keep THE
-- FIRST ONE! This is true because in such a case the
-- explicit signature is generated BEFORE the signature
-- of the included function. We know that we have such a case
-- if got_builtin_info is true for the first signature
-- IMPORTANT: this works only if the signatures are generated in
-- the correct order!!
if is_builtin and ~u.got_builtin_info then-- SIG::is_builtin SIG::got_builtin_info BOOL::not
-- we may find out after we created a signature
-- that it is builtin
u.builtin_info:=builtin_info;-- SIG::builtin_info SIG::builtin_info
u.got_builtin_info:=true;-- SIG::got_builtin_info
end;
end;
return u;
end;
-- will change when 1.1 once args are done (Boris)
private compute_str is
-- Compute the string representation of self. Uses no whitespace,
-- eg. "FOO::foo!(A!,outB{C}):D".
-- Equality of the string representation must occur if and only
-- if two SIGs are really the same object (including arg modes).
s::=#FSTR(64) + tp.str + "::" + name.str;-- FSTR::create SIG::tp FSTR::plus SIG::name IDENT::str
if ~void(args) then-- SIG::args BOOL::not
s:=s + '(';-- FSTR::plus
loop
arg ::= args.elt!;-- SIG::args ARRAY{1}::elt!
if ~void(arg) then-- BOOL::not
-- We don't append once yet (will do a bit later)
if arg.mode = MODES::once_mode then-- ARG::mode MODES::once_mode
s:=s+",".separate!(arg.tp.str); -- FSTR::plus STR::separate! ARG::tp
else
s:=s+",".separate!(arg.mode.str+arg.tp.str);-- FSTR::plus STR::separate! ARG::mode STR::plus ARG::tp
end;
end;
if ~void(hot) and hot.elt! then s:=s+'!' end end;-- SIG::hot BOOL::not SIG::hot ARRAY{1}::elt! FSTR::plus
s:=s + ')' end;-- FSTR::plus
if ~void(ret) then-- SIG::ret BOOL::not
if returns_same then s := s + ":SAME"-- SIG::returns_same
else s:=s + ':' + ret.str end;-- FSTR::plus FSTR::plus SIG::ret
end;
self.str:=s.str;-- SIG::str FSTR::str
end;
num_args:INT is
-- The number of arguments in this signature.
return args.size end;-- SIG::args ARRAY{1}::size
has_ret:BOOL is
-- True if there is a return value.
return ~void(ret) end;-- SIG::ret BOOL::not
is_iter:BOOL is
-- True if self is an iter.
return name.is_iter end;-- SIG::name IDENT::is_iter
is_routine:BOOL is return ~is_iter end;-- SIG::is_iter BOOL::not
is_builtin_iter:BOOL is
-- True if self is an iter.
return is_builtin and is_iter end;-- SIG::is_builtin SIG::is_iter
is_builtin_routine:BOOL is
-- True if self is an iter.
return is_builtin and is_routine end;-- SIG::is_builtin SIG::is_routine
is_attr_writer_sig:BOOL is
-- True if self could be a writer signature for an object attribute.
-- For ref it has a single in argument and no return value, for val
-- it has a single in arg and a return value.
if tp.kind=TP_KIND::val_tp then-- SIG::tp INT::is_eq TP_KIND::val_tp
if args.size=1 and tp=ret then-- SIG::args ARRAY{1}::size INT::is_eq SIG::tp SIG::ret
return args[0].mode = MODES::in_mode;-- SIG::args ARRAY{1}::aget ARG::mode MODES::in_mode
end;
elsif args.size=1 and void(ret) then-- SIG::args ARRAY{1}::size INT::is_eq SIG::ret
return args[0].mode = MODES::in_mode;-- SIG::args ARRAY{1}::aget ARG::mode MODES::in_mode
end;
return false;
end;
is_shared_writer_sig:BOOL is
-- True if self could be a writer signature for a shared attribute.
-- It has a in single in argument and no return value.
if args.size=1 and void(ret) then-- SIG::args ARRAY{1}::size INT::is_eq SIG::ret
return args[0].mode = MODES::in_mode;-- SIG::args ARRAY{1}::aget ARG::mode MODES::in_mode
else
return false;
end;
end;
is_reader_sig:BOOL is
-- True if self has a return value but no arguments.
return void(args) and ~void(ret)-- SIG::args SIG::ret
end;-- BOOL::not
is_invariant:BOOL is
-- True if self is the signature "invariant:BOOL".
return void(args) and ~void(ret) and TP_BUILTIN::bool=ret and-- SIG::args SIG::ret BOOL::not TP_BUILTIN::bool SIG::ret
name=IDENT_BUILTIN::invariant_ident-- SIG::name IDENT::is_eq IDENT_BUILTIN::invariant_ident
end;
conforms_to(s:SAME):BOOL
-- True if self conforms to `s' so as to satisfy the inheritance
-- rule. This means they:
-- 1) Have the same name,
-- 2) Have the same the number of args,
-- 3) If iters, then the same args are declared `once',
-- 4) Both have or do not have a return value,
-- 5) The mode of each argument is the same
-- 6) for any in or once arguments, the type in `s' is the subtype
-- in of the type in self;
-- for any `inout' arguments, the type in self is the same as in `s';
-- for any `out' arguments,the type in self is a subtype of the type in
-- s if it has one, the return type of self is a subtype of the return
-- type of `s'
-- 7) For the resulttype, the type in self is a subtype of the type in
-- s if it has one. The resulttype has to be SAME if it is SAME in
-- s.
-- Ignores `tp'.
-- Some of the following will need to be modified when 1.1
-- once args are implemented (Boris)
pre ~void(self) and ~void(s) is-- BOOL::not BOOL::not
if name/=s.name or args.size/=s.args.size or-- SIG::name IDENT::is_eq SIG::name BOOL::not SIG::args ARRAY{1}::size INT::is_eq SIG::args ARRAY{1}::size BOOL::not
hot.size/=s.hot.size or has_ret/=s.has_ret then return false end;-- SIG::hot ARRAY{1}::size INT::is_eq SIG::hot ARRAY{1}::size BOOL::not SIG::has_ret BOOL::is_eq SIG::has_ret BOOL::not
loop if hot.elt!/=s.hot.elt! then return false end end;-- SIG::hot ARRAY{1}::elt! BOOL::is_eq SIG::hot ARRAY{1}::elt! BOOL::not
loop if args.elt!.mode /=s.args.elt!.mode then return false end end;-- SIG::args ARRAY{1}::elt! ARG::mode SIG::args ARRAY{1}::elt! ARG::mode BOOL::not
if has_ret then-- SIG::has_ret
if s.returns_same and ~returns_same then-- SIG::returns_same SIG::returns_same BOOL::not
return false
elsif ~ret.is_subtype(s.ret) then-- SIG::ret SIG::ret BOOL::not
return false
end
end;
loop
self_arg ::= args.elt!; s_arg ::= s.args.elt!;-- SIG::args ARRAY{1}::elt! SIG::args ARRAY{1}::elt!
self_arg_mode ::= self_arg.mode ; s_arg_mode ::= s_arg.mode;-- ARG::mode ARG::mode
case self_arg_mode
when MODES::in_mode then-- MODES::in_mode
if ~s_arg.tp.is_subtype(self_arg.tp) then return false; end;-- ARG::tp ARG::tp BOOL::not
when MODES::out_mode then-- MODES::out_mode
if ~self_arg.tp.is_subtype(s_arg.tp) then return false; end;-- ARG::tp ARG::tp BOOL::not
when MODES::inout_mode then-- MODES::inout_mode
if self_arg.tp /= s_arg.tp then return false; end;-- ARG::tp ARG::tp BOOL::not
when MODES::once_mode then-- MODES::once_mode
if ~s_arg.tp.is_subtype(self_arg.tp) then return false; end;-- ARG::tp ARG::tp BOOL::not
end;
end;
return true;
end;
conflicts_with(s:SAME):BOOL
-- True if self conflicts with `s'. This is a symmetric
-- relationship. It means that they:
-- 1) Have the same name,
-- 2) Have the same the number of args,
-- 3) There is no argument that they declare as having different
-- types and neither type declaration is abstract, bound.
-- 4) Both have or do not have a return value.
-- Ignores `tp'.
-- Conflicts are independent of argument modes
pre ~void(self) and ~void(s) is-- BOOL::not BOOL::not
if name/=s.name or args.size/=s.args.size or-- SIG::name IDENT::is_eq SIG::name BOOL::not SIG::args ARRAY{1}::size INT::is_eq SIG::args ARRAY{1}::size BOOL::not
has_ret/=s.has_ret -- SIG::has_ret BOOL::is_eq SIG::has_ret
then return false end;-- BOOL::not
arg, s_arg:ARG;
t,st:$TP;
conflict:BOOL := false;
abs:BOOL := false;
same_args:BOOL := true; -- sigs have the same args
loop
arg := args.elt!; s_arg := s.args.elt!;-- SIG::args ARRAY{1}::elt! SIG::args ARRAY{1}::elt!
t:=arg.tp; st:=s_arg.tp;-- ARG::tp ARG::tp
if t/=st then same_args := false; end;-- BOOL::not
if t/=st and ~t.is_abstract and ~t.is_bound and-- BOOL::not BOOL::not BOOL::not
~st.is_abstract and ~st.is_bound-- BOOL::not
then-- BOOL::not
-- this takes care of concrete types
return false;
else
if ((t.is_abstract and st.is_abstract) or
(t.is_bound and st.is_bound)) then
abs := true;
if ~(t.is_subtype(st) or st.is_subtype(t)) then-- BOOL::not
conflict := true;
end;
else
if t /= st then-- BOOL::not
return false; -- at least one arg has a concrete type
end;
end;
end;
end;
return (abs and conflict) or ~abs or same_args;-- BOOL::not
end;
-- this will be fixed to conform to 1.1 once arg (Boris)
is_eq_but_tp(s:SAME):BOOL is
-- True if self is equal to `s' except for the `tp' field.
-- This is a symmetric relationship.
-- It means that they:
-- 1) Have the same name,
-- 2) Have the same the number of args,
-- 3) Each argument type of `s' *is equal* to the corresponding
-- argument in self,
-- 4) If iters, then the same args are declared `hot', (fix Boris)
-- 5) Modes of args are the same
-- 6) Both have or do not have a return value.
-- 7) The return types must be equal, if present.
if void(self) then return void(s)
elsif void(s) then return false end;
if SYS::ob_eq(self,s) then return true end; -- Do easy check first!-- SYS::ob_eq
if name/=s.name or args.size/=s.args.size or-- SIG::name IDENT::is_eq SIG::name BOOL::not SIG::args ARRAY{1}::size INT::is_eq SIG::args ARRAY{1}::size BOOL::not
hot.size/=s.hot.size or has_ret/=s.has_ret then-- SIG::hot ARRAY{1}::size INT::is_eq SIG::hot ARRAY{1}::size BOOL::not SIG::has_ret BOOL::is_eq SIG::has_ret BOOL::not
return false end;
loop
arg ::= args.elt!; s_arg ::= s.args.elt!;-- SIG::args ARRAY{1}::elt! SIG::args ARRAY{1}::elt!
if (arg.tp /= s_arg.tp) or (arg.mode /= s_arg.mode)-- ARG::tp ARG::tp BOOL::not ARG::mode ARG::mode
then return false
end
end;
loop if hot.elt!/=s.hot.elt! then return false end end;-- SIG::hot ARRAY{1}::elt! BOOL::is_eq SIG::hot ARRAY{1}::elt! BOOL::not
if has_ret and ret/=s.ret and-- SIG::has_ret SIG::ret SIG::ret BOOL::not
( ~returns_same or ~s.returns_same )-- SIG::returns_same BOOL::not SIG::returns_same BOOL::not
then return false end;
return true end;
hash:INT is
-- this can be done because of unique sig's
return SYS::id(self).hash;-- SYS::id INT::hash
end;
is_eq(s: $OB): BOOL is
-- Equality change
typecase s
when SAME then return is_eq(s)-- SIG::is_eq
else return false end;
end;
is_eq(s:SAME):BOOL is
-- See below. This should be faster.
return SYS::ob_eq(self,s);-- SYS::ob_eq
end;
-- This is what is_eq used to be. Object equality can be used now
-- because it is much faster. String equality can be used before
-- registration.
old_is_eq(s:SAME):BOOL is
-- True if self is equal to `s'. This is a symmetric relationship.
-- It means that they:
-- 1) Have the same name,
-- 2) Have the same the number of args,
-- 3) Each argument type of `s' *is equal* to the corresponding
-- argument in self,
-- 4) If iters, then the same args are declared `hot',
-- 5) Both have or do not have a return value.
-- 6) The return types must be equal, if present.
-- 7) Has an equal `tp'.
if void(self) then return void(s)
elsif void(s) then return false;
elsif SYS::ob_eq(self,s) then return true;
elsif name/=s.name then return false;
elsif tp/=s.tp or args.size/=s.args.size or
hot.size/=s.hot.size or has_ret/=s.has_ret then
return false;
end;
loop
arg ::= args.elt!; s_arg ::= s.args.elt!;
if (arg.tp /= s_arg.tp) or (arg.mode /= s_arg.mode)
then return false
end
end;
loop if hot.elt!/=s.hot.elt! then return false end end;
if has_ret and ret/=s.ret then return false end;
return true
end;
is_neq(e:$OB):BOOL is return ~is_eq(e); end;
is_neq(e:SAME):BOOL is return ~is_eq(e); end;-- SIG::is_eq BOOL::not
is_writer_for(s:SAME):BOOL
-- True if self is the writer signature corresponding to the
-- reader signature `s'. This means that:
-- 1) self and `s' have the same name.
-- 2) self has 1 (in) arg, `s' has none.
-- 3) For value types self has a return value of type self,
-- otherwise it has no return value, `s' has 1 .
-- 4) The type of self's arg is equal to `s's return type.
pre ~void(self) and ~void(s) is
if name/=s.name or ~void(s.args) or void(s.ret) or
args.size/=1 or args[0].tp /=s.ret
then
return false end;
if args[0].mode /= MODES::in_mode then
return false;
end;
if tp.kind=TP_KIND::val_tp then
if s.ret/=s.tp then return false end
elsif ~void(s.ret) then return false end;
return true end;
rout_sig(as:AS_ROUT_DEF, nm:IDENT, srcparams: ARRAY{$TP}, con:TP_CONTEXT)
:SAME
-- The signature of the routine or iter in the type `con.same'
-- defined by `as' with the name `nm' and types resolved according
-- to `con'.
pre ~void(as) and ~void(nm) and ~void(con)-- BOOL::not BOOL::not
is-- BOOL::not
r::=new;
r.tp:=con.same; r.src_tparams := srcparams;-- SIG::tp TP_CONTEXT::same SIG::src_tparams
r.name:=nm; na::=as.args_dec.size;-- SIG::name AS_ROUT_DEF::args_dec AS_ARG_DEC::size
if as.is_builtin then-- AS_ROUT_DEF::is_builtin
r.builtin_info:=r.prog.config.get_rout(as.builtin_name.str);-- SIG::builtin_info SIG::prog PROG::config CONFIG_TBL::get_rout AS_ROUT_DEF::builtin_name IDENT::str
if void(r.builtin_info) then-- SIG::builtin_info
r.prog.err("builtin "+as.builtin_name.str+" not found in CONFIG\n");-- SIG::prog PROG::err STR::plus AS_ROUT_DEF::builtin_name IDENT::str STR::plus
end;
end;
if na/=0 then-- INT::is_eq BOOL::not
r.args:=#(na);-- SIG::args ARRAY{1}::create
ad::=as.args_dec;-- AS_ROUT_DEF::args_dec
loop until!(void(ad));
--*H*
if con.same.is_abstract and ad.tp.kind = AS_TYPE_SPEC::same then-- TP_CONTEXT::same TP_CLASS::is_abstract AS_ARG_DEC::tp AS_TYPE_SPEC::kind INT::is_eq AS_TYPE_SPEC::same
r.prog.err_loc( ad );-- SIG::prog PROG::err_loc
r.prog.err( "SAME may not occur as argument type in abstract types." );-- SIG::prog PROG::err
end;
r.args.set!(#ARG(con.tp_of(ad.tp),MODE::create_from_as(ad.mode)));-- SIG::args ARRAY{1}::set! ARG::create TP_CONTEXT::tp_of AS_ARG_DEC::tp MODE::create_from_as AS_ARG_DEC::mode
ad:=ad.next-- AS_ARG_DEC::next
end
end;
-- This will be changed when 1.1 once args are working (Boris)
dohot:BOOL;
tae::=as.args_dec;-- AS_ROUT_DEF::args_dec
loop until!(void(tae));
if tae.is_hot then dohot:=true end; tae:=tae.next end;-- AS_ARG_DEC::is_hot AS_ARG_DEC::next
if dohot then r.hot:=#(na);-- SIG::hot ARRAY{1}::create
ad::=as.args_dec;-- AS_ROUT_DEF::args_dec
loop until!(void(ad));
r.hot.set!(ad.is_hot); ad:=ad.next end end; -- SIG::hot ARRAY{1}::set! AS_ARG_DEC::is_hot AS_ARG_DEC::next
r.ret:=con.tp_of(as.ret_dec);-- SIG::ret TP_CONTEXT::tp_of AS_ROUT_DEF::ret_dec
r.returns_same := ~void(as.ret_dec)-- SIG::returns_same AS_ROUT_DEF::ret_dec
and as.ret_dec.kind = AS_TYPE_SPEC::same; -- *H*-- BOOL::not AS_ROUT_DEF::ret_dec AS_TYPE_SPEC::kind INT::is_eq AS_TYPE_SPEC::same
r.got_builtin_info:=true;-- SIG::got_builtin_info
return r.make_unique;-- SIG::make_unique
end;
const_reader_sig(as:AS_CONST_DEF, nm:IDENT, srcparams: ARRAY{$TP},
con:TP_CONTEXT):SAME
-- The signature of the reader routine in the type `con.same' for
-- the constant defined by `as' with the name specified by `nm' and
-- types resolved according to `con'.
pre ~void(as) and ~void(nm) and ~void(con)-- BOOL::not BOOL::not
is-- BOOL::not
r::=new; r.tp:=con.same; r.name:=nm; r.src_tparams := srcparams;-- SIG::tp TP_CONTEXT::same SIG::name SIG::src_tparams
if ~void(as.tp) then -- Explicit type specified.-- AS_CONST_DEF::tp BOOL::not
r.ret:=con.tp_of(as.tp);-- SIG::ret TP_CONTEXT::tp_of AS_CONST_DEF::tp
else -- No explicit type, so INT.
r.ret:=TP_BUILTIN::int end;-- SIG::ret TP_BUILTIN::int
return r.make_unique-- SIG::make_unique
end;
shared_reader_sig(as:AS_SHARED_DEF, nm:IDENT, srcparams: ARRAY{$TP},
con:TP_CONTEXT):SAME
-- The signature of the reader routine in the type `con.same' for
-- the shared defined by `as' with the name specified by `nm' and
-- types resolved according to `con'.
pre ~void(as) and ~void(nm) and ~void(con)-- BOOL::not BOOL::not
is-- BOOL::not
r::=new; r.tp:=con.same; r.name:=nm; r.src_tparams := srcparams;-- SIG::tp TP_CONTEXT::same SIG::name SIG::src_tparams
r.ret:=con.tp_of(as.tp);-- SIG::ret TP_CONTEXT::tp_of AS_SHARED_DEF::tp
return r.make_unique-- SIG::make_unique
end;
shared_writer_sig(as:AS_SHARED_DEF, nm:IDENT, srcparams: ARRAY{$TP},
con:TP_CONTEXT):SAME
-- The signature of the writer routine in the type `con.same' for
-- the shared defined by `as' with the name specified by `nm' and
-- types resolved according to `con'.
pre ~void(as) and ~void(nm) and ~void(con)-- BOOL::not BOOL::not
is-- BOOL::not
r::=new; r.tp:=con.same; r.name:=nm; r.src_tparams := srcparams;-- SIG::tp TP_CONTEXT::same SIG::name SIG::src_tparams
r.args:=ARRAY{ARG}::create(1);-- SIG::args ARRAY{1}::create
r.args[0] := #ARG(con.tp_of(as.tp)); --in argument mode-- SIG::args ARRAY{1}::aset ARG::create TP_CONTEXT::tp_of AS_SHARED_DEF::tp
return r.make_unique-- SIG::make_unique
end;
attr_reader_sig(as:AS_ATTR_DEF, nm:IDENT, srcparams: ARRAY{$TP},
con:TP_CONTEXT):SAME
-- The signature of the reader routine in the type `con.same' for
-- the object attribute defined by `as' with the name specified
-- by `nm' and types resolved according to `con'.
pre ~void(as) and ~void(nm) and ~void(con)-- BOOL::not BOOL::not
is-- BOOL::not
r::=new; r.tp:=con.same; r.name:=nm; r.src_tparams := srcparams;-- SIG::tp TP_CONTEXT::same SIG::name SIG::src_tparams
r.ret:=con.tp_of(as.tp);-- SIG::ret TP_CONTEXT::tp_of AS_ATTR_DEF::tp
return r.make_unique-- SIG::make_unique
end;
attr_writer_sig(as:AS_ATTR_DEF, nm:IDENT, srcparams: ARRAY{$TP},
con:TP_CONTEXT):SAME
-- The signature of the writer routine in the type `con.same' for
-- the object attribute defined by `as' with the name specified
-- by `nm' and types resolved according to `con'.
pre ~void(as) and ~void(nm) and ~void(con)-- BOOL::not BOOL::not
is-- BOOL::not
r::=new; r.tp:=con.same; r.name:=nm; r.src_tparams := srcparams;-- SIG::tp TP_CONTEXT::same SIG::name SIG::src_tparams
r.args:=ARRAY{ARG}::create(1);-- SIG::args ARRAY{1}::create
r.args[0] := #ARG(con.tp_of(as.tp)); -- arument mode: in-- SIG::args ARRAY{1}::aset ARG::create TP_CONTEXT::tp_of AS_ATTR_DEF::tp
if r.tp.kind=TP_KIND::val_tp then r.ret:=r.tp end;-- SIG::tp INT::is_eq TP_KIND::val_tp SIG::ret SIG::tp
return r.make_unique-- SIG::make_unique
end;
bound_routine_call(tp:TP_ROUT):SAME
-- The signature of the "call" routine for the bound routine
-- type `tp'.
pre ~void(tp) is-- BOOL::not
r::=new; r.tp:=tp; r.name:=IDENT_BUILTIN::call_ident;-- SIG::tp SIG::name IDENT_BUILTIN::call_ident
r.args:=tp.args; r.ret:=tp.ret;-- SIG::args TP_ROUT::args SIG::ret TP_ROUT::ret
return r.make_unique-- SIG::make_unique
end;
-- this will change when 1.1 once are ok (Boris),
bound_iter_call(tp:TP_ITER):SAME
-- The signature of the "call!" routine for the bound iter
-- type `tp'.
pre ~void(tp) is-- BOOL::not
r::=new; r.tp:=tp; r.name:=IDENT_BUILTIN::call_bang_ident;-- SIG::tp SIG::name IDENT_BUILTIN::call_bang_ident
r.args:=tp.args; r.hot:=tp.hot; r.ret:=tp.ret;-- SIG::args TP_ITER::args SIG::hot TP_ITER::hot SIG::ret TP_ITER::ret
return r.make_unique-- SIG::make_unique
end;
with_new_type(t:$TP):SAME
-- A new signature, the same as self, but with the new type `t'.
pre ~void(self) and ~void(t) is-- BOOL::not BOOL::not
r::=new;
r.tp:=t; r.name:=name; r.args:=args; r.hot:=hot;-- SIG::tp SIG::name SIG::name SIG::args SIG::args SIG::hot SIG::hot
if returns_same then-- SIG::returns_same
r.returns_same := true;-- SIG::returns_same
r.ret := t;-- SIG::ret
else
r.ret := ret-- SIG::ret SIG::ret
end;
return r.make_unique-- SIG::make_unique
end;
is_base_type(tp:$TP):BOOL is
-- True if `tp' is BOOL, CHAR, INT, FLT, FLTD, FLTX, FLTDX, or
-- EXT_OB.
-- Or one of external but recognized types
case tp
when TP_BUILTIN::bool then return true-- TP_BUILTIN::bool
when TP_BUILTIN::char then return true-- TP_BUILTIN::char
when TP_BUILTIN::int then return true-- TP_BUILTIN::int
when TP_BUILTIN::flt then return true-- TP_BUILTIN::flt
when TP_BUILTIN::fltd then return true-- TP_BUILTIN::fltd
when TP_BUILTIN::fltx then return true-- TP_BUILTIN::fltx
when TP_BUILTIN::fltdx then return true-- TP_BUILTIN::fltdx
when TP_BUILTIN::ext_ob then return true-- TP_BUILTIN::ext_ob
-- FORTRAN stuff
when TP_BUILTIN::f_integer then return true-- TP_BUILTIN::f_integer
when TP_BUILTIN::f_real then return true -- TP_BUILTIN::f_real
else return false end end;
is_base_aref_type(tp:$TP):BOOL is
-- True if `tp' has an include path to AREF{CHAR}, AREF{INT},
-- AREF{FLT}, AREF{FLTD}, AREF{FLTX}, AREF{FLTDX}, or AREF{EXT_OB}.
-- or AREF{one of external but recognized types}
typecase tp when TP_CLASS then
im:IMPL:=tp.impl;-- TP_CLASS::impl
if void(im) then return false end;
ar:TP_CLASS:=im.arr; if void(ar) then return false end;-- IMPL::arr
if ar.name/=IDENT_BUILTIN::AREF_ident then return false end;-- TP_CLASS::name IDENT::is_eq IDENT_BUILTIN::AREF_ident BOOL::not
if void(ar.params) then-- TP_CLASS::params
#OUT + "Compiler error, SIG::is_base_aref_type params=void.";-- OUT::create OUT::plus
return false end;
if ar.params.size/=1 then-- TP_CLASS::params ARRAY{1}::size INT::is_eq BOOL::not
#OUT + "Compiler error, SIG::is_base_aref_type params.size/=1.";-- OUT::create OUT::plus
return false end;
case ar.params[0]-- TP_CLASS::params ARRAY{1}::aget
when TP_BUILTIN::char then return true-- TP_BUILTIN::char
when TP_BUILTIN::int then return true-- TP_BUILTIN::int
when TP_BUILTIN::flt then return true-- TP_BUILTIN::flt
when TP_BUILTIN::fltd then return true-- TP_BUILTIN::fltd
when TP_BUILTIN::fltx then return true-- TP_BUILTIN::fltx
when TP_BUILTIN::fltdx then return true-- TP_BUILTIN::fltdx
when TP_BUILTIN::ext_ob then return true-- TP_BUILTIN::ext_ob
when TP_BUILTIN::f_integer then return true-- TP_BUILTIN::f_integer
when TP_BUILTIN::f_real then return true -- TP_BUILTIN::f_real
else return false end
else return false end end;
is_legal_ext_abs:BOOL
-- True if this signature is legal for an abstract routine
-- in an external class.
pre ~void(self) is-- BOOL::not
if name.is_iter then-- SIG::name IDENT::is_iter
prog.err("The iter signature " + str +-- SIG::prog PROG::err SIG::str
" isn't allowed in an external class.");-- STR::plus
return false end;
loop a::=args.elt!.tp;-- SIG::args ARRAY{1}::elt! ARG::tp
if a.is_abstract or ~(is_base_type(a) or is_base_aref_type(a)) then-- SIG::is_base_type SIG::is_base_aref_type BOOL::not
prog.err("The signature " + str +-- SIG::prog PROG::err SIG::str
" is not legal for a routine without body in an external "
"class. The argument type " + a.str +-- STR::plus STR::plus
" is not of the right type."); return false end end;-- STR::plus
if ~void(ret) and ~is_base_type(ret) then-- SIG::ret BOOL::not SIG::ret BOOL::not
prog.err("The signature " + str +-- SIG::prog PROG::err SIG::str
" is not legal for a routine without body in an external "
"class. The return type " + ret.str +-- STR::plus SIG::ret
" is not of the right type."); return false end;-- STR::plus
return true end;
is_legal_ext_bod:BOOL
-- True if this signature is legal for a routine with a body
-- in an external class.
pre ~void(self) is-- BOOL::not
if name.is_iter then-- SIG::name IDENT::is_iter
prog.err("The iter signature " + str +-- SIG::prog PROG::err SIG::str
" isn't allowed in an external class.");-- STR::plus
return false end;
loop a::=args.elt!.tp;-- SIG::args ARRAY{1}::elt! ARG::tp
if is_base_type(a) then-- SIG::is_base_type
else
prog.err("The signature " + str +-- SIG::prog PROG::err SIG::str
" is not legal for a routine with body in an external "
"class. The argument type " + a.str +-- STR::plus STR::plus
" is not of the right type."); return false end end;-- STR::plus
if ~void(ret) and ~is_base_type(ret) then-- SIG::ret BOOL::not SIG::ret BOOL::not
prog.err("The signature " + str +-- SIG::prog PROG::err SIG::str
" is not legal for a routine with body in an external "
"class. The return type " + ret.str +-- STR::plus SIG::ret
" is not of the right type."); return false end;-- STR::plus
return true end;
end; -- class SIG
class ARG
class ARG is
-- signature arguments
attr tp: $TP; -- argument type
attr mode: $MODE; -- argument mode
is_eq(a: $OB):BOOL is
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;
is_eq(a: ARG):BOOL is
return tp = a.tp and mode = a.mode;-- ARG::tp ARG::tp ARG::mode ARG::mode
end;
is_neq(a: ARG):BOOL is return ~is_eq(a); end;
str:STR is
return mode.str+tp.str;-- ARG::mode ARG::tp
end;
create(t:$TP): SAME is
-- The ``default'' constructor: mode is set to IN_MODE
res ::= new;
res.tp := t;-- ARG::tp
res.mode := #IN_MODE;-- ARG::mode IN_MODE::create
return res;
end;
create(t:$TP, m:$MODE): SAME is
res ::= new;
res.tp := t;-- ARG::tp
res.mode := m;-- ARG::mode
return res;
end;
end;
class SIG_TBL < $STR
class SIG_TBL < $STR is
-- Table of routine and iter signatures retrievable by name.
--
-- `get_query!(i:IDENT):SIG' yields each sig with the name `i'.
-- `test(SIG):BOOL' tests for the given sig.
-- `insert(SIG):SAME' inserts a sig.
-- `delete(SIG):SAME' deletes a sig.
-- `elt!:ELT' yields each sig.
include FQSET{IDENT,SIG};
query_test(name:IDENT, s:SIG):BOOL is
-- True if `s' is a signature with the name `name'.
if void(s) then return false end;
return s.name=name end;-- SIG::name IDENT::is_eq
query_hash(i:IDENT):INT is
-- A hash value computed from the name `i'.
return i.hash end;-- IDENT::hash
elt_hash(s:SIG):INT is
-- A hash value computed from the name of an element.
return s.name.hash end;-- SIG::name IDENT::hash
sig_eq_to(s:SIG):SIG
-- Returns an element of self equal to `s' if one exists,
-- otherwise returns void. New implementation by MBK. Much faster.
pre ~void(s) is
return get(s);
end;
sig_conflicting_with(s:SIG):SIG
-- Returns an element of self that conflicts with `s' if one
-- exists, otherwise returns void.
pre ~void(s) is-- BOOL::not
loop r::=get_query!(s.name);-- SIG_TBL::get_query! SIG::name
if r.conflicts_with(s) then return r end end;-- SIG::conflicts_with
return void end;
str:STR is
a:ARRAY{STR}:=#(size);-- ARRAY{1}::create SIG_TBL::size
loop
a.set!(elt!.str);-- ARRAY{1}::set! SIG_TBL::elt! SIG::str
end;
a.sort;-- ARRAY{1}::sort
s:STR:="";
i::=0;
loop
while!(i<a.asize);-- INT::is_lt ARRAY{1}::asize
if i/=0 then s:=s+";"; end;-- INT::is_eq BOOL::not STR::plus
s:=s+a[i];-- STR::plus ARRAY{1}::aget
i:=i+1;-- INT::plus
end;
return s;
end;
end; -- class SIG_TBL
-- vim:sw=3:nosmartindent