language-Modula2-0.1: examples/Modula-2_Libraries/C.-Lins_Modula-2_Software_Component_Library/Vol1/STACKS/STKSUMI.MOD
(*
7.2 StackSUMI Implementation
*)
IMPLEMENTATION MODULE StkSUMI;
(*===========================================================
Version : 1.00 28 Apr 1989 C. Lins
Compiler : JPI TopSpeed Modula-2 Compiler
Code Size: R- bytes
Component: Monolithic Structures - Stack (Opaque)
Sequential Unbounded Managed Iterator
INTRODUCTION
This module provides the implementation for the operations
of the unbounded stack abstract data type.
REVISION HISTORY
v1.00 28 Apr 1989 C. Lins:
Initial implementation for JPI Modula-2.
===========================================================*)
FROM JPIStorage IMPORT
(*--Proc*) Allocate, Deallocate;
FROM Items IMPORT
(*--Cons*) NullItem, NoDisposeProc,
(*--Type*) Item, AssignProc, DisposeProc, AccessProc, ChangeProc,
LoopAccessProc, LoopChangeProc, CompareProc;
FROM Relations IMPORT
(*--Type*) Relation;
FROM ErrorHandling IMPORT
(*--Type*) HandlerProc,
(*--Proc*) NullHandler, ExitOnError, Raise;
FROM StackEnum IMPORT
(*--Type*) Exceptions, Operations, ComponentID;
FROM TypeManager IMPORT
(*--Cons*) NullType,
(*--Type*) TypeID,
(*--Proc*) AssignOf, DisposeOf, CompareOf;
(*--------------------*)
(*
7.2.1 Internal Unbounded Stack Representation
Figure 7.1
7.2.1.1 Stack Header
For the internal representation of an unbounded stack we will use a singly linked list of
nodes, with a header node, called UnboundedStack. This header contains a pointer to the
topmost node on the stack, a count of the current stack depth, and the data type ID of the
stack. An empty stack is represented by a UnboundedStack with a Top pointer of NIL
and a Depth of zero. Where possible, a NIL value for the Stack will be accepted as a legal
value for an empty stack when this will not disrupt the semantics of the invoked
operation.
7.2.1.2 Node
Each node in the list of stack items contains the Item stored on the stack, and a link to
the node immediately beneath it. The link for the bottommost node on the stack will
contain a value of NIL to represent the end of the stack.
7.2.1.3 Management of Free Stack Nodes
A separate list of free nodes is kept global for all items popped from the stack. The
FreeList is effectively a FreeStack due to the LIFO management scheme employed. This
technique is used in order to minimize calls to Allocate and Deallocate system routines,
since both (though especially Allocate) involve a rather large overhead compared to the
bounded form.
7.2.1.4 Stack ╨ Representation of Depth
The cost to maintain the depth of each stack is relatively small, consisting of a field to
store the depth (a CARDINAL) and the execution cost to maintain this field whenever an
item is pushed or popped from the stack. The alternative would be to iterate over every
item in the stack to calculate the depth whenever this operation was requested. The
implementation used yields an algorithm of O(1) time complexity for determination of
the stack's depth as opposed to an O(n) algorithm at the expense of a small increase in
space complexity, and a small increase in the proportionality constants for the time
complexity of Push and Pop.
7.2.1.5 Stack ╨ Representation of an Empty Stack
The representation of an opaque type is restricted to POINTER types [Wirth85, pg. 169].
An alternative representation for an empty stack would be to use a value of NIL for the
Stack. Though this would simplify testing for an empty stack, it would complicate
primitive operations such as Pop and Clear, which would then require the Free operation
as a parameter.
7.2.2 Efficiency of Operations
Within the implementation of a component, we allow ourselves to violate the abstraction
by examining the internal components of the data structure. Repetitive invocations of
procedures supporting the abstraction may be replaced with the ╥inline╙ equivalent of the
operation. This is most commonly done when testing for the empty stack condition and
in copying items.
*)
TYPE NodePtr = POINTER TO Node;
TYPE Node = RECORD (*-- a stack node *)
item : Item; (*-- generic data item *)
next : NodePtr; (*-- next node beneath this one, if any *)
END (*-- Node *);
TYPE UnboundedStack = RECORD
dataID: TypeID; (*-- Defined data type for this stack*)
depth : CARDINAL; (*-- current stack depth, := 0 *)
top : NodePtr; (*-- current stack top := NIL *)
END (*-- UnboundedStack *);
TYPE Stack = POINTER TO UnboundedStack;
(*-----------------------*)
(*
7.2.3 Exceptions
To support the exception handling mechanism two variables are needed. The first,
stackError, is used to record the exception code from each operation; while handlers is an
array of exception handling procedures indexed by the exception code.
The routines StackError, GetHandler, and SetHandler have been previously described in
the definition module, and their operation should be readily apparent. RaiseErrIn is a
local routine used to set stackError and invoke the Raise routine of the ErrorHandling
module.
*)
VAR stackError : Exceptions;
VAR handlers : ARRAY Exceptions OF HandlerProc;
(*-----------------------*)
PROCEDURE StackError () : Exceptions (*-- out *);
BEGIN
RETURN stackError;
END StackError;
(*----------------------------*)
PROCEDURE GetHandler ( theError : Exceptions (*-- in *))
: HandlerProc (*-- out *);
BEGIN
RETURN handlers[theError];
END GetHandler;
(*----------------------------*)
PROCEDURE SetHandler ( theError : Exceptions (*-- in *);
theHandler : HandlerProc (*-- in *));
BEGIN
handlers[theError] := theHandler;
END SetHandler;
(*----------------------------*)
PROCEDURE RaiseErrIn ( theRoutine : Operations (*-- in *);
theError : Exceptions (*-- in *));
BEGIN
stackError := theError;
Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
END RaiseErrIn;
(*----------------------------*)
(* ╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤
µ Local µ Local µ Local µ Local µ Local µ Local µ
╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤ *)
MODULE FreeListMgr;
(*-- This local module controls access to the Available node list.
-- Version 1.00 07 Jun. 1987 C. Lins *)
IMPORT Node, NodePtr, Allocate, Deallocate;
EXPORT FreeNode, GetNode;
VAR FreeList : NodePtr; (*-- Free list of available stack nodes *)
(*----------------------------*)
(*
FreeNode adds the given node to the front of the free list. theNode's next field is linked
to the front of the free list and the node becomes the new front of the free list.
*)
PROCEDURE FreeNode (VAR theNode: NodePtr);
BEGIN
theNode^.next := FreeList;
FreeList := theNode;
END FreeNode;
(*----------------------------*)
(*
GetNode attempts to generate a new stack node. If the free list is empty, attempt to
allocate a brand new node. If the allocation attempt fails, return False and exit, otherwise
return the brand new node, a function result of True and exit. If the free list is not empty,
remove the first available node from the free list and return the used node to the caller
along with a function result of True.
*)
PROCEDURE GetNode (VAR theNode: NodePtr (*-- out *)): BOOLEAN;
BEGIN
IF (FreeList = NIL) THEN
Allocate(theNode, SIZE(Node));
IF (theNode = NIL) THEN
RETURN FALSE;
END (*--if*);
ELSE
theNode := FreeList;
FreeList := FreeList^.next;
END (*--if*);
RETURN TRUE;
END GetNode;
(*----------------------------*)
(* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ *)
(* ~~~~~ Local Module Initialization ~~~~~ *)
BEGIN
FreeList := NIL; (*-- Initialize the free list to empty. *)
END FreeListMgr;
(* ╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤
á Local á Local á Local á Local á Local á Local á
╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤╤ *)
(*
7.3.4 Constructors
Create begins by clearing the stackError field under the assumption of a successful result.
The stack header is then allocated in a local variable since the function result cannot be
manipulated but only returned. If the unbounded stack could not be allocated, the
overflow exception must be raised, and the NullStack returned.
At this point, all possibility of failure has been avoided and the unbounded stack header
can be initialized to its empty state (top is set to NIL, depth set to zero), and the data type
ID can be stored for this unbounded stack. Lastly, the new stack is returned to the caller.
Complexity: O(1).
*)
PROCEDURE Create ( theType : TypeID (*-- in *))
: Stack (*-- out *);
VAR newStack : Stack;
BEGIN
stackError := noerr;
Allocate(newStack, SIZE(UnboundedStack));
IF (newStack # NIL) THEN
WITH newStack^ DO
dataID := theType;
depth := 0;
top := NIL;
END (*--with*);
RETURN newStack;
END (*--if*);
RaiseErrIn(create, overflow);
RETURN NullStack;
END Create;
(*----------------------------*)
(*
Destroy takes advantage that Clear sets stackError to noerr and raises the undefined
stack exception. So if Clear succeeds, Destroy simply releases the allocated stack header.
Complexity: O(n).
*)
PROCEDURE Destroy (VAR theStack : Stack (*-- inout *));
BEGIN
Clear(theStack);
IF (stackError = noerr) THEN
Deallocate(theStack, SIZE(theStack^));
END (*--if*);
END Destroy;
(*----------------------------*)
(*
After initializing stackError and verifying that the given stack is a valid object, Clear
retrieves the item disposal routine associated with the stack's data type from the
TypeManager module. Then each item on the stack is deallocated followed by its stack
node. To do this safely a local variable, nodeToFree, is used to hold each node. The loop
invariant takes advantage of the fact that the bottommost stack node contains a next field
of NIL, and this will automatically cause top to contain that value once all stack nodes
have been cleared. The last step is to reset depth to zero.
Complexity O(n).
*)
PROCEDURE Clear (VAR theStack : Stack (*-- inout *));
VAR nodeToFree : NodePtr;
freeItem : DisposeProc; (*-- item disposal routine *)
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
WITH theStack^ DO
freeItem := DisposeOf(dataID);
WHILE (top # NIL) DO
nodeToFree := top;
top := top^.next;
freeItem(nodeToFree^.item);
FreeNode(nodeToFree);
END (*--while*);
depth := 0;
END (*--with*);
ELSE
RaiseErrIn(clear, undefined);
END (*--if*);
END Clear;
(*----------------------------*)
(*
Assignment for unbounded objects has the complication that overflow may occur while
adding individual stack nodes. When the target object is undefined, it must be created
using the data type attribute of the source object. If overflow does not occur, the actual
assignment can commence, otherwise its suffices to exit (Create has already raised the
exception). When the target object is defined on entry to the Assign operation, it is
sufficient to Clear the existing contents and update the data type with that of the source
stack. If the source stack is empty, the routine may simply exit. Otherwise, the top
node is copied from the source to the target, followed by a loop over the remaining items,
if any.
In order to properly copy the source stack, two node pointers are necessary: one, to loop
through each of the source nodes, and the second to keep track of the last node added to the
target stack.
The assignment operator cannot be used to copy individual items as the data type of those
items is unknown; using assignment for dynamically allocated items would cause
structural sharing of items, which is not desired.
Complexity O(mn).
*)
PROCEDURE Assign ( theStack : Stack (*-- in *);
VAR toStack : Stack (*-- inout *));
VAR fromIndex : NodePtr; (*-- node to add from source stack *)
toIndex : NodePtr; (*-- last node added to target stack *)
assignItem: AssignProc; (*-- item assignment routine *)
BEGIN
IF (theStack # NIL) THEN
IF (toStack # NIL) THEN
Clear(toStack);
toStack^.dataID := theStack^.dataID;
ELSE
toStack := Create(theStack^.dataID);
END (*--if*);
IF (stackError # noerr) OR (theStack^.top = NIL) THEN
RETURN;
END (*--if*);
assignItem := AssignOf(theStack^.dataID);
IF GetNode(toStack^.top) THEN
WITH toStack^.top^ DO
item := assignItem(theStack^.top^.item);
next := NIL;
END (*--with*);
fromIndex := theStack^.top;
toIndex := toStack^.top;
INC(toStack^.depth);
ELSE
RaiseErrIn(assign, overflow);
END (*--if*);
WHILE (stackError = noerr) & (fromIndex^.next # NIL) DO
fromIndex := fromIndex^.next;
IF GetNode(toIndex^.next) THEN
toIndex := toIndex^.next;
WITH toIndex^ DO
item := assignItem(fromIndex^.item);
next := NIL;
END (*--with*);
INC(toStack^.depth);
ELSE
RaiseErrIn(assign, overflow);
END (*--if*);
END (*--while*);
ELSE
RaiseErrIn(assign, undefined);
END (*--if*);
END Assign;
(*----------------------------*)
(*
Push attempts retrieval of a stack node for the new item, which if successful allows us to
store the data for new stack top and a link to the current stack top. Then the stack top can
be updated to point to the new node and the depth can be updated. If a stack node could not
be allocated the overflow exception is raised and the stack is left unchanged.
Complexity O(1)
*)
PROCEDURE Push (VAR toStack : Stack (*-- inout *);
theItem : Item (*-- in *));
VAR newNode: NodePtr;
BEGIN
stackError := noerr;
IF (toStack # NIL) THEN
IF GetNode(newNode) THEN
WITH toStack^ DO
newNode^.item := theItem;
newNode^.next := top;
top := newNode;
INC(depth);
END (*--with*);
ELSE
RaiseErrIn(push, overflow);
END (*--if*);
ELSE
RaiseErrIn(push, undefined);
END (*--if*);
END Push;
(*----------------------------*)
(*
Pop is the inverse of Push, requiring a test for stack underflow, before effectively
undoing what was done in order to place a node on the stack.
PopTopOf is similar to Pop except the item is not deallocated, but instead is returned to
the caller.
*)
PROCEDURE Pop (VAR theStack : Stack (*-- inout *));
VAR nodeToPop: NodePtr;
freeItem : DisposeProc; (*-- item disposal routine *)
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
WITH theStack^ DO
IF (top # NIL) THEN (*-- Check for stack underflow *)
nodeToPop := top; (*-- Remember current top of stack *)
top := top^.next; (*-- Update the top of stack *)
DEC(depth); (*-- Maintain a correct depth count *)
freeItem := DisposeOf(dataID);
freeItem(nodeToPop^.item); (*-- Safely recover the item space *)
FreeNode(nodeToPop); (*-- Recover the node space *)
ELSE
RaiseErrIn(pop, underflow);
END (*--if*);
END (*--with*);
ELSE
RaiseErrIn(pop, undefined);
END (*--if*);
END Pop;
(*----------------------------*)
PROCEDURE PopTopOf (VAR theStack : Stack (*-- inout *))
: Item (*-- out *);
VAR oldTop : NodePtr;
topItem : Item;
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
WITH theStack^ DO
IF (top # NIL) THEN (*-- Check for stack underflow *)
oldTop := top; (*-- Remember current top of stack *)
topItem:= top^.item; (*-- Remember current item at stack top *)
top := top^.next; (*-- Update the stack top *)
DEC(depth); (*-- Maintain a correct depth count *)
FreeNode(oldTop); (*-- Recover the node space *)
RETURN topItem; (*-- Return the data item *)
END (*--if*);
END (*--with*);
RaiseErrIn(poptopof, underflow);
ELSE
RaiseErrIn(poptopof, undefined);
END (*--if*);
RETURN NullItem;
END PopTopOf;
(*----------------------------*)
(*
7.2.5 Selectors
IsDefined simply tests for the stack top being not NIL, returning true or false as
appropriate. This is a simple test for a defined stack object.
*)
PROCEDURE IsDefined ( theStack : Stack (*-- in *))
: BOOLEAN (*-- out *);
BEGIN
RETURN (theStack # NIL);
END IsDefined;
(*----------------------------*)
(*
IsEmpty simply tests the link to the stack top being NIL, returning the appropriate
logical value. As mentioned in the interface, an undefined stack is considered empty.
*)
PROCEDURE IsEmpty ( theStack : Stack (*-- in *))
: BOOLEAN (*-- out *);
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
RETURN theStack^.top = NIL;
END (*--if*);
RaiseErrIn(isempty, undefined);
RETURN TRUE;
END IsEmpty;
(*----------------------------*)
(*
IsEqual scans both stacks looking for the first inequality between items which indicates
the stacks are unequal, otherwise if the loop completes the stacks must be equal. This
assumes that both stacks (1) have been defined, (2) have been given the same data type
ID, and (3) have the same depth. The first two of these assumptions, if unfounded, cause
the exceptions, undefined and typeerror, respectively, to be raised. Invariant: Since the
stacks have the same depth, when leftIndex is NIL, by definition rightIndex will also be
NIL.
*)
PROCEDURE IsEqual ( left : Stack (*-- in *);
right : Stack (*-- in *))
: BOOLEAN (*-- out *);
VAR leftIndex : NodePtr;
rightIndex: NodePtr;
compare : CompareProc; (*-- item comparison routine *)
BEGIN
stackError := noerr;
IF (left # NIL) & (right # NIL) THEN
IF (left^.dataID = right^.dataID) THEN
IF (left^.depth = right^.depth) THEN
compare := CompareOf(left^.dataID);
leftIndex := left^.top;
rightIndex:= right^.top;
WHILE (leftIndex # NIL) &
(compare(leftIndex^.item, rightIndex^.item) = equal) DO
leftIndex := leftIndex^.next;
rightIndex:= rightIndex^.next;
END (*--while*);
RETURN (leftIndex = NIL);
END (*--if*);
ELSE
RaiseErrIn(isequal, typeerror);
END (*--if*);
ELSE
RaiseErrIn(isequal, undefined);
END (*--if*);
RETURN FALSE;
END IsEqual;
(*----------------------------*)
PROCEDURE TypeOf ( theStack : Stack (*-- in *))
: TypeID (*-- out *);
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
RETURN theStack^.dataID;
END (*--if*);
RaiseErrIn(typeof, undefined);
RETURN NullType;
END TypeOf;
(*----------------------------*)
PROCEDURE DepthOf ( theStack : Stack (*-- in *))
: CARDINAL (*-- out *);
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
RETURN theStack^.depth;
END (*--if*);
RaiseErrIn(depthof, undefined);
RETURN 0;
END DepthOf;
(*----------------------------*)
PROCEDURE TopOf ( theStack : Stack (*-- in *))
: Item (*-- out *);
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
WITH theStack^ DO
IF (top # NIL) THEN
RETURN top^.item;
END (*--if*);
END (*--with*);
RaiseErrIn(topof, underflow);
ELSE
RaiseErrIn(topof, undefined);
END (*--if*);
RETURN NullItem;
END TopOf;
(*----------------------------*)
(*
7.3.6 Iterators
The two ╥looping╙ iterator routines, LoopOver and LoopChange, utilize the same
algorithm; the essential difference is the type of procedure parameter invoked for each item
processed. A similar statement can be made about the two traversal routines, Traverse and
TravChange. In all cases, the iteration begins with the top stack item and ends with the
bottom stack item.
*)
PROCEDURE LoopOver ( theStack : Stack (*-- in *);
theProcess: LoopAccessProc (*-- in *));
VAR index : NodePtr;
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
index := theStack^.top;
WHILE (index # NIL) & theProcess(index^.item) DO
index := index^.next;
END (*--while*);
ELSE
RaiseErrIn(loopover, undefined);
END (*--if*);
END LoopOver;
(*----------------------------*)
PROCEDURE LoopChange ( theStack : Stack (*-- in *);
theProcess: LoopChangeProc (*-- in *));
VAR index : NodePtr;
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
index := theStack^.top;
WHILE (index # NIL) & theProcess(index^.item) DO
index := index^.next;
END (*--while*);
ELSE
RaiseErrIn(loopchange, undefined);
END (*--if*);
END LoopChange;
(*----------------------------*)
PROCEDURE Traverse ( theStack : Stack (*-- in *);
theProcess: AccessProc (*-- in *));
VAR index : NodePtr;
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
index := theStack^.top;
WHILE (index # NIL) DO
theProcess(index^.item);
index := index^.next;
END (*--while*);
ELSE
RaiseErrIn(traverse, undefined);
END (*--if*);
END Traverse;
(*----------------------------*)
PROCEDURE TravChange ( theStack : Stack (*-- in *);
theProcess: ChangeProc (*-- in *));
VAR index : NodePtr;
BEGIN
stackError := noerr;
IF (theStack # NIL) THEN
index := theStack^.top;
WHILE (index # NIL) DO
theProcess(index^.item);
index := index^.next;
END (*--while*);
ELSE
RaiseErrIn(travchange, undefined);
END (*--if*);
END TravChange;
(*----------------------------*)
(*
7.3.7 Module Initialization
In the module initialization the local exception handlers array variables are set to default
handlers (ExitOnError) except for the noerr handler which is given the null handler.
stackError is given the value noerr avoiding an undefined state.
*)
BEGIN
FOR stackError := initfailed TO MAX(Exceptions) DO
SetHandler(stackError, ExitOnError);
END (*--for*);
SetHandler(noerr, NullHandler);
stackError := noerr;
END StkSUMI.
(*
References
[1] A. Aho, J. Hopcroft, and J. Ullman, Data Structures and Algorithms, Addison-Wesley,
Reading, MA 1983, pp. 37-53.
[2] G. Booch, Software Components With Ada Structures, Tools, and Subsystems,
Benjamin/Cummings, Menlo Park, CA 1987.
[3] D. Knuth, The Art of Computer Programming, Vol. 1, Fundamental Algorithms,
Addison-Wesley, Reading, MA 1973.
[4] R. Wiener and R. Sincovec, Data Structures Using Modula-2, John Wiley & Sons, New
York, NY 1986.
[5] N. Wirth, Algorithms and Data Structures, Prentice-Hall, Englewood Cliffs, NJ 1986.
[6] N. Wirth, Algorithms + Data Structures = Programs, Prentice-Hall, Englewood Cliffs,
NJ 1976.
[7] N. Wirth, Programming in Modula-2, Springer-Verlag, New York, NY 1983.
*)