/******************************** -*- C -*- ****************************
 *
 *	Semantic Tree manipulation module.
 *
 *	$Revision: 1.7.5$
 *	$Date: 2000/05/28 16:56:52$
 *	$Author: pb$
 *
 ***********************************************************************/

/***********************************************************************
 *
 * Copyright 1988-92, 1994-95, 1999, 2000 Free Software Foundation, Inc.
 * Written by Steve Byrne.
 *
 * This file is part of GNU Smalltalk.
 *
 * GNU Smalltalk is free software; you can redistribute it and/or modify it
 * under the terms of the GNU General Public License as published by the Free
 * Software Foundation; either version 2, or (at your option) any later 
 * version.
 * 
 * GNU Smalltalk 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 the GNU General Public License for
 * more details.
 * 
 * You should have received a copy of the GNU General Public License along with
 * GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
 * Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
 *
 ***********************************************************************/


#include "gst.h"
#include "alloc.h"
#include "obstack.h"
#include "sym.h"
#include "tree.h"
#include "dict.h"
#include "lex.h"
#include <stdio.h>

char	*nilName = "(nil)"; /* how to print nil */


mst_Boolean hadError = false;

static TreeNode makeMethodNode(), makeBlockNode(), makeListNode(), 
		makeExprNode();
static TreeNode makeTreeNode();
static OOP	makeUnarySelector(), makeBinarySelector();

#ifdef prev_obstacks
/**/static void	freeNode(), freeMethodNode(), freeBlockNode(), freeExprNode(),
/**/		freeListNode(), freeConstNode();
#endif

static void	printMethodNode(), printBlockNode(), printExprNode(), 
		printListNode(), printConstNode(), printNodeType(), indent(),
		printSelector();


/* Used only for printing tree node names when debugging */
static char *nodeTypeNames[] = {
  "methodNodeType", 		/* methodNodeType */
  "unaryExprType", 		/* unaryExprType */
  "binaryExprType", 		/* binaryExprType */
  "keywordExprType", 		/* keywordExprType */
  "variableNodeType", 		/* variableNodeType */
  "keywordListType", 		/* keywordListType */
  "variableListType", 		/* variableListType */
  "statementListType", 		/* statementListType */
  "returnExprType", 		/* returnExprType */
  "assignExprType", 		/* assignExprType */
  "constExprType", 		/* constExprType */
  "symbolNodeType", 		/* symbolNodeType */
  "arrayEltListType", 		/* arrayEltListType */
  "blockNodeType", 		/* blockNodeType */
  "cascadedMessageNodeType", 	/* cascadedMessageNodeType */
  "messageListType" 		/* messageListType */
};



/*
 *	TreeNode makeArrayElt(elt)
 *
 * Description
 *
 *	Create an element of an array constant, which is a list type object.
 *	Return the element with the next field NILed out.
 *
 * Inputs
 *
 *	elt   : TreeNode array element to use
 *
 * Outputs
 *
 *	TreeNode of type arrayEltListType that contains "elt".
 */
TreeNode
makeArrayElt(elt)
     TreeNode elt;
{
  return (makeListNode(arrayEltListType, nil, elt));
}

  
/*
 *	TreeNode makeMethod(selectorExpr, temporaries, primitiveIndex,
 *			    statements)
 *
 * Description
 *
 *	Create a method node.  The method will be invoked by a selector dervied
 *	from "selectorExpr", it has (possibly nil) "temporaries" variables,
 *	and contains "statements".  If the method has a primitive associated
 *	with it, then "primitiveIndex" is non-zero.
 *
 * Inputs
 *
 *	selectorExpr: 
 *		Expression that's to be the selector for this method.
 *	temporaries: 
 *		Possibly nil list of temporary variable names.
 *	primitiveIndex:
 *		Integer.  If non-zero, this method has associated with it
 *		a primitive with index "primitiveIndex".
 *	statements: 
 *		List of statements that comprise the procedural part of this
 *		method.
 *
 * Outputs
 *
 *	TreeNode of type methodNodeType.
 */
