/* _mtree.pkg - January 98 - by Marc Barilley    */
/* extended - November '98 - by Marc Barilley    */
/* original work - September 97 - by Romuald Bon */


/* original mention */
/**************************************************************/
/*   This package provides functions to deal with trees. Such */
/* a tree is of type :                                        */
/*                                                            */
/*                     [u0 r1 r1 r1 r1]                       */
/*                                                            */
/*   The "u0" part of this type represents the value of the   */
/* node. The first "r1" is a pointer to the father node of the*/
/* node, the second "r1" is a pointer to the firstchild of the*/
/* node, the third "r1" is a pointer to the previous brother  */
/* of the node and the last "r1" is a pointer to the next     */
/* brother of the node                                        */
/*                                                            */
/*------------------------------------------------------------*/
/*                 USER AVAILABLE FUNCTIONS:                  */
/*                                                            */
/* TREE_MkNode                                                */
/* TREE_Val                                                   */
/* TREE_Father                                                */
/* TREE_FirstChild                                            */
/* TREE_LastChild                                             */
/* TREE_NthChild                                              */
/* TREE_NextBrother                                           */
/* TREE_PreviousBrother                                       */
/*                                                            */
/* TREE_AddNodeToChildHead                                    */
/* TREE_AddNodeToChildTail                                    */
/* TREE_AddNodeAsPreviousBrother                              */
/* TREE_AddNodeAsNextBrother                                  */
/* TREE_RemoveNode                                            */
/* TREE_DsNode                                                */
/*                                                            */
/* TREE_SearchNodeWithFunction                                */
/* TREE_SearchNode                                            */
/* TREE_SearchNodeWithCoordinates                             */
/*                                                            */
/*------------------------------------------------------------*/
/*                      USED PACKAGES                         */
/*                                                            */
/* None                                                       */
/*                                                            */
/**************************************************************/

/**************************************************************/
/*   This package is an extension to package Tree.pkg         */
/*                                                            */
/*------------------------------------------------------------*/
/*                 USER AVAILABLE FUNCTIONS:                  */
/*                                                            */
/* TREE_ApplyOnTree                                           */
/* TREE_ApplyOnTreeWithReturn                                 */
/* TREE_TreeToList                                            */
/* TREE_TreeToListWithFunction                                */
/* TREE_NodePath                                              */
/* TREE_DepthNode                                             */
/* TREE_IsBrother                                             */
/*                                                            */
/*------------------------------------------------------------*/
/*                      USED PACKAGES                         */
/*                                                            */
/* locked/lib/_mlistlib.pkg                                   */
/*                                                            */
/**************************************************************/

/**************************************************************/
/*   Extension November '98                                   */
/*                                                            */
/*------------------------------------------------------------*/
/*                 USER AVAILABLE FUNCTIONS:                  */
/*                                                            */
/* TREE_SetVal                                                */
/*                                                            */
/**************************************************************/


/**************************************************************/
/**************************************************************/



/* Tree travelling order constants. Those constants are used to
	 indicate the manner of going all over a tree in search functions */
var TREE_PRE_ORDER      = 0x0;;
var TREE_POST_ORDER     = 0x1;;
var TREE_IN_ORDER       = 0x2;;
var TREE_REVERSED_ORDER = 0x3;;



/**************************************************************/
/**************************************************************/
/*                    INTERNAL FUNCTIONS                      */
/**************************************************************/
/**************************************************************/

/* Return 1 if two elements are equal else 0 */
fun TREE_Equality(NodeVal,Val)=
	NodeVal==Val;;



/* Destroy a node and its descent
			 Node : Node to destroy */
proto TREE_Destroy = fun [[u0 u1 r1 u2 r1]] [u0 u1 r1 u2 r1];;
fun TREE_Destroy(Node)=
	if (Node==nil)
	then
		nil
	else
		let Node -> [_ _ FirstChild _ NextBrother] in
		(
			TREE_Destroy FirstChild;
			TREE_Destroy NextBrother;
			mutate Node <- [_ nil nil nil nil]
		);;



/**************************************************************/
/**************************************************************/
/*                 USER CALLABLE FUNCTIONS                    */
/**************************************************************/
/**************************************************************/

/* Make a node with a given value
			 Val : Value for the created node */
proto TREE_MkNode=fun [u0] [u0 r1 r1 r1 r1];;
fun TREE_MkNode(Val)=
	[Val nil nil nil nil]
;;



/* Return the value of a node
			 Node : Node which value should be returned */
proto TREE_Val = fun [[u0 r1 r1 r1 r1]] u0;;
fun TREE_Val(Node)=
	if (Node==nil)
	then
		nil
	else
		let Node -> [Val _ _ _ _] in
			Val
