------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 1995 by International Computer Science Institute            --
-- This file is part of the GNU Sather package. It is free software; you may --
-- redistribute  and/or modify it under the terms of the  GNU General Public --
-- License (GPL)  as  published  by the  Free  Software  Foundation;  either --
-- version 2 of the license, or (at your option) any later version.          --
-- This  program  is distributed  in the  hope that it will  be  useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/GPL for more details.        --
-- The license text is also available from:  Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     --
-------------->  Please email comments to <bug-sather@gnu.org>  <--------------

-- as_out.sa: Pretty Printing of the Abstract Syntax tree representation
------------------------------------------------------------------------

class AS_OUT is
   shared prog:PROG;
   private shared indent : INT;
   
   private iinc is
      indent := indent + 3;
   end;

   private idec is
      indent := indent - 3;
   end;

   private ind is
      loop indent.times!;
	 #OUT+" ";
      end;
   end;
      
   -- Output an AS tree for debugging purposes.

   AS_NODE_out(t:$AS_NODE) is
      if void(t) then #OUT + "$AS_NODE=void "; return end;
      typecase t
      when AS_CLASS_DEF then AS_CLASS_DEF_out(t)
      when AS_CONST_DEF then AS_CONST_DEF_out(t)
      when AS_SHARED_DEF then AS_SHARED_DEF_out(t)
      when AS_ATTR_DEF then AS_ATTR_DEF_out(t)
      when AS_ROUT_DEF then AS_ROUT_DEF_out(t)
      when AS_INCLUDE_CLAUSE then AS_INCLUDE_CLAUSE_out(t)
      when AS_STMT_LIST then AS_STMT_LIST_out(t)
      when AS_DEC_STMT then AS_DEC_STMT_out(t)
      when AS_ASSIGN_STMT then AS_ASSIGN_STMT_out(t)
      when AS_IF_STMT then AS_IF_STMT_out(t)
      when AS_LOOP_STMT then AS_LOOP_STMT_out(t)
      when AS_RETURN_STMT then AS_RETURN_STMT_out(t)
      when AS_YIELD_STMT then AS_YIELD_STMT_out(t)
      when AS_QUIT_STMT then AS_QUIT_STMT_out(t)
      when AS_CASE_STMT then AS_CASE_STMT_out(t)
      when AS_TYPECASE_STMT then AS_TYPECASE_STMT_out(t)
      when AS_ASSERT_STMT then AS_ASSERT_STMT_out(t)
      when AS_PROTECT_STMT then AS_PROTECT_STMT_out(t)
      when AS_RAISE_STMT then AS_RAISE_STMT_out(t)
      when AS_EXPR_STMT then AS_EXPR_STMT_out(t)
      when AS_SELF_EXPR then AS_SELF_EXPR_out(t)
      when AS_CALL_EXPR then AS_CALL_EXPR_out(t)
      when AS_VOID_EXPR then AS_VOID_EXPR_out(t)
      when AS_IS_VOID_EXPR then AS_IS_VOID_EXPR_out(t)
      when AS_ARRAY_EXPR then AS_ARRAY_EXPR_out(t)
      when AS_CREATE_EXPR then AS_CREATE_EXPR_out(t)
      when AS_BOUND_CREATE_EXPR then AS_BOUND_CREATE_EXPR_out(t)
      when AS_UNDERSCORE_ARG then AS_UNDERSCORE_ARG_out(t)
      when AS_AND_EXPR then AS_AND_EXPR_out(t)
      when AS_OR_EXPR then AS_OR_EXPR_out(t)
      when AS_EXCEPT_EXPR then AS_EXCEPT_EXPR_out(t)
      when AS_NEW_EXPR then AS_NEW_EXPR_out(t)
      when AS_INITIAL_EXPR then AS_INITIAL_EXPR_out(t)
      when AS_BREAK_EXPR then AS_BREAK_EXPR_out(t)
      when AS_RESULT_EXPR then AS_RESULT_EXPR_out(t)
      when AS_BOOL_LIT_EXPR then AS_BOOL_LIT_EXPR_out(t)
      when AS_CHAR_LIT_EXPR then AS_CHAR_LIT_EXPR_out(t)
      when AS_STR_LIT_EXPR then AS_STR_LIT_EXPR_out(t)
      when AS_INT_LIT_EXPR then AS_INT_LIT_EXPR_out(t)
      when AS_FLT_LIT_EXPR then AS_FLT_LIT_EXPR_out(t)
      when AS_PARAM_DEC then AS_PARAM_DEC_out(t)
      when AS_TYPE_SPEC then AS_TYPE_SPEC_out(t)
      when AS_ARG_DEC then AS_ARG_DEC_out(t)
      when AS_FEAT_MOD then AS_FEAT_MOD_out(t)
      when AS_CASE_WHEN then AS_CASE_WHEN_out(t)
      when AS_TYPECASE_WHEN then AS_TYPECASE_WHEN_out(t)
      when AS_PROTECT_WHEN then AS_PROTECT_WHEN_out(t)
      when AS_LOCK_IF_WHEN then AS_LOCK_IF_WHEN_out(t)
      when AS_PAR_STMT then AS_PAR_STMT_out(t)
      when AS_INTERF_ATTACH_STMT then AS_INTERF_ATTACH_STMT_out(t)
      when AS_LOCK_STMT then AS_LOCK_STMT_out(t)
      when AS_UNLOCK_STMT then AS_UNLOCK_STMT_out(t)
      when AS_WITH_NEAR_STMT then AS_WITH_NEAR_STMT_out(t)
      when AS_ATTACH_STMT then AS_ATTACH_STMT_out(t)
      when AS_FORK_STMT then AS_FORK_STMT_out(t)
      when AS_SYNC_STMT then AS_SYNC_STMT_out(t)
      end end;
	 
   AS_CLASS_ELT_out(t:$AS_CLASS_ELT) is	 
      if void(t) then return end;
      typecase t
      when AS_CONST_DEF then AS_CONST_DEF_out(t)
      when AS_SHARED_DEF then AS_SHARED_DEF_out(t)
      when AS_ATTR_DEF then AS_ATTR_DEF_out(t)
      when AS_ROUT_DEF then AS_ROUT_DEF_out(t)
      when AS_INCLUDE_CLAUSE then AS_INCLUDE_CLAUSE_out(t) 
      end end;
      
   AS_STMT_LIST_out(t:AS_STMT_LIST) is
      if void(t) then return end;
      AS_STMT_out(t.stmts);
   end;
   
   AS_STMT_out(t:$AS_STMT) is
      if void(t) then return end;
      if void(t.surr_stmt_list) then #OUT+"void surr_ptr" end;
      typecase t
      when AS_DEC_STMT then AS_DEC_STMT_out(t)
      when AS_ASSIGN_STMT then AS_ASSIGN_STMT_out(t)
      when AS_IF_STMT then AS_IF_STMT_out(t)
      when AS_LOOP_STMT then AS_LOOP_STMT_out(t)
      when AS_RETURN_STMT then AS_RETURN_STMT_out(t)
      when AS_YIELD_STMT then AS_YIELD_STMT_out(t)
      when AS_QUIT_STMT then AS_QUIT_STMT_out(t)
      when AS_CASE_STMT then AS_CASE_STMT_out(t)
      when AS_TYPECASE_STMT then AS_TYPECASE_STMT_out(t)
      when AS_ASSERT_STMT then AS_ASSERT_STMT_out(t)
      when AS_PROTECT_STMT then AS_PROTECT_STMT_out(t)
      when AS_RAISE_STMT then AS_RAISE_STMT_out(t)
      when AS_EXPR_STMT then AS_EXPR_STMT_out(t) 
      
      --pSather
      
      when AS_PAR_STMT then AS_PAR_STMT_out(t)
      when AS_INTERF_ATTACH_STMT then AS_INTERF_ATTACH_STMT_out(t)
      when AS_LOCK_STMT then AS_LOCK_STMT_out(t)
      when AS_UNLOCK_STMT then AS_UNLOCK_STMT_out(t)
      when AS_WITH_NEAR_STMT then AS_WITH_NEAR_STMT_out(t)
      when AS_ATTACH_STMT then AS_ATTACH_STMT_out(t)
      when AS_FORK_STMT then AS_FORK_STMT_out(t)
      when AS_SYNC_STMT then AS_SYNC_STMT_out(t)

      end;
      if ~void(t.next) then
	 AS_STMT_out(t.next);
      end;
   end;
      
   AS_EXPR_out(t:$AS_EXPR) is
      if void(t) then #OUT + "$AS_EXPR=void"; return end;
      typecase t
      when AS_SELF_EXPR then AS_SELF_EXPR_out(t)
      when AS_CALL_EXPR then AS_CALL_EXPR_out(t)
      when AS_VOID_EXPR then AS_VOID_EXPR_out(t)
      when AS_IS_VOID_EXPR then AS_IS_VOID_EXPR_out(t)
      when AS_ARRAY_EXPR then AS_ARRAY_EXPR_out(t)
      when AS_CREATE_EXPR then AS_CREATE_EXPR_out(t)
      when AS_BOUND_CREATE_EXPR then AS_BOUND_CREATE_EXPR_out(t)
      when AS_UNDERSCORE_ARG then AS_UNDERSCORE_ARG_out(t)
      when AS_AND_EXPR then AS_AND_EXPR_out(t)
      when AS_OR_EXPR then AS_OR_EXPR_out(t)
      when AS_EXCEPT_EXPR then AS_EXCEPT_EXPR_out(t)
      when AS_NEW_EXPR then AS_NEW_EXPR_out(t)
      when AS_INITIAL_EXPR then AS_INITIAL_EXPR_out(t)
      when AS_BREAK_EXPR then AS_BREAK_EXPR_out(t)
      when AS_RESULT_EXPR then AS_RESULT_EXPR_out(t)
      when AS_BOOL_LIT_EXPR then AS_BOOL_LIT_EXPR_out(t)
      when AS_CHAR_LIT_EXPR then AS_CHAR_LIT_EXPR_out(t)
      when AS_STR_LIT_EXPR then AS_STR_LIT_EXPR_out(t)
      when AS_INT_LIT_EXPR then AS_INT_LIT_EXPR_out(t)
      when AS_FLT_LIT_EXPR then AS_FLT_LIT_EXPR_out(t) 
      
      -- pSather
      
      when AS_HERE_EXPR then AS_HERE_EXPR_out(t)
      when AS_ANY_EXPR then AS_ANY_EXPR_out(t)
      when AS_WHERE_EXPR then AS_WHERE_EXPR_out(t)
      when AS_NEAR_EXPR then AS_NEAR_EXPR_out(t)
      when AS_FAR_EXPR then AS_FAR_EXPR_out(t)
      when AS_AT_EXPR then AS_AT_EXPR_out(t)
      when AS_CLUSTER_EXPR then AS_CLUSTER_EXPR_out(t)
      when AS_CLUSTER_SIZE_EXPR then AS_CLUSTER_SIZE_EXPR_out(t)	 
      when AS_COHORT_EXPR then AS_COHORT_EXPR_out(t)
      when AS_GLOBAL_EXPR then AS_GLOBAL_EXPR_out(t)
      
      end; 
      if ~void(t.next) then
	 #OUT+", ";
	 AS_EXPR_out(t.next);
      end;
   end;

   AS_MODE_EXPR_out(m: AS_ARG_MODE, t:$AS_EXPR) is
      if void(t) then #OUT + "$AS_EXPR=void"; return end;
      AS_MODE_out(m);
      typecase t
      when AS_SELF_EXPR then AS_SELF_EXPR_out(t)
      when AS_CALL_EXPR then AS_CALL_EXPR_out(t)
      when AS_VOID_EXPR then AS_VOID_EXPR_out(t)
      when AS_IS_VOID_EXPR then AS_IS_VOID_EXPR_out(t)
      when AS_ARRAY_EXPR then AS_ARRAY_EXPR_out(t)
      when AS_CREATE_EXPR then AS_CREATE_EXPR_out(t)
      when AS_BOUND_CREATE_EXPR then AS_BOUND_CREATE_EXPR_out(t)
      when AS_UNDERSCORE_ARG then AS_UNDERSCORE_ARG_out(t)
      when AS_AND_EXPR then AS_AND_EXPR_out(t)
      when AS_OR_EXPR then AS_OR_EXPR_out(t)
      when AS_EXCEPT_EXPR then AS_EXCEPT_EXPR_out(t)
      when AS_NEW_EXPR then AS_NEW_EXPR_out(t)
      when AS_INITIAL_EXPR then AS_INITIAL_EXPR_out(t)
      when AS_BREAK_EXPR then AS_BREAK_EXPR_out(t)
      when AS_RESULT_EXPR then AS_RESULT_EXPR_out(t)
      when AS_BOOL_LIT_EXPR then AS_BOOL_LIT_EXPR_out(t)
      when AS_CHAR_LIT_EXPR then AS_CHAR_LIT_EXPR_out(t)
      when AS_STR_LIT_EXPR then AS_STR_LIT_EXPR_out(t)
      when AS_INT_LIT_EXPR then AS_INT_LIT_EXPR_out(t)
      when AS_FLT_LIT_EXPR then AS_FLT_LIT_EXPR_out(t) 
      
      -- pSather
      
      when AS_HERE_EXPR then AS_HERE_EXPR_out(t)
      when AS_ANY_EXPR then AS_ANY_EXPR_out(t)
      when AS_WHERE_EXPR then AS_WHERE_EXPR_out(t)
      when AS_NEAR_EXPR then AS_NEAR_EXPR_out(t)
      when AS_FAR_EXPR then AS_FAR_EXPR_out(t)
      when AS_AT_EXPR then AS_AT_EXPR_out(t)
      when AS_CLUSTER_EXPR then AS_CLUSTER_EXPR_out(t)
      when AS_CLUSTER_SIZE_EXPR then AS_CLUSTER_SIZE_EXPR_out(t)	 
      when AS_COHORT_EXPR then AS_COHORT_EXPR_out(t)
      when AS_GLOBAL_EXPR then AS_GLOBAL_EXPR_out(t)
      
      end; 
      if ~void(t.next) then
	 #OUT+", ";
	 AS_MODE_EXPR_out(m.next, t.next);
      end;
   end;
	 
   AS_CLASS_DEF_out(t:AS_CLASS_DEF) is
      indent := 0;
      if void(t) then #OUT + "AS_CLASS_DEF=void\n\n"; return end;
      case t.kind
      when t.imm then #OUT + "immutable class ";
      when t.ref then #OUT + "class "
      when t.abs then #OUT + "type ";
      when t.c_ext then #OUT + "external C class " 
      when t.fortran_ext then #OUT + "external FORTRAN class " 	 
      when t.spr then #OUT + "spread class "
      end;	 
      #OUT + withoutunder(t.name.str.upper) + ' ';
      if ~void(t.params) then
	 #OUT+"{";
	 AS_PARAM_DEC_out(t.params);
	 #OUT+"}";
      end;
      if ~void(t.under) then 
	 #OUT+" < ";
	 AS_TYPE_SPEC_out(t.under);
      end;
      if ~void(t.over) then 
	 #OUT+" > ";
	 AS_TYPE_SPEC_out(t.over);
      end;
      #OUT+" is \n";
      iinc;
      AS_CLASS_ELT_out(t.body);
      #OUT+"end;    -- of " + withoutunder(t.name.str.upper) + "\n";
   end;
      
   AS_CONST_DEF_out(t:AS_CONST_DEF) is
      if void(t) then #OUT + "AS_CONST_DEF=void\n\n"; return end;      
      ind;
      if t.is_private then #OUT+"private "; end;
      #OUT+"const "+withoutunder(t.name.str)+' ';
      if ~void(t.tp) then
	 #OUT+": ";
	 AS_TYPE_SPEC_out(t.tp);
      end;
      if ~void(t.init) then
	 #OUT+":= ";
	 AS_EXPR_out(t.init);
      end;
      #OUT+";\n";
      if ~void(t.next) then AS_CLASS_ELT_out(t.next) end;
   end;
      
   AS_SHARED_DEF_out(t:AS_SHARED_DEF) is
      if void(t) then #OUT + "AS_SHARED_DEF=void\n\n"; return end;
      ind;
      if t.is_private then #OUT+"private "; end;
      if t.is_readonly then #OUT+"readonly "; end;
      #OUT+"shared "+withoutunder(t.name.str)+' ';
      if ~void(t.tp) then
	 #OUT+": ";
	 AS_TYPE_SPEC_out(t.tp);
      end;
      if ~void(t.init) then
	 #OUT+":= ";
      end;
      #OUT+";\n";
      if ~void(t.next) then AS_CLASS_ELT_out(t.next) end;
   end;
      
   AS_ATTR_DEF_out(t:AS_ATTR_DEF) is
      if void(t) then #OUT + "AS_ATTR_DEF=void\n\n"; return end;      
      ind;
      if t.is_private then #OUT+"private "; end;
      if t.is_readonly then #OUT+"readonly "; end;
      #OUT+"attr "+withoutunder(t.name.str)+' ';
      if ~void(t.tp) then
	 #OUT+": ";
	 AS_TYPE_SPEC_out(t.tp);
      end;
      #OUT+";\n";
      if ~void(t.next) then AS_CLASS_ELT_out(t.next) end;
   end;
      
   AS_ROUT_DEF_out(t:AS_ROUT_DEF) is
      if void(t) then #OUT + "AS_ROUT_DEF=void\n\n"; return end;  
      ind;    
      if t.is_private then #OUT+"private "; end;
      #OUT+withoutunder(t.name.str)+' ';
      if ~void(t.args_dec) then
	 #OUT+"(";
	 AS_ARG_DEC_out(t.args_dec);
	 #OUT+")";
      end;      
      if ~void(t.ret_dec) then
	 #OUT+": ";
	 AS_TYPE_SPEC_out(t.ret_dec);
	 if ~void(t.pre_e) or ~void(t.post_e) then #OUT+"\n";ind; end;
      end;
      if ~void(t.pre_e) then
	 #OUT+"pre ";
	 AS_EXPR_out(t.pre_e);
	 #OUT+"\n";ind;
      end;
      if ~void(t.post_e) then
	 #OUT+"post ";
	 AS_EXPR_out(t.post_e);
	 #OUT+"\n";ind;
      end;
      if t.is_abstract then 
	 #OUT+";\n";
      elsif t.is_builtin then
         #OUT+"builtin "+t.builtin_name.str+";\n";
      else
	 #OUT+" is\n";
	 iinc;
	 AS_STMT_LIST_out(t.body);
	 idec;
	 ind;
	 #OUT+"end;  -- of "+withoutunder(t.name.str)+"\n";
      end;
      if ~void(t.next) then AS_CLASS_ELT_out(t.next) end 
   end;      
      
   AS_INCLUDE_CLAUSE_out(t:AS_INCLUDE_CLAUSE) is
      if void(t) then #OUT + "AS_INCLUDE_CLAUSE=void\n\n"; return end; 
      ind;
      if t.is_private then #OUT+"private "; end;
      #OUT+"include ";      
      AS_TYPE_SPEC_out(t.tp);
      if ~void(t.mods) then
	 #OUT+"\n";
	 iinc;
	 AS_FEAT_MOD_out(t.mods);
      end;
      #OUT+";\n";
      if ~void(t.mods) then
	 idec;
      end;
      if ~void(t.next) then AS_CLASS_ELT_out(t.next) end 
   end;            
      
   AS_DEC_STMT_out(t:AS_DEC_STMT) is
      if void(t) then #OUT + "void"; return end;
      ind;
      #OUT+withoutunder(t.name.str)+": ";
      AS_TYPE_SPEC_out(t.tp);
      #OUT+";\n";      
   end;
      
   AS_ASSIGN_STMT_out(t:AS_ASSIGN_STMT) is
      if void(t) then #OUT + "void"; return end;
      ind;      
      if ~void(t.lhs_expr) then
	 AS_EXPR_out(t.lhs_expr);
      else
	 #OUT+withoutunder(t.name.str);
	 #OUT+":";
      end;
      if ~void(t.tp) then
	 AS_TYPE_SPEC_out(t.tp);
      end;
      #OUT+":=";
      AS_EXPR_out(t.rhs);
      #OUT+";\n";
   end;
      
   AS_IF_STMT_out(t:AS_IF_STMT) is
      if void(t) then #OUT + "void"; return end;  
      ind;
      #OUT+"if ";
      AS_EXPR_out(t.test);
      #OUT+" then\n";
      iinc;
      AS_STMT_LIST_out(t.then_part);
      idec;
      if ~void(t.else_part) then
	 ind;
	 #OUT+"else\n";
	 iinc;
	 AS_STMT_LIST_out(t.else_part);
	 idec;
      end;
      ind;
      #OUT+"end;  -- of if\n";
   end;
      
   AS_LOOP_STMT_out(t:AS_LOOP_STMT) is
      if void(t) then #OUT + "void"; return end;      
      ind;
      #OUT+"loop\n";
      iinc;
      AS_STMT_LIST_out(t.body);
      idec; ind;
      #OUT+"end;  -- of loop\n";
   end;
      
   AS_RETURN_STMT_out(t:AS_RETURN_STMT) is
      if void(t) then #OUT + "void"; return end;      
      ind;
      #OUT+"return ";
      if ~void(t.val) then
	 AS_EXPR_out(t.val);
      end;
      #OUT+";\n";
   end;
      
   AS_YIELD_STMT_out(t:AS_YIELD_STMT) is
      if void(t) then #OUT + "void"; return end;      
      ind;
      #OUT+"yield ";
      if ~void(t.val) then
	 AS_EXPR_out(t.val);
      end;
      #OUT+";\n";
   end;
      
   AS_QUIT_STMT_out(t:AS_QUIT_STMT) is
      if void(t) then #OUT + "void"; return end;      
      ind;
      #OUT+"quit;\n";
   end;
      
   AS_CASE_STMT_out(t:AS_CASE_STMT) is
      if void(t) then #OUT + "void"; return end; 
      ind;
      #OUT+"case ";
      AS_EXPR_out(t.test);
      #OUT+"\n";
      if ~void(t.when_part) then
	 AS_CASE_WHEN_out(t.when_part);
      end;
      if ~t.no_else then
	 ind;
	 #OUT+"else\n";
	 iinc;
	 AS_STMT_LIST_out(t.else_part);
	 idec;
      end;
      ind;
      #OUT+"end;  -- of case\n";
   end;
      
   AS_TYPECASE_STMT_out(t:AS_TYPECASE_STMT) is
      if void(t) then #OUT + "void"; return end;      
      ind;
      #OUT+"typecase "+withoutunder(t.name.str)+"\n";
      if ~void(t.when_part) then
	 AS_TYPECASE_WHEN_out(t.when_part);
      end;
      if ~t.no_else then
	 ind;
	 #OUT+"else\n";
	 iinc;
	 AS_STMT_LIST_out(t.else_part);
	 idec;
      end;
      ind;
      #OUT+"end;  -- of typecase\n";
   end;
      
   AS_ASSERT_STMT_out(t:AS_ASSERT_STMT) is
      if void(t) then #OUT + "void"; return end;      
      ind;
      #OUT+"assert ";
      AS_EXPR_out(t.test);
      #OUT+";\n";
      end;
      
   AS_PROTECT_STMT_out(t:AS_PROTECT_STMT) is
      if void(t) then #OUT + "void"; return end;      
      ind;
      #OUT+"protect\n";
      iinc;
      AS_STMT_LIST_out(t.body);
      idec;
      if ~void(t.when_part) then
	 AS_PROTECT_WHEN_out(t.when_part);
      end;
      if ~t.no_else then
	 ind;
	 #OUT+"else\n";
	 iinc;
	 AS_STMT_LIST_out(t.else_part);
	 idec;
      end;
      ind;
      #OUT+"end;  -- of protect\n";
   end;
      
   AS_RAISE_STMT_out(t:AS_RAISE_STMT) is
      if void(t) then #OUT + "void"; return end;      
      ind;
      #OUT+"raise ";
      AS_EXPR_out(t.val);
      #OUT+";\n";
    end;
      
   AS_EXPR_STMT_out(t:AS_EXPR_STMT) is
      if void(t) then #OUT + "void"; return end;      
      ind;
      AS_EXPR_out(t.e);
      if ~void(t.at) then
	 #OUT+" @ ";
	 AS_EXPR_out(t.at);
      end;
      #OUT+";\n";
   end;

   -- pSather
   AS_PAR_STMT_out(t:AS_PAR_STMT) is
     if void(t) then #OUT + "void"; return end;
     ind;
     #OUT+"-- par:\n";
     if ~void(t.body) then
	iinc;
	AS_STMT_LIST_out(t.body);
	idec;
	ind;
	#OUT+"-- end;  -- of par\n";
     end;
   end;
   
   -- pSather
   AS_INTERF_ATTACH_STMT_out(t:AS_INTERF_ATTACH_STMT) is
      if void(t) then #OUT + "void"; return end;
      ind;
      #OUT+"THREAD("+withoutunder(t.routname.str)+", ";
      #OUT+withoutunder(t.helpername.str)+", ";
      #OUT+withoutunder(t.gatename.str)+", ";
      if void(t.at) then #OUT+"void" else AS_EXPR_out(t.at) end;
      #OUT+");  -- conc.\n"
   end;
   
   -- pSather
   AS_LOCK_STMT_out(t:AS_LOCK_STMT) is
      if void(t) then #OUT + "void"; return end;
      ind;
      #OUT+"lock\n";
      iinc;
      AS_LOCK_IF_WHEN_out(t.if_when_part);
      if ~t.no_else then
	 ind;
	 #OUT+"else\n"; 
	 AS_STMT_LIST_out(t.else_part);
      end;
      idec;
      ind;
      #OUT+"end;  -- of lock\n";
   end;
     