TreeNode
makeMethod(selectorExpr, temporaries, primitiveIndex, statements)
     TreeNode selectorExpr, temporaries, statements;
     int	primitiveIndex;
{
  return (makeMethodNode(selectorExpr, temporaries,
			 primitiveIndex, statements));
}


/*
 *	TreeNode makeCascadedMessage(messageExpr, cascadedMessages)
 *
 * Description
 *
 *	Creates a node for holding a list of cascaded messages (basically an
 *	Expr node that isn't using its symbol.  "messageExpr" is the expression
 *	invoke first as it computes the receiver.  Then the remaining cascaded
 *	messages are sent to that receiver.
 *
 * Inputs
 *
 *	messageExpr: 
 *		Evaluates to the receiver of the cascaded messages
 *	cascadedMessages: 
 *		List of the cascaded messages to send to the receiver.
 *
 * Outputs
 *
 *	TreeNode of type cascadedMessageTypeNode.
 */
TreeNode
makeCascadedMessage(messageExpr, cascadedMessages)
     TreeNode messageExpr, cascadedMessages;
{
  return (makeExprNode(cascadedMessageNodeType, messageExpr, nil,
		       cascadedMessages));
}


TreeNode
makeUnaryExpr(receiver, unarySelectorExpr)
     TreeNode receiver;
     char	 *unarySelectorExpr;
{
  OOP		selector;

  /* selectors, being interned symbols, don't need to be incubated -- symbols
   * once created are always referenced
   */
  selector = makeUnarySelector(unarySelectorExpr);
  return (makeExprNode(unaryExprType, receiver, selector, nil));
}

TreeNode
internBinOP(binaryOp)
     char	*binaryOp;
{
  return (makeExprNode(symbolNodeType, nil, makeBinarySelector(binaryOp),
		       nil));
}

TreeNode
internIdent(ident)
     char	*ident;
{
  return (makeExprNode(symbolNodeType, nil, internString(ident), nil));
}

TreeNode
makeStatementList(expression, statements)
     TreeNode expression, statements;
{
  return (makeExprNode(statementListType, expression, nilOOP, statements));
}

TreeNode
makeReturn(expression)
     TreeNode expression;
{
  return (makeExprNode(returnExprType, expression, nilOOP, nil));
}

TreeNode
makeKeywordExpr(receiver, keywordMessage)
     TreeNode receiver, keywordMessage;
{
  return (makeExprNode(keywordExprType, receiver, nilOOP, keywordMessage));
}

TreeNode
makeAssign(variables, expression)
     TreeNode variables, expression;
{
  return (makeExprNode(assignExprType, variables, nilOOP, expression));
}

TreeNode
makeKeywordList(keyword, expression)
     char	*keyword;
     TreeNode expression;
{
  return (makeListNode(keywordListType, keyword, expression));
}

/*
 *	TreeNode makeVariableList(variable)
 *
 * Description
 *
 *	Given a variable tree node, this routine returns a variable list tree
 *	node with a nil next link.  Actually, we rely on the fact that a
 *	variable is represented as a tree node of type ListNode, so  all we do
 *	is change the node tag to variableListType.
 *
 * Inputs
 *
 *	variable: 
 *		Name of variable that's to be part of the list, TreeNode.
 *
 * Outputs
 *
 *	New TreeNode.
 */
TreeNode
makeVariableList(variable)
     TreeNode variable;
{
  variable->nodeType = variableListType;
  return (variable);
}


TreeNode
makeBinaryExpr(receiver, binaryOp, argument)
     TreeNode receiver, argument;
     char	*binaryOp;
{
  OOP		selector;

  selector = makeBinarySelector(binaryOp);
  return (makeExprNode(binaryExprType, receiver, selector, argument));
}