;;



/* Return the father of a node
			 Node : Node which father should be returned */
proto TREE_Father = fun [[u0 r1 r1 r1 r1]] [u0 r1 r1 r1 r1];;
fun TREE_Father(Node)=
	if (Node==nil)
	then
		nil
	else
		let Node -> [_ Father _ _ _] in
			Father;;



/* Return the first child of a node
			 Node : Node which first child should be returned */
proto TREE_FirstChild = fun [[u0 r1 r1 r1 r1]] [u0 r1 r1 r1 r1];;
fun TREE_FirstChild(Node)=
	if (Node==nil)
	then
		nil
	else
		let Node -> [_ _ FirstChild _ _] in
			FirstChild;;



/* Return the last child of a node
			 Node : Node which last child should be returned */
proto TREE_LastChild = fun [[u0 r1 r1 r1 r1]] [u0 r1 r1 r1 r1];;
fun _TREE_LastChild (Node)=
  if Node==nil
  then
    nil
  else
    let Node -> [_ _ _ _ NextBrother] in
      if NextBrother==nil
      then
        Node
      else
        _TREE_LastChild NextBrother;;

fun TREE_LastChild(Node)=
	if Node==nil
	then
		nil
	else
		let Node -> [_ _ FirstChild _ _] in
		  _TREE_LastChild FirstChild;;
/*
  	let FirstChild -> [_ _ _ _ NextBrother] in
		(
			while NextBrother!=nil do
				let NextBrother -> [_ _ _ _ NBrother] in
  				set NextBrother=NBrother;
			NextBrother
		);;
*/

/* Return the nth child of a node
			 Node : Node Which Nth child should be returned
			 Nth : Position of the requested child in the child list of Node */
proto TREE_NthChild = fun [[u0 r1 r1 r1 r1] I] [u0 r1 r1 r1 r1];;
fun TREE_NthChild(Node,Nth)=
	if (Node==nil) || (Nth<0)
	then
		nil
	else
		let Node -> [_ _ Child _ _] in
		(
			while (Nth!=0) && (Child!=nil) do
			(
				let Child -> [_ _ _ _ NextBrother] in
					set Child=NextBrother;
				set Nth=Nth-1
			);
			Child
		);;



/* Return the next brother of a node
			 Node : Node which next brother should be returned */
proto TREE_NextBrother = fun [[u0 r1 r1 r1 r1]] [u0 r1 r1 r1 r1];;
fun TREE_NextBrother(Node)=
	if (Node==nil)
	then
		nil
	else
		let Node -> [_ _ _ _ NextBrother] in
			NextBrother;;



/* Return the previous brother of a node
			 Node : Node which previous brother should be returned */
proto TREE_PreviousBrother = fun [[u0 r1 r1 r1 r1]] [u0 r1 r1 r1 r1];;
fun TREE_PreviousBrother(Node)=
	if (Node==nil)
	then
		nil
	else
		let Node -> [_ _ _ PreviousBrother _] in
			PreviousBrother
;;



/* Add a node to the head of the child list of another node
			 Node : Node which NodeToAdd should be added to
			 NodeToAdd : Node to add */
proto TREE_AddNodeToChildHead = fun [[u0 r1 r1 r1 r1] [u0 r1 r1 r1 r1]] [u0 r1 r1 r1 r1];;
fun TREE_AddNodeToChildHead(Node,NodeToAdd)=
	if (Node==nil) || (NodeToAdd==nil)
	then
		nil
	else
	{
		let Node -> [_ _ FirstChild _ _] in
		(
			mutate Node <- [_ _ NodeToAdd _ _];
			if (FirstChild!=nil)
			then
				mutate FirstChild <- [_ _ _ NodeToAdd _]
			else
				nil;
			mutate NodeToAdd <- [_ Node _ nil FirstChild]
		);
  	Node
  };;



/* Add a node to the tail of the child list of another node
			 Node : Node which NodeToAdd should be added to
			 NodeToAdd : Node to add */
proto TREE_AddNodeToChildTail = fun [[u0 r1 r1 r1 r1] [u0 r1 r1 r1 r1]] [u0 r1 r1 r1 r1];;
fun TREE_AddNodeToChildTail(Node,NodeToAdd)=
	if (Node==nil) || (NodeToAdd==nil)
	then
		nil
	else
	{
		let TREE_LastChild Node -> LastChild in
			if (LastChild==nil)
			then
			(
				mutate Node <- [_ _ NodeToAdd _ _];
				mutate NodeToAdd <- [_ Node _ nil nil]
			)
			else
			(
				mutate LastChild <- [_ _ _ _ NodeToAdd];
				mutate NodeToAdd <- [_ Node _ LastChild nil]
			);
  	Node
  };;



