Below is one of the "interesting" programs. This one is an implementation of balanced "AA" trees. This doesn't illustrate any explicit parallelism, but does illustrate creating and updating interesting data structures without using explicit pointers. Pointer-free data structures allow the compiler to easily understand any aliasing, since there is no hidden sharing between distinct objects. That allows the compiler to eliminate race conditions at compile-time.
Here is the interface to the AA_Tree module. (As a side-note, the program that "HTML"-ized this code was itself written in ParaSail. I've included it at the bottom of this posting.)
interface AA_Tree<Element is Comparable<>> is
// This module implements a balanced "AA" tree, originally
// described by Arne Andersson in the "Proceedings of the Workshop
// on Algorithms and Data Structures," pp 60-71, Springer Verlag, 1993.
// The following algorithm and descriptions were taken from the
// WikiPedia article on AA_Tree:
// http://en.wikipedia.org/wiki/AA_tree
// Note that various additional checks for a null tree have been added.
// Only two operations are needed for maintaining balance in an AA tree.
// These operations are called skew and split. Skew is a right rotation
// when an insertion or deletion creates a left horizontal link. Split
// is a conditional left rotation when an insertion or deletion creates two
// horizontal right links, which once again corresponds to two
// consecutive red links in red-black trees.
op "[]"() -> optional AA_Tree;
// Create an empty tree
func Insert(var T : optional AA_Tree; X : Element);
// input: X, the value to be inserted, and
// T, the root of the tree to insert it into.
// output: A balanced T' including X.
func Delete(var T : optional AA_Tree; X : Element);
// input: X, the value to delete, and T,
// the root of the tree from which it should be deleted.
// output: T', balanced, without the value X.
op "in"(X : Element; T : optional AA_Tree) -> Boolean;
func Overlapping(T : optional AA_Tree; X : Element) -> optional Element;
// input: X, the value to find, and T,
// the root of the tree to be searched.
// output: the element equal to or "unordered" relative to X.
op "|="(var T : optional AA_Tree; X : Element);
func First(T : optional AA_Tree) -> optional Element;
// Return first (smallest) element in tree
func Last(T : optional AA_Tree) -> optional Element;
// Return last (greatest) element in tree
func Remove_First(var T : optional AA_Tree) -> optional Element;
// Remove first (smallest) element in tree
func Remove_Last(var T : optional AA_Tree) -> optional Element;
// Remove last (greatest) element in tree
func Remove_Any(var T : optional AA_Tree) -> optional Element;
// Remove some element from tree
func Count(T : optional AA_Tree) -> Univ_Integer;
// Return a count of the nodes in the tree
end interface AA_Tree;
Here is the class that provides the implementation for the AA_Tree module:class AA_Tree is
var Left : optional AA_Tree;
var Right : optional AA_Tree;
var Value : Element;
var Level : Univ_Integer := 0;
func Node(Value : Element; Level : Univ_Integer; Left : optional AA_Tree;
Right : optional AA_Tree) -> AA_Tree is
// Create a new tree.
return (Left => Left, Right => Right, Value => Value,
Level => Level);
end func Node;
func Is_Leaf(T : optional AA_Tree) -> Boolean is
return T not null and then
T.Left is null and then T.Right is null;
end func Is_Leaf;
func Leftmost(ref T : optional AA_Tree) -> ref optional AA_Tree is
for L => T loop
if L not null and then L.Left not null then
// Continue with Left until we reach null
continue loop with L.Left;
else
// Found left-most
return L;
end if;
end loop;
end func Leftmost;
func Successor(T : optional AA_Tree) -> optional Element is
// Return element in tree greater than but closest to T.Value
if T.Right not null then
return Leftmost(T.Right).Value;
else
return null;
end if;
end func Successor;
func Rightmost(ref T : optional AA_Tree) -> ref optional AA_Tree is
for R => T loop
if R not null and then R.Right not null then
// Keep following down Right side
continue loop with R.Right;
else
// Found right-most
return R;
end if;
end loop;
end func Rightmost;
func Predecessor(T : optional AA_Tree) -> optional Element is
// Return element in tree less than but closest to T.Value
if T.Left not null then
return Rightmost(T.Left).Value;
else
return null;
end if;
end func Predecessor;
func Skew(var T : optional AA_Tree) is
// input: T, a node representing an AA tree that needs to be rebalanced.
// output: T' Another node representing the rebalanced AA tree.
if T not null and then
T.Left not null and then
T.Left.Level == T.Level then
// The current T.Left becomes new root
// Exchange value of T.Left with root
T.Value <=> T.Left.Value;
// Move old root and T.Left.Right over to right side of tree
T.Left.Right <=> T.Right;
T.Left.Left <=> T.Right;
T.Left <=> T.Right;
end if;
end func Skew;
func Split(var T : optional AA_Tree) is
// input: T, a node representing an AA tree that needs to be rebalanced.
// output: T' Another node representing the rebalanced AA tree.
if T not null and then
T.Right not null and then
T.Right.Right not null and then
T.Level == T.Right.Right.Level then
// T.Right becomes the new root
// Exchange value and level between root and T.Right
T.Value <=> T.Right.Value;
T.Level <=> T.Right.Level;
// Move old root and T.Right.Left to left side of tree
T.Left <=> T.Right.Right;
T.Right.Left <=> T.Right.Right;
T.Left <=> T.Right;
// Increment level
T.Level += 1;
end if;
end func Split;
func Decrease_Level(var T : optional AA_Tree) is
// input: T, a tree for which we want to remove links that skip levels.
// output: T with its level decreased.
if T is null then
return;
end if;
var Should_Be : Univ_Integer := 1;
if T.Left not null then
Should_Be := T.Left.Level + 1;
end if;
if T.Right not null then
Should_Be := Min(Should_Be, T.Right.Level + 1);
end if;
if Should_Be < T.Level then
T.Level := Should_Be;
if T.Right not null and then
Should_Be < T.Right.Level then
T.Right.Level := Should_Be;
end if;
end if;
end func Decrease_Level;
exports
op "[]"() -> optional AA_Tree is
// Create an empty tree
return null;
end op "[]";
// Insertion begins with the normal binary tree search and insertion
// procedure. Then, as the call stack unwinds (assuming a recursive
// implementation of the search), it's easy to check the validity of the
// tree and perform any rotations as necessary. If a horizontal left link
// arises, a skew will be performed, and if two horizontal right links
// arise, a split will be performed, possibly incrementing the level of the
// new root node of the current subtree. Note, in the code as given above,
// the increment of T.Level. This makes it necessary to continue checking
// the validity of the tree as the modifications bubble up from the leaves.
func Insert(var T : optional AA_Tree; X : Element) is
// input: X, the value to be inserted, and
// T, the root of the tree to insert it into.
// output: A balanced T' including X.
// Do the normal binary tree insertion procedure.
// Set the result of the recursive call to the correct
// child in case a new node was created or the
// root of the subtree changes.
if T is null then
// Create a new leaf node with X.
T := Node(X, 1, null, null);
return;
end if;
case X =? T.Value of
[#less] =>
Insert(T.Left, X);
[#greater] =>
Insert(T.Right, X);
[#equal | #unordered] =>
// Note that the case of X == T.Value is unspecified.
// As given, an insert will have no effect.
// The implementor may desire different behavior.
return;
end case;
// Perform skew and then split.
// The conditionals that determine whether or
// not a rotation will occur or not are inside
// of the procedures, as given above.
Skew(T);
Split(T);
end func Insert;
// As in most balanced binary trees, the deletion of an internal node can
// be turned into the deletion of a leaf node by swapping the internal node
// with either its closest predecessor or successor, depending on which are
// in the tree or on the implementor's whims. Retrieving a predecessor is
// simply a matter of following one left link and then all of the remaining
// right links. Similarly, the successor can be found by going right once
// and left until a null pointer is found. Because of the AA property of
// all nodes of level greater than one having two children, the successor
// or predecessor node will be in level 1, making their removal trivial.
//
// To re-balance a tree, there are a few approaches. The one described by
// Andersson in his original paper is the simplest, and it is described
// here, although actual implementations may opt for a more optimized
// approach. After a removal, the first step to maintaining tree validity
// is to lower the level of any nodes whose children are two levels below
// them, or who are missing children. Then, the entire level must be skewed
// and split. This approach was favored, because when laid down
// conceptually, it has three easily understood separate steps:
//
// Decrease the level, if appropriate.
// Skew the level.
// Split the level.
//
// However, we have to skew and split the entire level this time instead of
// just a node, complicating our code.
func Delete(var T : optional AA_Tree; X : Element) is
// input: X, the value to delete, and T,
// the root of the tree from which it should be deleted.
// output: T', balanced, without the value X.
if T is null then
// Not in tree -- should we complain?
return;
end if;
case X =? T.Value of
[#less] =>
Delete(T.Left, X);
[#greater] =>
Delete(T.Right, X);
[#equal] =>
// If we're a leaf, easy, otherwise reduce to leaf case.
if Is_Leaf(T) then
T := null;
elsif T.Left is null then
// Get successor value and delete it from right tree,
// and set root to have that value
const Succ := Successor(T);
Delete(T.Right, Succ);
T.Value := Succ;
else
// Get predecessor value and delete it from left tree,
// and set root to have that value
const Pred := Predecessor(T);
Delete(T.Left, Pred);
T.Value := Pred;
end if;
[#unordered] =>
// Not in tree; should we complain?
return;
end case;
// Rebalance the tree. Decrease the level of all nodes in this level if
// necessary, and then skew and split all nodes in the new level.
if T is null then
return;
end if;
Decrease_Level(T);
Skew(T);
Skew(T.Right);
if T.Right not null then
Skew(T.Right.Right);
end if;
Split(T);
Split(T.Right);
end func Delete;
op "in"(X : Element; T : optional AA_Tree) -> Result : Boolean is
for P => T while P not null loop
case X =? P.Value of
[#less] =>
continue loop with P.Left;
[#greater] =>
continue loop with P.Right;
[#equal] =>
return #true;
[#unordered] =>
return #false;
end case;
end loop;
return #false; // Not found
end op "in";
func First(T : optional AA_Tree) -> optional Element is
// Return first (smallest) element in tree
if T is null then
return null;
else
return Leftmost(T).Value;
end if;
end func First;
func Last(T : optional AA_Tree) -> optional Element is
// Return last (greatest) element in tree
if T is null then
return null;
else
return Rightmost(T).Value;
end if;
end func Last;
func Remove_First(var T : optional AA_Tree) -> Result : optional Element is
// Remove first (smallest) element in tree
Result := First(T);
if Result not null then
Delete(T, Result);
end if;
end func Remove_First;
func Remove_Last(var T : optional AA_Tree) -> Result : optional Element is
// Remove last (greatest) element in tree
Result := Last(T);
if Result not null then
Delete(T, Result);
end if;
end func Remove_Last;
func Remove_Any(var T : optional AA_Tree) -> Result : optional Element is
// Remove some element from tree
if T is null then
return null;
end if;
Result := T.Value;
if Result not null then
Delete(T, Result);
end if;
end func Remove_Any;
func Count(T : optional AA_Tree) -> Univ_Integer is
// Return a count of the nodes in the tree
if T is null then
return 0;
else
return Count(T.Left) + Count(T.Right) + 1;
end if;
end func Count;
op "|="(var T : optional AA_Tree; X : Element) is
Insert(T, X);
end op "|=";
func Overlapping(T : optional AA_Tree; X : Element) -> optional Element is
// input: X, the value to find, and T,
// the root of the tree to be searched.
// output: the element equal to or "unordered" relative to X.
if T is null or else T.Value is null then
return null;
else
case X =? T.Value of
[#less] =>
return Overlapping(T.Left, X);
[#greater] =>
return Overlapping(T.Right, X);
[#equal | #unordered] =>
// Close enough
return T.Value;
end case;
end if;
end func Overlapping;
end class AA_Tree;Here is a small test program for AA_Tree:func Test_AA_Tree(A : Univ_Integer; B : Univ_Integer; C : Univ_Integer) is
type Univ_Tree is AA_Tree<Univ_Integer>;
var T : Univ_Tree := [];
var X : Univ_Integer := A;
Insert(T, A);
Println("Count = " | Count(T) | " after insert of " | A);
Insert(T, B);
Println("Count = " | Count(T) | " after insert of " | B);
Insert(T, C);
Println("Count = " | Count(T) | " after insert of " | C);
Insert(T, A);
Println("Count = " | Count(T) | " after another insert of " | A);
Println(A | " in T = " | [[A in T]]);
Println(B | " in T = " | [[B in T]]);
Println(C | " in T = " | [[C in T]]);
Println("7 in T = " | [[7 in T]]);
for E := Remove_First(T) then Remove_First(T) while E not null loop
Println("Remove_First = " | E);
end loop;
Println("Count after loop : " | Count(T));
for I in 1..10 forward loop
Insert(T, I);
Println("Count = " | Count(T) | " after insert of " | I);
end loop;
for L := Remove_Last(T) then Remove_Last(T) while L not null loop
Println("Remove_Last = " | L);
end loop;
Println("Count after loop : " | Count(T));
for J in 1..10 reverse loop
Insert(T, J);
Println("Count = " | Count(T) | " after insert of " | J);
end loop;
Println("Count after loop : " | Count(T));
Println("Overlapping(T, 5) = " | Overlapping(T, 5));
for Z := Remove_Any(T) then Remove_Any(T) while Z not null loop
Println("Remove_Any = " | Z);
end loop;
Println("Count after loop : " | Count(T));
for K in 1..10 loop
Insert(T, K);
Println("Count = " | Count(T) | " after insert of " | K);
end loop;
for F := Remove_First(T) then Remove_First(T) while F not null loop
Println("Remove_First = " | F);
end loop;
Println("Count after loop : " | Count(T));
end func Test_AA_Tree;Here is the ParaSail program that was used to "HTML"-ize the listings above (as well as the one below!). Not terribly sophisticated, but illustrates some of the character handling:func Html_Escape(C : Univ_Character) -> Univ_String is
// Do single-character escapes
case C of
['<'] =>
return "<";
['>'] =>
return ">";
['&'] =>
return "&";
['\\'] =>
return "\\"; // Prevent "Print" from expanding control chars
[..] =>
return "" | C; // Convert character into a string
end case;
end func Html_Escape;
func Htmlize_Line(Orig : Univ_String) -> Result : Univ_String is
// bold lower case words that are not in comments or
// character, string, or enum literals
Result := "";
var I := 1;
const L := Length(Orig);
var State : Univ_Enumeration := #other;
while I <= L loop
var C := Orig[I];
case C of
['\\'] =>
if State == #string_literal or else State == #char_literal then
// skip next character no matter what it is
if I < L then
Result |= Html_Escape(C);
I += 1;
C := Orig[I];
end if;
end if;
['/'] =>
if I < L and then Orig[I+1] == '/' then
// comment, italicize it
Result |= "<i>" | Html_Escape(C);
while I < L loop
I += 1;
Result |= Html_Escape(Orig[I]);
end loop;
Result |= "</i>";
C := null;
end if;
['a' .. 'z'] =>
if State == #other then
// Presume this is a reserved word, so bold it
Result |= "<b>" | C;
while I < L and then Orig[I+1] in 'a' .. 'z' loop
I += 1;
Result |= Orig[I];
end loop;
Result |= "</b>";
C := null;
end if;
['#' | '0'..'9' | 'A' .. 'Z' | '_'] =>
// Presume this is not a reserved word, pass through as is
if State == #other then
State := #unreserved;
end if;
['"'] =>
if State == #string_literal then
// End of string literal
State := #other;
elsif State != #char_literal then
State := #string_literal;
end if;
['\''] =>
if State == #char_literal then
// End of char literal
State := #other;
elsif State != #string_literal then
State := #char_literal;
end if;
[..] =>
if State != #string_literal and then State != #char_literal then
State := #other;
end if;
end case;
if C not null then
Result |= Html_Escape(C);
end if;
I += 1;
end loop;
Println(Result);
end func Htmlize_Line;
func Htmlize() is
// Htmlize the standard input,
// putting the result on the standard output
Println("<pre>");
loop
const Line : Univ_String := Readln();
if Line is null then
// End of file indicated by "null"
exit loop;
end if;
Htmlize_Line(Line);
end loop;
Println("</pre>");
end func Htmlize;