TreeNode
makeMessageList(messageElt)
     TreeNode messageElt;
{
  return (makeListNode(messageListType, nil, messageElt));
}

/*
 *	TreeNode makeBlock(arguments, temporaries, statements)
 *
 * Description
 *
 *	Creates a block tree node and returns it.
 *
 * Inputs
 *
 *	arguments: 
 *		The arguments to the block, possibly nil.
 *	temporaries: 
 *		Possibly nil list of temporary variable names to use for this
 *		block 
 *	statements: 
 *		List of statements that are the procedure part of this block.
 *
 * Outputs
 *
 *	New tree node.
 */
TreeNode
makeBlock(arguments, temporaries, statements)
     TreeNode arguments, temporaries, statements;
{
  return (makeBlockNode(arguments, temporaries, statements));
}

TreeNode
makeVariable(name)
     char	*name;
{
  return (makeListNode(variableNodeType, name, nil));
}


TreeNode
makeIntConstant(ival)
     long	ival;
{
  TreeNode 	result;

  result = makeTreeNode(constExprType);
  result->vConst.constType = intConst;
  result->vConst.val.iVal = ival;

  return (result);
}

TreeNode
makeByteObjectConstant(boval)
     ByteObject boval;
{
  TreeNode 	result;

  result = makeTreeNode(constExprType);
  result->vConst.constType = byteObjConst;
  result->vConst.val.boVal = boval;

  return (result);
}

TreeNode
makeFloatConstant(fval)
     double	fval;
{
  TreeNode 	result;

  result = makeTreeNode(constExprType);
  result->vConst.constType = floatConst;
  result->vConst.val.fVal = fval;

  return (result);
}

TreeNode
makeCharConstant(cval)
     char	cval;
{
  TreeNode 	result;

  result = makeTreeNode(constExprType);
  result->vConst.constType = charConst;
  result->vConst.val.cVal = cval;

  return (result);
}

TreeNode
makeStringConstant(sval)
     char	*sval;
{
  TreeNode 	result;

  result = makeTreeNode(constExprType);
  result->vConst.constType = stringConst;
  result->vConst.val.sVal = sval;

  return (result);
}

TreeNode
makeSymbolConstant(symbolNode)
     TreeNode symbolNode;
{
  TreeNode 	result;

  result = makeTreeNode(constExprType);
  result->vConst.constType = symbolConst;
  if (symbolNode) {
    result->vConst.val.symVal = symbolNode->vExpr.selector;
#ifdef prev_obstacks
/**/    freeNode(symbolNode);
#endif
  } else {
    result->vConst.val.symVal = nilOOP;
  }

  return (result);
}

/* This function converts an Array constant's format (linked list of its
 * elements) to a ByteArray constant's format (ByteObject struct).  The code
 * itself is awful and the list is extremely space inefficient, but consider
 * that:
 * a) it makes the parser simpler (Arrays and ByteArrays are treated in almost
 *    the same way; only, the latter call this function and the former don't).
 * b) a list is indeed an elegant solution because we don't know the size of
 *    the byte array until we have parsed it all (that is, until we call this
 *    function.
 * c) the ByteObject is the best format for ByteArrays: first, it is the one
 *    which makes it easiest to make a full-fledged object out of the parse
 *    tree; second, it is logical to choose it since LargeIntegers use it,
 *    and ByteArrays are represented exactly the same as LargeIntegers.
 */
TreeNode
makeByteArrayConstant(aval)
     TreeNode aval;
{
  TreeNode      arrayElt, ival;
  int           len;
  ByteObject	bo;
  Byte		*data;

  for(len = 0, arrayElt = aval; arrayElt;
      len++, arrayElt = arrayElt->vList.next);

  bo = (ByteObject)obstack_alloc(compilationObstack,
    sizeof(ByteObjectStruct) + len);

  bo->class = byteArrayClass;
  bo->size = len;
  data = bo->body;

  /* Now extract the node for each integer constant, storing its value
   * into the ByteObject */
  for (arrayElt = aval; arrayElt; arrayElt = arrayElt->vList.next) {
    ival = arrayElt->vList.value;
    *data++ = ival->vConst.val.iVal;
  }

#ifdef prev_obstacks
/**/    freeNode(aval);
#endif
  return (makeByteObjectConstant(bo));
}