/* Add a node as previous brother of another node
			 Node : Node which NodeToAdd should become the previous brother
			 NodeToAdd : Node to add */
proto TREE_AddNodeAsPreviousBrother = fun [[u0 r1 r1 r1 r1] [u0 r1 r1 r1 r1]] [u0 r1 r1 r1 r1];;
fun TREE_AddNodeAsPreviousBrother(Node,NodeToAdd)=
	if (Node==nil) || (NodeToAdd==nil)
	then
		nil
	else
	{
		let Node -> [_ Father _ PreviousBrother _] in
		(
			mutate Node <- [_ _ _ NodeToAdd _];
			if (PreviousBrother==nil)
			then
				if (Father!=nil)
				then
					mutate Father <- [_ _ NodeToAdd _ _]
				else
					nil
			else
				mutate PreviousBrother <- [_ _ _ _ NodeToAdd];
			mutate NodeToAdd <- [_ Father _ PreviousBrother Node]
		);
  	Node
  };;



/* Add a node as next brother of another node
			 Node : Node which NodeToAdd should become the next brother
			 NodeToAdd : Node to add */
proto TREE_AddNodeAsNextBrother = fun [[u0 r1 r1 r1 r1] [u0 r1 r1 r1 r1]] [u0 r1 r1 r1 r1];;
fun TREE_AddNodeAsNextBrother(Node,NodeToAdd)=
	if (Node==nil) || (NodeToAdd==nil)
	then
		nil
	else
	{
		let Node -> [_ Father _ _ NextBrother] in
		(
			mutate Node <- [_ _ _ _ NodeToAdd];
			if (NextBrother!=nil)
			then
				mutate NextBrother <- [_ _ _ NodeToAdd _]
			else
				nil;
			mutate NodeToAdd <- [_ Father _ Node NextBrother]
		);
  	Node
	}
;;



/* Remove a node. This function removes a node from the links to its brothers
	 and its father
			 Node : Node to remove */
proto TREE_RemoveNode = fun [[u0 r1 r1 r1 r1]] [u0 r1 r1 r1 r1];;
fun TREE_RemoveNode(Node)=
	if (Node==nil)
	then
		nil
	else
		let Node -> [_ Father _ PreviousBrother NextBrother] in
		(
			if (PreviousBrother!=nil)
			then
				mutate PreviousBrother <- [_ _ _ _ NextBrother]
			else
				if (Father!=nil)
				then
					mutate Father <- [_ _ NextBrother _ _]
				else
					nil;
			if (NextBrother!=nil)
			then
				mutate NextBrother <- [_ _ _ PreviousBrother _]
			else
				nil;
			mutate Node <- [_ nil _ nil nil];
			Father
		)
;;



/* Destroy a node. This function destroyes a node and all its descent
			 Node : Node to destroy */
proto TREE_DsNode = fun [[u0 r1 r1 r1 r1]] [u0 r1 r1 r1 r1];;
fun TREE_DsNode(Node)=
	if (Node==nil)
	then
		nil
	else
	  let TREE_RemoveNode Node -> father in
	  {
  		TREE_RemoveNode Node;
  		TREE_Destroy Node;
  		mutate Node <- [_ _ nil _ _];
  		father
    }
;;



/* Search a node of a tree according to a function of its value. It
	 returns the node if a matching value has been found else nil. If Order
	 doesn't have a correct value, the function will return nil
			 Tree : Tree the node should be searched in
			 Function : Function that compares the value of a node of the tree
									with the Val parameter and return 1 if they did match
									else 0
			 Val : Value that should be compared to the value of the node of
						 the tree when executing Function
			 Order : Travelling order of research (TREE_PRE_ORDER, TREE_POST_ORDER,
							 TREE_IN_ORDER or TREE_REVERSED_ORDER) */
