find_types.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 "Dc/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. <----------
class FIND_TYPES < $FIND_TYPES
class FIND_TYPES < $FIND_TYPES is
-- This is the phase which finds all possible types in the program.
-- It starts from the non-parameterized types parsed in the first
-- phase. It produces an IMPL for each such type and determines all
-- types mentioned within it. If any of these types is missing or if
-- any of the builtin types is missing an error is signalled
-- and compilation ends. It causes errors for overloaded name
-- conflicts.
include CS_COMPONENT;
private attr con:TP_CONTEXT; -- Context in which to interpret types.
create(p:PROG):SAME
is
r ::= new;
r.prog := p;-- FIND_TYPES::prog
r.pending_includes := #;-- FIND_TYPES::pending_includes FLIST{1}::create
return r
end;
private tree_for(nm:IDENT, num:INT):AS_CLASS_DEF
-- Return the code tree for the class with name `nm' and the
-- number of type parameters `num'. Return void if no such class.
is
return prog.parse.tree_for(nm,num)-- FIND_TYPES::prog PROG::parse
end;
find_types
-- Walk through all the code trees and find all the types referred
-- to and put them in `tp_done'. Cause errors for any types
-- referred to but not existing.
is
-- Make sure the main class at least gets searched.
err_loc(void);-- FIND_TYPES::err_loc
dummy_tree ::= tree_for( #IDENT(prog.main_class), 0 );-- FIND_TYPES::tree_for IDENT::create FIND_TYPES::prog PROG::main_class
dummy ::= prog.tp_tbl.tp_class_for( #IDENT(prog.main_class), void );-- FIND_TYPES::prog PROG::tp_tbl TP_TBL::tp_class_for IDENT::create FIND_TYPES::prog PROG::main_class
-- All non parameterized classes which are NOT in the library
-- should be parsed in any case.
loop
nonlib_class ::= prog.as_tbl.elt!;-- FIND_TYPES::prog PROG::as_tbl PROG_AS_TBL::elt!
if void(nonlib_class.params) then-- AS_CLASS_DEF::params
dummy := prog.tp_tbl.tp_class_for( nonlib_class.name, void );-- FIND_TYPES::prog PROG::tp_tbl TP_TBL::tp_class_for AS_CLASS_DEF::name
end
end;
loop
-- Fetch all classes to do for the next loop.
-- get only the ones which are not already done.
tp_doing ::= #FSET{TP_CLASS};-- FSET{1}::create
tp: TP_CLASS;
loop
tp := prog.tp_tbl.class_tbl.elt!;-- FIND_TYPES::prog PROG::tp_tbl TP_TBL::class_tbl TP_CLASS_TBL::elt!
if ~prog.tp_done.test(tp) then-- FIND_TYPES::prog PROG::tp_done FSET{1}::test BOOL::not
tp_doing := tp_doing.insert(tp);-- FSET{1}::insert
end;
end;
until!( void(tp_doing) );
loop
tp := tp_doing.elt!;-- FSET{1}::elt!
if prog.show_types then-- FIND_TYPES::prog PROG::show_types
(#OUT+"\nfinding types in "+tp.str).flush;-- OUT::create OUT::plus OUT::plus TP_CLASS::str OUT::flush
end;
prog.tp_done:=prog.tp_done.insert(tp); -- FIND_TYPES::prog PROG::tp_done FIND_TYPES::prog PROG::tp_done FSET{1}::insert
as_tree ::= tree_for(tp.name,tp.params.size);-- FIND_TYPES::tree_for TP_CLASS::name TP_CLASS::params ARRAY{1}::size
if ~void(as_tree) then-- BOOL::not
con := tp.tp_context_for;-- FIND_TYPES::con TP_CLASS::tp_context_for
do_tps(as_tree)-- FIND_TYPES::do_tps
end;
end;
if 0.up! > 100 then-- INT::up! INT::is_lt
-- Rather stupid detection of infinite class generation loops.
prog.err( "Probably infinite class loop detected,"-- FIND_TYPES::prog PROG::err
" perhaps involving " + tp.str );-- STR::plus TP_CLASS::str
break!;
end;
end;
end;
private process_tp(t:$TP)
-- Looks up, whether there is a tree for this class.
-- ROUTs and ITERs are completely checked and marked as done.
-- CLASSes are only marked in the find_types loop!
is
if void(t) then return end; -- A typespec error, ignore.
if prog.tp_done.test(t) then return end; -- Already processed.-- FIND_TYPES::prog PROG::tp_done FSET{1}::test
typecase t
when TP_CLASS then
-- Does not go into tp_done, as the implementation has to be
-- checked.
nm:IDENT:=t.name; pnum:INT:=t.params.size;-- TP_CLASS::name TP_CLASS::params ARRAY{1}::size
if ~void(tree_for(nm,pnum)) and pnum > 0 then-- FIND_TYPES::tree_for BOOL::not INT::is_lt
loop process_tp(t.params[0.upto!(pnum-1)]); end-- FIND_TYPES::process_tp TP_CLASS::params ARRAY{1}::aget INT::upto! INT::minus
end;
when TP_ROUT then
prog.tp_done:=prog.tp_done.insert(t);-- FIND_TYPES::prog PROG::tp_done FIND_TYPES::prog PROG::tp_done FSET{1}::insert
if ~void(t.args) then-- TP_ROUT::args BOOL::not
loop process_tp(t.args[0.upto!(t.args.size-1)].tp); end-- FIND_TYPES::process_tp TP_ROUT::args ARRAY{1}::aget INT::upto! TP_ROUT::args ARRAY{1}::size INT::minus ARG::tp
end;
if ~void(t.ret) then process_tp(t.ret); end;-- TP_ROUT::ret BOOL::not FIND_TYPES::process_tp TP_ROUT::ret
when TP_ITER then
prog.tp_done:=prog.tp_done.insert(t);-- FIND_TYPES::prog PROG::tp_done FIND_TYPES::prog PROG::tp_done FSET{1}::insert
if ~void(t.args) then-- TP_ITER::args BOOL::not
loop process_tp(t.args[0.upto!(t.args.size-1)].tp) end-- FIND_TYPES::process_tp TP_ITER::args ARRAY{1}::aget INT::upto! TP_ITER::args ARRAY{1}::size INT::minus ARG::tp
end;
if ~void(t.ret) then process_tp(t.ret); end;-- TP_ITER::ret BOOL::not FIND_TYPES::process_tp TP_ITER::ret
end;
end;
private do_tps(as:$AS_NODE)
-- Find all the types mentioned in `as' and interpret them via
-- `con'. INCLUDE_CLAUSEs are treated specially.
is
as_n: $AS_NODE;
loop
until!(void(as));
err_loc(as); -- Set error location.-- FIND_TYPES::err_loc
typecase as
when AS_CLASS_DEF then
do_tps(as.params); do_tps(as.under); do_tps(as.over);-- FIND_TYPES::do_tps AS_CLASS_DEF::params FIND_TYPES::do_tps AS_CLASS_DEF::under FIND_TYPES::do_tps AS_CLASS_DEF::over
do_tps(as.body); return-- FIND_TYPES::do_tps AS_CLASS_DEF::body
when AS_PARAM_DEC then do_tps(as.type_constraint); return-- FIND_TYPES::do_tps AS_PARAM_DEC::type_constraint
-- The following typecase braches iterate within this loop
-- in order to reduce the stack load. Note that the above
-- branches do 'return'.
when AS_TYPE_SPEC then prog.err_loc(as); process_tp(con.tp_of(as));-- FIND_TYPES::prog PROG::err_loc FIND_TYPES::con TP_CONTEXT::tp_of
as_n := as.next;-- AS_TYPE_SPEC::next
when AS_INCLUDE_CLAUSE then do_include(as.tp); as_n:=as.next;-- FIND_TYPES::do_include AS_INCLUDE_CLAUSE::tp AS_INCLUDE_CLAUSE::next
when AS_CONST_DEF then do_tps(as.tp); do_tps(as.init);-- FIND_TYPES::do_tps AS_CONST_DEF::tp FIND_TYPES::do_tps AS_CONST_DEF::init
as_n:=as.next;-- AS_CONST_DEF::next
when AS_SHARED_DEF then do_tps(as.tp); do_tps(as.init);-- FIND_TYPES::do_tps AS_SHARED_DEF::tp FIND_TYPES::do_tps AS_SHARED_DEF::init
as_n:=as.next;-- AS_SHARED_DEF::next
when AS_ATTR_DEF then do_tps(as.tp);-- FIND_TYPES::do_tps AS_ATTR_DEF::tp
as_n:=as.next;-- AS_ATTR_DEF::next
when AS_ROUT_DEF then do_tps(as.args_dec); do_tps(as.ret_dec);-- FIND_TYPES::do_tps AS_ROUT_DEF::args_dec FIND_TYPES::do_tps AS_ROUT_DEF::ret_dec
do_tps(as.pre_e); do_tps(as.post_e); do_tps(as.body);-- FIND_TYPES::do_tps AS_ROUT_DEF::pre_e FIND_TYPES::do_tps AS_ROUT_DEF::post_e FIND_TYPES::do_tps AS_ROUT_DEF::body
as_n:=as.next;-- AS_ROUT_DEF::next
when AS_STMT_LIST then do_tps(as.stmts); return-- FIND_TYPES::do_tps AS_STMT_LIST::stmts
when AS_ARG_DEC then do_tps(as.tp); as_n:=as.next;-- FIND_TYPES::do_tps AS_ARG_DEC::tp AS_ARG_DEC::next
when AS_DEC_STMT then do_tps(as.tp); as_n:=as.next;-- FIND_TYPES::do_tps AS_DEC_STMT::tp AS_DEC_STMT::next
when AS_ASSIGN_STMT then do_tps(as.lhs_expr); do_tps(as.tp); -- FIND_TYPES::do_tps AS_ASSIGN_STMT::lhs_expr FIND_TYPES::do_tps AS_ASSIGN_STMT::tp
do_tps(as.rhs); as_n:=as.next;-- FIND_TYPES::do_tps AS_ASSIGN_STMT::rhs AS_ASSIGN_STMT::next
when AS_IF_STMT then do_tps(as.test); do_tps(as.then_part); -- FIND_TYPES::do_tps AS_IF_STMT::test FIND_TYPES::do_tps AS_IF_STMT::then_part
do_tps(as.else_part); as_n:=as.next;-- FIND_TYPES::do_tps AS_IF_STMT::else_part AS_IF_STMT::next
when AS_LOOP_STMT then do_tps(as.body); as_n:=as.next;-- FIND_TYPES::do_tps AS_LOOP_STMT::body AS_LOOP_STMT::next
when AS_RETURN_STMT then do_tps(as.val); as_n:=as.next;-- FIND_TYPES::do_tps AS_RETURN_STMT::val AS_RETURN_STMT::next
when AS_YIELD_STMT then do_tps(as.val); as_n:=as.next;-- FIND_TYPES::do_tps AS_YIELD_STMT::val AS_YIELD_STMT::next
when AS_QUIT_STMT then as_n:=as.next;-- AS_QUIT_STMT::next
when AS_CASE_STMT then do_tps(as.test); do_tps(as.when_part); -- FIND_TYPES::do_tps AS_CASE_STMT::test FIND_TYPES::do_tps AS_CASE_STMT::when_part
do_tps(as.else_part); as_n:=as.next;-- FIND_TYPES::do_tps AS_CASE_STMT::else_part AS_CASE_STMT::next
when AS_CASE_WHEN then
do_tps(as.val); do_tps(as.then_part); as_n:=as.next;-- FIND_TYPES::do_tps AS_CASE_WHEN::val FIND_TYPES::do_tps AS_CASE_WHEN::then_part AS_CASE_WHEN::next
when AS_TYPECASE_STMT then do_tps(as.when_part); -- FIND_TYPES::do_tps AS_TYPECASE_STMT::when_part
do_tps(as.else_part); as_n:=as.next;-- FIND_TYPES::do_tps AS_TYPECASE_STMT::else_part AS_TYPECASE_STMT::next
when AS_TYPECASE_WHEN then
do_tps(as.tp); do_tps(as.then_part); as_n:=as.next;-- FIND_TYPES::do_tps AS_TYPECASE_WHEN::tp FIND_TYPES::do_tps AS_TYPECASE_WHEN::then_part AS_TYPECASE_WHEN::next
when AS_ASSERT_STMT then do_tps(as.test); as_n:=as.next;-- FIND_TYPES::do_tps AS_ASSERT_STMT::test AS_ASSERT_STMT::next
when AS_PROTECT_STMT then do_tps(as.body); do_tps(as.when_part); -- FIND_TYPES::do_tps AS_PROTECT_STMT::body FIND_TYPES::do_tps AS_PROTECT_STMT::when_part
do_tps(as.else_part); as_n:=as.next;-- FIND_TYPES::do_tps AS_PROTECT_STMT::else_part AS_PROTECT_STMT::next
when AS_PROTECT_WHEN then
do_tps(as.tp); do_tps(as.then_part); as_n:=as.next;-- FIND_TYPES::do_tps AS_PROTECT_WHEN::tp FIND_TYPES::do_tps AS_PROTECT_WHEN::then_part AS_PROTECT_WHEN::next
when AS_RAISE_STMT then do_tps(as.val); as_n:=as.next;-- FIND_TYPES::do_tps AS_RAISE_STMT::val AS_RAISE_STMT::next
when AS_EXPR_STMT then do_tps(as.e); as_n:=as.next;-- FIND_TYPES::do_tps AS_EXPR_STMT::e AS_EXPR_STMT::next
when AS_SELF_EXPR then as_n:=as.next;-- AS_SELF_EXPR::next
when AS_CALL_EXPR then do_tps(as.ob); do_tps(as.tp); -- FIND_TYPES::do_tps AS_CALL_EXPR::ob FIND_TYPES::do_tps AS_CALL_EXPR::tp
do_tps(as.args); as_n:=as.next;-- FIND_TYPES::do_tps AS_CALL_EXPR::args AS_CALL_EXPR::next
when AS_VOID_EXPR then as_n:=as.next;-- AS_VOID_EXPR::next
when AS_IS_VOID_EXPR then do_tps(as.arg);-- FIND_TYPES::do_tps AS_IS_VOID_EXPR::arg
when AS_ARRAY_EXPR then do_tps(as.elts); as_n:=as.next;-- FIND_TYPES::do_tps AS_ARRAY_EXPR::elts AS_ARRAY_EXPR::next
when AS_CREATE_EXPR then do_tps(as.tp); do_tps(as.elts); -- FIND_TYPES::do_tps AS_CREATE_EXPR::tp FIND_TYPES::do_tps AS_CREATE_EXPR::elts
as_n:=as.next;-- AS_CREATE_EXPR::next
when AS_BOUND_CREATE_EXPR then do_tps(as.call); do_tps(as.ret); -- FIND_TYPES::do_tps AS_BOUND_CREATE_EXPR::call FIND_TYPES::do_tps AS_BOUND_CREATE_EXPR::ret
as_n:=as.next; -- AS_BOUND_CREATE_EXPR::next
when AS_UNDERSCORE_ARG then do_tps(as.tp); as_n:=as.next; -- FIND_TYPES::do_tps AS_UNDERSCORE_ARG::tp AS_UNDERSCORE_ARG::next
when AS_AND_EXPR then do_tps(as.e1); do_tps(as.e2); as_n:=as.next;-- FIND_TYPES::do_tps AS_AND_EXPR::e1 FIND_TYPES::do_tps AS_AND_EXPR::e2 AS_AND_EXPR::next
when AS_OR_EXPR then do_tps(as.e1); do_tps(as.e2); as_n:=as.next;-- FIND_TYPES::do_tps AS_OR_EXPR::e1 FIND_TYPES::do_tps AS_OR_EXPR::e2 AS_OR_EXPR::next
when AS_EXCEPT_EXPR then as_n:=as.next;-- AS_EXCEPT_EXPR::next
when AS_NEW_EXPR then do_tps(as.arg); as_n:=as.next;-- FIND_TYPES::do_tps AS_NEW_EXPR::arg AS_NEW_EXPR::next
when AS_INITIAL_EXPR then do_tps(as.e); as_n:=as.next; -- FIND_TYPES::do_tps AS_INITIAL_EXPR::e AS_INITIAL_EXPR::next
when AS_BREAK_EXPR then as_n:=as.next;-- AS_BREAK_EXPR::next
when AS_RESULT_EXPR then as_n:=as.next;-- AS_RESULT_EXPR::next
when AS_BOOL_LIT_EXPR then as_n:=as.next;-- AS_BOOL_LIT_EXPR::next
when AS_CHAR_LIT_EXPR then as_n:=as.next;-- AS_CHAR_LIT_EXPR::next
when AS_STR_LIT_EXPR then as_n:=as.next;-- AS_STR_LIT_EXPR::next
when AS_INT_LIT_EXPR then as_n:=as.next;-- AS_INT_LIT_EXPR::next
when AS_FLT_LIT_EXPR then as_n:=as.next;-- AS_FLT_LIT_EXPR::next
--pSather
when AS_PAR_STMT then do_tps(as.body); as_n:=as.next;-- FIND_TYPES::do_tps AS_PAR_STMT::body AS_PAR_STMT::next
when AS_ATTACH_STMT then
do_tps(as.lhs); do_tps(as.rhs); as_n:=as.next;-- FIND_TYPES::do_tps AS_ATTACH_STMT::lhs FIND_TYPES::do_tps AS_ATTACH_STMT::rhs AS_ATTACH_STMT::next
when AS_LOCK_STMT then
do_tps(as.e_list); do_tps(as.then_part); as_n:=as.next;-- FIND_TYPES::do_tps AS_LOCK_STMT::e_list FIND_TYPES::do_tps AS_LOCK_STMT::then_part AS_LOCK_STMT::next
when AS_LOCK_IF_WHEN then do_tps(as.val); do_tps(as.e_list);-- FIND_TYPES::do_tps AS_LOCK_IF_WHEN::val FIND_TYPES::do_tps AS_LOCK_IF_WHEN::e_list
do_tps(as.then_part); as_n := as.next;-- FIND_TYPES::do_tps AS_LOCK_IF_WHEN::then_part AS_LOCK_IF_WHEN::next
when AS_UNLOCK_STMT then do_tps(as.e); as_n:=as.next;-- FIND_TYPES::do_tps AS_UNLOCK_STMT::e AS_UNLOCK_STMT::next
when AS_WITH_NEAR_STMT then
do_tps(as.near_part); do_tps(as.else_part); as_n:=as.next;-- FIND_TYPES::do_tps AS_WITH_NEAR_STMT::near_part FIND_TYPES::do_tps AS_WITH_NEAR_STMT::else_part AS_WITH_NEAR_STMT::next
-- ident_list skipped (only locals, args and self)
when AS_FORK_STMT then
do_tps(as.at); do_tps(as.body); as_n:=as.next;-- FIND_TYPES::do_tps AS_FORK_STMT::at FIND_TYPES::do_tps AS_FORK_STMT::body AS_FORK_STMT::next
when AS_INTERF_ATTACH_STMT then do_tps( as.at );-- FIND_TYPES::do_tps AS_INTERF_ATTACH_STMT::at
as_n := as.next;-- AS_INTERF_ATTACH_STMT::next
when AS_SYNC_STMT then as_n := as.next;-- AS_SYNC_STMT::next
when AS_HERE_EXPR then as_n:=as.next-- AS_HERE_EXPR::next
when AS_WHERE_EXPR then do_tps(as.e); as_n:=as.next;-- FIND_TYPES::do_tps AS_WHERE_EXPR::e AS_WHERE_EXPR::next
when AS_NEAR_EXPR then do_tps(as.e); as_n:=as.next;-- FIND_TYPES::do_tps AS_NEAR_EXPR::e AS_NEAR_EXPR::next
when AS_FAR_EXPR then do_tps(as.e); as_n:=as.next;-- FIND_TYPES::do_tps AS_FAR_EXPR::e AS_FAR_EXPR::next
when AS_AT_EXPR then do_tps(as.e); do_tps(as.at); as_n:=as.next;-- FIND_TYPES::do_tps AS_AT_EXPR::e FIND_TYPES::do_tps AS_AT_EXPR::at AS_AT_EXPR::next
when AS_ANY_EXPR then as_n:=as.next;-- AS_ANY_EXPR::next
when AS_CLUSTER_EXPR then as_n:=as.next;-- AS_CLUSTER_EXPR::next
when AS_CLUSTER_SIZE_EXPR then as_n:=as.next; -- AS_CLUSTER_SIZE_EXPR::next
when AS_COHORT_EXPR then as_n:=as.next;-- AS_COHORT_EXPR::next
end;
as := as_n;
end; -- loop
end;
private shared pending_includes: FLIST{TUP{IDENT,INT}};
private cycle_error
is
str: STR;
loop
cur ::= pending_includes.elt!;-- FIND_TYPES::pending_includes FLIST{1}::elt!
str := str + ", ".separate!( cur.t1.str(cur.t2) );-- STR::plus STR::separate! TUP{2}::t1 IDENT::str TUP{2}::t2
end;
prog.err( "Cyclic include detected involving "+str+"." );-- FIND_TYPES::prog PROG::err STR::plus STR::plus
end;
do_include( inc_type: AS_TYPE_SPEC )
-- Processing an include clause.
-- 1.) Trying to load the syntax tree of the included type.
-- Checking against cyclic inclusion.
-- 2.) If included type is parameterized:
-- 2a) Resolving the actual type parameters.
-- This is done even if the syntax tree was not found.
-- 2b) Retrieving the formal type parameters.
-- 3.) Creating a new context for the syntax tree.
-- 4.) Processing the tree.
-- 5.) Restoring the old context.
is
params: ARRAY{$TP};
pnames: ARRAY{IDENT};
inc_param_c ::= inc_type.params.size;-- AS_TYPE_SPEC::params AS_TYPE_SPEC::size
typeid: TUP{IDENT,INT} := #(inc_type.name, inc_param_c);-- TUP{2}::create AS_TYPE_SPEC::name
if pending_includes.contains(typeid) then-- FIND_TYPES::pending_includes FLIST{1}::contains
cycle_error;-- FIND_TYPES::cycle_error
return;
end;
pending_includes := pending_includes.push(typeid);-- FIND_TYPES::pending_includes FIND_TYPES::pending_includes FLIST{1}::push
include_tree ::= tree_for( inc_type.name, inc_param_c );-- FIND_TYPES::tree_for AS_TYPE_SPEC::name
if inc_param_c > 0 then-- INT::is_lt
params := #ARRAY{$TP}(inc_param_c);-- ARRAY{1}::create
inc_param ::= inc_type.params;-- AS_TYPE_SPEC::params
loop until!(void(inc_param));
params.set!( con.tp_of(inc_param) );-- ARRAY{1}::set! FIND_TYPES::con TP_CONTEXT::tp_of
inc_param := inc_param.next;-- AS_TYPE_SPEC::next
end;
if void(include_tree) then return end;
pnames := #ARRAY{IDENT}(inc_param_c);-- ARRAY{1}::create
tree_pnames ::= include_tree.params;-- AS_CLASS_DEF::params
assert tree_pnames.size = inc_param_c;-- AS_PARAM_DEC::size INT::is_eq
loop until!(void(tree_pnames));
pnames.set!( tree_pnames.name );-- ARRAY{1}::set! AS_PARAM_DEC::name
tree_pnames := tree_pnames.next;-- AS_PARAM_DEC::next
end;
end;
dummy_class ::= con.tp_of(inc_type,false);-- FIND_TYPES::con TP_CONTEXT::tp_of
-- Make sure that the included type goes into the included_classes
-- table.
old_con ::= con;-- FIND_TYPES::con
con := #TP_CONTEXT(con.same,pnames,params,prog);-- FIND_TYPES::con TP_CONTEXT::create FIND_TYPES::con TP_CONTEXT::same FIND_TYPES::prog
do_tps( include_tree );-- FIND_TYPES::do_tps
-- include_tree can be void if inc_param_c = 0 !
-- but this should be caught in do_tps.
con := old_con;-- FIND_TYPES::con
dummy ::= pending_includes.pop;-- FIND_TYPES::pending_includes FLIST{1}::pop
end; -- do_include
end; -- class FIND_TYPES