TreeNode
makeArrayConstant(aval)
     TreeNode aval;
{
  TreeNode 	result;

  result = makeTreeNode(constExprType);
  result->vConst.constType = arrayConst;
  result->vConst.val.aVal = aval;

  return (result);
}

/*
 *	void addNode(n1, n2)
 *
 * Description
 *
 *	adds node "n2" onto a list of nodes headed by "n1".  "n1" contains
 *	the address of the last "next" field in the chain, so storing "n2" into
 *	there indirectly and then making that "next" field point to "n2"'s
 *	"next" field works properly.
 *
 * Inputs
 *
 *	n1    : head of list of nodes, of type listNode.
 *	n2    : node to be added, of type listNode.
 *
 */
void
addNode(n1, n2)
     TreeNode n1, n2;
{
  *(n1->vList.nextAddr) = n2;
  n1->vList.nextAddr = n2->vList.nextAddr; /* since they're all created this
					    * way anyway, we might as well
					    * use it to our advantage */
}

void
freeTree(tree)
     TreeNode tree;
{
  if (tree == nil) {
    return;
  }

  obstack_free(compilationObstack, NULL);
  obstack_init(compilationObstack);

#ifdef prev_obstacks
/**/  switch (tree->nodeType) {
/**/  case methodNodeType:
/**/    freeMethodNode(tree);
/**/    break;
/**/    
/**/  case blockNodeType:
/**/    freeBlockNode(tree);
/**/    break;
/**/
/**/  case symbolNodeType:
/**/  case unaryExprType:
/**/  case binaryExprType:
/**/  case keywordExprType:
/**/  case cascadedMessageNodeType:
/**/  case statementListType:
/**/  case returnExprType:
/**/  case assignExprType:
/**/    freeExprNode(tree);
/**/    break;
/**/    
/**/  case variableNodeType:
/**/  case keywordListType:
/**/  case variableListType:
/**/  case arrayEltListType:
/**/  case messageListType:
/**/    freeListNode(tree);
/**/    break;
/**/
/**/  case constExprType:
/**/    freeConstNode(tree);
/**/    break;
/**/
/**/  }
#endif
}





/***********************************************************************
 *
 * Internal tree construction routines.
 *
 ***********************************************************************/


static TreeNode
makeMethodNode(selectorExpr, temporaries, primitiveIndex, statements)
     TreeNode selectorExpr, temporaries, statements;
     int	primitiveIndex;
{
  TreeNode	result;

  result = makeTreeNode(methodNodeType);
  result->vMethod.selectorExpr = selectorExpr;
  result->vMethod.temporaries = temporaries;
  result->vMethod.primitiveIndex = primitiveIndex;
  result->vMethod.statements = statements;
  return (result);
}

static TreeNode
makeBlockNode(arguments, temporaries, statements)
     TreeNode arguments, temporaries, statements;
{
  TreeNode	result;

  result = makeTreeNode(blockNodeType);
  result->vBlock.arguments = arguments;
  result->vBlock.temporaries = temporaries;
  result->vBlock.statements = statements;
  return (result);
}

static TreeNode
makeListNode(nodeType, name, value)
     NodeType nodeType;
     char	*name;
     TreeNode value;
{
  TreeNode result;

  result = makeTreeNode(nodeType);
  result->vList.name = name;
  result->vList.value = value;
  result->vList.next = nil;
  result->vList.nextAddr = &result->vList.next;
  return (result);
}

