---------------------------> Sather 1.1 source file <--------------------------
class GENERATE_AM < $GENERATE_AM
class GENERATE_AM < $GENERATE_AM is -- This phase does a code walk from main and generates the AM form -- It causes errors for failures of type checking, name clashes, -- etc. It is interleaved in time with the back-end for each -- routine generated. include CS_COMPONENT; attr sig_list:FLIST{SIG}; -- Signatures to still consider -- outputting. attr optimize:BOOL; attr only_check: BOOL; -- Holger -- Ivin: Signatures in process of being output. attr sig_inprocout:FSET{SIG}; -- Ivin: Signatures of routines that have been called recursively. attr sig_recursive:FSET{SIG}; -- attr inline_tbl:INLINE_TBL; -- Ivin attr global_tbl:GLOBAL_TBL; create(p:PROG):SAME is r::=new; r.prog:=p; -- GENERATE_AM::prog r.global_tbl:=#(p); -- GENERATE_AM::global_tbl GLOBAL_TBL::create return r; end; generate_am is -- Get optimize attr and whether code should be generated. cgen::=prog.back_end;-- GENERATE_AM::prog PROG::back_end typecase cgen when CGEN then optimize:=cgen.optimize;-- GENERATE_AM::optimize CGEN::optimize only_check:=cgen.only_check;-- GENERATE_AM::only_check CGEN::only_check else end; -- Generate all the code. mn:SIG:=prog.get_main_sig.main_sig;-- GENERATE_AM::prog PROG::get_main_sig if void(mn) then return end; if prog.show_generated_sig then -- GENERATE_AM::prog PROG::show_generated_sig #OUT + "Output sig " + mn.str + "\n"-- OUT::create OUT::plus OUT::plus SIG::str end;-- OUT::plus output_sig(mn);-- GENERATE_AM::output_sig output_externals_with_bodies;-- GENERATE_AM::output_externals_with_bodies loop until!(sig_list.is_empty); -- GENERATE_AM::sig_list FLIST{1}::is_empty s:SIG:=sig_list.pop;-- GENERATE_AM::sig_list FLIST{1}::pop if prog.show_generated_sig then -- GENERATE_AM::prog PROG::show_generated_sig #OUT + "Output sig " + s.str + "\n"-- OUT::create OUT::plus OUT::plus SIG::str end; -- OUT::plus output_sig(s);-- GENERATE_AM::output_sig end; prog.all_reached:=true;-- GENERATE_AM::prog PROG::all_reached end; output_sig(s:SIG) -- Transform and output the signature `s' if it hasn't already -- been done. Put the routines and iters that it calls on -- `sig_list'. Now searches depth first on routines, so these -- don't get put on the list. -- Puts information in the inline table for inlining. pre ~void(s) is-- BOOL::not if s.am_created then-- SIG::am_created if sig_inprocout.test(s) then -- Ivin.-- GENERATE_AM::sig_inprocout FSET{1}::test sig_recursive:=sig_recursive.insert(s);-- GENERATE_AM::sig_recursive GENERATE_AM::sig_recursive FSET{1}::insert end; return end; if s.am_created then return; end;-- SIG::am_created if s.tp.is_abstract then output_abs_sig(s); return end;-- SIG::tp GENERATE_AM::output_abs_sig -- skip things coming from partial classes. -- partial classes cannot be instantiated if s.tp.is_partial then return; end;-- SIG::tp s.am_created:=true;-- SIG::am_created elt:ELT:=s.tp.impl.elts.elt_with_sig(s);-- SIG::tp IMPL::elts ELT_TBL::elt_with_sig if void(elt) then return end; if elt.is_external and elt.is_abstract then return end;-- ELT::is_external ELT::is_abstract -- this is needed for recursion detection -- necessary for inlining sig_inprocout:=sig_inprocout.insert(s); -- Ivin.-- GENERATE_AM::sig_inprocout GENERATE_AM::sig_inprocout FSET{1}::insert am:AM_ROUT_DEF:=TRANS::transform_elt(elt);-- TRANS::transform_elt sig_inprocout:=sig_inprocout.delete(s); -- Ivin.-- GENERATE_AM::sig_inprocout GENERATE_AM::sig_inprocout FSET{1}::delete if void(am) then return end; prog.inliner.consider(am);-- GENERATE_AM::prog PROG::inliner if prog.show_am then-- GENERATE_AM::prog PROG::show_am #OUT + "\nAM for " + am.sig.str + "="; -- OUT::create OUT::plus OUT::plus AM_ROUT_DEF::sig SIG::str OUT::plus AM_OUT::AM_out(am); #OUT + "\n" end;-- AM_OUT::AM_out OUT::create OUT::plus i:INT; loop while!(i<am.calls.size);-- INT::is_lt AM_ROUT_DEF::calls FLIST{1}::size c:$AM_EXPR:=am.calls[i];-- AM_ROUT_DEF::calls FLIST{1}::aget typecase c when AM_ROUT_CALL_EXPR then output_sig(c.fun);-- GENERATE_AM::output_sig AM_ROUT_CALL_EXPR::fun when AM_ITER_CALL_EXPR then output_sig(c.fun);-- GENERATE_AM::output_sig AM_ITER_CALL_EXPR::fun when AM_BND_CREATE_EXPR then output_sig(c.fun);-- GENERATE_AM::output_sig AM_BND_CREATE_EXPR::fun else end; i:=i+1 end; -- INT::plus if ~prog.err_seen and ~only_check then-- GENERATE_AM::prog PROG::err_seen BOOL::not GENERATE_AM::only_check BOOL::not if optimize then-- GENERATE_AM::optimize prog.optimizer.optimize(am);-- GENERATE_AM::prog PROG::optimizer else prog.optimizer.no_optimize(am);-- GENERATE_AM::prog PROG::optimizer end; end; end; output_abs_sig(s:SIG) -- Do the output for the abstract call `s'. pre ~void(s) is-- BOOL::not if s.am_created then return end;-- SIG::am_created s.am_created:=true;-- SIG::am_created am:AM_ROUT_DEF:=#AM_ROUT_DEF(1+s.args.size,void);-- AM_ROUT_DEF::create INT::plus SIG::args ARRAY{1}::size am.sig:=s; am.is_abstract:=true;-- AM_ROUT_DEF::sig AM_ROUT_DEF::is_abstract stp:TP_CLASS; ostp::=s.tp;-- SIG::tp typecase ostp when TP_CLASS then stp:=ostp end; desof::=prog.tp_graph_abs_des.des_of(stp);-- GENERATE_AM::prog PROG::tp_graph_abs_des TP_GRAPH_ABS_DES::des_of tparr::=#TP_ARRAY(desof.size); -- For determinism-- TP_ARRAY::create FSET{1}::size loop tparr.set!(desof.elt!); end;-- TP_ARRAY::set! FSET{1}::elt! tparr.sort;-- TP_ARRAY::sort loop --tp::=prog.tp_graph_abs_des.des_of(stp).elt!; tp::=tparr.elt!;-- TP_ARRAY::elt! ifc:IFC:=tp.ifc; cs:SIG:=ifc.sig_conforming_to(s); -- The call in the descendant.-- IFC::sig_conforming_to output_sig(cs);-- GENERATE_AM::output_sig -- sig_list:=sig_list.push(cs); end; SYS::destroy(tparr);-- SYS::destroy if prog.show_am then-- GENERATE_AM::prog PROG::show_am #OUT + "\nAM for " + am.sig.str + "="; -- OUT::create OUT::plus OUT::plus AM_ROUT_DEF::sig SIG::str OUT::plus AM_OUT::AM_out(am); #OUT + "\n" end;-- AM_OUT::AM_out OUT::create OUT::plus if ~prog.err_seen and ~only_check then-- GENERATE_AM::prog PROG::err_seen BOOL::not GENERATE_AM::only_check BOOL::not prog.optimizer.optimize(am) end end;-- GENERATE_AM::prog PROG::optimizer output_externals_with_bodies is loop tp::=prog.tp_tbl.class_tbl.elt!;-- GENERATE_AM::prog PROG::tp_tbl TP_TBL::class_tbl TP_CLASS_TBL::elt! if tp.is_external then-- TP_CLASS::is_external et::=tp.impl.elts;-- TP_CLASS::impl IMPL::elts sig_tbl::=tp.ifc.sigs;-- TP_CLASS::ifc IFC::sigs loop sig::=sig_tbl.elt!;-- SIG_TBL::elt! elt::=et.elt_with_sig(sig);-- ELT_TBL::elt_with_sig if ~elt.is_abstract then output_sig(sig) end;-- ELT::is_abstract BOOL::not GENERATE_AM::output_sig end; end; end; end; end; -- class GENERATE_AM
class TP_ARRAY
class TP_ARRAY is include ARRAY{$TP}; elt_lt(a,b:$TP):BOOL is return a.str<b.str;-- STR::is_lt end; end;