fun TREE_SearchNodeWithFunction(Tree,Function,Val,Order)=
	if (Tree==nil) || ((Order!=TREE_PRE_ORDER) && (Order!=TREE_POST_ORDER) &&
										 (Order!=TREE_IN_ORDER) && (Order!=TREE_REVERSED_ORDER))
	then
		nil
	else
		let Tree -> [NodeVal _ FirstChild _ NextBrother] in
			if (Order==TREE_PRE_ORDER)
			then
				if (exec Function with [NodeVal Val])
				then
					Tree
				else
					let TREE_SearchNodeWithFunction FirstChild Function Val Order
					-> ChildResult in
						if (ChildResult==nil)
						then
							TREE_SearchNodeWithFunction NextBrother Function Val Order
						else
							ChildResult
			else
				if (Order==TREE_POST_ORDER)
				then
					let TREE_SearchNodeWithFunction FirstChild Function Val Order
					-> ChildResult in
						if (ChildResult==nil)
						then
							let TREE_SearchNodeWithFunction NextBrother Function Val Order
							-> BrotherResult in
								if (BrotherResult==nil)
								then
									if (exec Function with [NodeVal Val])
									then
										Tree
									else
										nil
								else
									BrotherResult
						else
							ChildResult
				else
					if (Order==TREE_IN_ORDER)
					then
						let TREE_SearchNodeWithFunction FirstChild Function Val Order
						-> ChildResult in
							if (ChildResult==nil)
							then
								if (exec Function with [NodeVal Val])
								then
									Tree
								else
									TREE_SearchNodeWithFunction NextBrother Function Val Order
							else
								ChildResult
					else
						if (Order==TREE_REVERSED_ORDER)
						then
							let TREE_SearchNodeWithFunction NextBrother Function Val Order
							-> BrotherResult in
								if (BrotherResult==nil)
								then
									let TREE_SearchNodeWithFunction FirstChild Function
																									Val Order
									-> ChildResult in
										if (ChildResult==nil)
										then
											if (exec Function with [NodeVal Val])
											then
												Tree
											else
												nil
										else
											ChildResult
								else
									BrotherResult
						else
							nil
;;



/* Search a node in a tree according to the identity of its value with
	 a given one and return that node if it was found else nil. If Order
	 doesn't have a correct value, the function also returns nil
			 Tree : Tree the node should be searched in
			 Val : Value that should be compared to the value of the node
			 Order : Travelling order of research (TREE_PRE_ORDER, TREE_POST_ORDER,
							 TREE_IN_ORDER or TREE_REVERSED_ORDER) */
fun TREE_SearchNode(Tree,Val,Order)=
	TREE_SearchNodeWithFunction Tree @TREE_Equality Val Order
;;



/* Returns the node of a tree that is at a certain location. Its location
	 is defined by a list of integers. In this list, integers that are at
	 even positions indicates the number of childs that should be passed and
	 the integers that are at odd positions in the list indicates the number
	 of brothers that should be passed. This function returns nil if no node
	 has been found at the requested coordinates
			 Tree : Tree the node should be searched in
			 Coordinates : Coordinates of the requested node

	 WARNING : Due to the meaning of Coordinates, the tree is travelled in
	 a pre-order way */
fun TREE_SearchNodeWithCoordinates(Tree,Coordinates)=
	let 0 -> DirectionFlag in
		while (Coordinates!=nil) && (Tree!=nil) do
		(
			let hd Coordinates -> Distance in
				if (Distance<0)
				then
				(
					set Tree=nil;
					nil
				)
				else
					while (Distance!=0) do
					(
						let Tree -> [_ _ FirstChild _ NextBrother] in
							set Tree=if (DirectionFlag==0)
											 then
												 FirstChild
											 else
												 NextBrother;
						set Distance=Distance-1
					);
			set DirectionFlag=DirectionFlag^1;
			set Coordinates=tl Coordinates
		);
	Tree
;;




proto TREE_ApplyOnTree = fun [[u0 r1 r1 r1 r1] fun [[u0 r1 r1 r1 r1] u1] u2 u1 I] u2;;
fun TREE_ApplyOnTree (tree, function, param, order)=
  if tree==nil
  then
    nil
  else
    let tree -> [nodeVal _ firstChild _ nextBrother] in
    if (order==TREE_PRE_ORDER)
    then
    {
      exec function with [tree param];
      TREE_ApplyOnTree firstChild  function param order;
      TREE_ApplyOnTree nextBrother function param order;
    }
    else if (order==TREE_POST_ORDER)
    then
    {
      TREE_ApplyOnTree firstChild  function param order;
      TREE_ApplyOnTree nextBrother function param order;
      exec function with [tree param];
    }
    else if (order==TREE_IN_ORDER)
    then
    {
      TREE_ApplyOnTree firstChild  function param order;
      exec function with [tree param];
      TREE_ApplyOnTree nextBrother function param order;
    }
    else if (order==TREE_REVERSED_ORDER)
    then
    {
      TREE_ApplyOnTree nextBrother function param order;
      TREE_ApplyOnTree firstChild  function param order;
      exec function with [tree param];
    }
    else
      nil;;

