The changelog is something that will be formally defined during the
process of preparing the release. At the moment, there has been a couple
of minor fixes done in the dev trunk and-or the mozart-1-3-0-fixes
brunch, some of them will have to merged. But, the main thing is that
now the source compiles with gcc-4.0.
We are just starting with this work to gain the expertise of making
releases, so we will go through the cvs to define the changelog. We will
come up with a list soon.
Hi,
I have a wish for one of the future releases. I think that Mozart lacks
some common data structures in the standard library. I think one of the
most needed is a sorted associative container. Another such structure is
a priority queue. I wonder why those did not make it into the Mozart's
stdlib - I see it as a drawback for beginners who are used to C++'s or
Java's stdlib.
To be constructive, I attach an implementation of sorted associative
container that uses a red-black tree and a double-linked list (it is not
as generic as could be, but could be enhanced easily).
Cheers,
Filip
local
class RBTree
feat
new:% Creates a new red-black tree
fun {$} {New RBTree Init} end
isEmpty:% Checks whether the tree is empty
fun {$ T}
RootNode=T.ROOT
NilNode=T.NIL
in
@(RootNode.left)==NilNode
end
put:% Add/set Value at Key
proc {$ T Key Value}
({T Access(Key default:Value $)}.value):=Value
end
exchange:% Same as put, but retrieve the old value; throws if the key did
not exist
proc {$ T Key OldValue NewValue}
{Exchange {T Access(Key can_throw:true $)}.value OldValue NewValue}
end
condExchange:% Same as put, but retrieve the old value; uses default
value if the key did not exist
proc {$ T Key Default OldValue NewValue}
{Exchange {T Access(Key default:Default $)}.value OldValue NewValue}
end
get:% Retrieve value at key; throws if the key does not exist
fun {$ T Key}
@({T Access(Key can_throw:true $)}.value)
end
condGet:% Retrieve value at key; returns default if the key does not exist
fun {$ T Key Default}
try
@({T Access(Key can_throw:true $)}.value)
catch !NOT_FOUND_EXCEPTION then
Default
end
end
access:% Returns node the given key. If the key did not exist, creates a
new node with value Default.
%% The node has format node(key:Key value:ValueCell ...).
fun {$ T Key Default}
{RBTree.MakeExtNode {T Access(Key default:Default $)}}
end
condGetNode:%% Returns the node at the given key. Returns null if the key
does not exist.
%% The node has format node(key:Key value:ValueCell ...).
fun {$ T Key}
try
{RBTree.MakeExtNode {T Access(Key can_throw:true $)}}
catch !NOT_FOUND_EXCEPTION then
null
end
end
member:% Checks whether the key exists
fun {$ T Key}
try
_={T Access(Key can_throw:true $)}
true
catch !NOT_FOUND_EXCEPTION then
false
end
end
removeAll:% Clears the tree
proc {$ T}
RootNode=T.ROOT
NilNode=T.NIL
in
(RootNode.left):=NilNode
(RootNode.right):=NilNode
(RootNode.parent):=NilNode
end
remove:% Removes an entry
proc {$ T Key}
{T Delete({T Access(Key can_throw:true $)})}
end
silentRemove:% Removes an entry; does nothing when the key does not exist
proc {$ T Key}
try
{T Delete({T Access(Key can_throw:true $)})}
catch !NOT_FOUND_EXCEPTION then
skip
end
end
removeNode:% Removes the specified node.
proc {$ T Node}
{T Delete(Node.NODE)}
end
getNextNode:% Retrieves the next node (null if there is no next node).
fun {$ Node}
NextNode=@(Node.NODE.succ)
in
if NextNode==null then null else
{RBTree.MakeExtNode NextNode}
end
end
getPrevNode:% Retrieves the previous node (null if there is no previous
node).
fun {$ Node}
PrevNode=@(Node.NODE.prec)
in
if PrevNode==null then null else
{RBTree.MakeExtNode PrevNode}
end
end
entries:% Retrieves the entries in the form Key#Value
fun {$ T}
{T CollectEntries($)}
end
keys:% Retrieves the keys
fun {$ T}
{T CollectKeys($)}
end
items:% Retrieves the values
fun {$ T}
{T CollectValues($)}
end
mentries:% Retrieves the entries in the form Key#<Value> (i.e. value as a
modifiable cell)
fun {$ T}
{T CollectMEntries($)}
end
entryRange:% Retrieves all entries with LBKey =< Key =< UBKey
fun {$ T LBKey UBKey}
{T CollectEntriesRange(LBKey UBKey $)}
end
keyRange:% Retrieves all keys such that LBKey =< Key =< UBKey
fun {$ T LBKey UBKey}
{T CollectKeysRange(LBKey UBKey $)}
end
itemsRange:% Retrieves all items with LBKey =< Key =< UBKey
fun {$ T LBKey UBKey}
{T CollectValuesRange(LBKey UBKey $)}
end
mentryRange:% Retrieves all modifiable entries with LBKey =< Key =< UBKey
fun {$ T LBKey UBKey}
{T CollectMEntriesRange(LBKey UBKey $)}
end
getKeyLB:% Retrieves the key that is greater or equal to the specified
lower bound; Default if there is no such key
fun {$ T LBKey Default}
Node={T FindLB(LBKey $)}
in
if Node==T.NIL then
Default
else
@(Node.key)
end
end
getKeyUB:% Retrieves the key that is smaller or equal to the specified
upper bound; Default if there is no such key
fun {$ T UBKey Default}
Node={T FindUB(UBKey $)}
in
if Node==T.NIL then
Default
else
@(Node.key)
end
end
firstKey:% Returns the first key; Default if the tree is empty
fun {$ T Default}
FirstNode=@(T.NIL.succ)
in
if FirstNode==T.NIL then
Default
else
@(FirstNode.key)
end
end
lastKey:% Returns the last key; Default if the tree is empty
fun {$ T Default}
LastNode=@(T.NIL.prec)
in
if LastNode==T.NIL then
Default
else
@(LastNode.key)
end
end
listAdd:% Adds an entry to the list stored under Key.
proc {$ T Key Value}
Node={T Access(Key default:nil $)}
in
(Node.value):=Value|@(Node.value)
end
listRemove:% Removes an entry from the list stored under Key; if the list
becomes empty, removes the Key.
proc {$ T Key Value}
try
Node={T Access(Key can_throw:true $)}
L
in
L={Filter @(Node.value) fun {$ V2} V2\=Value end}
if L\=nil then
(Node.value):=L
else
{T Delete(Node)}
end
catch !NOT_FOUND_EXCEPTION then
skip %% The key did not exist
end
end
%%=============================================================
%% Implementation
%%=============================================================
%% The root and nil nodes
NOT_FOUND_EXCEPTION:unit
NODE:unit
ROOT
NIL
MakeExtNode:%
fun {$ Node}
node(NODE:Node key:@(Node.key) value:Node.value)
end
NewNode:% Creates a new node
fun {$ Key Value Color PLR}
node(parent:{NewCell PLR}
left:{NewCell PLR}
right:{NewCell PLR}
color:{NewCell Color}
key:{NewCell Key}
value:{NewCell Value}
prec:{NewCell PLR}
succ:{NewCell PLR}
)
end
meth Init
NilNode
in
NilNode={RBTree.NewNode null null black NilNode}
self.ROOT={RBTree.NewNode null null black NilNode}
self.NIL=NilNode
end
meth RotateLeft(Node)
Right=@(Node.right)
RightLeft=@(Right.left)
NodeParent=@(Node.parent)
in
(Node.right):=RightLeft
if RightLeft\=self.NIL then (RightLeft.parent):=Node end
(Right.parent):=NodeParent
if Node==@(NodeParent.left) then
(NodeParent.left):=Right
else
(NodeParent.right):=Right
end
(Right.left):=Node
(Node.parent):=Right
end
meth RotateRight(Node)
Left=@(Node.left)
LeftRight=@(Left.right)
NodeParent=@(Node.parent)
in
(Node.left):=LeftRight
if LeftRight\=self.NIL then (LeftRight.parent):=Node end
(Left.parent):=NodeParent
if Node==@(NodeParent.left) then
(NodeParent.left):=Left
else
(NodeParent.right):=Left
end
(Left.right):=Node
(Node.parent):=Left
end
meth FindLB(Key $)
X={NewCell null}
Y={NewCell null}
in
Y:=self.ROOT
X:=@(self.ROOT.left)
case
for while:@X\=self.NIL return:R default:false do
[EMAIL PROTECTED]
in
if @(XNode.key) == Key then
{R true}
elseif @(XNode.key) > Key then
X:=@(XNode.left)
else
X:=@(XNode.right)
end
Y:=XNode
end
of true then
@X
else
if @Y==self.ROOT then
self.NIL
else
YKey=@(@Y.key)
in
if Key<YKey then
@Y
else
@(@Y.succ)
end
end
end
end
meth FindUB(Key $)
X={NewCell null}
Y={NewCell null}
in
Y:=self.ROOT
X:=@(self.ROOT.left)
case
for while:@X\=self.NIL return:R default:false do
[EMAIL PROTECTED]
in
if @(XNode.key) == Key then
{R true}
elseif @(XNode.key) > Key then
X:=@(XNode.left)
else
X:=@(XNode.right)
end
Y:=XNode
end
of true then
@X
else
if @Y==self.ROOT then
self.NIL
else
YKey=@(@Y.key)
in
if Key>YKey then
@Y
else
@(@Y.prec)
end
end
end
end
%% Returns Node at Key; uses Default as the initial value.
%% When CanThrow==true, it throws NOT_FOUND_EXCEPTION rather than
creating a new node.
meth Access(Key can_throw:CanThrow<=false default:Default<=_ $)
X={NewCell null}
Y={NewCell null}
in
Y:=self.ROOT
X:=@(self.ROOT.left)
case
for while:@X\=self.NIL return:R default:false#_ do
[EMAIL PROTECTED]
in
Y:=XNode
if @(XNode.key) == Key then
{R true#XNode}
elseif @(XNode.key) > Key then
X:=@(XNode.left)
else
X:=@(XNode.right)
end
end
of true#FoundNode then
FoundNode
else
if CanThrow then
raise NOT_FOUND_EXCEPTION end
end
local
[EMAIL PROTECTED]
Node={RBTree.NewNode Key Default red self.NIL}
X={NewCell Node}
in
(Node.parent):=YNode
if YNode==self.ROOT then
(YNode.left):=Node
(self.NIL.succ):=Node
(self.NIL.prec):=Node
else
if @(YNode.key)>Key then
YNodePrec=@(YNode.prec)
in
(YNode.prec):=Node
(YNodePrec.succ):=Node
(Node.prec):=YNodePrec
(Node.succ):=YNode
(YNode.left):=Node
else
YNodeSucc=@(YNode.succ)
in
(YNode.succ):=Node
(YNodeSucc.prec):=Node
(Node.succ):=YNodeSucc
(Node.prec):=YNode
(YNode.right):=Node
end
end
%% Do the rotations...
for while:@(@(@X.parent).color)==red do
[EMAIL PROTECTED]
Parent=@(Node.parent)
Grandparent=@(Parent.parent)
in
if Parent==@(Grandparent.left) then
Uncle=@(Grandparent.right)
in
if @(Uncle.color)==red then
(Parent.color):=black
(Uncle.color):=black
(Grandparent.color):=red
X:=Grandparent
else
if Node==@(Parent.right) then
X:=Parent
RBTree, RotateLeft(Parent)
end
local
[EMAIL PROTECTED]
Parent=@(Node.parent)
Grandparent=@(Parent.parent)
in
(Parent.color):=black
(Grandparent.color):=red
RBTree, RotateRight(Grandparent)
end
end
else
Uncle=@(Grandparent.left)
in
if @(Uncle.color)==red then
(Parent.color):=black
(Uncle.color):=black
(Grandparent.color):=red
X:=Grandparent
else
if Node==@(Parent.left) then
X:=Parent
RBTree, RotateRight(Parent)
end
local
[EMAIL PROTECTED]
Parent=@(Node.parent)
Grandparent=@(Parent.parent)
in
(Parent.color):=black
(Grandparent.color):=red
RBTree, RotateLeft(Grandparent)
end
end
end
end
(@(self.ROOT.left).color):=black
%% Return the new node
Node
end
end
end
meth Successor(Node $)
Right=@(Node.right)
Y={NewCell Right}
in
if Right\=self.NIL then
for while:@(@Y.left)\=self.NIL do
Y:=@(@Y.left)
end
@Y
else
X={NewCell Node}
in
Y:=@(Node.parent)
for while:@X==@(@Y.right) do
X:[EMAIL PROTECTED]
Y:=@(@Y.parent)
end
if @Y==self.ROOT then
self.NIL
else
@Y
end
end
end
meth Predecessor(Node $)
Left=@(Node.left)
Y={NewCell Left}
in
if Left\=self.NIL then
for while:@(@Y.right)\=self.NIL do
Y:=@(@Y.right)
end
@Y
else
X={NewCell Node}
in
Y:=@(Node.parent)
for return:R do
[EMAIL PROTECTED]
[EMAIL PROTECTED]
in
if XNode\=@(YNode.left) then
{R YNode}
elseif YNode==self.ROOT then
{R self.NIL}
end
X:=YNode
Y:=@(YNode.parent)
end
end
end
meth DeleteFixUp(Node)
RootLeftNode=@(self.ROOT.left)
X={NewCell Node}
in
for
while:(@X.color)==black andthen @X\=RootLeftNode
break:B
do
[EMAIL PROTECTED]
Parent=@(Node.parent)
in
if Node==@(Parent.left) then
W={NewCell @(Parent.right)}
WColorC=(@W.color)
in
if @WColorC==red then
WColorC:=black
(Parent.color):=red
RBTree, RotateLeft(Parent)
W:=@(@(@X.parent).right)
end
local
Parent=@(@X.parent)
[EMAIL PROTECTED]
WNodeRightColorC=@(WNode.right).color
WNodeLeftColorC=@(WNode.left).color
in
if @WNodeRightColorC==black andthen @WNodeLeftColorC==black
then
(WNode.color):=red
X:=Parent
else
if @WNodeRightColorC==black then
WNodeLeftColorC:=black
(WNode.color):=red
RBTree, RotateRight(WNode)
W:=@(Parent.right)
end
local
[EMAIL PROTECTED]
in
(WNode.color):=@(Parent.color)
(Parent.color):=black
(@(WNode.right).color):=black
RBTree, RotateLeft(Parent)
{B}
end
end
end
else
W={NewCell @(Parent.left)}
WColorC=(@W.color)
in
if @WColorC==red then
WColorC:=black
(Parent.color):=red
RBTree, RotateRight(Parent)
W:=@(@(@X.parent).left)
end
local
Parent=@(@X.parent)
[EMAIL PROTECTED]
WNodeRightColorC=@(WNode.right).color
WNodeLeftColorC=@(WNode.left).color
in
if @WNodeRightColorC==black andthen @WNodeLeftColorC==black
then
(WNode.color):=red
X:=Parent
else
if @WNodeLeftColorC==black then
WNodeRightColorC:=black
(WNode.color):=red
RBTree, RotateLeft(WNode)
W:=@(Parent.left)
end
local
[EMAIL PROTECTED]
in
(WNode.color):=@(Parent.color)
(Parent.color):=black
(@(WNode.left).color):=black
RBTree, RotateRight(Parent)
{B}
end
end
end
end
end
(@X.color):=black
end
meth Delete(Node)
YNode=if @(Node.left)==self.NIL orelse @(Node.right)==self.NIL then
Node
else
RBTree, Successor(Node $)
end
XNode=if @(YNode.left)==self.NIL then @(YNode.right) else
@(YNode.left) end
Prec=@(Node.prec)
Succ=@(Node.succ)
in
(Prec.succ):=Succ
(Succ.prec):=Prec
(XNode.parent):=@(YNode.parent)
if self.ROOT==@(YNode.parent) then
(self.ROOT.left):=XNode
else
YParentNode=@(YNode.parent)
in
if YNode==@(YParentNode.left) then
(YParentNode.left):=XNode
else
(YParentNode.right):=XNode
end
end
if YNode\=Node then
Parent=@(Node.parent)
Left=@(Node.left)
Right=@(Node.right)
in
(YNode.left):=Left
(YNode.right):=Right
(YNode.parent):=Parent
(Left.parent):=YNode
(Right.parent):=YNode
if Node==@(Parent.left) then
(Parent.left):=YNode
else
(Parent.right):=YNode
end
if @(YNode.color)==black then
(YNode.color):=red
RBTree, DeleteFixUp(XNode)
else
(YNode.color):=@(Node.color)
end
else
if @(YNode.color)==black then
RBTree, DeleteFixUp(XNode)
end
end
end
meth CollectEntries($)
fun {CollectEntry Node}
if Node==self.NIL then
nil
else
@(Node.key)#@(Node.value) | {CollectEntry @(Node.succ)}
end
end
in
{CollectEntry @(self.NIL.succ)}
end
meth CollectKeys($)
fun {CollectKey Node}
if Node==self.NIL then
nil
else
@(Node.key) | {CollectKey @(Node.succ)}
end
end
in
{CollectKey @(self.NIL.succ)}
end
meth CollectValues($)
fun {CollectValue Node}
if Node==self.NIL then
nil
else
@(Node.value) | {CollectValue @(Node.succ)}
end
end
in
{CollectValue @(self.NIL.succ)}
end
meth CollectMEntries($)
fun {CollectMEntry Node}
if Node==self.NIL then
nil
else
@(Node.key)#(Node.value) | {CollectMEntry @(Node.succ)}
end
end
in
{CollectMEntry @(self.NIL.succ)}
end
meth CollectEntriesRange(LB UB $)
fun {CollectEntryUB Node}
if Node==self.NIL orelse @(Node.key)>UB then
nil
else
@(Node.key)#@(Node.value) | {CollectEntryUB @(Node.succ)}
end
end
in
{CollectEntryUB RBTree, FindLB(LB $)}
end
meth CollectKeysRange(LB UB $)
fun {CollectKeyUB Node}
if Node==self.NIL orelse @(Node.key)>UB then
nil
else
@(Node.key) | {CollectKeyUB @(Node.succ)}
end
end
in
{CollectKeyUB RBTree, FindLB(LB $)}
end
meth CollectValuesRange(LB UB $)
fun {CollectValueUB Node}
if Node==self.NIL orelse @(Node.key)>UB then
nil
else
@(Node.value) | {CollectValueUB @(Node.succ)}
end
end
in
{CollectValueUB RBTree, FindLB(LB $)}
end
meth CollectMEntriesRange(LB UB $)
fun {CollectMEntryUB Node}
if Node==self.NIL orelse @(Node.key)>UB then
nil
else
@(Node.key)#(Node.value) | {CollectMEntryUB @(Node.succ)}
end
end
in
{CollectMEntryUB RBTree, FindLB(LB $)}
end
end
in
{Browse {RBTree.new}}
end_________________________________________________________________________________
mozart-users mailing list
[email protected]
http://www.mozart-oz.org/mailman/listinfo/mozart-users
