home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sa104os2.zip / SATHR104.ZIP / SATHER / COMPILER / TRANS.SA < prev   
Text File  |  1995-02-14  |  89KB  |  2,145 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. -- trans.sa: Transformation of code from TR to AM form.
  9. -------------------------------------------------------------------
  10. class TRANS is
  11.    -- The context for a code transformation from TR form to AM form.
  12.    attr prog:PROG;        -- The program this code is from.
  13.    attr impl:IMPL;        -- The implementation structure for the
  14.       -- type within which this transformation appears.
  15.    attr tp_con:TP_CONTEXT;    -- The type context for interpreting
  16.       -- type specifiers.
  17.    attr cur_rout:AM_ROUT_DEF;    -- The current routine or iter.
  18.    attr cur_loop:AM_LOOP_STMT;    -- Current loop if any.
  19.    attr cur_yield_ind:INT;    -- Index of the current yield.
  20.    attr active_locals:FLIST{AM_LOCAL_EXPR}; -- Locals in scope.
  21.    attr in_pre:BOOL;        -- True if inside a `pre' clause.   
  22.    attr in_post:BOOL;        -- True if this code is inside
  23.       -- a "post" clause (and so can have initial expressions).
  24.    attr in_protect_body:BOOL;    -- True if inside a `protect' body.
  25.    attr in_protect_then:BOOL;    -- True if inside a `protect' `then' or
  26.       -- `else' clause.
  27.    attr ex_tp:$TP;        -- Type of exception expr.
  28.    attr in_invariant:BOOL;    -- True if inside an invariant body.
  29.    attr in_initial:BOOL;    -- True if inside an `initial' expr.
  30.    attr init_stmts:$AM_STMT;    -- The initial statments if any.
  31.    attr in_external:BOOL;    -- True if inside an external class.
  32.    attr in_constant:BOOL;    -- True if inside a constant or shared
  33.       -- initialization expression.
  34.  
  35.    create(e:ELT):SAME 
  36.       -- Create a new transformation context for the element e. 
  37.       pre ~void(e) is
  38.       r::=new; r.prog:=e.prog; r.impl:=e.impl;
  39.       r.tp_con:=e.con; 
  40.       if void(r.impl) or void(r.tp_con) then return void end;
  41.       return r end; 
  42.    
  43.    is_iter:BOOL is
  44.       -- True if we are working on an iter.
  45.       if void(cur_rout) then return false end;
  46.       return cur_rout.is_iter end;
  47.  
  48.    local_with_name(n:IDENT):AM_LOCAL_EXPR 
  49.       -- The local with the name `n', if any. Void otherwise.
  50.       pre ~void(cur_rout) is
  51.       loop r::=cur_rout.elt!;
  52.      if void(r) then 
  53.         #OUT + "Compiler error, TRANS::local_with_name, void local.";
  54.         return void end;
  55.      if r.name=n then return r end end;
  56.       loop r::=active_locals.elt!;
  57.      if void(r) then 
  58.         #OUT + "Compiler error, TRANS::local_with_name, void local.";
  59.         return void end;
  60.      if r.name=n then return r end end;        
  61.       return void end;
  62.  
  63.    add_local(l:AM_LOCAL_EXPR) is
  64.       -- Add the local variable `l'.
  65.       if void(cur_rout) then 
  66.      #OUT + "Compiler error, TRANS::add_local, cur_rout=void.";
  67.      return end;
  68.       cur_rout.locals:=cur_rout.locals.push(l);
  69.       if ~void(l.name) then active_locals:=active_locals.push(l) end end;
  70.    
  71.    tp_of(t:TR_TYPE_SPEC):$TP 
  72.       -- The type object corresponding to the type specifier `t' in
  73.       -- this context. Void if `t' is void. 
  74.       pre ~void(t) is
  75.       return tp_con.tp_of(t) end;
  76.  
  77.    inline(call:AM_ROUT_CALL_EXPR):$AM_EXPR is
  78.       -- If `call' can be inlined, return the inlining expression, 
  79.       -- otherwise just return it.
  80.       prog.prog_am_generate.output_sig(call.fun); -- Make sure it's been
  81.      -- generated.
  82.       itbl::=prog.prog_am_generate.inline_tbl;
  83.       in::=itbl.get_query(call.fun);
  84.       if void(in) then return call end;
  85.       return in.inline(call,self) end;
  86.    
  87. -----------      
  88.    
  89.    transform_elt(e:ELT):AM_ROUT_DEF 
  90.       -- Transform the element `e' into AM form. Ignores self.
  91.       -- Should not be applied to void.
  92.       -- If there is a problem, returns void.
  93.       pre ~void(e) is
  94.       t:SAME:=#(e); if void(t) then return void end;
  95.       tr::=e.tr;
  96.       r:AM_ROUT_DEF;
  97.       typecase tr
  98.       when TR_CONST_DEF then r:=t.transform_const_elt(e,tr)
  99.       when TR_SHARED_DEF then r:=t.transform_shared_elt(e,tr)
  100.       when TR_ATTR_DEF then r:=t.transform_attr_elt(e,tr)
  101.       when TR_ROUT_DEF then r:=t.transform_rout_elt(e,tr)
  102.       end;
  103.       return r;
  104.    end;
  105.    
  106.    transform_const_elt(e:ELT,tr:TR_CONST_DEF):AM_ROUT_DEF is
  107.       -- Transform the element `e' into AM form. 
  108.       r:AM_ROUT_DEF:=#AM_ROUT_DEF(1,tr.source); cur_rout:=r;
  109.       r.srcsig:=e.srcsig;
  110.       r[0]:=#AM_LOCAL_EXPR(tr.source,prog.ident_builtin.self_ident,e.tp);
  111.       r.sig:=e.sig;
  112.       g:AM_GLOBAL_EXPR:=prog.global_tbl.get(e.name,impl.tp);
  113.       if void(g) then 
  114.      g:=#AM_GLOBAL_EXPR(tr.source); g.name:=e.name;
  115.      g.tp_at:=e.ret; g.class_tp:=impl.tp; g.is_const:=true;
  116.      in_constant:=true;
  117.      g.init:=transform_expr(tr.init,g.tp_at); 
  118.      in_constant:=false;
  119.      prog.global_tbl.insert(g) end;
  120.       ar::=#AM_RETURN_STMT(tr.source); ar.val:=g;
  121.       r.code:=ar; r.is_clean:=true; 
  122.       return r end;
  123.    
  124.    transform_shared_elt(e:ELT,tr:TR_SHARED_DEF):AM_ROUT_DEF is
  125.       -- Transform the element `e' into AM form. 
  126.       if e.is_shared_reader then -- Shared reader.
  127.      r::=#AM_ROUT_DEF(1,tr.source); cur_rout:=r;
  128.      r.srcsig:=e.srcsig;
  129.      r[0]:=#AM_LOCAL_EXPR(tr.source, -- Local for self.
  130.      prog.ident_builtin.self_ident, e.tp);
  131.      r.sig:=e.sig;
  132.      g:AM_GLOBAL_EXPR:=prog.global_tbl.get(e.name,impl.tp);
  133.      if void(g) then 
  134.         g:=#AM_GLOBAL_EXPR(tr.source); g.name:=e.name;
  135.         g.tp_at:=e.ret; g.class_tp:=impl.tp; 
  136.         in_constant:=true;
  137.         g.init:=transform_expr(tr.init,g.tp); 
  138.         in_constant:=false;
  139.         prog.global_tbl.insert(g) end;
  140.      g.tp_at:=e.sig.ret;
  141.      ar::=#AM_RETURN_STMT(tr.source); ar.val:=g;
  142.      r.code:=ar; r.is_clean:=true; return r
  143. --    else                      -- Shared writer.
  144.       end;                      -- Shared writer.                               -- NLP
  145.      r::=#AM_ROUT_DEF(2,tr.source); cur_rout:=r;
  146.      r.srcsig:=e.srcsig;     
  147.      r[0]:=#AM_LOCAL_EXPR(tr.source, -- Local for self.
  148.           prog.ident_builtin.self_ident, e.tp);
  149.      if void(e.sig.args) then
  150.         prog.err("Compiler error, TRANS::transform_shared_elt, "
  151.         "e.sig.args=void."); return void end;     
  152.      r[1]:=#AM_LOCAL_EXPR(tr.source, e.name, e.sig.args[0]);
  153.      r.sig:=e.sig;
  154.      g:AM_GLOBAL_EXPR:=prog.global_tbl.get(e.name,impl.tp);
  155.      if void(g) then 
  156.         g:=#AM_GLOBAL_EXPR(tr.source); g.name:=e.name;
  157.         g.class_tp:=impl.tp;
  158.         in_constant:=true;
  159.         g.init:=transform_expr(tr.init,g.tp); 
  160.         in_constant:=false;
  161.         prog.global_tbl.insert(g) end;
  162.      g.tp_at:=e.sig.args[0];
  163.      ar::=#AM_ASSIGN_STMT(tr.source); 
  164.      ar.dest:=g; ar.src:=r[1];
  165.      inv:AM_INVARIANT_STMT;
  166.      if ~e.is_private and ~in_invariant then
  167.         isig:SIG:=impl.invariant_sig;
  168.         if ~void(isig) then
  169.            inv:=#AM_INVARIANT_STMT(tr.source); 
  170.            inv.sig:=isig;
  171.            icall::=#AM_ROUT_CALL_EXPR(1,tr.source);
  172.            icall.fun:=isig;
  173.            r.calls:=r.calls.push(icall) end end;
  174.      r.code:=ar; 
  175.      if void(r.code) then r.code:=inv
  176.      else r.code.append(inv) end;
  177. --       r.is_clean:=false; return r end end;                                   -- NLP
  178.          r.is_clean:=false; return r; end;                                      -- NLP
  179.    
  180.    transform_attr_elt(e:ELT,tr:TR_ATTR_DEF):AM_ROUT_DEF is
  181.       -- Transform the element `e' into AM form. 
  182.       r:AM_ROUT_DEF;
  183.       if e.is_attr_reader then    -- Attribute reader.
  184.      r:=#AM_ROUT_DEF(1,tr.source);    
  185.      r.srcsig:=e.srcsig;
  186.      r[0]:=#AM_LOCAL_EXPR(tr.source,prog.ident_builtin.self_ident, 
  187.         e.tp);
  188.      r.sig:=e.sig;
  189.      ae::=#AM_ATTR_EXPR(tr.source); 
  190.      ae.ob:=r[0]; ae.self_tp:=ae.ob.tp;
  191.      ae.at:=e.name; ae.tp_at:=tp_of(tr.tp);
  192.      if void(ae.tp_at) then 
  193.         prog.err_loc(tr.tp); prog.err("Cannot translate type.");
  194.         return void end;
  195.      ar::=#AM_RETURN_STMT(tr.source); 
  196.      ar.val:=ae; r.code:=ar; r.is_clean:=true; 
  197.       else            -- Attribute writer.
  198.      r:=#AM_ROUT_DEF(2,tr.source); 
  199.      r.srcsig:=e.srcsig;
  200.      r[0]:=#AM_LOCAL_EXPR(tr.source, prog.ident_builtin.self_ident, 
  201.         e.tp);
  202.      if void(e.sig.args) then
  203.         prog.err("Compiler error, TRANS::transform_attr_elt, "
  204.         "e.sig.args=void."); return void end;     
  205.      r[1]:=#AM_LOCAL_EXPR(tr.source,e.name,e.sig.args[0]);
  206.      r.sig:=e.sig;
  207.      if prog.tp_kind(tp_con.same)=TP_KIND::val_tp then -- Value type.
  208.         av::=#AM_VATTR_ASSIGN_EXPR(tr.source);
  209.         av.ob:=r[0]; av.at:=e.name; av.val:=r[1];
  210.         ar::=#AM_RETURN_STMT(tr.source);
  211.         ar.val:=av; r.code:=ar;
  212.      else            -- Reference type.
  213.         ae::=#AM_ATTR_EXPR(tr.source); 
  214.         ae.ob:=r[0]; ae.self_tp:=ae.ob.tp;
  215.         ae.at:=e.name; ae.tp_at:=tp_of(tr.tp);
  216.         if void(ae.tp_at) then 
  217.            prog.err_loc(tr.tp); prog.err("Cannot translate type.");
  218.            return void end;     
  219.         ar::=#AM_ASSIGN_STMT(tr.source); 
  220.         ar.dest:=ae; ar.src:=r[1]; r.code:=ar; 
  221.      end;
  222.      inv:AM_INVARIANT_STMT;
  223.      if ~e.is_private and ~in_invariant then
  224.         isig:SIG:=impl.invariant_sig;
  225.         if ~void(isig) then
  226.            inv:=#AM_INVARIANT_STMT(tr.source); 
  227.            inv.sig:=isig;
  228.            icall::=#AM_ROUT_CALL_EXPR(1,tr.source);
  229.            icall.fun:=isig;
  230.            r.calls:=r.calls.push(icall) end end;
  231.      if void(r.code) then r.code:=inv 
  232.      else r.code.append(inv) end;
  233.      r.is_clean:=false; end;
  234.       return r end;
  235.    
  236.    transform_rout_elt(e:ELT,tr:TR_ROUT_DEF):AM_ROUT_DEF is
  237.       -- Transform the element `e' into AM form. 
  238.       -- Changed by MBK to emit code for "nomacro" built-ins when
  239.       -- necessary
  240.       if e.sig.is_builtin then
  241.          if ~prog.back_end.built_in_which_may_be_emitted_anyway(e.sig)
  242.          then return void end; -- added MBK.
  243.       end;  -- Don't do it if builtin.
  244.  
  245.       if e.is_invariant then in_invariant:=true else
  246.      in_invariant:=false end;
  247.       if tr.is_abstract then 
  248.      if e.is_external then return void -- Don't do anything special for
  249.         -- abstract sigs in external classes. 
  250.      else
  251.         prog.err_loc(tr); 
  252.         prog.err("Compiler error, TRANS::tranform_rout_elt given "
  253.         "abstract"); return void end end; 
  254.       check_return(tr);
  255.       r::=#AM_ROUT_DEF(1+e.sig.args.size,tr.source); 
  256.       r.srcsig:=e.srcsig; r.sig:=e.sig;
  257.       if e.is_external then r.is_external:=true end;
  258.       r[0]:=#AM_LOCAL_EXPR(tr.source,prog.ident_builtin.self_ident, e.tp);
  259.       if e.sig.has_ret then 
  260.      r.rres:=#AM_LOCAL_EXPR(tr.source,void,e.ret); -- For return.
  261.      r.locals:=r.locals.push(r.rres);      
  262.       end;
  263.       i:INT:=0; na:TR_ARG_DEC:=tr.args_dec;
  264.       if na.size/=e.sig.args.size then
  265.      prog.err_loc(tr); 
  266.      prog.err("Compiler error, TRANS::transform_rout_elt size bug.");
  267.      return void end;
  268.       loop while!(i<e.sig.args.size);
  269.      l::=#AM_LOCAL_EXPR(tr.source, na.name, e.sig.args[i]);
  270.      r[i+1]:=l;
  271.      i:=i+1; na:=na.next end; 
  272.       cur_rout:=r;
  273.       pres:AM_PRE_STMT;
  274.       if ~void(tr.pre_e) then
  275.      in_pre:=true;
  276.      pres:=#AM_PRE_STMT(tr.source);
  277.      pres.tp:=impl.tp;
  278.      pres.test:=transform_expr(tr.pre_e,prog.tp_builtin.bool);
  279.      if void(pres.test) then pres:=void end;
  280.      in_pre:=false end;
  281.       posts:AM_POST_STMT;      
  282.       if ~void(tr.post_e) then
  283.      in_post:=true;
  284.      posts:=#AM_POST_STMT(tr.source);
  285.      posts.tp:=impl.tp;
  286.      posts.test:=transform_expr(tr.post_e,prog.tp_builtin.bool);
  287.      if void(posts.test) then posts:=void end;     
  288.      in_post:=false end;
  289.       code:$AM_STMT;
  290.       if is_array_sig(e.srcsig) then code:=transform_array_body(e)
  291.       else code:=transform_stmt_list(tr.stmts) end;
  292.       inv:AM_INVARIANT_STMT;
  293.       if ~e.is_private and ~in_invariant then
  294.      isig:SIG:=impl.invariant_sig;
  295.      if ~void(isig) then
  296.         inv:=#AM_INVARIANT_STMT(tr.source); 
  297.         inv.sig:=isig;
  298.         icall::=#AM_ROUT_CALL_EXPR(1,tr.source);
  299.         icall.fun:=isig;
  300.         r.calls:=r.calls.push(icall) end end;
  301.       r.code:=init_stmts;    -- First do the initial statments.
  302.       if void(r.code) then 
  303.      r.code:=pres        -- Then the pre statement.
  304.       else r.code.append(pres) end;
  305.       if void(r.code) then 
  306.      r.code:=code        -- Then the body statement.
  307.       else r.code.append(code) end; 
  308.       if void(r.code) then
  309.      r.code:=posts        -- Then the post statement.      
  310.       else r.code.append(posts) end;
  311.       if void(r.code) then
  312.      r.code:=inv        -- Then the invariant statement.      
  313.       else r.code.append(inv) end;
  314.       return r;
  315.    end;
  316.  
  317.    is_array_sig(s:SIG):BOOL is
  318.       -- True if `s' is `aset' or `aget' in AVAL or AREF.
  319.       if void(s) then return false end;
  320.       stp::=s.tp;
  321.       typecase stp
  322.       when TP_CLASS then
  323.      if stp.name/=prog.ident_builtin.AREF_ident and
  324.         stp.name/=prog.ident_builtin.AVAL_ident then return false end;
  325.      if void(stp.params) then return false end;
  326.      if stp.params.size/=1 then return false end;
  327.      if s.name/=prog.ident_builtin.aget_ident and
  328.         s.name/=prog.ident_builtin.aset_ident then return false end;
  329.      return true
  330. --    else return false end end;                                                -- NLP
  331.       else; end; return false; end;                                             -- NLP
  332.    
  333.    transform_array_body(e:ELT):$AM_STMT is
  334.       -- The statements implementing an array retrieval or assignment
  335.       -- assuming that `e' is `aset' or `aget' included from AVAL or AREF.
  336.       est::=e.srcsig.tp; stp:TP_CLASS;
  337.       typecase est when TP_CLASS then stp:=est end;
  338.       if stp.name=prog.ident_builtin.AREF_ident then -- from AREF
  339.      if e.srcsig.name=prog.ident_builtin.aget_ident then -- aget
  340.         r::=#AM_RETURN_STMT(e.tr.source);
  341.         aae::=#AM_ARR_EXPR(e.tr.source);
  342.         aae.ob:=cur_rout[0]; -- `self' is object to index into.
  343.         aae.ind:=cur_rout[1]; -- First arg is the index.
  344.         aae.tp_at:=stp.params[0]; -- Type of held element.
  345.         r.val:=aae;
  346.         return r
  347.      else            -- aset
  348.         r::=#AM_ASSIGN_STMT(e.tr.source);
  349.         aae::=#AM_ARR_EXPR(e.tr.source);
  350.         aae.ob:=cur_rout[0]; -- `self' is object to index into.
  351.         aae.ind:=cur_rout[1]; -- First arg is the index.
  352.         aae.tp_at:=stp.params[0]; -- Type of held element.
  353.         r.dest:=aae;
  354.         r.src:=cur_rout[2];    -- New value is second argument.
  355.         return r end;
  356. --    else                      -- from AVAL                                    -- NLP
  357.       end;                      -- from AVAL                                    -- NLP
  358.      if e.srcsig.name=prog.ident_builtin.aget_ident then -- aget
  359.         r::=#AM_RETURN_STMT(e.tr.source);
  360.         aae::=#AM_ARR_EXPR(e.tr.source);
  361.         aae.ob:=cur_rout[0]; -- `self' is object to index into.
  362.         aae.ind:=cur_rout[1]; -- First arg is the index.
  363.         aae.tp_at:=stp.params[0]; -- Type of held element.
  364.         r.val:=aae; return r
  365. --       else                   -- aset                                         -- NLP
  366.          end;                   -- aset                                         -- NLP
  367.         r::=#AM_RETURN_STMT(e.tr.source);
  368.         avae::=#AM_VARR_ASSIGN_EXPR(e.tr.source);
  369.         avae.ob:=cur_rout[0];
  370.         avae.ind:=cur_rout[1];
  371.         avae.val:=cur_rout[2];
  372. --          r.val:=avae; return r end end end;                                  -- NLP
  373.             r.val:=avae; return r; end;                                         -- NLP
  374.       
  375. -----------         
  376.    
  377.    transform_stmt_list(s:$TR_STMT):$AM_STMT is
  378.       -- A list of AM_STMT's which implements all the statements in
  379.       -- the source list `s'.
  380.       if void(s) then return void end;
  381.       osize:INT;
  382.       if ~void(active_locals) then osize:=active_locals.size end;
  383.       r:$AM_STMT;
  384.       loop while!(~void(s));
  385.      if void(r) then r:=transform_stmt(s)
  386.         else r.append(transform_stmt(s)) end;
  387.      s:=s.next end;
  388.         -- Close off the scope:
  389.       if ~void(active_locals) then
  390.      loop while!(active_locals.size>osize); 
  391.         ignore::=active_locals.pop end;
  392.       end;
  393.       return r end;
  394.    
  395.    transform_stmt(s:$TR_STMT):$AM_STMT is
  396.       -- A list of AM_STMT's which implements the source statement `s'.
  397.       if void(s) then return void end;
  398.       typecase s
  399.       when TR_DEC_STMT then return transform_dec_stmt(s)
  400.       when TR_ASSIGN_STMT then return transform_assign_stmt(s)
  401.       when TR_IF_STMT then return transform_if_stmt(s)
  402.       when TR_LOOP_STMT then return transform_loop_stmt(s)
  403.       when TR_RETURN_STMT then return transform_return_stmt(s)
  404.       when TR_YIELD_STMT then return transform_yield_stmt(s)
  405.       when TR_QUIT_STMT then return transform_quit_stmt(s)
  406.       when TR_CASE_STMT then return transform_case_stmt(s)
  407.       when TR_TYPECASE_STMT then return transform_typecase_stmt(s)
  408.       when TR_ASSERT_STMT then return transform_assert_stmt(s)
  409.       when TR_PROTECT_STMT then return transform_protect_stmt(s)
  410.       when TR_RAISE_STMT then return transform_raise_stmt(s)
  411. --    when TR_EXPR_STMT then return transform_expr_stmt(s) end end;             -- NLP
  412.       when TR_EXPR_STMT then return transform_expr_stmt(s) end; return void; end; -- NLP
  413.  
  414. -----------      
  415.    transform_dec_stmt(s:TR_DEC_STMT):$AM_STMT is
  416.       -- A list of AM_STMT's which implements the source statement `s'.
  417.       l:AM_LOCAL_EXPR:=local_with_name(s.name);
  418.       prog.err_loc(s);
  419.       if ~void(l) then 
  420.      prog.err("This local variable declaration is in the scope of " +
  421.         l.name.str + ":" + l.tp_at.str +
  422.         " which has the same name."); return void end;
  423.       l:=#AM_LOCAL_EXPR(s.source, s.name, tp_of(s.tp)); 
  424.       l.needs_init:=true; 
  425.       add_local(l);
  426.       return void end;
  427.  
  428. -----------      
  429.    transform_assign_stmt(s:TR_ASSIGN_STMT):$AM_STMT is
  430.       -- A list of AM_STMT's which implements the source statement `s'.
  431.       if void(s.lhs_expr) then return transform_assign_dec_stmt(s) end;
  432.       lhs:$TR_EXPR:=s.lhs_expr; prog.err_loc(lhs); 
  433.       typecase lhs
  434.       when TR_CALL_EXPR then 
  435.      if lhs.is_array then 
  436.         return transform_array_assign_stmt(lhs,s)
  437.      else return transform_call_assign_stmt(lhs,s) end;
  438.       when TR_SELF_EXPR then 
  439.      prog.err("It is illegal to assign to `self'.");
  440.       when TR_VOID_EXPR then 
  441.      prog.err("It is illegal to assign to `void'.");
  442.       when TR_IS_VOID_EXPR then 
  443.      prog.err("It is illegal to assign to a `void' test expression.");
  444.       when TR_ARRAY_EXPR then 
  445.      prog.err("It is illegal to assign to an array expression.");
  446.       when TR_CREATE_EXPR then
  447.      prog.err("It is illegal to assign to a creation expression.");
  448.       when TR_BOUND_CREATE_EXPR then 
  449.      prog.err("It is illegal to assign to a bound create expression.");
  450.       when TR_AND_EXPR then 
  451.      prog.err("It is illegal to assign to an `and' expression.");
  452.       when TR_OR_EXPR then 
  453.      prog.err("It is illegal to assign to an `or' expression.");     
  454.       when TR_EXCEPT_EXPR then
  455.      prog.err("It is illegal to assign to an `exception' expression.");
  456.       when TR_NEW_EXPR then 
  457.      prog.err("It is illegal to assign to a `new' expression.");
  458.       when TR_INITIAL_EXPR then
  459.      prog.err("It is illegal to assign to an `initial' expression.");
  460.       when TR_BREAK_EXPR then 
  461.      prog.err("It is illegal to assign to a `break!' expression.");    
  462.       when TR_RESULT_EXPR then 
  463.      prog.err("It is illegal to assign to a `result' expression.");    
  464.       when TR_BOOL_LIT_EXPR then
  465.      prog.err("It is illegal to assign to a boolean literal.");    
  466.       when TR_CHAR_LIT_EXPR then
  467.      prog.err("It is illegal to assign to a character literal.");    
  468.       when TR_STR_LIT_EXPR then 
  469.      prog.err("It is illegal to assign to a string literal.");    
  470.       when TR_INT_LIT_EXPR then 
  471.      prog.err("It is illegal to assign to an integer literal.");    
  472.       when TR_FLT_LIT_EXPR then 
  473.      prog.err("It is illegal to assign to a floating point literal.");
  474.       end;
  475.       return void end;
  476.  
  477.    transform_assign_dec_stmt(s:TR_ASSIGN_STMT):$AM_STMT
  478.       -- A list of AM_STMT's which implements the source statement `s'.
  479.       -- This is an assignment which declares a local variable and
  480.       -- assigns to it.
  481.       pre void(s) or void(s.lhs_expr) is
  482.       if void(s) then return void end;
  483.       l:AM_LOCAL_EXPR:=local_with_name(s.name);
  484.       prog.err_loc(s);
  485.       if ~void(l) then 
  486.      prog.err("This local variable declaration is in the scope of " +
  487.         l.name.str + ":" + l.tp_at.str +
  488.         " which has the same name."); return void end;
  489.       l:=#AM_LOCAL_EXPR(s.source,s.name,void); 
  490.       if in_protect_body then l.is_volatile:=true end;
  491.       r:AM_ASSIGN_STMT;
  492.       if ~void(s.tp) then    -- Explicitly specified type ":FOO:="
  493.      l.tp_at:=tp_of(s.tp); 
  494.      if void(l.tp_at) then 
  495.         prog.err_loc(s);
  496.         prog.err("Compiler error, TRANS::transform_assign_dec_stmt, "
  497.         "bad type."); 
  498.         return void end;
  499.      add_local(l);        -- Add it here since type is known.
  500.      r:=#AM_ASSIGN_STMT(s.source); r.dest:=l; 
  501.      r.src:=transform_expr(s.rhs,l.tp);
  502.      if void(r.src) then return void end;
  503.      return r end;
  504.       -- If you get here, then the declared type is inferred.
  505.       rhs:$TR_EXPR:=s.rhs; prog.err_loc(s.rhs);
  506.       typecase rhs
  507.       when TR_VOID_EXPR then 
  508.      prog.err("The right hand side of `::=' may not be `void'.");
  509.      return void;
  510.       when TR_CREATE_EXPR then 
  511.      if void(rhs.tp) then
  512.         prog.err("Creation expressions on the right hand side "
  513.         "of `::=' must explicitly specify a type."); return void end;
  514.       when TR_ARRAY_EXPR then
  515.      prog.err("The right hand side of `::=' may not be an array "
  516.      "creation expression."); return void
  517.       else end;
  518.       r:=#AM_ASSIGN_STMT(s.source); r.dest:=l;      
  519.       r.src:=transform_expr(s.rhs,void);
  520.       if void(r.src) then 
  521.      l.tp_at:=prog.tp_builtin.dollar_ob; add_local(l); return void end;
  522.       l.tp_at:=r.src.tp; add_local(l); return r end; 
  523.    
  524.    transform_array_assign_stmt(l:TR_CALL_EXPR,s:TR_ASSIGN_STMT):$AM_STMT
  525.       -- A list of AM_STMT's which implements the source statement `s'.
  526.       -- This is an assignment to the call expression `l' which has 
  527.       -- `is_array' equal to true. So we know it is one of the forms:
  528.       -- "[a,b,c]:=d" or "e[a,b,c]:=d" and should become "aset(a,b,c,d)"
  529.       -- or "e.aset(a,b,c,d).
  530.       pre l.is_array=true is
  531.       -- We change the call object by giving it the name "aset" adding
  532.       -- on the righthand side as an extra argument, transform it and
  533.       -- then change it back.
  534.       r::=#AM_EXPR_STMT(l.source);
  535.       l.name:=prog.ident_builtin.aset_ident; l.is_array:=false;      
  536.       if void(l.args) then l.args:=s.rhs;
  537.      r.expr:=transform_call_expr(l,void,false);     
  538.      l.args:=void;
  539.       else lst::=l.args; loop until!(void(lst.next)); lst:=lst.next end;
  540.      lst.next:=s.rhs;
  541.      r.expr:=transform_call_expr(l,void,false);     
  542.      lst.next:=void;
  543.       end;
  544.       l.name:=void; l.is_array:=true;
  545.       return r end;
  546.    
  547.    transform_call_assign_stmt(l:TR_CALL_EXPR,s:TR_ASSIGN_STMT):$AM_STMT 
  548.       -- A list of AM_STMT's which implements the source statement `s'.
  549.       -- This is an assignment to the call expression `l' which has
  550.       -- `is_array' equal to false.
  551.       pre l.is_array=false is      
  552.       if ~void(l.args) then    -- One of the forms: 
  553.      -- "a(5):=foo", "x.a(5):=foo", or "A::a(5):=foo"
  554.      prog.err_loc(l);
  555.      prog.err("It is illegal to assign to a call with arguments."); 
  556.      return void end;
  557.       if void(l.ob) and void(l.tp) then
  558.      -- "a:=foo", This is the case that might be a local variable. 
  559.      loc:AM_LOCAL_EXPR:=local_with_name(l.name);
  560.      if ~void(loc) then return transform_local_assign_stmt(loc,s)
  561.      end end;
  562.       -- At this point we are either of the form "a:=foo" and not a 
  563.       -- local, "x.a:=foo" or "A::x:=foo".
  564.       -- We change the call object by adding on the righthand side as an 
  565.       -- argument, transform it and then put it back to void:
  566.       l.args:=s.rhs;
  567.       r::=#AM_EXPR_STMT(l.source);
  568.       r.expr:=transform_call_expr(l,void,false);
  569.       l.args:=void; return r end;
  570.       
  571.    transform_local_assign_stmt(loc:AM_LOCAL_EXPR, 
  572.                                s:TR_ASSIGN_STMT):$AM_STMT is
  573.       -- A list of AM_STMT's which implements the source assignment
  574.       -- `s'. At this point we know it is an assignment to the local
  575.       -- variable `loc'.
  576.       if loc.no_assign then
  577.      prog.err_loc(s); 
  578.      prog.err("It is illegal to assign to the typecase variable."); 
  579.      return void end;
  580.       r::=#AM_ASSIGN_STMT(s.source);
  581.      -- Does the assignment to the local. 
  582.       r.dest:=loc;        -- Make the local be the destination.
  583.       if in_protect_body then loc.is_volatile:=true end;
  584.       r.src:=transform_expr(s.rhs,loc.tp);
  585.       if void(r.src) then return void end; -- Type error.
  586.       return r end;
  587.    
  588. -----------      
  589.    transform_if_stmt(s:TR_IF_STMT):$AM_STMT is
  590.       -- A list of AM_STMT's which implements the source statement `s'.
  591.       r::=#AM_IF_STMT(s.source);      
  592.       r.test:=transform_expr(s.test, prog.tp_builtin.bool);
  593.       if void(r.test) then return void end; -- Not a boolean.
  594.       r.if_true:=transform_stmt_list(s.then_part);
  595.       r.if_false:=transform_stmt_list(s.else_part);      
  596.       return r end;
  597.       
  598. -----------        
  599.    transform_loop_stmt(s:TR_LOOP_STMT):$AM_STMT is
  600.       -- A list of AM_STMT's which implements the source statement `s'.
  601.       ol:AM_LOOP_STMT:=cur_loop; -- Save the old loop object, if any.
  602.       r::=#AM_LOOP_STMT(s.source); 
  603.       cur_loop:=r;        -- Any enclosed iters will add themselves.
  604.       r.body:=transform_stmt_list(s.body);
  605.       if ~void(ol) and ~void(r) then
  606.      ol.has_yield:=ol.has_yield or r.has_yield; -- Prop "has_yield".
  607.       end;
  608.       cur_loop:=ol;        -- Restore the old loop object, if any.
  609.       return r end;
  610.  
  611. -----------      
  612.    transform_return_stmt(s:TR_RETURN_STMT):$AM_STMT is
  613.       -- A list of AM_STMT's which implements the source statement `s'.
  614.       if is_iter then return_in_iter_err(s); return void end;
  615.       if ~void(s.next) then stmts_after_return_err(s) end;
  616.       rtp:$TP:=cur_rout.sig.ret; -- The return type if any.      
  617.       if void(s.val) then    -- No return value specified.
  618.      if ~void(rtp) then 
  619.         missing_return_value_err(s,rtp); return void end;
  620.      return #AM_RETURN_STMT(s.source) 
  621. --    else                      -- with return value.                           -- NLP
  622.       end;                      -- with return value.                           -- NLP
  623.      if void(rtp) then 
  624.         extra_return_value_err(s, cur_rout.sig); return void end;
  625.      r::=#AM_RETURN_STMT(s.source);      
  626.      r.val:=transform_expr(s.val,rtp);
  627.      if void(r.val) then return void end; -- wrong type.
  628. --       return r end end;                                                      -- NLP
  629.          return r; end;                                                         -- NLP
  630.  
  631.    return_in_iter_err(s:TR_RETURN_STMT) is
  632.       prog.err_loc(s);
  633.       prog.err("`return' statements may not appear in iters.") end;
  634.    
  635.    stmts_after_return_err(s:TR_RETURN_STMT) is
  636.       prog.err_loc(s);
  637.       prog.err("No statements may follow `return' in a statment list.");
  638.       end;
  639.       
  640.    missing_return_value_err(s:TR_RETURN_STMT, tp:$TP) is
  641.       prog.err_loc(s);
  642.       prog.err("A return value of type: " + tp.str +
  643.       " must be specified.") end;      
  644.  
  645.    extra_return_value_err(s:TR_RETURN_STMT, sig:SIG) is
  646.       prog.err_loc(s);
  647.       prog.err("No return value should be provided for the signature: " +
  648.                sig.str + ".") end;
  649.    
  650. -----------      
  651.    transform_yield_stmt(s:TR_YIELD_STMT):$AM_STMT is
  652.       -- A list of AM_STMT's which implements the source statement `s'.
  653.       if ~is_iter then yield_in_rout_err(s); return void end;      
  654.       rtp:$TP:=cur_rout.sig.ret; -- The return type if any.      
  655.       if void(s.val) then    -- No return value specified.
  656.      if ~void(rtp) then 
  657.         missing_yield_value_err(s,rtp); return void end;
  658.      y::=#AM_YIELD_STMT(s.source); 
  659.      cur_yield_ind:=cur_yield_ind+1; y.ret:=cur_yield_ind; 
  660.      cur_rout.num_yields:=cur_rout.num_yields+1;
  661.      if ~void(cur_loop) then cur_loop.has_yield:=true end;
  662.      return y
  663. --    else                      -- with return value.                           -- NLP
  664.       end;                      -- with return value.                           -- NLP
  665.      if void(rtp) then 
  666.         extra_yield_value_err(s, cur_rout.sig); return void end;
  667.      r::=#AM_YIELD_STMT(s.source);
  668.      r.val:=transform_expr(s.val,rtp);
  669.      if void(r.val) then return void end; -- wrong type.     
  670.      cur_yield_ind:=cur_yield_ind+1; r.ret:=cur_yield_ind; 
  671.      cur_rout.num_yields:=cur_rout.num_yields+1;     
  672.      if ~void(cur_loop) then cur_loop.has_yield:=true end;     
  673. --       return r end end;                                                      -- NLP
  674.          return r; end;                                                         -- NLP
  675.  
  676.    yield_in_rout_err(s:TR_YIELD_STMT) is
  677.       prog.err_loc(s);
  678.       prog.err("`yield' statements may not appear in routines.") end;
  679.    
  680.    missing_yield_value_err(s:TR_YIELD_STMT, tp:$TP) is
  681.       prog.err_loc(s);
  682.       prog.err("A yield value of type: " + tp.str +
  683.          " must be specified.") end;      
  684.  
  685.    extra_yield_value_err(s:TR_YIELD_STMT, sig:SIG) is
  686.       prog.err_loc(s);
  687.       prog.err("No yield value should be provided for the signature: " +
  688.          sig.str + ".") end;
  689.    
  690. -----------   
  691.    transform_quit_stmt(s:TR_QUIT_STMT):$AM_STMT is
  692.       -- A list of AM_STMT's which implements the source statement `s'.
  693.       if ~is_iter then quit_in_rout_err(s); return void end;
  694.       if ~void(s.next) then stmts_after_quit_err(s) end;
  695.       return #AM_RETURN_STMT(s.source) end;
  696.  
  697.    quit_in_rout_err(s:TR_QUIT_STMT) is
  698.       prog.err_loc(s);
  699.       prog.err("`quit' statements may not appear in routines.") end;
  700.    
  701.    stmts_after_quit_err(s:TR_QUIT_STMT) is
  702.       prog.err_loc(s);
  703.       prog.err("No statements may follow `quit' in a statment list.") end;
  704.  
  705. -----------      
  706.    transform_case_stmt(s:TR_CASE_STMT):$AM_STMT is
  707.       -- A list of AM_STMT's which implements the source statement `s'.
  708.       if void(s) then return void end;
  709.       r::=#AM_ASSIGN_STMT(s.source);
  710.      -- Assign test to a local variable.
  711.       r.src:=transform_expr(s.test,void);
  712.       if void(r.src) then return void end; 
  713.       l::=#AM_LOCAL_EXPR(s.source,void,r.src.tp); 
  714.       add_local(l); r.dest:=l;
  715.       r.next:=transform_case_when(s,s.when_part,l);
  716.       return r end;
  717.  
  718.    private const_to_switch(e:$AM_EXPR):$AM_CONST is
  719.       -- returns a constant expression that can be used in a
  720.       -- when clause of an AM_CASE_STMT, or void if it cannot
  721.       -- be used.
  722.       if void(e) then return void; end;
  723.       typecase e
  724.       when AM_CHAR_CONST then return e;
  725.       when AM_INT_CONST then return e;
  726.       when AM_GLOBAL_EXPR then return const_to_switch(e.init);
  727. --        else return void;                                                     -- NLP
  728.           else;                                                                 -- NLP
  729.       end;
  730.       return void;                                                              -- NLP
  731.    end;
  732.       
  733.    transform_case_when(s:TR_CASE_STMT, cw:TR_CASE_WHEN,
  734.       l:AM_LOCAL_EXPR):$AM_STMT is
  735.       -- A list of AM_STMT's which implements the list of "when" clauses
  736.       -- and else clause in `s' starting at `cw'. `l' is the local variable
  737.       -- with the value to test against. This will generate 
  738.       -- AM_CASE_STMT's for constants and AM_IF_STMT's otherwise.
  739.       if void(cw) then        -- Just do the else clause.
  740.      if s.no_else then
  741.         r::=#AM_CASE_STMT(s.source);
  742.         r.test:=l; r.no_else:=true; return r
  743.      else
  744.         return transform_stmt_list(s.else_part) end end;        
  745.       prog.err_loc(cw);        -- In case of error.
  746.       ct:$CALL_TP:=call_tp_of_expr(cw.val); -- Call type of test expr.
  747.       v:$AM_EXPR;        -- The value of test expr.
  748.       if void(ct) then v:=transform_expr(cw.val,void); 
  749.      if void(v) then return void end; -- Error!
  750.      cv:$AM_CONST:=const_to_switch(v);
  751.      if ~void(cv) then
  752.         r::=#AM_CASE_STMT(cw.source);
  753.         r.test:=l;
  754.         last_then:$TR_STMT:=cw.then_part;
  755.         ls:FLIST{$AM_CONST}; ls:=ls.push(cv);
  756.         r.tgts:=r.tgts.push(ls);
  757.         r.stmts:=r.stmts.push(transform_stmt_list(cw.then_part));
  758.         loop cw:=cw.next;
  759.            if void(cw) then 
  760.           if s.no_else then r.no_else:=true 
  761.           else r.else_stmts:=transform_stmt_list(s.else_part) end;
  762.           return r end;
  763.            if ~void(call_tp_of_expr(cw.val)) then -- Do an if in else.
  764.           r.else_stmts:=transform_case_when(s,cw,l); 
  765.           return r end;
  766.            v:=transform_expr(cw.val,void);
  767.            if void(v) then return void end; -- Error!        
  768.            cv:=const_to_switch(v);
  769.            if ~void(cv) then
  770.           if SYS::ob_eq(last_then,cw.then_part) then 
  771.              -- add to same stmt
  772.              ls:=r.tgts.pop; ls:=ls.push(cv); 
  773.              r.tgts:=r.tgts.push(ls);
  774.           else        -- Start a new "when" list
  775.              ls:=void; ls:=ls.push(cv); r.tgts:=r.tgts.push(ls);
  776.              r.stmts:=
  777.               r.stmts.push(transform_stmt_list(cw.then_part));
  778.           end;
  779.            else        -- Do an if and put it in else.
  780.           r.else_stmts:=transform_case_when(s,cw,l); 
  781.           return r
  782.            end; -- if
  783.         end; -- loop
  784.      end; -- if
  785.       end; -- if
  786.      -- At this point we need to generate an `if'. One of `ct' and
  787.      -- `v' is void, the other non-void.
  788.       cs::=#CALL_SIG;
  789.       cs.tp:=l.tp_at; cs.name:=prog.ident_builtin.is_eq_ident;
  790.       cs.has_ret:=true; 
  791.       cs.args:=#ARRAY{$CALL_TP}(1); 
  792.       if ~void(ct) then cs.args[0]:=ct else cs.args[0]:=v.tp end;
  793.       sig:SIG:=cs.lookup(tp_con.same=cs.tp); -- Arg true if in this class.
  794.       if void(sig) then return void end; -- Error!
  795.       if sig.ret/=prog.tp_builtin.bool then
  796.      prog.err("The `is_eq' routine corresponding to a `case' branch "
  797.      "must return a boolean."); return void end;
  798.       if void(v) then v:=transform_expr(cw.val,sig.args[0]) end;
  799.       if void(v) then return void end; -- Error!
  800.      -- Create the call on the routine `is_eq'.
  801.       arc::=#AM_ROUT_CALL_EXPR(2,cw.source);
  802.       arc.fun:=sig; arc[0]:=l; arc[1]:=v;
  803.       r::=#AM_IF_STMT(cw.source);      
  804.       r.test:=inline(arc); 
  805.       r.if_true:=transform_stmt_list(cw.then_part);
  806.       r.if_false:=transform_case_when(s,cw.next,l); 
  807.       return r end;
  808.    
  809. -----------      
  810.  
  811.    transform_typecase_stmt(s:TR_TYPECASE_STMT):$AM_STMT is
  812.       -- A list of AM_STMT's which implements the source statement `s'.
  813.       res:$AM_STMT;
  814.       l:AM_LOCAL_EXPR:=local_with_name(s.name); 
  815.       if void(l) then typecase_local_err(s); return void end;
  816.       if cur_rout.local_is_hot(l) then 
  817.      typecase_hot_local_err(s); return void end;
  818.       ono_assign:BOOL:=l.no_assign; -- Old value (if currently in typecase).
  819.       l.no_assign:=true;    -- Freeze it for the current typecase.
  820.       ltp:$TP:=l.tp;        -- The declared type of the local.
  821.       if ltp.is_abstract or ltp.is_bound then -- Do a full typecase.
  822.      r::=#AM_TYPECASE_STMT(s.source);
  823.      r.test:=l; wp:TR_TYPECASE_WHEN:=s.when_part;
  824.      loop while!(~void(wp));
  825.         tp:$TP:=tp_of(wp.tp); -- Type to compare against.
  826.         if tp.is_abstract or tp.is_bound or tp.is_subtype(ltp) then
  827.            -- Only these could possibly match.
  828.            if ltp.is_subtype(tp) then
  829.           if ~r.has_void_stmts then
  830.              r.has_void_stmts:=true;
  831.              r.void_stmts:=transform_stmt_list(wp.then_part) end
  832.            else -- Change declared type in the `then'.
  833.            l.tp_at:=tp;
  834.            end;
  835.            r.tgts:=r.tgts.push(tp);
  836.            r.stmts:=r.stmts.push(transform_stmt_list(wp.then_part)); 
  837.            l.tp_at:=ltp;    -- Change the declared type back.
  838.         end; 
  839.         wp:=wp.next end;
  840.      if s.no_else then r.no_else:=true;
  841.      else            -- Do the else statements.
  842.         r.else_stmts:=transform_stmt_list(s.else_part) end;
  843.         if ~r.has_void_stmts then
  844.            r.has_void_stmts:=true;
  845.            r.void_stmts:=transform_stmt_list(s.else_part) end;
  846.      res:=r; 
  847.       else            -- Look for single matching branch, if any.
  848.      -- Always keep the type the same.
  849.      wp:TR_TYPECASE_WHEN:=s.when_part;
  850.      loop while!(~void(wp));
  851.         if ltp.is_subtype(tp_of(wp.tp)) then
  852.            res:=transform_stmt_list(wp.then_part); 
  853.            l.no_assign:=ono_assign;
  854.            return res end;
  855.         wp:=wp.next end;
  856.      if s.no_else then -- No matching branches.
  857.         typecase_no_branch_err(s); return res
  858.      else            -- Just output the else branch.
  859.         res:=transform_stmt_list(s.else_part) end end;
  860.       l.no_assign:=ono_assign; -- Put the local back the way it was.
  861.       return res end;
  862.      
  863.    typecase_local_err(s:TR_TYPECASE_STMT) is
  864.       prog.err_loc(s);
  865.       prog.err("The name `" + s.name.str +
  866.          "' isn't a local variable.") end;
  867.  
  868.    typecase_hot_local_err(s:TR_TYPECASE_STMT) is
  869.       prog.err_loc(s);
  870.       prog.err("The typecase test local `" + s.name.str +
  871.       "' must not be a `!' argument to an iter.") end;
  872.       
  873.    typecase_no_branch_err(s:TR_TYPECASE_STMT) is
  874.       prog.err_loc(s);
  875.       prog.err("There are no matching branches in this typecase.") end;
  876.       
  877. -----------         
  878.    transform_assert_stmt(s:TR_ASSERT_STMT):$AM_STMT is
  879.       -- A list of AM_STMT's which implements the source statement `s'.
  880.       r::=#AM_ASSERT_STMT(s.source);
  881.       r.test:=transform_expr(s.test, prog.tp_builtin.bool);
  882.       if void(r.test) then return void end; -- Not a boolean.
  883.       return r end;
  884.  
  885. -----------         
  886.    transform_protect_stmt(s:TR_PROTECT_STMT):$AM_STMT is
  887.       -- A list of AM_STMT's which implements the source statement `s'.
  888.       -- Since registers are restored after a longjump, we have to make
  889.       -- sure that no local variables which could have been changed in
  890.       -- the protect and are used later are held in registers. We are
  891.       -- a bit conservative here and make any locals which are assigned
  892.       -- to in the protect body be volatile.
  893.       r::=#AM_PROTECT_STMT(s.source);
  894.       old_in_protect_body:BOOL:=in_protect_body; in_protect_body:=true;
  895.       r.body:=transform_stmt_list(s.stmts);
  896.       in_protect_body:=old_in_protect_body;
  897.       wp:TR_PROTECT_WHEN:=s.when_part;
  898.       loop while!(~void(wp));
  899.      tp:$TP:=tp_of(wp.tp);    -- Type to compare against.
  900.      oex_tp:$TP:=ex_tp; ex_tp:=tp;    
  901.      old_in_protect_then:BOOL:=in_protect_then; in_protect_then:=true;
  902.      r.tgts:=r.tgts.push(tp);
  903.      r.stmts:=r.stmts.push(transform_stmt_list(wp.then_part));
  904.      in_protect_then:=old_in_protect_then;
  905.      ex_tp:=oex_tp;        -- Change exception type back.
  906.      wp:=wp.next end;
  907.       if s.no_else then        -- Raise the same exception.
  908.      r.no_else:=true;
  909.       else            -- Do the else statements.
  910.      oex_tp:$TP:=ex_tp; ex_tp:=prog.tp_builtin.dollar_ob;
  911.      old_in_protect_then:BOOL:=in_protect_then; in_protect_then:=true;
  912.      r.else_stmts:=transform_stmt_list(s.else_part);
  913.      in_protect_then:=old_in_protect_then;
  914.      ex_tp:=oex_tp; end;
  915.       return r end;
  916.  
  917. -----------         
  918.    transform_raise_stmt(s:TR_RAISE_STMT):$AM_STMT is
  919.       -- A list of AM_STMT's which implements the source statement `s'.
  920.       if ~void(s.next) then stmts_after_raise_err(s) end;
  921.       r::=#AM_RAISE_STMT(s.source);
  922.       r.val:=transform_expr(s.val,void);
  923.       if void(r.val) then return void end; 
  924.       return r end;
  925.    
  926.    stmts_after_raise_err(s:TR_RAISE_STMT) is
  927.       prog.err_loc(s);
  928.       prog.err("No statements may follow `raise' in a statment list.") end;
  929.  
  930. -----------         
  931.    transform_expr_stmt(s:TR_EXPR_STMT):$AM_STMT is
  932.       -- A list of AM_STMT's which implements the source statement `s'.
  933.       e:$TR_EXPR:=s.e;            -- The expression.
  934.       typecase e
  935.       when TR_BREAK_EXPR then 
  936.      if void(cur_loop) then break_not_in_loop_err(s); return void end;
  937.      return #AM_BREAK_STMT(s.source)
  938.       when TR_CALL_EXPR then 
  939.      r::=#AM_EXPR_STMT(s.source); 
  940.      r.expr:=transform_call_expr(e,void,false);
  941.      if void(r.expr) then return void end;
  942.      return r
  943. --    else expr_stmt_err(s); return void end end;                               -- NLP
  944.       else expr_stmt_err(s); end; return void; end;                             -- NLP
  945.  
  946.    break_not_in_loop_err(s:TR_EXPR_STMT) is
  947.       prog.err_loc(s);
  948.       prog.err("`break!', `while!' and `until!' calls must appear "
  949.       "inside loops.") end;
  950.  
  951.    expr_stmt_err(s:TR_EXPR_STMT) is
  952.       prog.err_loc(s);
  953.       prog.err("Expressions used as statements may not have return "
  954.       "values.") end;
  955.  
  956. -----------         
  957.    call_tp_of_expr(e:$TR_EXPR):$CALL_TP is
  958.       -- Returns the call type of an expression, if it is one of the
  959.       -- special cases. Otherwise it returns void. (To get the
  960.       -- actual type, you have to do `transform_expr'.
  961.       if void(e) then 
  962.      #OUT + "Compiler error, TRANS::call_tp_of_expr(void).";
  963.      return void end;
  964.       typecase e
  965.       when TR_VOID_EXPR then return #CALL_TP_VOID
  966.       when TR_CREATE_EXPR then 
  967.      if void(e.tp) then return #CALL_TP_CREATE 
  968.      else return void end
  969.       when TR_ARRAY_EXPR then return #CALL_TP_ARRAY
  970.       when TR_UNDERSCORE_ARG then 
  971.      tua::=#CALL_TP_UNDERSCORE; 
  972.      if ~void(e.tp) then tua.tp:=tp_of(e.tp) end; 
  973.      return tua
  974. --    else return void end end;                                                 -- NLP
  975.       else; end; return void; end;                                              -- NLP
  976.      
  977.    transform_expr(e:$TR_EXPR, tp:$TP):$AM_EXPR is
  978.       -- Return an expression which evaluates `e'. If `tp' is not void
  979.       -- then use it as the inferred type. Print an error message if
  980.       -- if is not a supertype of the expression type. In this case 
  981.       -- return void. If `tp' is void then the expression must determine
  982.       -- its own type.
  983.       if void(e) then return void end;
  984.       typecase e
  985.       when TR_SELF_EXPR then return transform_self_expr(e,tp)
  986.       when TR_CALL_EXPR then return transform_call_expr(e,tp,true)
  987.      -- This is special since we need to know whether a return
  988.      -- value is used to resolve overloading. The only way the 
  989.      -- return value won't be used is in an expression statement.
  990.      -- If we get to it from here, the value must be used.
  991.       when TR_VOID_EXPR then return transform_void_expr(e,tp)
  992.       when TR_IS_VOID_EXPR then return transform_is_void_expr(e,tp)     
  993.       when TR_ARRAY_EXPR then return transform_array_expr(e,tp)
  994.       when TR_CREATE_EXPR then return transform_create_expr(e,tp)
  995.       when TR_BOUND_CREATE_EXPR then 
  996.      return transform_bound_create_expr(e,tp)
  997.       when TR_AND_EXPR then return transform_and_expr(e,tp)
  998.       when TR_OR_EXPR then return transform_or_expr(e,tp)
  999.       when TR_EXCEPT_EXPR then return transform_except_expr(e,tp)
  1000.       when TR_NEW_EXPR then return transform_new_expr(e,tp)
  1001.       when TR_INITIAL_EXPR then return transform_initial_expr(e,tp)
  1002.       when TR_BREAK_EXPR then return transform_break_expr(e,tp)
  1003.       when TR_RESULT_EXPR then return transform_result_expr(e,tp)
  1004.       when TR_BOOL_LIT_EXPR then return transform_bool_lit_expr(e,tp)
  1005.       when TR_CHAR_LIT_EXPR then return transform_char_lit_expr(e,tp)
  1006.       when TR_STR_LIT_EXPR then return transform_str_lit_expr(e,tp)
  1007.       when TR_INT_LIT_EXPR then return transform_int_lit_expr(e,tp)
  1008.       when TR_FLT_LIT_EXPR then 
  1009. --       return transform_flt_lit_expr(e,tp) end end;                           -- NLP
  1010.          return transform_flt_lit_expr(e,tp) end; return void; end;             -- NLP
  1011.  
  1012. -----------         
  1013.    transform_self_expr(e:TR_SELF_EXPR, tp:$TP):$AM_EXPR is
  1014.       -- Expression implementing `e' in type context `tp'.
  1015.       if in_constant then self_const_err(e); return void end;
  1016.       sl:AM_LOCAL_EXPR:=cur_rout.self_local;
  1017.       if ~void(tp) then
  1018.      if ~sl.tp.is_subtype(tp) then
  1019.      self_context_err(e,sl.tp,tp); return void end end;
  1020.       return sl end;
  1021.  
  1022.    self_const_err(e:TR_SELF_EXPR) is
  1023.       prog.err_loc(e);
  1024.       prog.err("`self' may not appear in a shared or constant "
  1025.       "initialization expression.") end;
  1026.    
  1027.    self_context_err(e:TR_SELF_EXPR, stp,tp:$TP) is
  1028.       prog.err_loc(e); 
  1029.       prog.err("The type of self: " + stp.str +
  1030.       " is not a subtype of " + tp.str + ".") end; 
  1031.    
  1032. -----------         
  1033.    transform_call_expr(e:TR_CALL_EXPR, tp:$TP, has_ret:BOOL):$AM_EXPR is
  1034.       -- Expression implementing `e' in type context `tp'. `has_ret' says
  1035.       -- whether the return value is used. 
  1036.       if void(cur_rout) and ~in_constant then
  1037.      #OUT + "Compiler error, TRANS::transform_call_expr, "
  1038.      "cur_rout=void."; return void end;
  1039.       if void(e) then return void end;
  1040.       r:$AM_EXPR; prog.err_loc(e);
  1041.       r:=call_expr_check_local(e,tp); if ~void(r) then return r end;
  1042.       stup:TUP{$AM_EXPR,$TP}:=call_self(e); 
  1043.       if void(stup) then return void end; -- Fail
  1044.       self_val:$AM_EXPR:=stup.t1; self_tp:$TP:=stup.t2;
  1045.       if void(self_tp) then return void end; -- Failure.
  1046.       in_class:BOOL; if self_tp=tp_con.same then in_class:=true end;
  1047.       call_sig::=#CALL_SIG; call_sig.has_ret:=has_ret;
  1048.       call_sig.name:=call_expr_rout_name(e); call_sig.tp:=self_tp;
  1049.       args:ARRAY{$AM_EXPR}; nargs:INT:=e.args_size;
  1050.       if ~void(e.args) then args:=#ARRAY{$AM_EXPR}(nargs);
  1051.      call_sig.args:=#ARRAY{$CALL_TP}(nargs) end; 
  1052.       sig:SIG:=call_expr_get_sig(e,call_sig,args,in_class);
  1053.       if void(sig) then return void end;
  1054.       cr:$AM_CALL_EXPR;
  1055.       er:AM_EXT_CALL_EXPR; ir:AM_ITER_CALL_EXPR; rr:AM_ROUT_CALL_EXPR;
  1056.       brr:AM_BND_ROUT_CALL_EXPR; bir:AM_BND_ITER_CALL_EXPR;
  1057.       typecase self_tp
  1058.       when TP_CLASS then
  1059.      if prog.tp_kind(self_tp)=TP_KIND::ext_tp then
  1060.         if in_constant then ext_call_const_err(e); return void end;
  1061.         im:IMPL:=prog.impl_tbl.impl_of(self_tp);
  1062.         if void(im) then
  1063.            #OUT + "Compiler err, TRANS::transform_call_expr, "
  1064.            "im=void."; return void end;
  1065.         el:ELT:=im.elt_with_sig(sig);
  1066.         if void(el) then
  1067.            #OUT + "Compiler err, TRANS::transform_call_expr, "
  1068.            "el=void.";
  1069.            return void end;        
  1070.         er:=#AM_EXT_CALL_EXPR(nargs+1,e.source,name_for_ext(el)); 
  1071.         er[0]:=self_val; er.fun:=sig;
  1072.         if ~void(args) then
  1073.           i:INT:=0; 
  1074.           loop while!(i<nargs); er[i+1]:=args[i]; i:=i+1 end;
  1075.         end;
  1076.         cr:=er;
  1077.      elsif e.name.is_iter then 
  1078.         ir:=#AM_ITER_CALL_EXPR(nargs+1,e.source); 
  1079.         ir[0]:=self_val; ir.fun:=sig;
  1080.         if ~void(args) then
  1081.            i:INT:=0; 
  1082.            loop while!(i<nargs); ir[i+1]:=args[i]; i:=i+1 end;
  1083.         end;
  1084.         cr:=call_fix_iter(ir);
  1085.      else rr:=#AM_ROUT_CALL_EXPR(nargs+1,e.source); 
  1086.         rr[0]:=self_val; rr.fun:=sig;
  1087.         if ~void(args) then
  1088.            i:INT:=0; 
  1089.            loop while!(i<nargs); rr[i+1]:=args[i]; i:=i+1 end;
  1090.            end;
  1091.         cr:=rr; end;
  1092.       when TP_ROUT then
  1093.      if in_constant then bnd_rout_call_const_err; return void end;
  1094.      brr:=#AM_BND_ROUT_CALL_EXPR(nargs,e.source); 
  1095.      brr.br:=self_val; 
  1096.      if ~void(args) then
  1097.         i:INT:=0; 
  1098.         loop while!(i<nargs); brr[i]:=args[i]; i:=i+1 end;
  1099.      end;
  1100.      cr:=brr;
  1101.       when TP_ITER then
  1102.      bir:=#AM_BND_ITER_CALL_EXPR(nargs,e.source); 
  1103.      bir.bi:=self_val; 
  1104.      if ~void(args) then
  1105.         i:INT:=0; 
  1106.         loop while!(i<nargs); bir[i]:=args[i]; i:=i+1 end;
  1107.         end;
  1108.      cr:=call_fix_bnd_iter(bir,sig) end; 
  1109.       if void(cr) then return void end;
  1110.       if ~void(tp) and ~void(cr.tp) then
  1111.      if ~cr.tp.is_subtype(tp) then
  1112.      call_context_err(e,cr.tp,tp); return void end end;
  1113.  
  1114.       -- DPS: changed rest of function to attempt inline
  1115.       ncr:$AM_EXPR:=cr;
  1116.       typecase cr
  1117.       when AM_ROUT_CALL_EXPR then ncr:=inline(cr);
  1118.       else
  1119.       end;
  1120.  
  1121.       -- see if still an $AM_CALL_EXPR and add to list if so
  1122.       if ~void(cur_rout) then 
  1123.       typecase ncr
  1124.           when $AM_CALL_EXPR then cur_rout.calls:=cur_rout.calls.push(ncr)
  1125.           else
  1126.       end;
  1127.       end;
  1128.          
  1129.       return ncr end;
  1130.  
  1131.    call_local_context_err(e:TR_CALL_EXPR, stp,tp:$TP) is
  1132.       prog.err_loc(e); 
  1133.       prog.err("The type of this local variable: " + stp.str +
  1134.       " is not a subtype of " + tp.str + ".") end; 
  1135.    
  1136.    call_const_err(e:TR_CALL_EXPR) is
  1137.       prog.err_loc(e);
  1138.       prog.err("Illegal call for a shared or constant initialization "
  1139.       "expression.") end;
  1140.  
  1141.    call_expr_check_local(e:TR_CALL_EXPR,tp:$TP):AM_LOCAL_EXPR is
  1142.       -- Check if the call `e' is a local variable reference.
  1143.       -- If it is return the local.
  1144.       if in_constant then return void end; -- No locals in initializers.
  1145.       if void(e) then
  1146.      prog.err("Compiler error, TRANS::call_expr_check_local on void.");
  1147.      return void end;
  1148.       self_tr:$TR_EXPR:=e.ob; 
  1149.       r:AM_LOCAL_EXPR;
  1150.       if void(self_tr) and void(e.tp) and void(e.args) and 
  1151.      e.is_array=false then    -- check for local.
  1152.      r:=local_with_name(e.name);
  1153.      if ~void(r) then
  1154.         if ~void(tp) then
  1155.            if ~r.tp.is_subtype(tp) then
  1156.           call_local_context_err(e,r.tp,tp); return void
  1157.            end
  1158.         end;
  1159.      end;
  1160.       end;
  1161.       return r end;
  1162.    
  1163.    call_self(e:TR_CALL_EXPR):TUP{$AM_EXPR,$TP} 
  1164.       -- Return an expression for self and the type of self for the
  1165.       -- call `e'. 
  1166.       pre ~void(e) is
  1167.       self_tr:$TR_EXPR:=e.ob;
  1168.       if ~void(self_tr) then    -- Call made on an expr.
  1169.      typecase self_tr
  1170.      when TR_VOID_EXPR then call_self_void_err(e); return void
  1171.      when TR_CREATE_EXPR then
  1172.         if void(self_tr.tp) then 
  1173.            call_self_create_err(e); return void
  1174.         else self_val:$AM_EXPR:=transform_expr(self_tr,void); 
  1175.            if void(self_val) then return void end;
  1176.            return #TUP{$AM_EXPR,$TP}(self_val,self_val.tp) end;
  1177.      when TR_ARRAY_EXPR then call_self_array_err(e); return void
  1178.      when TR_UNDERSCORE_ARG then 
  1179.         call_self_underscore_err(e); return void
  1180.      else self_val:$AM_EXPR:=transform_expr(self_tr,void);
  1181.         if void(self_val) then return void end;
  1182.         return #TUP{$AM_EXPR,$TP}(self_val,self_val.tp); 
  1183.      end;
  1184.       elsif ~void(e.tp) then    -- Double colon call.
  1185.      av::=#AM_VOID_CONST(e.source);
  1186.      av.tp_at:=tp_of(e.tp);
  1187.      return #TUP{$AM_EXPR,$TP}(av,av.tp_at)
  1188. --    else                      -- Call on self.                                -- NLP
  1189.       end;                      -- Call on self.                                -- NLP
  1190.      self_val:$AM_EXPR;
  1191.      if in_constant then    -- Self is void in initializers.
  1192.         av::=#AM_VOID_CONST(e.source);
  1193.         av.tp_at:=tp_con.same; self_val:=av;
  1194.      else
  1195.         self_val:=cur_rout.self_local end;
  1196.      if void(self_val) then
  1197.         #OUT + "Compiler error, TRANS::call_self, self_val=void.";
  1198.         return void end;
  1199. --       return #TUP{$AM_EXPR,$TP}(self_val,self_val.tp) end end;               -- NLP
  1200.          return #TUP{$AM_EXPR,$TP}(self_val,self_val.tp); end;                  -- NLP
  1201.      
  1202.    call_self_void_err(e:TR_CALL_EXPR) is
  1203.       prog.err_loc(e);
  1204.       prog.err("Calls may not be made directly on `void'.") end;
  1205.       
  1206.    call_self_create_err(e:TR_CALL_EXPR) is
  1207.       prog.err_loc(e);
  1208.       prog.err("Calls may not be made on create expressions which "
  1209.       "don't specify the type of object being created.") end;
  1210.    
  1211.    call_self_array_err(e:TR_CALL_EXPR) is
  1212.       prog.err_loc(e);
  1213.       prog.err("Calls may not be made on array expressions.") end;
  1214.    
  1215.    call_self_underscore_err(e:TR_CALL_EXPR) is
  1216.       prog.err_loc(e);
  1217.       prog.err("Underscore arguments may not appear in this position.") 
  1218.    end;
  1219.    
  1220.    call_context_err(e:TR_CALL_EXPR, stp,tp:$TP) is
  1221.       prog.err_loc(e); 
  1222.       prog.err("The type of the call: " + stp.str +
  1223.       " is not a subtype of " + tp.str + ".") end; 
  1224.  
  1225.    ext_call_const_err(e:TR_CALL_EXPR) is
  1226.       prog.err_loc(e);
  1227.       prog.err("External calls may not appear in shared or constant "
  1228.       "initialization expressions.") end;
  1229.    
  1230.    call_expr_get_sig(e:TR_CALL_EXPR, call_sig:CALL_SIG, 
  1231.       args:ARRAY{$AM_EXPR},in_class:BOOL):SIG is
  1232.       -- Get the signature of the call with `call_sig' and if there
  1233.       -- are arguments, put their expressions in `args'. If anything fails,
  1234.       -- return void. If `in_class' is true then look at private routines
  1235.       -- as well as public ones. 
  1236.       if void(args) then
  1237.      if ~void(e.args) then 
  1238.      prog.err("Compiler error, TRANS::call_expr_get_sig, args size.");
  1239.      return void end;
  1240.       elsif args.size/=e.args_size or 
  1241.      call_sig.args.size/=e.args_size then
  1242.      prog.err("Compiler error, TRANS::call_expr_get_sig, args size.");
  1243.      return void end;
  1244.       a:$TR_EXPR:=e.args; i:INT:=0;
  1245.       ce:$AM_EXPR;
  1246.       loop while!(~void(a));
  1247.      ct:$CALL_TP:=call_tp_of_expr(a);
  1248.      if void(ct) then ce:=transform_expr(a,void); 
  1249.         if void(ce) then return void
  1250.         else ct:=ce.tp end;
  1251.      else ce:=void end;
  1252.      call_sig.args[i]:=ct; args[i]:=ce; 
  1253.      a:=a.next; i:=i+1 end;
  1254.       prog.err_loc(e); r::=call_sig.lookup(in_class);
  1255.       if void(r) then return void end; -- Failure.
  1256.       if r.args.size/=e.args_size then
  1257.      prog.err("Compiler error, TRANS::call_expr_get_sig, res size.");
  1258.      return void end;
  1259.       a:=e.args; i:=0;
  1260.       loop while!(~void(a));
  1261.      ce:=args[i]; at:$TP:=r.args[i];
  1262.      if void(ce) then ce:=transform_expr(a,at) end;
  1263.      if void(ce) then return void end;
  1264.      args[i]:=ce; 
  1265.      a:=a.next; i:=i+1 end;
  1266.       return r end;
  1267.       
  1268.    call_expr_rout_name(e:TR_CALL_EXPR):IDENT 
  1269.       -- The name of the routine being called.
  1270.       pre ~void(e) is
  1271.       if e.is_array then return prog.ident_builtin.aget_ident
  1272. --    else return e.name end end;                                               -- NLP
  1273.       end; return e.name; end;                                                  -- NLP
  1274.    
  1275.    call_fix_iter(ir:AM_ITER_CALL_EXPR):AM_ITER_CALL_EXPR 
  1276.       -- Move the once args out in the iter call `ir'.
  1277.       pre ~void(ir) is
  1278.       if in_constant then iter_call_const_err; return void end;      
  1279.       if void(cur_loop) then iter_call_out_of_loop_err; return void end;
  1280.       ir.lp:=cur_loop;
  1281.       if void(ir[0]) then 
  1282.      #OUT + "Compiler error, TRANS::call_fix_iter, ir[0]=void."; 
  1283.      return void end;      
  1284.       if void(ir.fun) then 
  1285.      #OUT + "Compiler error, TRANS::call_fix_iter, ir.fun=void."; 
  1286.      return void end;      
  1287.       if contains_iter_call(ir[0]) then -- iter in self expression.
  1288.      iter_call_in_once_arg_err(0); return void end;      
  1289.       nl::=#AM_LOCAL_EXPR(ir.source, void, ir[0].tp); 
  1290.       add_local(nl); 
  1291.       ass::=#AM_ASSIGN_STMT(ir.source); 
  1292.       ass.dest:=nl;
  1293.       ass.src:=ir[0]; ir[0]:=nl; ir.init:=ass;
  1294.       i:INT:=0;
  1295.       loop while!(i<ir.size-1);
  1296.      if void(ir[i+1]) then
  1297.         #OUT + "Compiler error, TRANS::call_fix_iter, ir[" + (i+1) +
  1298.         "]=void."; return void end;              
  1299.      once:BOOL:=false;
  1300.      if void(ir.fun.hot) then once:=true 
  1301.      elsif ~ir.fun.hot[i] then once:=true end;
  1302.      if once then
  1303.         if contains_iter_call(ir[i+1]) then
  1304.            iter_call_in_once_arg_err(i+1); return void end;
  1305.         nl:=#AM_LOCAL_EXPR(ir.source,void, ir[i+1].tp);
  1306.         add_local(nl); 
  1307.         ass:=#AM_ASSIGN_STMT(ir.source); ass.dest:=nl;
  1308.         ass.src:=ir[i+1]; ir[i+1]:=nl; 
  1309.         if void(ir.init) then ir.init:=ass
  1310.         else ir.init.append(ass) end end; 
  1311.      i:=i+1 end;
  1312.       cur_loop.its:=cur_loop.its.push(ir);
  1313.       return ir end;
  1314.  
  1315.    iter_call_const_err is
  1316.       prog.err("Iter calls may not appear in shared or constant "
  1317.       "initialization expressions.") end;
  1318.    
  1319.    iter_call_out_of_loop_err is
  1320.       prog.err("Iters may only be called within loop statements.") end;
  1321.  
  1322.    contains_iter_call(e:$AM_EXPR):BOOL is
  1323.       -- True if `e' contains an iter call. This is used to check for
  1324.       -- iter calls in the expressions for once iter arguments.
  1325.       if void(e) then return void end;
  1326.       typecase e
  1327.       when AM_ROUT_CALL_EXPR then
  1328.      loop if contains_iter_call(e.elt!) then return true end end;
  1329.       when AM_ITER_CALL_EXPR then return true
  1330.       when AM_ARRAY_EXPR then
  1331.      loop if contains_iter_call(e.elt!) then return true end end;
  1332.       when AM_BND_CREATE_EXPR then 
  1333.      loop if contains_iter_call(e.elt!) then return true end end;     
  1334.       when AM_BND_ROUT_CALL_EXPR then
  1335.      loop if contains_iter_call(e.elt!) then return true end end;
  1336.       when AM_BND_ITER_CALL_EXPR then return true
  1337.       when AM_IF_EXPR then
  1338.      if contains_iter_call(e.test) or 
  1339.         contains_iter_call(e.if_true) or
  1340.         contains_iter_call(e.if_false) then return true end     
  1341.       when AM_IS_VOID_EXPR then
  1342.      if contains_iter_call(e.arg) then return true end     
  1343.       when AM_NEW_EXPR then
  1344.      if contains_iter_call(e.asz) then return true end     
  1345.       when AM_ATTR_EXPR then 
  1346.      if contains_iter_call(e.ob) then return true end    
  1347.       when AM_ARR_EXPR then 
  1348.      if contains_iter_call(e.ob) or contains_iter_call(e.ind) then
  1349.         return true end     
  1350.       when AM_EXT_CALL_EXPR then
  1351.      loop if contains_iter_call(e.elt!) then return true end end;     
  1352.       else end;
  1353.       return false end;
  1354.       
  1355.    iter_call_in_once_arg_err(i:INT) is
  1356.       if i=0 then
  1357.      prog.err("The expression specifying `self' in this iter call, "
  1358.      "itself contains an iter call.")
  1359.       else prog.err("The expression for argument number " + i +
  1360.      " in this iter call, itself contains an iter call.") end end;
  1361.      
  1362.    bnd_rout_call_const_err is
  1363.       prog.err("Bound routine calls may not appear in shared or "
  1364.       "constant initialization expressions.") end;
  1365.  
  1366.    call_fix_bnd_iter(bir:AM_BND_ITER_CALL_EXPR, 
  1367.       sig:SIG):AM_BND_ITER_CALL_EXPR is
  1368.       -- Move the once args out in the bound iter call `bir' with 
  1369.       -- signature `sig'.      
  1370.       if void(bir) or void(sig) then return void end;
  1371.       if in_constant then bnd_iter_call_const_err; return void end;      
  1372.       if void(cur_loop) then 
  1373.      bnd_iter_call_out_of_loop_err; return void end;
  1374.       bir.lp:=cur_loop;
  1375.       i:INT:=0;
  1376.       loop while!(i<bir.size);
  1377.      if void(bir[i]) then prog.err_loc(bir);
  1378.         prog.err("Compiler error, TRANS::call_fix_bnd_iter, bir[" +
  1379.            i + "]=void."); return void end;
  1380.      once:BOOL:=false;
  1381.      if void(sig.hot) then once:=true
  1382.      elsif ~sig.hot[i] then once:=true end;
  1383.      if once then
  1384.         if contains_iter_call(bir[i]) then
  1385.            bnd_iter_call_in_once_err(i); return void end;
  1386.         nl::=#AM_LOCAL_EXPR(bir.source,void,bir[i].tp);
  1387.         add_local(nl); 
  1388.         ass::=#AM_ASSIGN_STMT(bir.source); 
  1389.         ass.dest:=nl;
  1390.         ass.src:=bir[i]; bir[i]:=nl; 
  1391.         if void(bir.init) then bir.init:=ass
  1392.         else bir.init.append(ass) end end;
  1393.      i:=i+1 end;
  1394.       cur_loop.bits:=cur_loop.bits.push(bir); 
  1395.       return bir end;
  1396.       
  1397.    bnd_iter_call_const_err is
  1398.       prog.err("Bound iter calls may not appear in shared or constant "
  1399.       "initialization expressions.") end;
  1400.    
  1401.    bnd_iter_call_out_of_loop_err is
  1402.       prog.err("Bound iters may only be called inside loop statements.") 
  1403.       end;
  1404.    
  1405.    bnd_iter_call_in_once_err(i:INT) is
  1406.       prog.err("Argument " + i + " of this bound iter call is " +
  1407.       "a once argument, but an iter call appears in its expression.") end;
  1408.       
  1409. -----------         
  1410.    transform_void_expr(e:TR_VOID_EXPR, tp:$TP):$AM_EXPR is
  1411.       -- Expression implementing `e' in type context `tp'.
  1412.       r::=#AM_VOID_CONST(e.source); 
  1413.       if void(tp) then
  1414.      prog.err_loc(e);
  1415.      prog.err("Compiler error, no type for void."); return void end;
  1416.       r.tp_at:=tp; return r end;      
  1417.       
  1418. -----------            
  1419.    transform_is_void_expr(e:TR_IS_VOID_EXPR, tp:$TP):$AM_EXPR is
  1420.       -- Expression implementing `e' in type context `tp'.
  1421.       if ~void(tp) then
  1422.      if ~prog.tp_builtin.bool.is_subtype(tp) then
  1423.         prog.err_loc(e); 
  1424.         prog.err("Void test expressions return BOOL objects which "
  1425.         "are not subtypes of " + tp.str + "."); return void end end;
  1426.       r::=#AM_IS_VOID_EXPR(e.source); 
  1427.       r.tp_at:=prog.tp_builtin.bool; prog.err_loc(e.arg);
  1428.       earg::=e.arg;
  1429.       typecase earg
  1430.       when TR_VOID_EXPR then
  1431.      prog.err("void(void) is not allowed."); return void
  1432.       when TR_CREATE_EXPR then 
  1433.      if void(earg.tp) then 
  1434.         prog.err("void() on create expression without type."); 
  1435.         return void end;
  1436.       when TR_ARRAY_EXPR then 
  1437.      prog.err("void() on array creation expression."); return void
  1438.       when TR_UNDERSCORE_ARG then 
  1439.      prog.err("void(_) is illegal."); return void
  1440.       else end;
  1441.       r.arg:=transform_expr(e.arg,void); 
  1442.       if void(r.arg) then return void end;
  1443.       return r end;      
  1444.    
  1445. -----------         
  1446.    transform_array_expr(e:TR_ARRAY_EXPR, tp:$TP):$AM_EXPR is
  1447.       -- Expression implementing `e' in type context `tp'.
  1448.       if void(tp) then array_tp_void_err(e); return void end;
  1449.       pt:$TP;
  1450.       typecase tp
  1451.       when TP_CLASS then
  1452.      if tp.name/=prog.ident_builtin.ARRAY_ident 
  1453.         or tp.params.size/=1 then
  1454.         array_wrong_tp_err(e,tp); return void end;
  1455.      pt:=tp.params[0];    -- The parameter type.
  1456.       else array_wrong_tp_err(e,tp); return void end;
  1457.       r::=#AM_ARRAY_EXPR(e.elts_size, e.source); 
  1458.       r.tp_at:=tp;
  1459.       ae:$TR_EXPR:=e.elts; i:INT:=0;
  1460.       loop while!(~void(ae));
  1461.      tae:$AM_EXPR:=transform_expr(ae,pt);
  1462.      if void(tae) then return void end;
  1463.      r[i]:=tae;
  1464.      ae:=ae.next; i:=i+1 end;
  1465.       return r end;
  1466.    
  1467.    array_tp_void_err(e:TR_ARRAY_EXPR) is
  1468.       prog.err_loc(e);
  1469.       prog.err("The type of this array creation expression cannot be "
  1470.       "inferred from context.") end;
  1471.      
  1472.    array_wrong_tp_err(e:TR_ARRAY_EXPR, tp:$TP) is
  1473.       prog.err_loc(e);
  1474.       prog.err("The inferred type: " + tp.str + " for this array " +
  1475.          "creation expression is not of the form `ARRAY{T}'.") end;
  1476.       
  1477. -----------         
  1478.    transform_create_expr(e:TR_CREATE_EXPR, tp:$TP):$AM_EXPR is
  1479.       -- Expression implementing `e' in type context `tp'.
  1480.       at:$TP;
  1481.       if in_constant then create_const_err(e); return void end;      
  1482.       if ~void(e.tp) then
  1483.      at:=tp_of(e.tp);
  1484.      if ~void(tp) then
  1485.         if ~at.is_subtype(tp) then 
  1486.         create_context_err(e,at,tp); return void end end;
  1487.       elsif void(tp) then 
  1488.      create_tp_spec_err(e); return void
  1489.       else at:=tp end;
  1490.      -- Now `at' has the type we are creating.
  1491.       if at.is_abstract then prog.err_loc(e);
  1492.      prog.err("Creation expressions may not specify abstract types.");
  1493.      return void end;
  1494.       na:INT:=e.elts_size;    -- Number of arguments.
  1495.       r::=#AM_ROUT_CALL_EXPR(na+1,e.source); 
  1496.       av::=#AM_VOID_CONST(e.source); av.tp_at:=at;
  1497.       r[0]:=av;     
  1498.       cs::=#CALL_SIG; 
  1499.       if na>0 then cs.args:=#ARRAY{$CALL_TP}(na) end;
  1500.       cs.tp:=at; cs.name:=prog.ident_builtin.create_ident;
  1501.       cs.has_ret:=true;        -- Creation expressions always return vals.
  1502.       ce:$TR_EXPR:=e.elts; i:INT:=0;
  1503.       loop while!(~void(ce));
  1504.      cs.args[i]:=call_tp_of_expr(ce);
  1505.      if void(cs.args[i]) then -- Not a type inference case.
  1506.         r[i+1]:=transform_expr(ce,void); -- Compute arg expr.
  1507.         if void(r[i+1]) then return void end;
  1508.         cs.args[i]:=r[i+1].tp end;  -- Get type from expr.
  1509.      ce:=ce.next; i:=i+1 end;
  1510.       prog.err_loc(e);
  1511.  
  1512.       -- DPS: was: r.fun:=prog.ifc_tbl.ifc_of(at).sig_for_call(cs);
  1513.       if at=tp_con.same then
  1514.       r.fun:=prog.impl_tbl.impl_of(at).sig_for_internal_call(cs);
  1515.       else
  1516.       r.fun:=prog.ifc_tbl.ifc_of(at).sig_for_call(cs);
  1517.       end;
  1518.       -- DPS end of change
  1519.  
  1520.       if void(r.fun) then return void end;
  1521.       ce:=e.elts; i:=0;
  1522.       loop while!(~void(ce));
  1523.      if void(r[i+1]) then    -- Need to compute by inference.
  1524.         r[i+1]:=transform_expr(ce,r.fun.args[i]); 
  1525.            -- Here is where the type inference gets done. We tell
  1526.            -- it to use the found signature type to evaluate ce.
  1527.         if void(r[i+1]) then return void end end; 
  1528.      ce:=ce.next; i:=i+1 end;
  1529.       if r.fun.ret/=at then
  1530.      create_bad_return_type_err(e,r.fun.ret,at); return void end;
  1531.       cur_rout.calls:=cur_rout.calls.push(r);      
  1532.       return inline(r) end;
  1533.  
  1534.    create_const_err(e:TR_CREATE_EXPR) is
  1535.       prog.err_loc(e);
  1536.       prog.err("Creation expressions may not appear in shared or "
  1537.       "constant initialization expressions.") end;
  1538.    
  1539.    create_context_err(e:TR_CREATE_EXPR, stp,tp:$TP) is
  1540.       prog.err_loc(e); 
  1541.       prog.err("The type of the creation expression: " + stp.str +
  1542.       " is not a subtype of " + tp.str + ".") end;
  1543.    
  1544.    create_tp_spec_err(e:TR_CREATE_EXPR) is
  1545.       prog.err_loc(e); 
  1546.       prog.err("This creation expression does not specify its type "
  1547.       "and it cannot be inferred from context.") end;
  1548.    
  1549.    create_bad_return_type_err(e:TR_CREATE_EXPR, rt,at:$TP) is
  1550.       prog.err_loc(e);
  1551.       prog.err("This creation expression returns the type: " + rt.str +
  1552.       " rather than " + at.str + " as it must.") end;
  1553.    
  1554. -----------       
  1555.    transform_bound_create_expr(e:TR_BOUND_CREATE_EXPR, tp:$TP):$AM_EXPR is
  1556.       -- Expression implementing `e' in type context `tp'.
  1557.       if in_constant then bound_create_in_const_err(e); return void end; 
  1558.       st::=bound_create_self(e); self_val::=st.t1; self_tp::=st.t2;
  1559.       if void(self_tp) then return void end; -- Failure.
  1560.       nbnd::=bound_create_num_bnd(self_val,e);
  1561.       r::=#AM_BND_CREATE_EXPR(nbnd);
  1562.       r.fun:=bound_create_sig(e,self_tp);
  1563.       if void(r.fun) then return void end; -- Failure.
  1564.       if e.is_iter and r.fun.is_iter.not then
  1565.      bound_create_not_iter_err(e); return void
  1566.       elsif ~e.is_iter and r.fun.is_iter then
  1567.      bound_create_iter_err(e); return void end;
  1568.       r.bnd_args:=bound_create_bnd_args(nbnd,e);
  1569.       r.unbnd_args:=bound_create_unbnd_args(nbnd,e);
  1570.       bind::=0;            -- Index into bound arguments.
  1571.       if ~void(self_val) then r[bind]:=self_val; bind:=bind+1;
  1572.      if e.is_iter and contains_iter_call(self_val) then
  1573.         bound_create_self_has_iter_err(e); return void end;
  1574.      hot:BOOL;
  1575.      a::=e.call.args;
  1576.      loop while!(~void(a)); atp::=r.fun.args.elt!;
  1577.         if ~void(r.fun.hot) then hot:=r.fun.hot.elt! end;
  1578.         typecase a when TR_UNDERSCORE_ARG then else
  1579.            r[bind]:=transform_expr(a,atp);
  1580.            if void(r[bind]) then return void end;
  1581.            if e.is_iter and ~hot and contains_iter_call(r[bind]) then
  1582.           bound_create_iter_in_once_err(a); return void end;
  1583.            bind:=bind+1 end;
  1584.         a:=a.next;
  1585.      end;
  1586.       end;
  1587.       bound_create_set_tp(r);
  1588.       if ~void(tp) and ~r.tp.is_subtype(tp) then
  1589.      bound_create_context_err(e,r.tp,tp); return void end;
  1590.       cur_rout.calls:=cur_rout.calls.push(r);
  1591.       return r end;
  1592.  
  1593.    bound_create_in_const_err(e:TR_BOUND_CREATE_EXPR) is
  1594.       prog.err_loc(e);
  1595.       prog.err("Bound creation expressions may not appear in shared or "
  1596.          "constant initialization expressions.") end;
  1597.    
  1598.    bound_create_self(e:TR_BOUND_CREATE_EXPR):TUP{$AM_EXPR,$TP} is
  1599.       -- Return an expression for self and the type of self for the
  1600.       -- bound create expression `e'. If `t1' is void, then it is a 
  1601.       -- call on underscore.
  1602.       call::=e.call; self_tr::=call.ob;
  1603.       self_val:$AM_EXPR;
  1604.       if ~void(self_tr) then    -- Call made on an expr.
  1605.      typecase self_tr
  1606.      when TR_VOID_EXPR then bound_create_self_void_err(e); 
  1607.         return #(void,void)
  1608.      when TR_CREATE_EXPR then 
  1609.         if void(self_tr.tp) then bound_create_self_create_err(e); 
  1610.            return #(void,void)
  1611.         else self_val:=transform_expr(self_tr,void); 
  1612.            return #(self_val,self_val.tp) end;
  1613.      when TR_ARRAY_EXPR then bound_create_self_array_err(e); 
  1614.         return #(void,void)
  1615.      when TR_UNDERSCORE_ARG then
  1616.         -- `self_val' is void if self is an underscore expression.
  1617.         if void(self_tr.tp) then return #(void,impl.tp)
  1618.         else return #(void,tp_of(self_tr.tp)) end;
  1619.      else self_val:=transform_expr(self_tr,void);
  1620.         return #(self_val,self_val.tp) end;
  1621.       elsif ~void(call.tp) then    -- Double colon call.
  1622.      res::=#AM_VOID_CONST(call.source);
  1623.      res.tp_at:=tp_of(call.tp);
  1624.      return #(res, res.tp_at);
  1625.       else            -- Call on self.
  1626.      if void(call.args) then    -- Might be a local.
  1627.         l::=local_with_name(call.name);
  1628.         if ~void(l) then 
  1629.            bound_create_self_local_err(e); return #(void,void)
  1630.         else end end;
  1631.      self_val:=cur_rout.self_local; 
  1632. --       return #(self_val, self_val.tp) end end;                               -- NLP
  1633.          end; return #(self_val, self_val.tp); end;                             -- NLP
  1634.    
  1635.    bound_create_self_void_err(e:TR_BOUND_CREATE_EXPR) is
  1636.       prog.err_loc(e);
  1637.       prog.err("Bound creation calls may not be made directly on `void'.") 
  1638.    end;
  1639.       
  1640.    bound_create_self_create_err(e:TR_BOUND_CREATE_EXPR) is
  1641.       prog.err_loc(e);
  1642.       prog.err("Bound creation calls may not be made on create "
  1643.          "expressions which don't specify the type of object being "
  1644.          "created.") end;
  1645.  
  1646.    bound_create_self_array_err(e:TR_BOUND_CREATE_EXPR) is
  1647.       prog.err_loc(e);
  1648.       prog.err("Bound creation calls may not be made on array "
  1649.          "expressions.") end;
  1650.  
  1651.    bound_create_self_local_err(e:TR_BOUND_CREATE_EXPR) is
  1652.       prog.err_loc(e); 
  1653.       prog.err("Bound creation calls must be calls on routines or iters, "
  1654.          "not references to local variables.") end;
  1655.  
  1656.    bound_create_sig(e:TR_BOUND_CREATE_EXPR, self_tp:$TP):SIG is
  1657.       -- The signature of the call represented by `e' where the type of
  1658.       -- self has been determined to be `self_tp'. Void if there
  1659.       -- is a problem.
  1660.       call_sig::=#CALL_SIG; call_sig.tp:=self_tp;
  1661.       call_sig.name:=e.call.name;
  1662.       call_sig.args:=#ARRAY{$CALL_TP}(e.call.args_size);
  1663.       if ~void(e.ret) then call_sig.has_ret:=true else 
  1664.      call_sig.unknown_ret:=true end;
  1665.       ca::=e.call.args;
  1666.       loop while!(~void(ca)); atp::=call_tp_of_expr(ca);
  1667.      if void(atp) then atp:=transform_expr(ca,void).tp end;
  1668.      call_sig.args.set!(atp);
  1669.      ca:=ca.next end;
  1670.         -- At this point call_sig is complete.
  1671.       prog.err_loc(e);        -- Just in case.
  1672.       return call_sig.lookup(self_tp=tp_con.same) end;
  1673.  
  1674.    bound_create_not_iter_err(e:TR_BOUND_CREATE_EXPR) is
  1675.       prog.err_loc(e);
  1676.       prog.err("Bound iters must be formed from iter calls.") end;
  1677.  
  1678.    bound_create_iter_err(e:TR_BOUND_CREATE_EXPR) is
  1679.       prog.err_loc(e);
  1680.       prog.err("Bound routines must be formed from routine calls.") end;
  1681.    
  1682.    bound_create_num_bnd(self_val:$AM_EXPR, e:TR_BOUND_CREATE_EXPR):INT is
  1683.       -- The number of argument which are bound up (including self).
  1684.       r:INT;
  1685.       if void(self_val) then r:=0 else r:=1 end; -- Count self.
  1686.       a::=e.call.args;
  1687.       loop while!(~void(a));
  1688.      typecase a when TR_UNDERSCORE_ARG then else r:=r+1 end;
  1689.      a:=a.next end;
  1690.       return r end;
  1691.    
  1692.    bound_create_bnd_args(nbnd:INT,e:TR_BOUND_CREATE_EXPR):ARRAY{INT} is
  1693.       -- An array of the indices of arguments which are bound up in
  1694.       -- order. 0 is self. `nbnd' is the number of bound args.
  1695.       r::=#ARRAY{INT}(nbnd); 
  1696.       rind::=0;            -- Index into r.
  1697.       st::=e.call.ob;
  1698.       typecase st when TR_UNDERSCORE_ARG then 
  1699.       else r[rind]:=0; rind:=rind+1 end;
  1700.       aind::=0;            -- Index into argument list.      
  1701.       a::=e.call.args;
  1702.       loop while!(~void(a)); aind:=aind+1;
  1703.      typecase a when TR_UNDERSCORE_ARG then 
  1704.      else r[rind]:=aind; rind:=rind+1 end;
  1705.      a:=a.next end;
  1706.       return r end;
  1707.  
  1708.    bound_create_unbnd_args(nbnd:INT,e:TR_BOUND_CREATE_EXPR):ARRAY{INT} is
  1709.       -- An array of the indices of arguments which are not bound in
  1710.       -- order. 0 is self. `nbnd' is the number of bound args.
  1711.       r::=#ARRAY{INT}(1+e.call.args_size-nbnd);      
  1712.       rind::=0;            -- Index into r.
  1713.       st::=e.call.ob;
  1714.       typecase st when TR_UNDERSCORE_ARG then 
  1715.      r[rind]:=0; rind:=rind+1 else end;
  1716.       aind::=0;            -- Index into argument list.      
  1717.       a::=e.call.args;
  1718.       loop while!(~void(a)); aind:=aind+1; 
  1719.      typecase a when TR_UNDERSCORE_ARG then 
  1720.         r[rind]:=aind; rind:=rind+1 else end;
  1721.      a:=a.next end;
  1722.       return r end;
  1723.  
  1724.    bound_create_self_has_iter_err(e:TR_BOUND_CREATE_EXPR) is
  1725.       prog.err_loc(e);
  1726.       prog.err("The expression for self in an iter call may not "
  1727.          "itself contain an iter call.") end;
  1728.    
  1729.    bound_create_iter_in_once_err(a:$TR_EXPR) is
  1730.       prog.err_loc(a);
  1731.       prog.err("Once arguments of iter calls may not themselves "
  1732.          "contain iter calls.") end;
  1733.  
  1734.    bound_create_set_tp(r:AM_BND_CREATE_EXPR) is
  1735.       -- Set the type in `r', assuming everything else is there.
  1736.       fun::=r.fun;
  1737.       args::=#ARRAY{$TP}(r.unbnd_args.size);      
  1738.       t:$TP; h:BOOL;
  1739.       if fun.is_iter then    -- A bound iter.      
  1740.      hot::=#ARRAY{BOOL}(r.unbnd_args.size);
  1741.      loop i::=r.unbnd_args.elt!;
  1742.         if i=0 then t:=fun.tp else t:=fun.args[i-1] end;
  1743.         args.set!(t);
  1744.         if i=0 or void(fun.hot) then h:=false else 
  1745.            h:=fun.hot[i-1] end;
  1746.         hot.set!(h) end;
  1747.      r.tp_at:=prog.tp_tbl.tp_iter_for(args,hot,fun.ret)
  1748.       else            -- A bound routine.
  1749.      loop i::=r.unbnd_args.elt!;
  1750.         if i=0 then t:=fun.tp else t:=fun.args[i-1] end;
  1751.         args.set!(t) end;
  1752.      r.tp_at:=prog.tp_tbl.tp_rout_for(args,fun.ret) end end;
  1753.  
  1754.    bound_create_context_err(e:TR_BOUND_CREATE_EXPR, stp,tp:$TP) is
  1755.       prog.err_loc(e); 
  1756.       prog.err("The type of the bound creation expression: " + stp.str + 
  1757.       " is not a subtype of " + tp.str + ".") end; 
  1758.    
  1759. -----------      
  1760.    transform_and_expr(e:TR_AND_EXPR, tp:$TP):$AM_EXPR is
  1761.       -- Expression implementing `e' in type context `tp'.
  1762.       if ~void(tp) then
  1763.      if ~prog.tp_builtin.bool.is_subtype(tp) then
  1764.      and_context_err(e,tp); return void end end;
  1765.       e1:$AM_EXPR:=transform_expr(e.e1, prog.tp_builtin.bool);      
  1766.       e2:$AM_EXPR:=transform_expr(e.e2, prog.tp_builtin.bool);            
  1767.       if void(e1) or void(e2) then return void end; -- Not booleans.
  1768.       r::=#AM_IF_EXPR(e.source);
  1769.       r.test:=e1; r.if_true:=e2;
  1770.       abc::=#AM_BOOL_CONST(e.source); 
  1771.       abc.val:=false;
  1772.       r.if_false:=abc;
  1773.       r.tp_at:=prog.tp_builtin.bool; 
  1774.       return r end;      
  1775.  
  1776.    and_context_err(e:TR_AND_EXPR, tp:$TP) is
  1777.       prog.err_loc(e); 
  1778.       prog.err("And expressions return BOOL objects which are " +
  1779.       "not subtypes of " + tp.str + ".") end; 
  1780.    
  1781. -----------         
  1782.    transform_or_expr(e:TR_OR_EXPR, tp:$TP):$AM_EXPR is
  1783.       -- Expression implementing `e' in type context `tp'.
  1784.       if ~void(tp) then
  1785.      if ~prog.tp_builtin.bool.is_subtype(tp) then
  1786.      or_context_err(e,tp); return void end end;
  1787.       e1:$AM_EXPR:=transform_expr(e.e1, prog.tp_builtin.bool);      
  1788.       e2:$AM_EXPR:=transform_expr(e.e2, prog.tp_builtin.bool);            
  1789.       if void(e1) or void(e2) then return void end; -- Not booleans.
  1790.       r::=#AM_IF_EXPR(e.source);
  1791.       r.test:=e1; r.if_false:=e2;
  1792.       abc::=#AM_BOOL_CONST(e.source); abc.val:=true;
  1793.       r.if_true:=abc;
  1794.       r.tp_at:=prog.tp_builtin.bool; 
  1795.       return r end;
  1796.  
  1797.    or_context_err(e:TR_OR_EXPR, tp:$TP) is
  1798.       prog.err_loc(e); 
  1799.       prog.err("Or expressions return BOOL objects which are " +
  1800.       "not subtypes of " + tp.str + ".") end; 
  1801.    
  1802. -----------         
  1803.    transform_except_expr(e:TR_EXCEPT_EXPR, tp:$TP):$AM_EXPR is
  1804.       -- Expression implementing `e' in type context `tp'.
  1805.       if in_constant then except_const_err(e); return void end;      
  1806.       if in_protect_then=false then except_loc_err(e); return void end;
  1807.       r::=#AM_EXCEPT_EXPR(ex_tp);
  1808.       if ~void(tp) then
  1809.      if ~r.tp.is_subtype(tp) then
  1810.      except_context_err(e,r.tp,tp); return void end end;
  1811.       return r end;
  1812.    
  1813.    except_const_err(e:TR_EXCEPT_EXPR) is
  1814.       prog.err_loc(e);
  1815.       prog.err("`exception' expressions may not appear in shared "
  1816.       "or constant initialization expressions.") end;
  1817.  
  1818.    except_loc_err(e:TR_EXCEPT_EXPR) is
  1819.       prog.err_loc(e); 
  1820.       prog.err("`exception' expressions may only appear in `then'"
  1821.       "and `else' clauses of `protect' statements.") end;
  1822.    
  1823.    except_context_err(e:TR_EXCEPT_EXPR, stp,tp:$TP) is
  1824.       prog.err_loc(e); 
  1825.       prog.err("The type of the exception expression: "+ stp.str +
  1826.          " is not a subtype of " + tp.str + ".") end; 
  1827.    
  1828. -----------         
  1829.    transform_new_expr(e:TR_NEW_EXPR, tp:$TP):$AM_EXPR is
  1830.       -- Expression implementing `e' in type context `tp'.
  1831.       if in_constant then new_const_err(e); return void end;      
  1832.       t::=impl.tp;        -- The type in which this appears.
  1833.       k:INT:=prog.tp_kind(t);
  1834.       if k/=TP_KIND::ref_tp then new_in_non_ref_err(e); return void end;
  1835.       r:AM_NEW_EXPR;
  1836.       if ~void(tp) then
  1837.      if ~t.is_subtype(tp) then
  1838.      new_context_err(e,t,tp); return void end end;
  1839.       if ~void(e.arg) then    -- Specifies asize.
  1840.      if void(impl.arr) then new_arg_no_array_err(e); return void end;
  1841.      r:=#AM_NEW_EXPR(e.source); r.tp_at:=t; 
  1842.      r.asz:=transform_expr(e.arg,prog.tp_builtin.int);
  1843.      if void(r.asz) then return void end;
  1844.       else            -- Not an array class.
  1845.      if ~void(impl.arr) then new_no_arg_array_err(e); return void end;
  1846.      r:=#AM_NEW_EXPR(e.source); r.tp_at:=t end;
  1847.       return r end;
  1848.  
  1849.    new_const_err(e:TR_NEW_EXPR) is
  1850.       prog.err_loc(e);
  1851.       prog.err("`new' expressions may not appear in shared or constant "
  1852.       "initialization expressions.") end;
  1853.    
  1854.    new_in_non_ref_err(e:TR_NEW_EXPR) is
  1855.       prog.err_loc(e);
  1856.       prog.err("`new' expressions may only appear in reference classes.") 
  1857.    end;
  1858.  
  1859.    new_context_err(e:TR_NEW_EXPR, stp,tp:$TP) is
  1860.       prog.err_loc(e); 
  1861.       prog.err("The type of the `new' expression: " + stp.str +
  1862.       " is not a subtype of " + tp.str + ".") end; 
  1863.    
  1864.    new_arg_no_array_err(e:TR_NEW_EXPR) is
  1865.       prog.err_loc(e);
  1866.       prog.err("`new' expressions only take an argument in classes "
  1867.       "which have an include path to AREF.") end;      
  1868.       
  1869.    new_no_arg_array_err(e:TR_NEW_EXPR) is
  1870.       prog.err_loc(e);
  1871.       prog.err("`new' expressions must take an argument specifying "
  1872.       "`asize' in classes which have an include path to AREF.") end;
  1873.    
  1874. -----------         
  1875.    transform_initial_expr(e:TR_INITIAL_EXPR, tp:$TP):$AM_EXPR is
  1876.       -- Expression implementing `e' in type context `tp'.
  1877.       -- Append initialization code to `init_stmts'.
  1878.       if ~in_post then initial_out_of_post_err(e); return void end;
  1879.       if in_initial then nested_initial_err(e); return void end;
  1880.       in_initial:=true; 
  1881.       te:$AM_EXPR:=transform_expr(e.e,tp); 
  1882.       in_initial:=false;
  1883.       if void(te) then return void end;
  1884.       v::=#AM_LOCAL_EXPR(e.source, void,te.tp);
  1885.       cur_rout.locals:=cur_rout.locals.push(v);
  1886.       as::=#AM_ASSIGN_STMT(e.source); 
  1887.       as.src:=te; as.dest:=v;
  1888.       inst::=#AM_INITIAL_STMT(e.source); 
  1889.       inst.tp:=impl.tp; inst.stmts:=as;
  1890.       if void(init_stmts) then init_stmts:=inst
  1891.       else init_stmts.append(inst) end;
  1892.       return v end;
  1893.    
  1894.    initial_out_of_post_err(e:TR_INITIAL_EXPR) is
  1895.       prog.err_loc(e);
  1896.       prog.err("`initial' expressions can only occur in `post' clauses.") 
  1897.    end;
  1898.  
  1899.    nested_initial_err(e:TR_INITIAL_EXPR) is
  1900.       prog.err_loc(e);
  1901.       prog.err("`initial' expressions may not be nested.") end; 
  1902.    
  1903.    initial_context_err(e:TR_INITIAL_EXPR, stp,tp:$TP) is
  1904.       prog.err_loc(e); 
  1905.       prog.err("The type of the `initial' expression: " + stp.str +
  1906.       " is not a subtype of " + tp.str + ".") end; 
  1907.    
  1908. -----------         
  1909.    transform_break_expr(e:TR_BREAK_EXPR, tp:$TP):$AM_EXPR is
  1910.       -- Break's must always be handled in expression statements. If
  1911.       -- we get here, something's wrong.
  1912.       prog.err_loc(e);
  1913.       prog.err("`break!' may not appear as a part of an expression.");
  1914.       return void end;
  1915.  
  1916. -----------         
  1917.    transform_result_expr(e:TR_RESULT_EXPR, tp:$TP):$AM_EXPR is
  1918.       -- Expression implementing `e' in type context `tp'.
  1919.       if in_post=false then result_out_of_post_err(e); return void end;
  1920.       if in_initial=true then result_in_initial_err(e); return void end;
  1921.       if void(cur_rout.rres) then 
  1922.      if void(cur_rout.sig.ret) then 
  1923.         result_and_no_return_err(e); return void end;
  1924.      cur_rout.rres:=#AM_LOCAL_EXPR(e.source,void,cur_rout.sig.ret) end;
  1925.       if ~void(tp) then
  1926.      if ~cur_rout.rres.tp.is_subtype(tp) then
  1927.      result_context_err(e,cur_rout.rres.tp,tp); return void end end;
  1928.       return cur_rout.rres end;
  1929.  
  1930.    result_out_of_post_err(e:TR_RESULT_EXPR) is
  1931.       prog.err_loc(e);
  1932.       prog.err("`result' expressions can only occur in `post' clauses.")
  1933.    end;
  1934.  
  1935.    result_in_initial_err(e:TR_RESULT_EXPR) is
  1936.       prog.err_loc(e);
  1937.       prog.err("`result' expressions may not appear in `initial' "
  1938.       "expressions.") end; 
  1939.    
  1940.    result_and_no_return_err(e:TR_RESULT_EXPR) is
  1941.       prog.err_loc(e); 
  1942.       prog.err("`result' expressions may not appear in routines or "
  1943.       "iters without return values.") end;
  1944.    
  1945.    result_context_err(e:TR_RESULT_EXPR, stp,tp:$TP) is
  1946.       prog.err_loc(e); 
  1947.       prog.err("The type of the `result' expression: " + stp.str +
  1948.       " is not a subtype of " + tp.str + ".") end; 
  1949.  
  1950. -----------         
  1951.    transform_bool_lit_expr(e:TR_BOOL_LIT_EXPR, tp:$TP):$AM_EXPR is
  1952.       -- Expression implementing `e' in type context `tp'.
  1953.       if ~void(tp) then
  1954.      if ~prog.tp_builtin.bool.is_subtype(tp) then
  1955.         bool_lit_context_err(e,tp); return void end end;
  1956.       r::=#AM_BOOL_CONST(e.source); 
  1957.       r.tp_at:=prog.tp_builtin.bool;
  1958.       r.val:=e.val; 
  1959.       return r end;
  1960.  
  1961.    bool_lit_context_err(e:TR_BOOL_LIT_EXPR, tp:$TP) is
  1962.       prog.err_loc(e); 
  1963.       prog.err("Boolean literals are not subtypes of " + tp.str + ".");
  1964.    end;
  1965.    
  1966. -----------         
  1967.    transform_char_lit_expr(e:TR_CHAR_LIT_EXPR, tp:$TP):$AM_EXPR is
  1968.       -- Expression implementing `e' in type context `tp'.
  1969.       if ~void(tp) then
  1970.      if ~prog.tp_builtin.char.is_subtype(tp) then
  1971.      char_lit_context_err(e,tp); return void end end;
  1972.       r::=#AM_CHAR_CONST(e); 
  1973.       r.tp_at:=prog.tp_builtin.char;
  1974.       return r end;
  1975.  
  1976.    char_lit_context_err(e:TR_CHAR_LIT_EXPR, tp:$TP) is
  1977.       prog.err_loc(e); 
  1978.       prog.err("Character literals are not subtypes of " + tp.str + ".") 
  1979.    end;
  1980.  
  1981. -----------         
  1982.    transform_str_lit_expr(e:TR_STR_LIT_EXPR, tp:$TP):$AM_EXPR is
  1983.       -- Expression implementing `e' in type context `tp'.
  1984.       if ~void(tp) then
  1985.      if ~prog.tp_builtin.str.is_subtype(tp) then
  1986.      str_lit_context_err(e,tp); return void end end;
  1987.       r::=#AM_STR_CONST(e); r.tp_at:=prog.tp_builtin.str;
  1988.       return r end;
  1989.  
  1990.    str_lit_context_err(e:TR_STR_LIT_EXPR, tp:$TP) is
  1991.       prog.err_loc(e); 
  1992.       prog.err("String literals are not subtypes of " + tp.str + ".") end;
  1993.    
  1994. -----------         
  1995.    transform_int_lit_expr(e:TR_INT_LIT_EXPR, tp:$TP):$AM_EXPR is
  1996.       -- Expression implementing `e' in type context `tp'.
  1997.       if e.is_inti then
  1998.      ri::=#AM_INTI_CONST(e); 
  1999.      ri.tp_at:=prog.tp_builtin.inti; 
  2000.      if void(tp) then return ri
  2001.      elsif ~ri.tp_at.is_subtype(tp) then
  2002.         prog.err_loc(e); prog.err("The type of the destination: " +
  2003.         tp.str + " is not a supertype of INTI."); return void
  2004.      else return ri end;
  2005. --    else                                                                      -- NLP
  2006.       end;                                                                      -- NLP
  2007.      r::=#AM_INT_CONST(e); 
  2008.      r.tp_at:=prog.tp_builtin.int; 
  2009.      if void(tp) then return r
  2010.      elsif ~r.tp_at.is_subtype(tp) then
  2011.         prog.err_loc(e); prog.err("The type of the destination: " +
  2012.         tp.str + " is not a supertype of INT."); return void
  2013. --       else return r end;                                                     -- NLP
  2014.          end; return r;                                                         -- NLP
  2015. --    end;                                                                      -- NLP
  2016.    end;
  2017.  
  2018. -----------         
  2019.    transform_flt_lit_expr(e:TR_FLT_LIT_EXPR, tp:$TP):$AM_EXPR is
  2020.       -- Expression implementing `e' in type context `tp'.   
  2021.       case e.tp
  2022.       when TR_FLT_LIT_EXPR::flt then
  2023.      rf::=#AM_FLT_CONST(e); 
  2024.      rf.tp_at:=prog.tp_builtin.flt; 
  2025.      if void(tp) then return rf
  2026.      elsif ~rf.tp_at.is_subtype(tp) then
  2027.         prog.err_loc(e); prog.err("The type of the destination: " +
  2028.         tp.str + " is not a supertype of FLT."); return void
  2029.      else return rf end;
  2030.       when TR_FLT_LIT_EXPR::fltd then
  2031.      rfd::=#AM_FLTD_CONST(e); 
  2032.      rfd.tp_at:=prog.tp_builtin.fltd; 
  2033.      if void(tp) then return rfd
  2034.      elsif ~rfd.tp_at.is_subtype(tp) then
  2035.         prog.err_loc(e); prog.err("The type of the destination: " +
  2036.         tp.str + " is not a supertype of FLTD."); return void
  2037.      else return rfd end;
  2038.       when TR_FLT_LIT_EXPR::fltx then
  2039.      rfx::=#AM_FLTX_CONST(e); 
  2040.      rfx.tp_at:=prog.tp_builtin.fltx; 
  2041.      if void(tp) then return rfx
  2042.      elsif ~rfx.tp_at.is_subtype(tp) then
  2043.         prog.err_loc(e); prog.err("The type of the destination: " +
  2044.         tp.str + " is not a supertype of FLTX."); return void
  2045.      else return rfx end;
  2046.       when TR_FLT_LIT_EXPR::fltdx then
  2047.      rfdx::=#AM_FLTDX_CONST(e); 
  2048.      rfdx.tp_at:=prog.tp_builtin.fltdx; 
  2049.      if void(tp) then return rfdx
  2050.      elsif ~rfdx.tp_at.is_subtype(tp) then
  2051.         prog.err_loc(e); prog.err("The type of the destination: " +
  2052.         tp.str + " is not a supertype of FLTDX."); return void
  2053.      else return rfdx end;
  2054.       when TR_FLT_LIT_EXPR::flti then
  2055.      rfi::=#AM_FLTI_CONST(e); 
  2056.      rfi.tp_at:=prog.tp_builtin.flti; 
  2057.      if void(tp) then return rfi
  2058.      elsif ~rfi.tp_at.is_subtype(tp) then
  2059.         prog.err_loc(e); prog.err("The type of the destination: " +
  2060.         tp.str + " is not a supertype of FLTI."); return void
  2061.      else return rfi end;
  2062. --    end end;                                                                  -- NLP
  2063.       end; return void; end;                                                    -- NLP
  2064.  
  2065. -----------         
  2066.    check_return(t:TR_ROUT_DEF) is
  2067.       -- Check the routine `t' to make sure that if it has a return
  2068.       -- value, then the last statement actually returns a value.
  2069.       -- If not, then print an error.
  2070.       if void(t) then return end;
  2071.       if void(t.ret_dec) then return end; -- No return value.
  2072.       if t.name.is_iter then return end; -- No check for iters.
  2073.       prog.err_loc(t);
  2074.       check_stmt_list_for_return(t.stmts) end;
  2075.    
  2076.    check_stmt_list_for_return(t:$TR_STMT) is
  2077.       -- `t' must either be a return statement, a raise statement
  2078.       -- or terminate in one. If not, print an error.
  2079.       if void(t) then return_err; return end;
  2080.       s:$TR_STMT:=t; loop until!(void(s.next)); s:=s.next end;
  2081.       prog.err_loc(s);
  2082.       typecase s
  2083.       when TR_DEC_STMT then return_err
  2084.       when TR_ASSIGN_STMT then return_err
  2085.       when TR_IF_STMT then check_stmt_list_for_return(s.then_part);
  2086.      check_stmt_list_for_return(s.else_part);
  2087.       when TR_LOOP_STMT then 
  2088.      -- Don't check anything if the last statement is a loop since
  2089.      -- can't be sure. (Maybe later check whether there is a return
  2090.      -- or raise somewhere in the loop.)
  2091.      -- check_stmt_list_for_return(s.body);     
  2092.       when TR_RETURN_STMT then 
  2093.       when TR_YIELD_STMT then return_err
  2094.       when TR_QUIT_STMT then return_err
  2095.       when TR_CASE_STMT then 
  2096.      if ~s.no_else then
  2097.         check_stmt_list_for_return(s.else_part) end;
  2098.      wp:TR_CASE_WHEN:=s.when_part;
  2099.      loop while!(~void(wp));
  2100.         check_stmt_list_for_return(wp.then_part);
  2101.         wp:=wp.next end;
  2102.       when TR_TYPECASE_STMT then
  2103.      if ~s.no_else then
  2104.         check_stmt_list_for_return(s.else_part) end;     
  2105.      wp:TR_TYPECASE_WHEN:=s.when_part;
  2106.      loop while!(~void(wp));
  2107.         check_stmt_list_for_return(wp.then_part);
  2108.         wp:=wp.next end;
  2109.       when TR_ASSERT_STMT then return_err
  2110.       when TR_PROTECT_STMT then 
  2111.      if ~s.no_else then
  2112.         check_stmt_list_for_return(s.else_part) end;     
  2113.      wp:TR_PROTECT_WHEN:=s.when_part;
  2114.      loop while!(~void(wp));
  2115.         check_stmt_list_for_return(wp.then_part);
  2116.         wp:=wp.next end;
  2117.       when TR_RAISE_STMT then 
  2118.       when TR_EXPR_STMT then return_err
  2119.       else #OUT +
  2120.      "Compiler error, TRANS::check_stmt_list_for_return else branch."
  2121.       end end;
  2122.  
  2123.    return_err is
  2124.       prog.err("Routine must terminate with a `return' statement or a "
  2125.       "`raise' statement.") end;
  2126.  
  2127.    name_for_ext(el:ELT):IDENT is
  2128.       -- Name to use for an external class call.
  2129.       if el.is_abstract then return el.sig.name;
  2130. --    else return prog.ident_for(el.tp.str+'_'+el.sig.name.str);                -- NLP
  2131.       end; return prog.ident_for(el.tp.str+'_'+el.sig.name.str);                -- NLP
  2132. --    end;                                                                      -- NLP
  2133.    end;
  2134.    
  2135. end; -- class TRANS
  2136. -------------------------------------------------------------------
  2137.  
  2138.  
  2139.  
  2140.  
  2141.  
  2142.  
  2143.  
  2144.  
  2145.