-- pSather
   AS_LOCK_IF_WHEN_out(t:AS_LOCK_IF_WHEN) is
      if void(t) then #OUT + "void"; return end;
      ind;
      with_guard ::= true;
      tv ::= t.val;
      typecase tv 
      when AS_BOOL_LIT_EXPR then
	 if tv.val = true then with_guard := false end;
      else
      end;
      if with_guard then
	 #OUT+"if ";
	 AS_EXPR_out(t.val);
	 #OUT+" ";
      end;
      #OUT+"when ";
      AS_EXPR_out(t.e_list);
      #OUT+" then\n";
      iinc;
      AS_STMT_LIST_out(t.then_part);
      idec;
      ind;
      #OUT+"end -- lock clause\n";
      if ~void(t.next) then AS_LOCK_IF_WHEN_out(t.next);
      end;
   end;
   
   -- pSather
   AS_UNLOCK_STMT_out(t:AS_UNLOCK_STMT) is
      if void(t) then #OUT + "void"; return end;
      ind;
      #OUT+"unlock ";
      AS_EXPR_out(t.e);
      #OUT+";\n";
   end;
   
   -- pSather
   AS_WITH_NEAR_STMT_out(t:AS_WITH_NEAR_STMT) is
      if void(t) then #OUT + "void"; return end;
      ind;
      #OUT+"with ";
      AS_IDENT_LIST_out(t.idents);
      if t.self_occurred then
	 if ~void(t.idents) then
	    #OUT+", ";
	 end;
	 #OUT+"self";
      end;
      #OUT+" near\n";
      iinc;
      AS_STMT_LIST_out(t.near_part);
      idec;
      if ~void(t.else_part) then
	 ind;
	 #OUT+"else\n";
	 iinc;
	 AS_STMT_LIST_out(t.else_part);
	 idec;
      end;
      ind;
      #OUT+"end;  -- of with-near\n";
   end;
   
   -- pSather
   AS_ATTACH_STMT_out(t:AS_ATTACH_STMT) is
      if void(t) then #OUT + "void"; return end;
      ind;
      if t.dont_print then
	 #OUT+"-- attach:\n";
      else
	 AS_EXPR_out(t.lhs);
	 #OUT+" :- ";
	 AS_EXPR_out(t.rhs);
	 #OUT+";\n";
      end;
   end;
   
   -- pSather
   AS_FORK_STMT_out(t:AS_FORK_STMT) is
      if void(t) then #OUT + "void"; return end;
      ind;
      #OUT+"-- fork @ ";
      AS_EXPR_out(t.at);
      #OUT+"\n";
      if ~void(t.body) then  -- this will be set to void during pSather trafo
	 iinc;
	 AS_STMT_LIST_out(t.body);
	 idec;
	 ind;
	 #OUT+"-- end;  -- of fork\n";
      end;
   end;
      
   -- pSather
   AS_SYNC_STMT_out(t:AS_SYNC_STMT) is
      if void(t) then #OUT + "void"; return end;
      ind;
      #OUT+"sync;\n";
   end;
        
   AS_SELF_EXPR_out(t:AS_SELF_EXPR) is
      if void(t) then #OUT + "void"; return end;      
      #OUT+"self";
   end;
      
   AS_CALL_EXPR_out(t:AS_CALL_EXPR) is
      if void(t) then #OUT + "void"; return end;      
      if ~void(t.ob) then
	 e::=t.ob; close_it:BOOL:=false;
	 typecase e
	 when AS_VOID_EXPR then
	 when AS_CREATE_EXPR then
	 when AS_ARRAY_EXPR then
	 when AS_UNDERSCORE_ARG then
	 else #OUT+"("; close_it:=true;
	 end;
	 AS_EXPR_out(t.ob);
	 if close_it then #OUT+")"; end;
	 if ~t.is_array then #OUT+"."; end;
      end;
      if ~void(t.tp)
         and (   (t.tp.name.str /= "SYS")
              or (~void(t.name) and t.name.str /= "cluster!"))
      then
	 AS_TYPE_SPEC_out(t.tp);
	 #OUT+"::";
      end;
      if ~void(t.name) then
	 #OUT+withoutunder(t.name.str);
      end;
      if ~void(t.args) then
	  if t.is_array then 
	      #OUT+"["; 
	      AS_EXPR_out(t.args);
	      #OUT+"]";
	  else
	      #OUT + "(";
	      AS_MODE_EXPR_out(t.modes, t.args);
	      #OUT+")"; 
	  end;
      end;
   end;
      
   AS_VOID_EXPR_out(t:AS_VOID_EXPR) is
      if void(t) then #OUT + "void"; return end;      
      #OUT+"void";
   end;
      
   AS_IS_VOID_EXPR_out(t:AS_IS_VOID_EXPR) is
      if void(t) then #OUT + "void"; return end;      
      #OUT+"void(";
      AS_EXPR_out(t.arg);
      #OUT+")";
   end;
      
   AS_ARRAY_EXPR_out(t:AS_ARRAY_EXPR) is
      if void(t) then #OUT + "void"; return end;      
      #OUT+"|";
      AS_EXPR_out(t.elts);
      #OUT+"|";
   end;
      
   AS_CREATE_EXPR_out(t:AS_CREATE_EXPR) is
      if void(t) then #OUT + "void"; return end;      
      #OUT+"#";
      if ~void(t.tp) then
	 AS_TYPE_SPEC_out(t.tp);
      end;
      if ~void(t.elts) then
	 #OUT+"(";
	 AS_MODE_EXPR_out(t.modes, t.elts);
	 #OUT+")";
      end;
   end;
      
   AS_BOUND_CREATE_EXPR_out(t:AS_BOUND_CREATE_EXPR) is
      if void(t) then #OUT + "void"; return end;      
      #OUT+"#";
      if t.is_iter then #OUT+"ITER(" else #OUT+"ROUT(" end;
      AS_CALL_EXPR_out(t.call);
      if ~void(t.ret) then
	 #OUT+":";
	 AS_TYPE_SPEC_out(t.ret);
      end;
      #OUT+")";
   end;

   
   AS_AND_EXPR_out(t:AS_AND_EXPR) is
      if void(t) then #OUT + "void"; return end;      
      #OUT+"(";
      AS_EXPR_out(t.e1);
      #OUT+") and (";
      AS_EXPR_out(t.e2);
      #OUT+")";
   end;
      
   AS_OR_EXPR_out(t:AS_OR_EXPR) is
      if void(t) then #OUT + "void"; return end;      
      #OUT+"(";
      AS_EXPR_out(t.e1);
      #OUT+") or (";
      AS_EXPR_out(t.e2);
      #OUT+")";
   end;
      
   AS_EXCEPT_EXPR_out(t:AS_EXCEPT_EXPR) is
      if void(t) then #OUT + "void"; return end;      
      #OUT+"exception";
   end;
      
   AS_NEW_EXPR_out(t:AS_NEW_EXPR) is
      if void(t) then #OUT + "void"; return end;      
      #OUT+"new";
      if ~void(t.arg) then
	 #OUT+"(";
	 AS_EXPR_out(t.arg);
	 #OUT+")";
      end;
   end;
      
   AS_INITIAL_EXPR_out(t:AS_INITIAL_EXPR) is
      if void(t) then #OUT + "void"; return end;      
      #OUT+"initial(";
      AS_EXPR_out(t.e);
      #OUT+")";
   end;
      
   AS_BREAK_EXPR_out(t:AS_BREAK_EXPR) is
      if void(t) then #OUT + "void"; return end;
      #OUT+"break!";      
   end;
      
   AS_RESULT_EXPR_out(t:AS_RESULT_EXPR) is
      if void(t) then #OUT + "void"; return end;      
      #OUT+"result";
   end;
      
   AS_BOOL_LIT_EXPR_out(t:AS_BOOL_LIT_EXPR) is
      if void(t) then #OUT + "void"; return end;      
      #OUT+t.val;
   end;
      
   AS_CHAR_LIT_EXPR_out(t:AS_CHAR_LIT_EXPR) is
      if void(t) then #OUT + "void"; return end; 
      #OUT+t.val.char.pretty;   
   end;
      
   AS_STR_LIT_EXPR_out(t:AS_STR_LIT_EXPR) is
      if void(t) then #OUT + "void"; return end;      
      #OUT+t.s.pretty;
   end;
      
   AS_INT_LIT_EXPR_out(t:AS_INT_LIT_EXPR) is
      if void(t) then #OUT + "void"; return end;      
      #OUT+t.val;
      if t.is_inti then #OUT+"i" end;
   end;
      
   AS_FLT_LIT_EXPR_out(t:AS_FLT_LIT_EXPR) is
      if void(t) then #OUT + "void"; return end;  
      s,s2,s3:STR;
      case t.tp
      when AS_FLT_LIT_EXPR::flt then 
	 s:= t.val.str(8);
      else 
	 s:= t.val.str(17);
      end;
      posi ::= s.search('e');
      if posi /= -1 then
	 s2:= s.head(posi) +".0"+s.tail(s.length-posi);
      else
	 s2:= s+".0";
      end;
      case t.tp
      when AS_FLT_LIT_EXPR::flti  then s3 := s2+"i";
      when AS_FLT_LIT_EXPR::fltdx then s3 := s2+"dx";
      when AS_FLT_LIT_EXPR::fltd  then s3 := s2+"d";
      when AS_FLT_LIT_EXPR::fltx  then s3 := s2+"x";
      else
	 s3:=s2;
      end;
      #OUT+s3;
   end;

   --pSather
   AS_HERE_EXPR_out(t:AS_HERE_EXPR) is
      if void(t) then #OUT + "void"; return end;   
      #OUT+"here"   
   end;
   
   --zones
   AS_GLOBAL_EXPR_out(t:AS_GLOBAL_EXPR) is
      if void(t) then #OUT + "void"; return end;   
      #OUT+"global"   
   end;
   
   --pSather
   AS_ANY_EXPR_out(t:AS_ANY_EXPR) is
      if void(t) then #OUT + "void"; return end;      
      #OUT+"any"
   end;
   
   --pSather
   AS_CLUSTER_EXPR_out(t:AS_CLUSTER_EXPR) is
      if void(t) then #OUT + "void"; return end;      
      #OUT+"clusters"
   end;

   AS_CLUSTER_SIZE_EXPR_out(t:AS_CLUSTER_SIZE_EXPR) is
      if void(t) then #OUT + "void"; return end;      
      #OUT+"cluster_size"
   end;
   
   --pSather
   AS_COHORT_EXPR_out(t:AS_COHORT_EXPR) is
      if void(t) then #OUT + "void"; return end;      
      if void(t.name_after_pSather_trafo) then
	 #OUT+"cohort"
      else
	 #OUT+t.name_after_pSather_trafo.str;
      end;
   end;
   
   --pSather
   AS_WHERE_EXPR_out(t:AS_WHERE_EXPR) is
      if void(t) then #OUT + "void"; return end;      
      #OUT+"where(";
      AS_EXPR_out(t.e);
      #OUT+")";
   end;
   
   --pSather
   AS_NEAR_EXPR_out(t:AS_NEAR_EXPR) is
      if void(t) then #OUT + "void"; return end;      
      #OUT+"near(";
      AS_EXPR_out(t.e);
      #OUT+")";
   end;
   
   --pSather
   AS_FAR_EXPR_out(t:AS_FAR_EXPR) is
      if void(t) then #OUT + "void"; return end;      
      #OUT+"far(";
      AS_EXPR_out(t.e);
      #OUT+")";
   end;
            
   --pSather
   AS_AT_EXPR_out(t:AS_AT_EXPR) is
     if void(t) then #OUT + "void"; return end;
     AS_EXPR_out(t.e);
     #OUT+" @ ";
     AS_EXPR_out(t.at);
   end;
   
   AS_PARAM_DEC_out(t:AS_PARAM_DEC) is
      if void(t) then #OUT + "void"; return end;      
      #OUT+withoutunder(t.name.str);
      if ~void(t.type_constraint) then
	 #OUT+" < ";
	 AS_TYPE_SPEC_out(t.type_constraint);
      end;
      if ~void(t.next) then
	 #OUT+", ";
	 AS_PARAM_DEC_out(t.next);
      end;
   end;
      
   AS_TYPE_SPEC_out(t:AS_TYPE_SPEC) is
      if void(t) then #OUT + "void"; return end;      
      if ~void(t.mode) then
	  AS_MODE_out(t.mode);
      end;
      case t.kind
      when AS_TYPE_SPEC::same then 
	 #OUT+"SAME";
      when AS_TYPE_SPEC::rt then 
	 #OUT+"ROUT";
	 if ~void(t.params) then
	    #OUT+"{";
	    AS_TYPE_SPEC_out(t.params);
	    #OUT+"}";
	 end;
	 if ~void(t.ret) then
	    #OUT+":";
	    AS_TYPE_SPEC_out(t.ret);
	 end;
      when AS_TYPE_SPEC::it then 
	 #OUT+"ITER";
	 if ~void(t.params) then
	    #OUT+"{";
	    AS_TYPE_SPEC_out(t.params);
	    #OUT+"}";
	 end;
	 if ~void(t.ret) then
	    #OUT+":";
	    AS_TYPE_SPEC_out(t.ret);
	 end;
      else
	 #OUT+withoutunder(t.name.str.upper);
	 if ~void(t.params) then
	    #OUT+"{";
	    AS_TYPE_SPEC_out(t.params);
	    #OUT+"}";
	 end;
      end;
      if t.is_hot then #OUT+"!"; end;
      if ~void(t.next) then
	 #OUT+", ";
	 AS_TYPE_SPEC_out(t.next);
      end;
   end;
      
   AS_ARG_DEC_out(t:AS_ARG_DEC) is
      if void(t) then #OUT + "void"; return end;      
      AS_MODE_out(t.mode);
      #OUT+withoutunder(t.name.str)+":";
      AS_TYPE_SPEC_out(t.tp);
      if t.is_hot then #OUT+"!"; end;
      if ~void(t.next) then
	 #OUT+", ";
	 AS_ARG_DEC_out(t.next);
      end;
   end;
      
   AS_FEAT_MOD_out(t:AS_FEAT_MOD) is
      if void(t) then #OUT + "void"; return end;  
      ind;
      #OUT+withoutunder(t.name.str)+" -> ";
      if t.is_private  then #OUT+"private "; end;
      if t.is_readonly then #OUT+"readonly "; end;
      if ~void(t.new_name) then
	 #OUT+withoutunder(t.new_name.str);
      end;
      if ~void(t.next) then
	 #OUT+", \n";
	 AS_FEAT_MOD_out(t.next);
      end;
   end;
      
   AS_CASE_WHEN_out(t:AS_CASE_WHEN) is
      if void(t) then #OUT + "void"; return end;      
      ind;
      #OUT+"when ";
      AS_EXPR_out(t.val);
      #OUT+" then\n";
      iinc;
      AS_STMT_LIST_out(t.then_part);
      idec;
      if ~void(t.next) then
	 AS_CASE_WHEN_out(t.next);
      end;
   end;
      
   AS_TYPECASE_WHEN_out(t:AS_TYPECASE_WHEN) is
      if void(t) then #OUT + "void"; return end;      
      ind;
      #OUT+"when ";
      AS_TYPE_SPEC_out(t.tp);
      #OUT+" then\n";
      iinc;
      AS_STMT_LIST_out(t.then_part);
      idec;
      if ~void(t.next) then
	 AS_TYPECASE_WHEN_out(t.next);
      end;
   end;
      
   AS_PROTECT_WHEN_out(t:AS_PROTECT_WHEN) is
      if void(t) then #OUT + "void"; return end;      
      ind;
      #OUT+"when ";
      AS_TYPE_SPEC_out(t.tp);
      #OUT+" then\n";
      iinc;
      AS_STMT_LIST_out(t.then_part);
      idec;
      if ~void(t.next) then
	 AS_PROTECT_WHEN_out(t.next);
      end;
   end;

   AS_IDENT_LIST_out(t:AS_IDENT_LIST) is
     if void(t) then #OUT + "void"; return end;
     #OUT+withoutunder(t.name.str);
     if ~void(t.next) then
	#OUT+", ";
	AS_IDENT_LIST_out(t.next);
     end;
   end;

   AS_UNDERSCORE_ARG_out(t:AS_UNDERSCORE_ARG) is
     if void(t) then #OUT + "void"; return end;
     if ~void(t.tp) then
	 AS_MODE_out(t.tp.mode);
     end;
     #OUT+"_";
     if ~void(t.tp) then
	AS_TYPE_SPEC_out(t.tp);
     end;
   end;

   AS_MODE_out(m: AS_ARG_MODE) is
     case m.mod
     when AS_ARG_MODE::out_mode then
	 #OUT + "out ";
     when AS_ARG_MODE::inout_mode then
	 #OUT + "inout ";
     when AS_ARG_MODE::once_mode then
	 #OUT + "once ";
     when AS_ARG_MODE::in_mode then
	 #OUT + "in ";
     end;
   end;

   private withoutunder(s:STR):STR is
      if void(s) then
	 return void
      else
	 if s.head(1) = "_" then
	    return s.tail(s.size-1);
	 else
	    return s;
	 end;
      end;
   end;        
end;

-------------------------------------------------------------------