static TreeNode
makeExprNode(nodeType, receiver, selector, expression)
     NodeType nodeType;
     TreeNode receiver, expression;
     OOP	selector;
{
  TreeNode result;

  result = makeTreeNode(nodeType);
  result->vExpr.receiver = receiver;
  result->vExpr.selector = selector;
  result->vExpr.expression = expression;
  return (result);
}

static TreeNode
makeTreeNode(nodeType)
     NodeType nodeType;
{
  TreeNode result;

  result = (TreeNode)obstack_alloc(compilationObstack,
    sizeof(struct TreeNodeStruct));

  result->nodeType = nodeType;
  return (result);
}

/* ### these should probably be moved over into the symbol table module, yes?*/

static OOP
makeUnarySelector(name)
     char	*name;
{
  return (internString(name));
}

static OOP
makeBinarySelector(binaryOp)
     char	*binaryOp;
{
  return (internString(binaryOp));
}




/***********************************************************************
 *
 * Internal tree destruction routines.
 *
 ***********************************************************************/

#ifdef prev_obstacks
/**/static void
/**/freeMethodNode(node)
/**/     TreeNode node;
/**/{
/**/  freeTree(node->vMethod.selectorExpr);
/**/  freeTree(node->vMethod.temporaries);
/**/  freeTree(node->vMethod.statements);
/**/  freeNode(node);
/**/}
/**/
/**/static void
/**/freeBlockNode(node)
/**/     TreeNode node;
/**/{
/**/  freeTree(node->vBlock.arguments);
/**/  freeTree(node->vBlock.temporaries);
/**/  freeTree(node->vBlock.statements);
/**/  freeNode(node);
/**/}
/**/
/**/static void
/**/freeExprNode(node)
/**/     TreeNode node;
/**/{
/**/  freeTree(node->vExpr.receiver);
/**/  freeTree(node->vExpr.expression);
/**/  freeNode(node);
/**/}
/**/
/**/static void
/**/freeListNode(node)
/**/     TreeNode node;
/**/{
/**/  freeTree(node->vList.value);
/**/  freeTree(node->vList.next);
/**/  if (node->vList.name) {
/**/    xfree(node->vList.name);
/**/  }
/**/
/**/  freeNode(node);
/**/}
/**/
/**/static void
/**/freeConstNode(node)
/**/     TreeNode node;
/**/{
/**/  switch (node->vConst.constType) {
/**/  case intConst:
/**/  case floatConst:
/**/  case charConst:
/**/  case symbolConst:
/**/    /* these have no storage of their own */
/**/    break;
/**/
/**/  case byteObjConst:
/**/    if (node->vConst.val.boVal) {
/**/      xfree(node->vConst.val.boVal);
/**/    } else {
/**/      errorf("Internal error: badly formed tree for byte object constant"); 
/**/    }
/**/    break;
/**/
/**/  case stringConst:
/**/    if (node->vConst.val.sVal) {
/**/      xfree(node->vConst.val.sVal);
/**/    } else {
/**/      errorf("Internal error: badly formed tree for string constant"); 
/**/    }
/**/    break;
/**/
/**/  case arrayConst:
/**/    freeTree(node->vConst.val.aVal);
/**/    break;
/**/
/**/  default:
/**/    errorf("Internal error: corrupted tree structure"); 
/**/  }
/**/
/**/  freeNode(node);
/**/}
/**/
/**/
/**/static void
/**/freeNode(node)
/**/     TreeNode node;
/**/{
/**/  xfree(node);
/**/}
/**/
#endif


/***********************************************************************
 *
 *	Printing routines.
 *
 ***********************************************************************/


