-- (C) Copyright International Business Machines Corporation 23 January 
-- 1990.  All Rights Reserved. 
--  
-- See the file USERAGREEMENT distributed with this software for full 
-- terms and conditions of use. 
-- File: makeexpr.pp
-- Author: Andy Lowry
-- SCCS Info: @(#)makeexpr.pp	1.7 3/13/90

-- This module accepts the statement list from a Hermes absprog
-- expression clause and builds an expression tree representing the
-- clause.  Statements such as coercions that do not belong to the
-- expression proper are omitted from the tree (where would they go?).

#include "typemark.h"
#include "codegen.h"

makeExpr: using (exprTree)

process (Q: makeExprQ)
  
declare
  args: makeExpr;
  makeExpr: makeExprFn;
  tree: exprTree;
begin
block begin
  receive args from Q;
  
  -- Locate a statement definining the given result object
  for stmt in args.stmts where
	(B(B(B(stmt.operator <> predefined!operator#'call') and
	      B(stmt.operator <> predefined!operator#'discard')) and
	  B(stmt.operator <> predefined!operator#'expression_block')))
  inspect
    -- In all cases except CALL and expression block, destination
    -- operand comes first
    if B(objectname#(AREF(dst,stmt.operands,ZERO)) = args.result) then
      new tree;
      tree.opcode := stmt.operator;
      tree.qual := stmt.qualifier;
      tree.dst := objectname#(AREF(dst,stmt.operands,ZERO));
      new tree.args;
      -- Convert all the source operands
      makeExpr <- makeExprFn#(procedure of program#currentProgram);
      for srcOp in stmt.operands where (B(I(position of srcOp) > ZERO)) inspect
	insert exprTree!expr#(makeExpr(srcOp, args.stmts)) into tree.args;
      end for;
      tree.prag := stmt.prag;
      unite args.expr.tree from tree;
      exit done;
    end if;
  end for;
  
  -- See if definer is a CALL statement
  for stmt in args.stmts where (
      B(stmt.operator = predefined!operator#'call')) inspect
    if B(objectname#(AREF(dst,stmt.operands,I(I(size of stmt.operands)-ONE)))
	    = args.result) then
      -- destination operand comes first
      new tree;
      tree.opcode := stmt.operator;
      tree.qual := stmt.qualifier;
      tree.dst := objectname#
	  (AREF(dst,stmt.operands,I(I(size of stmt.operands)-ONE)));
      new tree.args;
      -- Convert all the source operands
      makeExpr <- makeExprFn#(procedure of program#currentProgram);
      for srcOp in stmt.operands where
	    (B(I(position of srcOp) < I(I(size of stmt.operands)-ONE)))
      inspect
	insert exprTree!expr#(makeExpr(srcOp, args.stmts)) into tree.args;
      end for;
      tree.prag := stmt.prag;
      unite args.expr.tree from tree;
      exit done;
    end if;
  end for;
  
  -- Definer, if there is one, must be an expression block
  -- Expression blocks only yield root objects
  if B(I(size of args.result.components) = ZERO) then
    for stmt in args.stmts where
	  (B(stmt.operator = predefined!operator#'expression_block')) inspect
      reveal stmt.qualifier.expression;
      if B(stmt.qualifier.expression.result = args.result.root) then
	-- Found it... make a node for it
	new tree;
	tree.opcode := stmt.operator;
	tree.qual := stmt.qualifier;
	tree.dst := args.result;
	new tree.args;
	tree.prag := stmt.prag;
	unite args.expr.tree from tree;
	exit done;
      end if;
    end for;
  end if;
  
  -- No statement defines the result object, so we bottom out
  unite args.expr.obj from objectname#(copy of args.result);
  exit done;
  
on exit(done)
  -- All done, send it back
  return args;

end block;
end process