fun TREE_ApplyOnTreeWithReturn (tree, function, param, order)=
  if tree==nil
  then
    1
  else
    let tree -> [nodeVal _ firstChild _ nextBrother] in
    if (order==TREE_PRE_ORDER)
    then
      (exec function with [tree param]) &&
      (TREE_ApplyOnTreeWithReturn firstChild  function param order) &&
      (TREE_ApplyOnTreeWithReturn nextBrother function param order)
    else if (order==TREE_POST_ORDER)
    then
      (TREE_ApplyOnTreeWithReturn firstChild  function param order) &&
      (TREE_ApplyOnTreeWithReturn nextBrother function param order) &&
      (exec function with [tree param])
    else if (order==TREE_IN_ORDER)
    then
      (TREE_ApplyOnTreeWithReturn firstChild  function param order) &&
      (exec function with [tree param]) &&
      (TREE_ApplyOnTreeWithReturn nextBrother function param order)
    else if (order==TREE_REVERSED_ORDER)
    then
      (TREE_ApplyOnTreeWithReturn nextBrother function param order) &&
      (TREE_ApplyOnTreeWithReturn firstChild  function param order) &&
      (exec function with [tree param])
    else
      0;;

fun TREE_TreeToList (tree, order)=
  if tree==nil
  then
    nil
  else
    let tree -> [nodeVal _ firstChild _ nextBrother] in
    if (order==TREE_PRE_ORDER)
    then
      nodeVal::(listcat (TREE_TreeToList firstChild order) (TREE_TreeToList nextBrother order))
    else if (order==TREE_POST_ORDER)
    then
      listcat
        listcat (TREE_TreeToList firstChild order) (TREE_TreeToList nextBrother order)
        nodeVal::nil
    else if (order==TREE_IN_ORDER)
    then
      listcat
        listcat (TREE_TreeToList firstChild order) nodeVal::nil
        TREE_TreeToList nextBrother order
    else if (order==TREE_REVERSED_ORDER)
    then
      listcat
        listcat (TREE_TreeToList nextBrother order) (TREE_TreeToList firstChild order)
      nodeVal::nil
    else
      nil;;

fun TREE_TreeToListWithFunction (tree, function, param, order)=
  if tree==nil
  then
    nil
  else
    let tree -> [nodeVal _ firstChild _ nextBrother] in
    if (order==TREE_PRE_ORDER)
    then
      (exec function with [nodeVal param])::
      listcat
        TREE_TreeToListWithFunction firstChild  function param order
        TREE_TreeToListWithFunction nextBrother function param order
    else if (order==TREE_POST_ORDER)
    then
      listcat
        listcat
          TREE_TreeToListWithFunction firstChild  function param order
          TREE_TreeToListWithFunction nextBrother function param order
      (exec function with [nodeVal param])::nil
    else if (order==TREE_IN_ORDER)
    then
      listcat
        listcat
          TREE_TreeToListWithFunction firstChild function param order
          (exec function with [nodeVal param])::nil
        TREE_TreeToListWithFunction nextBrother function param order
    else if (order==TREE_REVERSED_ORDER)
    then
      listcat
        listcat
          TREE_TreeToListWithFunction nextBrother function param order
          TREE_TreeToListWithFunction firstChild  function param order
      (exec function with [nodeVal param])::nil
    else
      nil;;

fun TREE_NodePath (node)=
  if node==nil
  then
    nil
  else
    let node -> [_ father _ _ _] in
    listcat (TREE_NodePath father) node::nil;;

fun TREE_DepthNode (node)=
  if node==nil
  then
    0
  else
    let node -> [nodeVal Father firstChild previousBrother nextBrother] in
      1+(TREE_DepthNode Father);;

fun TREE_IsBrother (tree, node)=
  if (tree==nil) || (node==nil)
  then
    0
  else
    let tree -> [_ _ _ _ treeNextBrother] in
      (tree==node) || (TREE_IsBrother treeNextBrother node);;


fun TREE_IsBrotherByVal (node, function, val)=
	if node==nil
	then
		0
	else
		let node -> [_ _ _ _ nextBrother] in
      (exec function with [node val]) || (TREE_IsBrotherByVal nextBrother function val);;


fun TREE_BrotherByVal (node, function, val)=
	if node==nil
	then
		nil
	else
    if exec function with [node val]
    then
      node
    else
  		let node -> [_ _ _ _ nextBrother] in
        TREE_BrotherByVal nextBrother function val;;


proto TREE_SetVal = fun [[u0 r1 r1 r1 r1] u0] [u0 r1 r1 r1 r1];;
fun TREE_SetVal (node, val)=
  mutate node <- [val _ _ _ _];;