home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sa104os2.zip / SATHR104.ZIP / SATHER / COMPILER / IFC.SA < prev    next >
Text File  |  1994-11-15  |  10KB  |  290 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. -- ifc.sa: Type interfaces in the Sather compiler.
  9. -------------------------------------------------------------------
  10. -- IFC: The interface of a type.
  11. -- IFC_TBL: A table of interfaces indexed by type.
  12. -- IFC_ABS_CREATE: Create an interface for an abstract type. 
  13. -------------------------------------------------------------------
  14. class IFC is
  15.    -- A type interface.
  16.    
  17.    attr tp:$TP;            -- The type whose interface this is. 
  18.    attr sigs:SIG_TBL;        -- The interface signatures.
  19.    
  20.    create(sigs:SIG_TBL, tp:$TP):SAME is
  21.       -- An interface with the signatures `sigs' for the type `tp'.
  22.       -- Never gives void.
  23.       r::=new; r.sigs:=sigs; r.tp:=tp; return r end;      
  24.  
  25.    prog:PROG is
  26.       -- The program this interface belongs to.
  27.       return tp.prog end;
  28.    
  29.    sig_conforming_to(s:SIG):SIG 
  30.       -- A signature from the interface which conforms to `s' or void
  31.       -- if none. This will be unique if the interface has no conflicts.
  32.       pre ~void(self) and ~void(s) is
  33.       loop ts::=sigs.get_query!(s.name);
  34.      if ts.conforms_to(s) then return ts end end;
  35.       return void end;
  36.  
  37.    sig_equal_to(s:SIG):SIG 
  38.       -- A signature from self which is equal to `s' if present, 
  39.       -- void if not.
  40.       pre ~void(self) and ~void(s) is      
  41.       loop ts::=sigs.get_query!(s.name);
  42.      if ts.is_eq(s) then return ts end end;
  43.       return void end;
  44.    
  45.    nonconforming_sig(i:IFC):SIG 
  46.       -- If self conforms to `i' then return void, otherwise return
  47.       -- a signature in `i' for which there is no conforming signature
  48.       -- in self.
  49.       pre ~void(self) and ~void(i) is
  50.       loop s::=i.sigs.elt!; 
  51.      if void(sig_conforming_to(s)) then return s end end;
  52.       return void end;
  53.  
  54.    conforms_to(i:IFC):BOOL is
  55.       -- True if self conforms to `i'. This means that for every
  56.       -- signature in `i' there is a signature in self which conforms
  57.       -- to it.
  58.       return void(nonconforming_sig(i)) end;      
  59.    
  60.    conflicting_sigs:TUP{SIG,SIG}
  61.       -- If self has a conflict, return two conflicting signatures.
  62.       -- Otherwise, return #(void,void).
  63.       pre ~void(self) is
  64.       loop s::=sigs.elt!;
  65.      loop st::=sigs.get_query!(s.name);
  66.         if ~SYS::ob_eq(st,s) and st.conflicts_with(s) then
  67.            return #(s,st) end end end;
  68.       return #(void,void) end;
  69.       
  70.    is_conflict_free:BOOL is
  71.       -- True if self is free of conflicting signatures.
  72.       return void(conflicting_sigs) end;      
  73.    
  74.    sig_for_call(c:CALL_SIG):SIG 
  75.       -- A signature from the interface to which the call `c' conforms.
  76.       -- Void if none. Reports an error if the call is ambiguous 
  77.       -- or missing (assumes that "err_loc" has been set).
  78.       -- If it is unknown whether there is a return value, then
  79.       -- choose the signature without one in case of conflict.
  80.       pre ~void(self) and ~void(c) is
  81.       r:SIG;
  82.       loop s::=sigs.get_query!(c.name);
  83.      if c.conforms_to(s) then
  84.         if void(r) then r:=s
  85.         elsif c.unknown_ret and void(r.ret) and ~void(s.ret) then
  86.            -- Keep this one.
  87.         elsif c.unknown_ret and ~void(r.ret) and void(s.ret) then
  88.            r:=s        -- Choose the version with no return.
  89.         else c.prog.err("The call " + c.str + 
  90.            " matches both the features: " + r.str + 
  91.            " and " + s.str + "."); return void end end end;
  92.       if void(r) then 
  93.      c.prog.err("No match for the call " + c.str + ".") end;
  94.       return r end;
  95.  
  96.    ifc_for_rout(t:TP_ROUT):SAME 
  97.       -- The interface of a bound routine type.
  98.       pre ~void(t) is
  99.       r::=new; r.tp:=t;
  100.       r.sigs:=r.sigs.insert(SIG::bound_routine_call(t));
  101.       return r end;
  102.  
  103.    ifc_for_iter(t:TP_ITER):SAME 
  104.       -- The interface of a bound iter type.
  105.       pre ~void(t) is
  106.       r::=new; r.tp:=t;
  107.       r.sigs:=r.sigs.insert(SIG::bound_iter_call(t));
  108.       return r end;      
  109.    
  110.    show is
  111.       -- Print the interface on OUT.
  112.       if void(self) then #OUT + "Interface=void\n"; return end;
  113.       if void(tp) then #OUT +  "Interface tp=void\n"; return end;
  114.       #OUT + "Interface of " + tp.str + " = ";
  115.       if void(sigs) then #OUT + "void\n"; return end;
  116.       loop s::=sigs.elt!;
  117.      if ~void(s) then #OUT + " ".separate!(s.str) end end;
  118.       #OUT + "\n" end;
  119.    
  120. end; -- class IFC
  121.  
  122. -------------------------------------------------------------------   
  123. class IFC_TBL is
  124.    -- A table of interfaces indexed by type.
  125.    
  126.    attr prog:PROG;        -- The program this is for.
  127.    attr tbl:FMAP{$TP,IFC};    -- The table mapping types to their
  128.       -- interfaces.
  129.    attr abs_cur:FSET{TUP{IDENT,INT}}; -- The set of abstract class
  130.       -- names and number of parameters which are currently having 
  131.       -- their interfaces worked out. 
  132.  
  133.    create(p:PROG):SAME is
  134.       -- A new table for the program `p'.
  135.       r::=new; r.prog:=p; return r end;
  136.       
  137.    ifc_of(t:$TP):IFC 
  138.       -- The interface corrponding to arg. Void if not computable.
  139.       -- Any caller of this should set the appropriate error location.
  140.       -- Never gives void.
  141.       pre ~void(t) is
  142.       r::=tbl.get(t); if ~void(r) then return r end;
  143.       typecase t
  144.       when TP_CLASS then
  145.      if t.is_abstract then
  146.         cq::=#TUP{IDENT,INT}(t.name,t.params.size);
  147.         if abs_cur.test(cq) then
  148.            cycle_err; abs_cur:=abs_cur.clear; 
  149.         else abs_cur:=abs_cur.insert(cq);
  150.            r:=IFC_ABS_CREATE::ifc_of(t);
  151.            abs_cur:=abs_cur.delete(cq) end
  152.      else
  153.         im:IMPL:=prog.impl_tbl.impl_of(t);
  154.         if void(im) then r:=void
  155.         else r:=im.ifc end end;
  156.       when TP_ROUT then
  157.      r:=IFC::ifc_for_rout(t);     
  158.       when TP_ITER then     
  159.      r:=IFC::ifc_for_iter(t) end;
  160.       if void(r) then 
  161.      prog.err("Compiler error, IFC_TBL::ifc_of=void") end;
  162.       tbl:=tbl.insert(t,r); return r end;
  163.    
  164.    tup_str(t:TUP{IDENT,INT}):STR is
  165.       -- A string for the specified type of the form "FOO{_,_,_}".
  166.       r::=t.t1.str;
  167.       if t.t2=0 then return r end;
  168.       r:=r+"{";
  169.       loop t.t2.times!; r:=r+",".separate!("_") end;
  170.       r:=r+"}"; return r end;
  171.       
  172.    cycle_err is
  173.       -- Print an error message about a cycle of include type names.
  174.       s:STR:="Cycle detected in `subtyping' clauses involving the types: ";
  175.       loop s:=s + ", ".separate!(tup_str(abs_cur.elt!)) end;
  176.       prog.err(s) end;
  177.  
  178. end; -- class IFC_TBL
  179.  
  180. -------------------------------------------------------------------
  181. class IFC_ABS_CREATE is
  182.    -- Create an interface for an abstract type. 
  183.    attr tp:TP_CLASS;        -- The abstract type it is for.
  184.    attr con:TP_CONTEXT;        -- The type context for tp.
  185.    attr tr:TR_CLASS_DEF;    -- The definition tree for tp.
  186.    attr class_sigs:SIG_TBL;    -- Table of signature explicitly
  187.       -- in the class.
  188.    attr supers:FLIST{IFC};    -- Interfaces of supertypes.   
  189.  
  190.    ifc_of(t:TP_CLASS):IFC 
  191.       -- Compute the interface of the abstract type `t'.
  192.       pre ~void(t) is
  193.       if t.prog.show_ifc_abs_create then
  194.      #OUT + "(Abstract ifc create " + t.str + ") " end;
  195.       ic::=new; ic.tp:=t;
  196.       ic.con:=ic.prog.tp_context_for(t);
  197.       if void(ic.con) then return void end;
  198.       ic.tr:=ic.prog.tree_for(t.name,t.params.size);
  199.       if void(ic.tr) then 
  200.      t.prog.err("Compiler error: IFC_ABS_CREATE:ifc_of tr=void for " +
  201.        t.str + "."); return void end;
  202.       ic.do_explicit_class_sigs;
  203.       ic.do_supers;
  204.       return IFC::create(ic.do_sigs,t) end;
  205.    
  206.    prog:PROG is
  207.       -- The program this belongs to.
  208.       return tp.prog end;
  209.  
  210.    do_explicit_class_sigs is
  211.       -- Compute `class_sigs'.
  212.       be:$TR_CLASS_ELT:=tr.body;
  213.       loop until!(void(be)); prog.err_loc(be);
  214.      typecase be
  215.      when TR_CONST_DEF then
  216.         prog.err("Abstract classes may not define constants.");
  217.      when TR_SHARED_DEF then
  218.         prog.err("Abstract classes may not define shareds.");
  219.      when TR_ATTR_DEF then
  220.         prog.err("Abstract classes may not define attributes.");
  221.      when TR_ROUT_DEF then
  222.         if ~be.is_abstract then prog.err(
  223.            "Abstract classes may only have abstract routines.") end;
  224.         ns:SIG:=SIG::rout_sig(be,be.name,con);
  225.         cs:SIG:=class_sigs.sig_conflicting_with(ns);
  226.         if ~void(cs) then
  227.            prog.err("The two explicitly defined signatures " +
  228.               ns.str + " and " + cs.str + " conflict.") 
  229.         else class_sigs:=class_sigs.insert(ns) end;
  230.      when TR_INCLUDE_CLAUSE then
  231.         prog.err("Abstract classes may not have include clauses.");
  232.      end;
  233.      be:=be.next end end;
  234.    
  235.    do_supers is
  236.       -- Compute `supers'.
  237.       ut:TR_TYPE_SPEC:=tr.under;
  238.       loop until!(void(ut)); 
  239.      tp:$TP:=con.tp_of(ut); prog.err_loc(ut);
  240.      typecase tp
  241.      when TP_CLASS then
  242.         if ~tp.is_abstract then
  243.            prog.err("Abstract types must have abstract supertypes.") 
  244.         else
  245.            itp:IFC:=prog.ifc_tbl.ifc_of(tp);
  246.            supers:=supers.push(itp) end;
  247.      else
  248.         prog.err("Abstract types must have abstract supertypes.") end;
  249.      ut:=ut.next end end;
  250.      
  251.    do_sigs:SIG_TBL is
  252.       -- The final sig table assuming everything else has been computed.
  253.       r:SIG_TBL;
  254.       loop r:=r.insert(class_sigs.elt!) end;
  255.       loop 
  256.      if supers.is_empty then break!
  257.      else
  258.         si:IFC:=supers.pop; 
  259.         loop sig::=si.sigs.elt!;
  260.            if ~void(r.sig_conflicting_with(sig)) then
  261.           -- included signature is overridden by explicit one
  262.           -- or we've already done this one.
  263.            else
  264.           i:INT:=0;
  265.           loop while!(i<supers.size);
  266.              cs:SIG:=supers[i].sigs.sig_conflicting_with(sig);
  267.              if ~void(cs) then
  268.             if ~cs.is_eq_but_tp(sig) then
  269.                prog.err_loc(tr);
  270.                prog.err("The signatures " + sig.str +
  271.                " and " + cs.str +
  272.                " must be disambiguated by an explicit sig.") 
  273.             end end;
  274.              i:=i+1 end;
  275.           r:=r.insert(sig.with_new_type(tp)) 
  276.            end;
  277.         end;
  278.      end;
  279.       end;
  280.       return r end;
  281.    
  282. end; -- class IFC_ABS_CREATE
  283.  
  284. -------------------------------------------------------------------
  285.  
  286.  
  287.  
  288.  
  289.  
  290.