void
printTree(node, level)
     TreeNode node;
     int level;
{
  if (node == nil) {
    indent(level);
    printf("%s\n", nilName);
    return;
  }

  switch (node->nodeType) {
  case methodNodeType:
    printMethodNode(node, level);
    break;
    
  case blockNodeType:
    printBlockNode(node, level);
    break;

  case symbolNodeType:
  case unaryExprType:
  case binaryExprType:
  case keywordExprType:
  case cascadedMessageNodeType:
  case statementListType:
  case returnExprType:
  case assignExprType:
    printExprNode(node, level);
    break;
    
  case variableNodeType:
  case keywordListType:
  case variableListType:
  case arrayEltListType:
  case messageListType:
    printListNode(node, level);
    break;

  case constExprType:
    printConstNode(node, level);
    break;

  default:
    errorf("Unknown tree note type %d\n", node->nodeType);
  }
}


static void
printListNode(node, level)
     TreeNode node;
     int level;
{
  printNodeType(node, level);
  indent(level+1);
  printf("name: %s\n", node->vList.name ? node->vList.name : nilName);
  indent(level+1);
  printf("value:\n");
  printTree(node->vList.value, level+2);
  indent(level+1);
  printf("next:\n");
  printTree(node->vList.next, level);
}

static void
printExprNode(node, level)
     TreeNode node;
     int level;
{
  printNodeType(node, level);
  indent(level+1);
  printf("selector: ");
  if (!isNil(node->vExpr.selector)) {
    printSelector(node->vExpr.selector);
  } else {
    printf("%s", nilName);
  }
  printf("\n");
    
  indent(level+1);
  printf("receiver:\n");
  printTree(node->vExpr.receiver, level+2);
  /* ??? don't print the expression for unary type things, and don't print
     the receiver for symbol nodes */
  indent(level+1);
  printf("expression:\n");
  printTree(node->vExpr.expression, level+2);
}

static void printMethodNode(node, level)
TreeNode node;
int level;
{
  printNodeType(node, level);
  indent(level+1);
  printf("selectorExpr: ");
  printTree(node->vMethod.selectorExpr, level+2);
  indent(level+1);
  /* ??? don't print the temporaries label if there are no temporaries */
  printf("temporaries:\n");
  printTree(node->vMethod.temporaries, level+2);
  indent(level+1);
  printf("statements:\n");
  printTree(node->vMethod.statements, level+2);
}

static void
printBlockNode(node, level)
     TreeNode node;
     int level;
{
  printNodeType(node, level);
  indent(level+1);
  printf("arguments:\n");
  printTree(node->vBlock.arguments, level+2);
  indent(level+1);
  /* ??? don't print the temporaries label if there are no temporaries */
  printf("temporaries:\n");
  printTree(node->vBlock.temporaries, level+2);
  indent(level+1);
  printf("statements:\n");
  printTree(node->vBlock.statements, level+2);
}

static void
printConstNode(node, level)
     TreeNode node;
     int level;
{
  indent(level);
  switch (node->vConst.constType) {
  case intConst:
    printf("int: %ld\n", node->vConst.val.iVal);
    break;

  case floatConst:
    printf("float: %g\n", node->vConst.val.fVal);
    break;

  case charConst:
    printf("char: %c\n", node->vConst.val.cVal);
    break;

  case stringConst:
    printf("string: \"%s\"\n", node->vConst.val.sVal);
    break;

  case symbolConst:
    printf("symbol: ");
    printSymbol(node->vConst.val.symVal);
    printf("\n");
    break;

  case arrayConst:
    printf("array:\n");
    printTree(node->vConst.val.aVal, level+1);
    break;
    
  default:
    errorf("Unknown constant type %d", node->vConst.constType);
  }
}


static void
printNodeType(node, level)
     TreeNode node;
     int level;
{
  indent(level);
  printf("%s\n", nodeTypeNames[ENUM_INT(node->nodeType)]);
}

/*
 *	static void indent(level)
 *
 * Description
 *
 *	Indent the output by level*2 spaces.
 *
 * Inputs
 *
 *	level : Indentation level.  C integer.
 *
 */
static void
indent(level)
     int level;
{
  for (; level > 0; level--) {
    printf("  ");
  }
}

static void
printSelector(selector)
     OOP	selector;
{
  printSymbol(selector);
}