/* dict.q: ordered dictionaries implemented by AVL trees
   $Id: dict.q,v 1.2 2004/01/28 16:54:43 agraef Exp $ */

/* This file is part of the Q programming system.

   The Q programming system 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.

   The Q programming system 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 this program; if not, write to the Free Software
   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */

include stdlib, stddecl;

public type Dict = private const nil, bin H XY D1 D2;

/* Construction and type checking: */

public emptydict;		// return the empty dictionary
public dict XYs;		// create a dictionary from a list of key/value
				// pairs
public mkdict Y Xs;		// create a dictionary from a list of keys
				// and an initial value
public isdict X;		// check whether X is a dictionary

/* Overloaded and public operations: */

// #D				// size of a dictionary
// D!X				// return the value Y associated with X in D

// null D			// tests whether D is the empty dictionary
// member D X			// tests whether D contains X as a key
// list D, members D		// list members (key-value pairs) of D in
				// ascending order
// keys D			// list the keys of D in ascending order
// vals D			// list the corresponding values

// first D, last D		// return first and last member of D
// rmfirst D, rmlast D		// remove first and last member from D
// insert D XY			// associate key X with value Y in D; update
				// an existing entry for X
// delete D X			// remove key X from D
// update D X Y			// same as insert D (X,Y)

/* Implementation: *********************************************************/

/* Private Functions: ******************************************************/

private height D;		// return height of tree
private slope D;		// return slope (height diff between left and
				// right subtree)
private mkbin XY D1 D2;		// construct node, recomputing height

private rebal D;		// rebalance tree after insertions and 
				// deletions
private rol D, ror D;		// single rotation left/right
private shl D, shr D;		// shift to left/right (single or double
				// rotation)

private join D1 D2;		// join two balanced subtrees

height nil			= 0;
height (bin H _ _ _)		= H;

slope nil			= 0;
slope (bin _ _ D1 D2)		= height D1 - height D2;

mkbin XY D1 D2			= bin (max (height D1) (height D2) + 1)
				  XY D1 D2;

rebal D				= shl D if slope D = -2;
				= shr D if slope D = 2;
				= D otherwise;

rol (bin H1 XY1 D1 (bin H2 XY2 D2 D3))
				= mkbin XY2 (mkbin XY1 D1 D2) D3;
ror (bin H1 XY1 (bin H2 XY2 D1 D2) D3)
				= mkbin XY2 D1 (mkbin XY1 D2 D3);

shl (bin H XY D1 D2)		= rol (mkbin XY D1 (ror D2))
				      if slope D2 = 1;
				= rol (bin H XY D1 D2) otherwise;

shr (bin H XY D1 D2)		= ror (mkbin XY (rol D1) D2)
				      if slope D1 = -1;
				= ror (bin H XY D1 D2) otherwise;

join nil D2			= D2;
join D1 D2			= rebal (mkbin (last D1) (rmlast D1) D2)
				      otherwise;

/* Public Functions: *******************************************************/

emptydict			= nil;
dict XYs:List			= foldl insert nil XYs;
mkdict Y Xs			= dict (zip Xs (mklist Y (#Xs)));

isdict _:Dict			= true;
isdict _			= false otherwise;

#nil				= 0;
#bin _ _ D1 D2			= #D1+#D2+1;

bin _ (X,Y) D1 D2 !X1		= D1!X1 if X>X1;
				= D2!X1 if X<X1;
				= Y if X=X1;

null nil			= true;
null _:Dict			= false otherwise;

member nil _			= false;
member (bin _ (X,_) D1 D2) X1
				= member D1 X1 if X>X1;
				= member D2 X1 if X<X1;
				= true if X=X1;

members nil			= [];
members (bin _ XY D1 D2)	= members D1 ++ [XY|members D2];

keys nil			= [];
keys (bin _ (X,_) D1 D2)	= keys D1 ++ [X|keys D2];

vals nil			= [];
vals (bin _ (_,Y) D1 D2)	= vals D1 ++ [Y|vals D2];

first (bin _ XY nil _)		= XY;
first (bin _ _ D1 _)		= first D1 otherwise;

last (bin _ XY _ nil)		= XY;
last (bin _ _ _ D2)		= last D2 otherwise;

rmfirst (bin _ _ nil D2)	= D2;
rmfirst (bin _ XY D1 D2)	= rebal (mkbin XY (rmfirst D1) D2)
				      otherwise;

rmlast (bin _ _ D1 nil)		= D1;
rmlast (bin _ XY D1 D2)		= rebal (mkbin XY D1 (rmlast D2))
				      otherwise;

insert nil (X1,Y1)		= bin 1 (X1,Y1) nil nil;
insert (bin H (X,Y) D1 D2) (X1,Y1)
				= rebal (mkbin (X,Y) (insert D1 (X1,Y1))
					 D2) if X>X1;
				= rebal (mkbin (X,Y) D1
					 (insert D2 (X1,Y1))) if X<X1;
				= bin H (X1,Y1) D1 D2 if X=X1;

delete nil _			= nil;
delete (bin _ (X,Y) D1 D2) X1	= rebal (mkbin (X,Y) (delete D1 X1) D2)
				      if X>X1;
				= rebal (mkbin (X,Y) D1 (delete D2 X1))
				      if X<X1;
				= join D1 D2 if X=X1;

update D:Dict X Y		= insert D (X,Y);

(D1:Dict = D2:Dict)		= (members D1 = members D2);
D1:Dict <> D2:Dict		= members D1 <> members D2;