home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sa104os2.zip / SATHR104.ZIP / SATHER / COMPILER / IMPL.SA < prev    next >
Text File  |  1995-02-13  |  24KB  |  623 lines
  1. -- Copyright (C) International Computer Science Institute, 1994.  COPYRIGHT  --
  2. -- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
  3. -- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in    --
  4. -- the file "Doc/License" of the Sather distribution.  The license is also   --
  5. -- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA.  --
  6. --------> Please email comments to "sather-bugs@icsi.berkeley.edu". <----------
  7.  
  8. -- impl.sa: Type implementations.
  9. -------------------------------------------------------------------
  10. -- IMPL: The implementation of a type. 
  11. -- IMPL_TBL: A table of implementations indexed by type.
  12. -- IMPL_INCLUDE: Information for handling an `include' clause.
  13. -- IMPL_CREATE: An object used while creating an interface.
  14. -------------------------------------------------------------------
  15. class IMPL is
  16.    -- The implementation of a type. 
  17.    
  18.    attr tp:$TP;            -- The type this is for.
  19.    attr ifc:IFC;        -- The public interface of the type.
  20.    attr elts:ELT_TBL;        -- The elements of the type.
  21.    attr arr:TP_CLASS;        -- AREF{T} or AVAL{T} if there is an
  22.       -- include path to one of them, or void if not. 
  23.       
  24.    prog:PROG is
  25.       -- The program this belongs to.
  26.       return tp.prog end;
  27.    
  28.    create_for_tp(t:$TP):SAME 
  29.       -- Compute the interface of the type `t'.
  30.       pre ~void(t) is
  31.       typecase t
  32.       when TP_CLASS then
  33.      if t.is_abstract then 
  34.         prog.err(
  35.         "Compiler error: Implementation requested for abstract type " +
  36.         t.str); 
  37.         return void end;     
  38.      return IMPL_CREATE::impl_of(t) 
  39.       else
  40.      t.prog.err("Compiler error: IMPL requested for non class type.");
  41. --       return void end end;                                                   -- NLP
  42.          end; return void; end;                                                 -- NLP
  43.  
  44.    create:SAME is
  45.       -- An empty IMPL object.
  46.       return new end;
  47.    
  48.    sig_for_internal_call(c:CALL_SIG):SIG 
  49.       -- The signature in self which corresponds to the internal call 
  50.       -- signature `c'. err_call_sig if none. Reports an error if the call 
  51.       -- is ambiguous or missing (assumes that "err_loc" has been set).
  52.       pre ~void(c) is
  53.       r:SIG;
  54.       loop s::=elts.get_query!(c.name).sig;
  55.      if c.conforms_to(s) then
  56.         if void(r) then r:=s
  57.         else c.prog.err("The internal call " + c.str + 
  58.            " matches both the features: " + r.str + 
  59.            " and " + s.str + ".") end end end;
  60.       if void(r) then 
  61.      c.prog.err("No match for the internal call " + c.str + ".") end;
  62.       return r end;
  63.       
  64.    sig_for_call(c:CALL_SIG):SIG is
  65.       -- The signature in the public interface which corresponds to
  66.       -- the call `c'. Void if none. Reports an error if the call is
  67.       -- ambiguous or missing (assumes that "err_loc" has been set).
  68.       return ifc.sig_for_call(c) end;
  69.  
  70.    elt_with_sig(s:SIG):ELT is
  71.       -- The element in this implementation with the signature `s',
  72.       -- if present, void if not.
  73.       return elts.elt_with_sig(s) end;
  74.  
  75.    has_invariant:BOOL is
  76.       -- True if this implementation defines a routine: `invariant:BOOL'.
  77.       loop 
  78.      if elts.get_query!(
  79.            prog.ident_builtin.invariant_ident).is_invariant then
  80.         return true end end;
  81.       return false end;
  82.    
  83.    invariant_sig:SIG is
  84.       -- Return the invariant signature if there is one, void if not.
  85.       loop e::=elts.get_query!(
  86.            prog.ident_builtin.invariant_ident);
  87.      if e.is_invariant then return e.sig end end;
  88.       return void end;
  89.  
  90.    asize_val:INT is
  91.       -- If `asize' is defined as an integer constant, this returns its
  92.       -- value. Otherwise it returns -1.
  93.       loop asze::=elts.get_query!(prog.ident_builtin.asize_ident);
  94.      if asze.is_const_reader and 
  95.         prog.tp_builtin.int=asze.sig.ret then
  96.         return 32
  97.            -- *** Have to fix this to read the const value!
  98.      else return -1 end end;
  99.       return -1; -- added this ???
  100.       end;
  101.    
  102.    am_ob_def:AM_OB_DEF 
  103.       -- An object layout object for this interface.
  104.       pre ~void(self) is
  105.       r::=#AM_OB_DEF(void); r.tp:=tp;
  106.       if ~void(arr) then a::=arr;
  107.      typecase a when TP_CLASS then r.arr:=a.params[0] end end;
  108.       r.asize:=asize_val;
  109.       loop e::=elts.elt!; 
  110.      if e.is_attr_reader then 
  111.         r.at:=r.at.insert(e.sig.name,e.sig.ret) end end;
  112.       return r end;
  113.  
  114.     is_atomic:BOOL pre ~void(self) is
  115.        -- return true if we can be allocated atomically.
  116.        loop e::= elts.elt!;
  117.         if e.is_attr_reader then
  118.            atp::=e.sig.ret;    -- the type of this attribute.
  119.            if ~(atp.is_value) then
  120.               -- we have a reference type or bound type.
  121.               --#ERR + tp.str + " is non-atomic because attribute "
  122.               --+e.sig.str+" is not a value type\n";
  123.               return false;
  124.            end;
  125.            if ~(atp.is_atomic) then
  126.               --#ERR + tp.str + " is non-atomic because value attribute "
  127.               --+e.sig.str+" is not atomic\n";
  128.               return false;
  129.            end;
  130.         end;
  131.        end;
  132.        -- now we check included AREF{T} or AVAL{T}.
  133.        if void(arr) then
  134.         -- guess it's OK
  135.         --#ERR + tp.str + " looks atomic with no included AREF/AVAL\n";
  136.         return true;
  137.        else
  138.         -- now we need implementation of array portion to find out
  139.         -- it's type parameter.
  140.         if void(arr.params) then
  141.            --#ERR + "Void parameter list in inclusion of AREF{T}\n";
  142.            return false;
  143.         elsif arr.params.asize /= 1 then
  144.            --#ERR + "Funny, >1 type param found in AREF{T} atomic checking.\n";
  145.            return false;
  146.         else
  147.            tparam ::= arr.params[0];
  148.            if ~(tparam.is_value) then
  149.               --#ERR + tp.str + " is non-atomic because included array param "
  150.               --+ " is not value type.\n";
  151.               return false;
  152.            elsif ~(tparam.is_atomic) then
  153.               --#ERR + tp.str + " is non-atomic because included value" +
  154.               --" array param is not atomic.\n";
  155.               return false;
  156.            else
  157.               --#ERR + tp.str + " looks atomic with atomic AREF/AVAL.\n";
  158.               return true;
  159.            end;
  160.         end;
  161.        end;  
  162.        return true;                                                             -- NLP
  163.     end;
  164.       
  165. end; -- class IMPL
  166.    
  167. -------------------------------------------------------------------
  168. class IMPL_TBL is
  169.    -- A table of implementations indexed by type.
  170.    
  171.    attr prog:PROG;        -- The program this is for.
  172.    attr tbl:FMAP{$TP,IMPL};    -- The table mapping types to their
  173.       -- implementations.
  174.    attr cur:FSET{TUP{IDENT,INT}}; -- The set of class names and number
  175.       -- of parameters which are currently having their implementations 
  176.       -- worked out. 
  177.  
  178.    create(p:PROG):SAME is
  179.       -- A new table for the program `p'.
  180.       r::=new; r.prog:=p; return r end;      
  181.  
  182.    impl_of(t:$TP):IMPL 
  183.       -- The implementation corresponding to arg. Void if not computable.
  184.       -- Any caller of this should set the appropriate error location.
  185.       pre ~void(t) is
  186.       r::=tbl.get(t); if ~void(r) then return r end;
  187.       typecase t
  188.       when TP_CLASS then
  189.      if t.is_abstract then
  190.         prog.err("Compiler error, IMPL_TBL::impl_of(" + t.str + ").");
  191.         return void end;
  192.      if cur.test(#(t.name, t.params.size)) then 
  193.         cycle_err; cur:=cur.clear; return void 
  194.      else cur:=cur.insert(#(t.name,t.params.size));
  195.         r:=IMPL::create_for_tp(t); tbl:=tbl.insert(t,r);
  196.         cur:=cur.delete(#(t.name,t.params.size)); return r end;  
  197.       when TP_ROUT then
  198.      prog.err("Compiler error, IMPL_TBL::impl_of(" + t.str + ").");
  199.      return void
  200.       when TP_ITER then
  201.      prog.err("Compiler error, IMPL_TBL::impl_of(" + t.str + ").");
  202. --       return void end end;                                                   -- NLP
  203.          return void end; return void; end;                                     -- NLP
  204.    
  205.    tup_str(t:TUP{IDENT,INT}):STR is
  206.       -- A string for the specified type of the form "FOO{_,_,_}".
  207.       r::=t.t1.str;
  208.       if t.t2=0 then return r end;
  209.       r:=r+"{";
  210.       loop t.t2.times!; r:=r+",".separate!("_") end;
  211.       r:=r+"}"; return r end;
  212.       
  213.    cycle_err is
  214.       -- Print an error message about a cycle of include type names.
  215.       s:STR:="Cycle detected in `include' clauses involving the types: ";
  216.       loop s:=s + ", ".separate!(tup_str(cur.elt!)) end;
  217.       prog.err(s) end;
  218.  
  219. end; -- class IMPL_TBL
  220.  
  221. -------------------------------------------------------------------
  222. class IMPL_INCLUDE is
  223.    -- Information for handling an `include' clause.
  224.    
  225.    attr tp:TP_CLASS;        -- The type with the include clause.
  226.    attr tr:TR_INCLUDE_CLAUSE;    -- The include clause.
  227.    attr itp:TP_CLASS;        -- The included type.
  228.    attr impl:IMPL;        -- The implementation of `itp'.
  229.    attr used_mods:FSET{TR_FEAT_MOD};  -- The modifiers which were used.
  230.    attr elt_tbl:ELT_TBL;    -- The translated included elements.   
  231.    
  232.    prog:PROG is
  233.       -- The program object for this interface.
  234.       return tp.prog end;   
  235.    
  236.    create(tp:TP_CLASS, tr:TR_INCLUDE_CLAUSE):SAME 
  237.       -- Compute the "include" information corresponding to the clause
  238.       -- `tr' within the definition of the type `tp'. If there  
  239.       -- is an error, return void.
  240.       pre ~void(tp) and ~void(tr) is
  241.       r::=new; r.tp:=tp; r.tr:=tr;
  242.       r.itp:=r.included_tp;
  243.       if void(r.itp) then return void end;      
  244.       if tp.prog.show_include then
  245.      #OUT + "(Including " + r.itp.str + " in " +
  246.         tp.str + ") " end;
  247.       r.impl:=r.included_impl;
  248.       if void(r.impl) then return void end;
  249.       if r.test_array_err then return void end;
  250.       if r.test_duplicate_feat_mod_err then return void end;
  251.       r.elt_tbl:=r.included_elt_tbl; 
  252.       if void(r.elt_tbl) then return void end;
  253.       return r end;
  254.       
  255.    included_tp:TP_CLASS is
  256.       -- Compute the type which is included by the clause `tr' in
  257.       -- the type `tp'. Print an error and return void if the included
  258.       -- type is external, bound, or a type parameter.
  259.       con:TP_CONTEXT:=prog.tp_context_for(tp);
  260.       if con.type_spec_is_param(tr.tp) then
  261.      param_include_err(tr); return void end;
  262.       r::=con.tp_of(tr.tp); 
  263.       typecase r
  264.       when TP_CLASS then
  265.      if r.is_abstract then 
  266.         prog.err_loc(tr); 
  267.         prog.err("Classes may not include abstract types."); 
  268.         return void end;
  269.      if prog.tp_kind(r)=TP_KIND::ext_tp then 
  270.         include_ext_err(tr); return void end;     
  271.      return r
  272.       when TP_ROUT then
  273.      include_bound_err(tr); return void
  274.       when TP_ITER then
  275. --       include_bound_err(tr); return void end end;                            -- NLP
  276.          include_bound_err(tr); return void end; return void; end;              -- NLP
  277.    
  278.    param_include_err(t:$TR_CLASS_ELT) is
  279.       prog.err_loc(t);
  280.       prog.err("Type specifiers in include clauses may not be class "
  281.       "parameters.") end;
  282.    
  283.    include_ext_err(t:$TR_CLASS_ELT) is
  284.       prog.err_loc(t);
  285.       prog.err("Classes may not include external types.") end;
  286.       
  287.    include_bound_err(t:$TR_CLASS_ELT) is
  288.       -- Print an error message about including bound types.
  289.       prog.err_loc(t);
  290.       prog.err("Classes may not include bound types.") end;
  291.  
  292.    included_impl:IMPL is
  293.       -- Compute the implementation `impl' of the included 
  294.       -- type. Set the location for reporting an error in case a loop 
  295.       -- is found.
  296.       prog.err_loc(tr);    return prog.impl_tbl.impl_of(itp) end;
  297.    
  298.    test_array_err:BOOL is
  299.       -- Print an error message and return true if `tp' is a value type
  300.       -- and `itp' includes AREF or if `tp' is a reference type and
  301.       -- `itp' includes AVAL.
  302.       k:INT:=prog.tp_kind(tp);
  303.       if void(impl.arr) then return false end;
  304.       if k=TP_KIND::val_tp and 
  305.      impl.arr.name=prog.ident_builtin.AREF_ident then
  306.      prog.err_loc(tr); 
  307.      prog.err("The value type " + tp.str +
  308.      " may not have an include path to the reference array type " +
  309.      impl.arr.str + '.');
  310.      return true
  311.       elsif k=TP_KIND::ref_tp and 
  312.      impl.arr.name=prog.ident_builtin.AVAL_ident then
  313.      prog.err_loc(tr); 
  314.      prog.err("The reference type " + tp.str +
  315.      " may not have an include path to the value array type " +
  316.      impl.arr.str + '.');
  317.      return true end;
  318.       return false end;
  319.    
  320.    test_duplicate_feat_mod_err:BOOL is
  321.       -- If two feature modifiers have the same name then print
  322.       -- an error and return true, otherwise return false. 
  323.       m1::=tr.mods;
  324.       loop until!(void(m1));
  325.      m2::=tr.mods;
  326.      loop until!(void(m2));
  327.         if ~SYS::ob_eq(m1,m2) and m1.name=m2.name then
  328.            prog.err_loc(m1);
  329.            prog.err("There are two feature modifiers for the name: " + 
  330.            m1.name.str + "."); 
  331.            return true end;
  332.         m2:=m2.next end;
  333.      m1:=m1.next end;
  334.       return false end;
  335.  
  336.    modifier_for_name(i:IDENT):TR_FEAT_MOD is
  337.       -- Return the feature modifier in `tr' for the name `i', or
  338.       -- void, if there isn't one for that name.
  339.       e::=tr.mods;
  340.       loop until!(void(e)); if e.name=i then 
  341.      used_mods:=used_mods.insert(e); return e end;
  342.      e:=e.next end;
  343.       return void end;   
  344.  
  345.    included_elt_tbl:ELT_TBL is
  346.       -- The table of elements as transformeded by the new value of SAME 
  347.       -- and any feature modification clauses. 
  348.       r:ELT_TBL;
  349.       loop e::=impl.elts.elt!; en::=modify_elt(e);
  350.      if ~void(en) then
  351.         f::=r.elt_conflicting_with(en);
  352.         if ~void(f) then include_conflict_err(en,f)
  353.         else r:=r.insert(en) end end end;
  354.       if used_mods.size/=tr.mods.size then
  355.      m::=tr.mods;
  356.      loop until!(void(m));
  357.         if ~used_mods.test(m) then unused_mod_err(m) end;
  358.         m:=m.next end end;
  359.       return r end;
  360.    
  361.    include_conflict_err(en,f:ELT) is
  362.       prog.err_loc(tr);      
  363.       prog.err("Two of the included signatures conflict: " +
  364.       en.sig.str + " and " + f.sig.str + ".") end;      
  365.  
  366.    unused_mod_err(t:TR_FEAT_MOD) is
  367.       prog.err_loc(t);
  368.       prog.err("There are no features with the name: " + t.name.str 
  369.          + ".") end;
  370.  
  371.    modify_elt(e:ELT):ELT 
  372.       -- Make a new element from `e' by changing its name by the 
  373.       -- modifiers in `tr', by changing SAME to have the value
  374.       -- `tp', and by modifying `is_private' according to the include
  375.       -- clause and feature modifier. Make `srctp' be the old `srctp'.
  376.       -- Return void if an error or if the element is made to be undefined.
  377.       pre ~void(e) is
  378.       con::=#TP_CONTEXT(tp, e.con.pnames, e.con.ptypes, prog);
  379.       if void(con) then return void end;
  380.       name:IDENT; read_pri:BOOL; write_pri:BOOL;
  381.       m::=modifier_for_name(e.name);
  382.       if ~void(m) then        -- Have a matching modifier. 
  383.      if m.new_name=#IDENT(void) then return void end; -- Feat undef.
  384.      name:=m.new_name; 
  385.      read_pri:=m.is_private; 
  386.      write_pri:=m.is_private or m.is_readonly;
  387.       else name:=e.name;
  388.      read_pri:=tr.is_private or e.is_private; 
  389.      write_pri:=read_pri end;
  390.       sig:SIG; pri:BOOL;
  391.       etr::=e.tr; typecase etr
  392.       when TR_CONST_DEF then 
  393.      sig:=SIG::const_reader_sig(etr,name,con); pri:=read_pri;
  394.       when TR_SHARED_DEF then
  395.      if e.is_shared_writer then 
  396.         sig:=SIG::shared_writer_sig(etr,name,con); pri:=write_pri;
  397.      else 
  398.         sig:=SIG::shared_reader_sig(etr,name,con); pri:=read_pri end;
  399.       when TR_ATTR_DEF then        
  400.      if e.is_attr_writer then 
  401.         sig:=SIG::attr_writer_sig(etr,name,con); pri:=write_pri;
  402.      else 
  403.         sig:=SIG::attr_reader_sig(etr,name,con); pri:=read_pri end;
  404.       when TR_ROUT_DEF then 
  405.      sig:=SIG::rout_sig(etr,name,con); pri:=read_pri      
  406.       end;
  407.       if void(sig) then return void end;
  408.       return ELT::create(sig, e.srcsig, e.tr, con, pri) end;
  409.      
  410. end; -- class IMPL_INCLUDE
  411.  
  412. -------------------------------------------------------------------
  413. class IMPL_CREATE is
  414.    -- An object used while creating an interface.
  415.    
  416.    attr tp:TP_CLASS;        -- The type it is for.
  417.    attr is_external:BOOL;    -- True if an external class. 
  418.    attr con:TP_CONTEXT;        -- The type context for tp.
  419.    attr tr:TR_CLASS_DEF;    -- The definition tree for tp.
  420.    attr class_elts:ELT_TBL;    -- Table of the elements explicitly
  421.       -- defined by this class. 
  422.    attr incs:FLIST{IMPL_INCLUDE}; -- A list of information
  423.       -- computed from each include clause. 
  424.    
  425.    impl_of(t:TP_CLASS):IMPL 
  426.       -- Compute the implementation of the type `t'.
  427.       pre ~void(t) is
  428.       if t.prog.show_impl_create then
  429.      #OUT + "(Impl create " + t.str + ") " end;
  430.       ic:IMPL_CREATE:=new; ic.tp:=t;
  431.       ic.is_external:=(t.prog.tp_kind(t)=TP_KIND::ext_tp);
  432.       ic.con:=ic.prog.tp_context_for(t);
  433.       if void(ic.con) then return void end;
  434.       ic.tr:=ic.prog.tree_for(t.name,t.params.size);
  435.       if void(ic.tr) then return void end;
  436.       ic.class_elts:=ic.explicit_class_elts;
  437.       ic.do_incs;
  438.       r::=#IMPL; r.tp:=t; 
  439.       r.arr:=ic.get_arr; 
  440.       r.elts:=ic.elt_tbl;
  441.       r.ifc:=r.elts.public_ifc;
  442.       if void(r.ifc) then r.ifc:=IFC::create(void,t) end;
  443.       return r end;
  444.  
  445.    prog:PROG is
  446.       -- The program this belongs to.
  447.       return tp.prog end;
  448.    
  449.    explicit_class_elts:ELT_TBL is
  450.       -- A table of class elements explicit defined in the class 
  451.       -- (i.e. ignoring "include" clauses). Prints an error 
  452.       -- if features with conflicting signatures are defined.
  453.       t:$TR_CLASS_ELT:=tr.body; r:ELT_TBL;
  454.       loop while!(~void(t)); 
  455.      er:ELT:=reader_elt_for(t);
  456.      if ~void(er) then
  457.         if is_external then
  458.            f:ELT:=r.elt_same_name_as(er);
  459.            if ~void(f) then ext_conflict_err(er,f)
  460.            else r:=r.insert(er) end;
  461.         else
  462.            f:ELT:=r.elt_conflicting_with(er);
  463.            if ~void(f) then reader_conflict_err(er,f)
  464.            else r:=r.insert(er) end end end; 
  465.      ew:ELT:=writer_elt_for(t);
  466.      if ~void(ew) then
  467.         f:ELT:=r.elt_conflicting_with(ew);
  468.         if ~void(f) then writer_conflict_err(ew,f)
  469.         else r:=r.insert(ew) end end;
  470.      t:=t.next;
  471.       end;
  472.       return r end;
  473.  
  474.    reader_conflict_err(er,f:ELT) is
  475.       prog.err_loc(er.tr);
  476.       prog.err("The signature: " + er.sig.str +
  477.       " of the reader routine for this feature conflicts with "
  478.       "the earlier feature signature: " + f.sig.str + '.') end;
  479.  
  480.    ext_conflict_err(er,f:ELT) is
  481.       prog.err_loc(er.tr);
  482.       prog.err("The signature: " + er.sig.str +
  483.       " has the same name as the earlier feature signature: " +
  484.       f.sig.str + " in an external class.") end;
  485.    
  486.    writer_conflict_err(ew,f:ELT) is
  487.       prog.err_loc(ew.tr);
  488.       prog.err("The signature: " + ew.sig.str +
  489.       " of the writer routine for this feature conflicts with " 
  490.       "the earlier feature signature: " + f.sig.str + '.') end;
  491.  
  492.    reader_elt_for(t:$TR_CLASS_ELT):ELT 
  493.       -- The "reader" elt corresponding to `t' if there is one, 
  494.       -- void if not.
  495.       pre ~void(t) is
  496.       sig:SIG; r:ELT;
  497.       typecase t
  498.       when TR_CONST_DEF then
  499.      if is_external then prog.err_loc(t);
  500.         prog.err("External classes may not define constants.");
  501.         return void end;
  502.      sig:=SIG::const_reader_sig(t,t.name,con)
  503.       when TR_SHARED_DEF then 
  504.      if is_external then prog.err_loc(t);
  505.         prog.err("External classes may not define shareds.");
  506.         return void end;
  507.      sig:=SIG::shared_reader_sig(t,t.name,con)
  508.       when TR_ATTR_DEF then 
  509.      if is_external then prog.err_loc(t);
  510.         prog.err("External classes may not define attributes.");
  511.         return void end;
  512.      sig:=SIG::attr_reader_sig(t,t.name,con)
  513.       when TR_ROUT_DEF then 
  514.      sig:=SIG::rout_sig(t,t.name,con);
  515.      if t.is_abstract then
  516.         if is_external then
  517.            if ~sig.is_legal_ext_abs then return void end;
  518.            r:=ELT::create(sig,sig,t,con,t.is_private); 
  519.            r.is_external:=true; return r
  520.         else prog.err_loc(t);
  521.            prog.err("Only external classes may have routines "
  522.            "without bodies."); return void end;
  523.      elsif is_external then
  524.         if ~sig.is_legal_ext_bod then return void end;
  525.         r:=#ELT(sig,sig,t,con,t.is_private); 
  526.         r.is_external:=true; return r end;
  527.       else return void end; -- Nothing for includes
  528.       if void(sig) then return void end;
  529.       r:=#ELT(sig,sig,t,con,t.is_private);
  530.       return r end;
  531.    
  532.    writer_elt_for(t:$TR_CLASS_ELT):ELT is
  533.       -- The "writer" elt corresponding to `t' if there is one, 
  534.       -- void if not.
  535.       sig:SIG; pri:BOOL;
  536.       if is_external then return void end; -- Already complained at reader.
  537.       typecase t
  538.       when TR_SHARED_DEF then
  539.      sig:=SIG::shared_writer_sig(t,t.name,con);
  540.      pri:=t.is_private or t.is_readonly;      
  541.       when TR_ATTR_DEF then
  542.      sig:=SIG::attr_writer_sig(t,t.name,con); 
  543.      pri:=t.is_private or t.is_readonly;      
  544.       else return void end;      
  545.       if void(sig) then return void end;
  546.       return ELT::create(sig,sig,t,con,pri) end;
  547.    
  548.    do_incs is
  549.       -- Compute and fill in `incs' with information computed from 
  550.       -- each include statement in `tp'.
  551.       e:$TR_CLASS_ELT:=tr.body;
  552.       loop while!(~void(e));
  553.      typecase e
  554.      when TR_INCLUDE_CLAUSE then
  555.         if is_external then prog.err_loc(e);
  556.            prog.err("External classes may not have include clauses.");
  557.         else
  558.            ii::=IMPL_INCLUDE::create(tp, e);
  559.            if ~void(ii) then incs:=incs.push(ii) end end;
  560.      else end;
  561.      e:=e.next end end;
  562.  
  563.    get_arr:TP_CLASS is
  564.       -- If we include AREF{T} or AVAL{T} or any class which includes
  565.       -- one of these return it. If we include more than one and they
  566.       -- are different, then print an error.
  567.       if tp.name=prog.ident_builtin.AREF_ident and tp.params.size=1 then 
  568.      return tp end;
  569.       if tp.name=prog.ident_builtin.AVAL_ident and tp.params.size=1 then 
  570.      return tp end;      
  571.       r:TP_CLASS;
  572.       loop inc::=incs.elt!; a::=inc.impl.arr;
  573.      if ~void(a) then
  574.         if void(r) then r:=a;
  575.         elsif r=a then    -- They agree.
  576.         else 
  577.            array_conflict_err(inc,r,a) end end end;
  578.       return r end;
  579.    
  580.    array_conflict_err(inc:IMPL_INCLUDE, a1,a2:TP_CLASS) is
  581.       prog.err_loc(inc.tr);
  582.       prog.err("This class has include paths to the array types: " +
  583.       a1.str + " and " + a2.str + '.') end;
  584.    
  585.    elt_tbl:ELT_TBL is
  586.       -- Compute the final element table for the class. Print an error 
  587.       -- if there is a conflict.
  588.       r:ELT_TBL;
  589.       loop r:=r.insert(class_elts.elt!) end;
  590.       loop while!(incs.is_empty.not); inc::=incs.pop; 
  591.      loop e::=inc.elt_tbl.elt!;
  592.         f::=r.elt_conflicting_with(e);
  593.  
  594.         -- DPS: added "and ~f.is_attr_access" below
  595.         if ~void(f) and e.is_attr_access and ~f.is_attr_access then
  596.            attr_conflict_err(e,f,inc) end;
  597.  
  598.         if void(f) and (~e.is_abstract or tp.is_abstract) then
  599.            -- Abstract routines don't go into non-abstract classes
  600.            -- and also aren't tested for conflict in this case. 
  601.            loop inc2::=incs.elt!;
  602.           g::=inc2.elt_tbl.elt_conflicting_with(e);
  603.           if ~void(g) then include_conflict_err(inc,inc2,e,g) end;
  604.            end;
  605.            r:=r.insert(e) end end end;
  606.       return r end;
  607.  
  608.    attr_conflict_err(e,f:ELT, inc:IMPL_INCLUDE) is
  609.       prog.err_loc(f.tr);
  610.       prog.err("This explicitly defined routine conflicts with "
  611.       "the attribute access routine: " + e.sig.str + 
  612.       " which is included from " + inc.itp.str + ".") end;
  613.  
  614.    include_conflict_err(inc,inc2:IMPL_INCLUDE, e,g:ELT) is
  615.       prog.err_loc(inc.tr);
  616.       prog.err("This includes the feature: " + e.sig.str + 
  617.       " which conflicts with: " + g.sig.str + 
  618.       " which is included from: " + inc2.itp.str + ".") end;      
  619.    
  620. end; -- class IMPL_CREATE
  621.  
  622. -------------------------------------------------------------------
  623.