The values of a list type will be finite sequences of values of the list's base type -- the type to which the elements of the list belong. The empty list, containing no elements, can be considered to belong to every list type.
As list constructors, we'll need a function that returns the empty list, and procedures for adding elements to existing lists. In some list implementations, only one such procedure is provided, and elements can be conveniently added to a list only at one end. However, we'll provide procedures for operating on lists at both ends and postpone until later the considerations of efficiency that might lead some to prefer the more limited design.
function empty_list: list; procedure prepend_to_list (first: element; var rest: list); procedure append_to_list (last: element; var rest: list);The
empty_list function, which takes no elements, simply
constructs and returns an empty list. The prepend_to_list
procedure adds a new element at the beginning of an existing list, and the
append_to_list function adds a new element at the end. A list
of arbitrary size can be constructed by initializing with a call to
empty_list and invoking either of the procedures once for each
desired element. Two other mechanisms for creating entirely new lists are also worth considering. In some cases, we might want to create lists of a specified size in which, initially, each element is the same -- for instance, a sequence of one hundred zeroes. Here's a function that creates and returns a list of that sort:
function list_of_duplicates (count: integer; repetend: element): list;It is an error to invoke this function with a negative value for
count, and the function returns an empty list if
count is zero. The other possibility is that we want to create a list of a specified length in which the elements are computed by applying some fixed function to the position numbers. For instance, we might want a sequence consisting of the cubes of the first twelve positive integers, with 1 as its first element, 8 as its second, 27 as its third, and so on up to 1728 in the twelfth position. To make this work, we'd need to be able to specify the function that transforms each position number into the corresponding list element as one of the parameters of the constructor. Pascal does in fact allow one to pass user-defined functions as arguments to other functions. Here's what the function header looks like:
function generate_list (count: integer; function f (pos: integer): element): list;That is: The
generate_list function takes two arguments, the
first of which is an integer and the second a function (call it
f that takes an integer argument and returns a list element.
The generate_list function returns a list, of the size
specified by count, containing the elements produced by
applying f to the integers from 1 to count, in
order.
An invocation of the generate_list function looks like this.
Notice that the cube function is only named, not invoked. (In
particular, no arguments are supplied to the cube function at
this point, because generate_list is expected to supply the
arguments. All that is being passed is the function itself.)
generate_list (12, cube)Of course, this presupposes that the
cube function has also
been defined at some point before the invocation shown:
function cube (n: integer): element; begin cube := n * n * n end;As selectors for the list data structure, I propose the following three functions:
function first_of_list (ls: list): element; function last_of_list (ls: list): element; function nth_of_list (ls: list; n: integer): element;The
first_of_list function returns the element at the
beginning of a non-empty list; it is an error to invoke this function on an
empty list. Similarly, the last_of_list function returns the
element at the end of a non-empty list, and should not be given an empty
list. Finally, the nth_of_list function, given a list and an
index into that list, returns the element at the specified position in the
list -- the first element if n is 1, the second element if
n is 2, and so on. It is an error to specify a non-positive
value for n or one that exceeds the number of elements in the
list. To be sure of invoking the selector functions correctly, one needs to be able to determine whether a list is empty and how many elements it contains, so we should provide functions that can find out these things:
function is_empty_list (ls: list): Boolean; function size_of_list (ls: list): integer;Since lists can be used as storage structures, we should be able to change the value stored at any position in a list. It's customary to make the mutator procedures correspond to the selector functions:
procedure assign_first_of_list (var ls: list; new_first: element); procedure assign_last_of_list (var ls: list; new_last: element); procedure assign_nth_of_list (var ls: list; n: integer; new_element: element);An error occurs if
assign_first_of_list or
assign_last_of_list is invoked on an empty list, or if
assign_nth_of_list is given a non-positive index or one that
exceeds the size of the list. When we're done with a list, we want to be able to recycle the storage associated with it:
procedure deallocate_list (var ls: list);There are a number of useful generic procedures involving lists. The most elementary of these is constructing a copy of a given list, in completely separate storage. Copy construction provides a replacement for the Pascal notion of data structure assignment. That is, whereas in Pascal one would completely copy the contents of an entire array variable into another array variable with an assignment of the form
arr2 := arr1, with
lists as implemented here one would instead write ls2 := copy_list
(ls1).
function copy_list (ls: list): list;Sometimes one wants to copy only a section of a list, specified by two positions: the positions of the first and last elements to be copied.
function section_of_list (ls: list; start, finish: integer): list;In this case, the best design is to return an empty list if
finish is non-positive or if start exceeds the
size of the list or if finish is strictly less than
start. Any one of these might be considered an error, but it
is hard to distinguish the cases in which it really reflects a programming
error from the cases in which the programmer actually wants to specify an
empty section.
Instead of building an exact copy of the original list, one might want to
build a new list in which each element of the original is transformed in
some way. The nature of the transformation can be specified by a function
parameter, as in the generate_list function described above.
Still another possibility would be to invoke a procedure to operate on each
element of the original list.
function map_list (ls: list; function f (arg: element): element): list; procedure apply_along_list (var ls: list; procedure p (var arg: element));The
prepend_to_list and append_to_list procedures
are all right for constructing lists in order, but sometimes one
subsequently wants random access, or at least the illusion of random
access. Instead of adding a new element to the list at the beginning or
end, one might want to add it at a specified position (increasing the
position number of every subsequent element):
procedure insert_into_list (new_element: element; n: integer; var ls: list);It would be an error to supply a non-positive value for
n, or one
that was too large; but specifying a position one greater than the current
size of the list is okay -- it's equivalent to saying that the new element
should be placed at the end of the list. Instead of inserting an element, one might want to remove an element from the list -- either the first one, or the last one, or one specified by its position number. Let's make these functions, so that the element that is being removed can be returned as the function value:
function behead_list (var ls: list): element; function curtail_list (var ls: list): element; function remove_from_list (var ls: list; n: integer): element;It's an error to invoke
behead_list or
curtail_list on the empty list, or to give
remove_from_list a non-positive index or one that exceeds the
size of the list. There should be a function that returns the result of concatenating two lists (forming the result entirely in newly allocated storage), and also a procedure for attaching a list by concatenation onto the end of an existing list:
function concatenate_lists (first, second: list): list; procedure attach_list (var base: list; var catenand: list);Note that the second argument to
attach_list ``gives up its
value'' to the first; the catenand list will no longer exist
as a separate object after it is attached to base. One common operation on lists is reversing the order of the elements. This can be done either destructively (replacing the original list without allocating any new storage) or non-destructively (allocating new storage for the reversed list and leaving the original list untouched).
procedure reverse_list (var ls: list); function reversal_of_list (ls: list): list;Given a list and a Boolean function that can be applied to elements of that list, one might want to find out whether the function returns
TRUE for all of the elements of the least, or perhaps just for
at least one of them; or one might want to know how many of the elements of
the list meet the condition expressed by the function:
function all_of_list (ls: list; function test (arg: element): Boolean): Boolean; function any_of_list (ls: list; function test (arg: element): Boolean): Boolean; function tally_along_list (ls: list; function test (arg: element): Boolean): integer;If applied to an empty list,
all_of_list will return
TRUE (a mathematician would say that the Boolean function is
``vacuously true'' of all the elements) and any_of_list will
return FALSE.
Again, given a list and a Boolean function, one might want to construct a
new list containing only those elements of the original list for which the
function returns TRUE, or indeed one might want to revise the
original list by removing from it all the elements that do not meet the
condition expressed by the function:
function filter_list (ls: list; function test (arg: element): Boolean): list; procedure prune_list (var ls: list; function test (arg: element): Boolean);We'll follow Pascal in not providing any input or output procedures for structured types such as lists. The application programmer can develop procedures suited to the particular application if they are needed. For the same reason, comparison functions, even the test for equality, are not provided.
append_to_list, last_of_list,
assign_last_of_list, curtail_list, and
attach_list) are very slow when the lists involved are long,
because of the necessity of traversing the list in order to locate the end
of it. The size_of_list function also requires a complete
list traversal if this representation is used.
Another possibility is doubly-linked lists with header nodes -- the same
structure as in the naturals module, but with a value of the
base type (rather than a digit) in the first field of each component.
Using this representation makes the size of a list easy to find (it's
stored in the header node) and allows us to get to either end of the
structure easily. However, it wastes a lot of space by placing a second
pointer in each component of the structure. None of the procedures and
functions mentioned in the header requires right-to-left traversal of the
list; provided we can access the first and last elements easily, the
traversals can all be in the same direction, starting with the first
element of the list and ending with the last one.
This reflection leads us to the implementation type that I've actually used
in constructing the lists module: a singly-linked list of
components, plus a header node that contains the size of the list and
pointers to its first and last elements. (These pointers will be
NIL if the list is empty.)
Here is the full text of the lists module:
{ This module defines an interface for a list data type and implements it
for HP 9000 Series 700 workstations under HP-UX 9.x, using HP Pascal.
It presupposes that the base type of the list is real, but any other type
may be substituted by changing the definition of `element' among the
exported types.
Programmer: John Stone, Grinnell College.
Original version: March 14, 1996.
}
{ The dispose() procedure does not actually recycle storage unless the
HEAP_DISPOSE compiler option is turned on. }
$heap_dispose on$
module lists;
export
{ The use of a pointer to a non-exported data type is HP Pascal's way of
making a data type effectively opaque. }
type
list = ^header;
element = real;
{ The empty_list function creates and returns an empty list. }
function empty_list: list;
{ The prepend_to_list function adds an element at the beginning of a
list. }
procedure prepend_to_list (first: element; var rest: list);
{ The append_to_list function adds an element at the end of a list. }
procedure append_to_list (last: element; var rest: list);
{ The list_of_duplicates function constructs and returns a list
comprising a specified number of copies of a given element. }
function list_of_duplicates (count: integer; repetend: element): list;
{ The generate_list function constructs and returns a list of a specified
length in which each element is obtained by applying a specified
function to its position in the list. }
function generate_list (count: integer;
function f (pos: integer): element): list;
{ The first_of_list function returns the first element of a non-empty
list. }
function first_of_list (ls: list): element;
{ The last_of_list function returns the last element of a non-empty
list. }
function last_of_list (ls: list): element;
{ Given a list and the number of a position in that list, the nth_of_list
function returns the element occupying that position. }
function nth_of_list (ls: list; n: integer): element;
{ The is_empty_list function determines whether a given list is empty. }
function is_empty_list (ls: list): Boolean;
{ The size_of_list function determines how many elements are in a given
list. }
function size_of_list (ls: list): integer;
{ The assign_first_of_list procedure replaces the first element of a
non-empty list with a new element. }
procedure assign_first_of_list (var ls: list; new_first: element);
{ The assign_last_of_list procedure replaces the last element of a
non-empty list with a new element. }
procedure assign_last_of_list (var ls: list; new_last: element);
{ Given a list and the number of a position in that list, the
assign_nth_of_list procedure overwrites the element in that position
with a new one. }
procedure assign_nth_of_list (var ls: list; n: integer;
new_element: element);
{ The deallocate_list procedure disposes of all of the storage associated
with a given list. }
procedure deallocate_list (var ls: list);
{ The copy_list function constructs and returns a copy of a given list,
but in completely separate storage. }
function copy_list (ls: list): list;
{ The section_of_list function constructs and returns a copy of that part
of a given list that lies between two specified positions in the list,
inclusive. (If start is non-positive, it is silently adjusted to 1;
if finish exceeds the length of the list, it is silently adjusted to
the length of the list. If finish is less than start, an empty list
is returned. }
function section_of_list (ls: list; start, finish: integer): list;
{ The map_list function creates and returns a list comprising the results
of applying a specified function to each element of a specified list. }
function map_list (ls: list; function f (arg: element): element): list;
{ The apply_along_list procedure applies a specified procedure to each
element of a specified list. }
procedure apply_along_list (var ls: list;
procedure p (var arg: element));
{ The insert_into_list procedure inserts a new element at a specified
position in an existing list, moving all subsequent elements to the
next higher-numbered position. }
procedure insert_into_list (new_element: element; n: integer;
var ls: list);
{ The behead_list function removes an element from the beginning of a
given list and returns it. }
function behead_list (var ls: list): element;
{ The curtail_list function removes an element from the end of a given
list and returns it. }
function curtail_list (var ls: list): element;
{ The remove_from_list function removes an element from a specified
position in a given list and returns it. }
function remove_from_list (var ls: list; n: integer): element;
{ The concatenate_lists function constructs (in completely separate
storage) and returns a list that comprises all of the elements of two
given lists, those of the first list being followed by those of the
second list in their original order. }
function concatenate_lists (first, second: list): list;
{ The attach_list procedure attaches a given list (the catenand) at the
end of another given list (the base). After the attachment, the
catenand no longer exists as a separate list and is undefined. }
procedure attach_list (var base: list; var catenand: list);
{ The reverse_list procedure reverses the elements of a given list,
in place. }
procedure reverse_list (var ls: list);
{ The reversal_of_list function constructs and returns a list comprising
the same elements as a given list, but in the opposite order. }
function reversal_of_list (ls: list): list;
{ The all_of_list function determines whether all of the elements of
a given list meet a condition expressed as a Boolean function. }
function all_of_list (ls: list;
function test (arg: element): Boolean): Boolean;
{ The any_of_list function determines whether any of the elements of
a given list meet a condition expressed as a Boolean function. }
function any_of_list (ls: list;
function test (arg: element): Boolean): Boolean;
{ The tally_along_list function determines how many of the elements of
a given list meet a condition expressed as a Boolean function. }
function tally_along_list (ls: list;
function test (arg: element): Boolean): integer;
{ The filter_list function constructs and returns a list comprising
exactly those elements of a given list that meet a condition expressed
as a Boolean function. }
function filter_list (ls: list;
function test (arg: element): Boolean): list;
{ The prune_list procedure removes from a given list all those elements
that do not meet a condition expressed as a Boolean function. }
procedure prune_list (var ls: list;
function test (arg: element): Boolean);
{ The structure_check function, which is defined and used only during
debugging, performs integrity and consistency tests on a given list
and returns a Boolean value indicating whether the list passes or
fails these tests.
function structure_check (ls: list): Boolean; }
implement
import stderr;
{ The following constants are more or less arbitrary integers
signifying various kinds of exceptions that can occur within this
module. }
const
FIRST_EXCEPTION_CODE = 1;
EMPTY_EXCEPTION = 1;
INDEX_EXCEPTION = 2;
EXCEPTION_EXCEPTION = 3;
LAST_EXCEPTION_CODE = EXCEPTION_EXCEPTION;
type
{ A list is implemented as a sequence of components, linked by
pointers (one per component) running from the beginning towards the
end of the list, together with a header node containing the size of
the list and pointers to its first and last components. The values
of the actual list type are pointers to these header nodes. }
link = ^component;
component = record
datum: element;
next: link
end;
header = record
size: integer;
fore, aft: link
end;
{ The list_handler procedure is invoked whenever one of the preconditions
for the successful execution of a procedure is found to be false. It
prints out an appropriate explanation of the exception just before the
program is halted. }
procedure list_handler (exception_code: integer);
begin
if (exception_code < FIRST_EXCEPTION_CODE) or
(LAST_EXCEPTION_CODE < exception_code) then
exception_code := EXCEPTION_EXCEPTION;
write (stderr, 'Exception #', exception_code : 1,
' in module LISTS: ');
case exception_code of
EMPTY_EXCEPTION:
writeln (stderr, 'attempted element operation on empty list');
INDEX_EXCEPTION:
writeln (stderr, 'list index out of range');
EXCEPTION_EXCEPTION:
writeln (stderr, 'argument out of range in procedure ',
'LIST_HANDLER.');
end
end;
function empty_list: list;
var
result: list;
{ the value to be returned by the function, once it is fully
constructed }
begin
new (result);
result^.size := 0;
result^.fore := NIL;
result^.aft := NIL;
empty_list := result
end;
procedure prepend_to_list (first: element; var rest: list);
var
new_component: link;
{ a pointer to storage for the new list element }
begin
new (new_component);
new_component^.datum := first;
new_component^.next := rest^.fore;
rest^.size := rest^.size + 1;
rest^.fore := new_component;
if rest^.aft = NIL then
rest^.aft := new_component
end;
procedure append_to_list (last: element; var rest: list);
var
new_component: link;
{ a pointer to storage for the new list element }
begin
new (new_component);
new_component^.datum := last;
new_component^.next := NIL;
rest^.size := rest^.size + 1;
if rest^.aft = NIL then
rest^.fore := new_component
else
rest^.aft^.next := new_component;
rest^.aft := new_component
end;
function list_of_duplicates (count: integer; repetend: element): list;
var
result: list;
{ the value to be returned by the function, once it is fully
constructed }
traverser: link;
{ pointer to successive elements of the list as it is constructed }
position: integer;
{ counts off positions in the list as they are completed }
begin
new (result);
result^.size := count;
if count = 0 then begin
result^.fore := NIL;
result^.aft := NIL
end
else begin
new (result^.fore);
traverser := result^.fore;
for position := 1 to count - 1 do begin
traverser^.datum := repetend;
new (traverser^.next);
traverser := traverser^.next
end;
traverser^.datum := repetend;
traverser^.next := NIL;
result^.aft := traverser
end;
list_of_duplicates := result
end;
function generate_list (count: integer;
function f (pos: integer): element): list;
var
result: list;
{ the value to be returned by the function, once it is fully
constructed }
traverser: link;
{ pointer to successive elements of the list as it is constructed }
position: integer;
{ counts off positions in the list as they are completed }
begin
new (result);
result^.size := count;
if count = 0 then begin
result^.fore := NIL;
result^.aft := NIL
end
else begin
new (result^.fore);
traverser := result^.fore;
for position := 1 to count - 1 do begin
traverser^.datum := f (position);
new (traverser^.next);
traverser := traverser^.next
end;
traverser^.datum := f (count);
traverser^.next := NIL;
result^.aft := traverser
end;
generate_list := result
end;
function first_of_list (ls: list): element;
begin
assert (0 < ls^.size, EMPTY_EXCEPTION, list_handler);
first_of_list := ls^.fore^.datum
end;
function last_of_list (ls: list): element;
begin
assert (0 < ls^.size, EMPTY_EXCEPTION, list_handler);
last_of_list := ls^.aft^.datum
end;
function nth_of_list (ls: list; n: integer): element;
var
traverser: link;
{ a pointer to successive components of the list }
position: integer;
{ counts off components of the list as they are reached }
begin
assert ((0 < n) and (n <= ls^.size), INDEX_EXCEPTION, list_handler);
traverser := ls^.fore;
for position := 2 to n do
traverser := traverser^.next;
nth_of_list := traverser^.datum
end;
function is_empty_list (ls: list): Boolean;
begin
is_empty_list := (ls^.size = 0)
end;
function size_of_list (ls: list): integer;
begin
size_of_list := ls^.size
end;
procedure assign_first_of_list (var ls: list; new_first: element);
begin
assert (0 < ls^.size, EMPTY_EXCEPTION, list_handler);
ls^.fore^.datum := new_first
end;
procedure assign_last_of_list (var ls: list; new_last: element);
begin
assert (0 < ls^.size, EMPTY_EXCEPTION, list_handler);
ls^.aft^.datum := new_last
end;
procedure assign_nth_of_list (var ls: list; n: integer;
new_element: element);
var
traverser: link;
{ a pointer to successive components of the list }
position: integer;
{ counts off components of the list as they are reached }
begin
assert ((0 < n) and (n <= ls^.size), INDEX_EXCEPTION, list_handler);
traverser := ls^.fore;
for position := 2 to n do
traverser := traverser^.next;
traverser^.datum := new_element
end;
procedure deallocate_list (var ls: list);
var
traverser: link;
{ a pointer to successive components of the list }
trailer: link;
{ a similar pointer, one component behind traverser }
begin
traverser := ls^.fore;
while traverser <> NIL do begin
trailer := traverser;
traverser := traverser^.next;
dispose (trailer)
end;
dispose (ls);
ls := NIL
end;
function copy_list (ls: list): list;
var
result: list;
{ the value to be returned by the function, once it is fully
constructed }
old_traverser, new_traverser: link;
{ pointers to corresponding components of the original list and the
copy being constructed }
position: integer;
{ counts off positions in each list }
begin
new (result);
result^.size := ls^.size;
if ls^.size = 0 then begin
result^.fore := NIL;
result^.aft := NIL
end
else begin
new (result^.fore);
old_traverser := ls^.fore;
new_traverser := result^.fore;
for position := 1 to ls^.size - 1 do begin
new_traverser^.datum := old_traverser^.datum;
new (new_traverser^.next);
old_traverser := old_traverser^.next;
new_traverser := new_traverser^.next
end;
new_traverser^.datum := old_traverser^.datum;
new_traverser^.next := NIL;
result^.aft := new_traverser
end;
copy_list := result
end;
function section_of_list (ls: list; start, finish: integer): list;
var
result: list;
{ the value to be returned by the function, once it is fully
constructed }
old_traverser, new_traverser: link;
{ pointers to corresponding components of the original list and the
copy being constructed }
position: integer;
{ counts off positions in each list }
begin
if start <= 0 then
start := 1;
if ls^.size < finish then
finish := ls^.size;
new (result);
if finish < start then begin
result^.size := 0;
result^.fore := NIL;
result^.aft := NIL
end
else begin
result^.size := finish - start + 1;
new (result^.fore);
old_traverser := ls^.fore;
for position := 1 to start - 1 do
old_traverser := old_traverser^.next;
new_traverser := result^.fore;
for position := start to finish - 1 do begin
new_traverser^.datum := old_traverser^.datum;
new (new_traverser^.next);
old_traverser := old_traverser^.next;
new_traverser := new_traverser^.next
end;
new_traverser^.datum := old_traverser^.datum;
new_traverser^.next := NIL;
result^.aft := new_traverser
end;
section_of_list := result
end;
function map_list (ls: list; function f (arg: element): element): list;
var
result: list;
{ the value to be returned by the function, once it is fully
constructed }
old_traverser, new_traverser: link;
{ pointer to corresponding elements of the original and new lists }
position: integer;
{ counts off positions in the list as they are completed }
begin
new (result);
result^.size := ls^.size;
if ls^.size = 0 then begin
result^.fore := NIL;
result^.aft := NIL
end
else begin
new (result^.fore);
old_traverser := ls^.fore;
new_traverser := result^.fore;
for position := 1 to ls^.size - 1 do begin
new_traverser^.datum := f (old_traverser^.datum);
new (new_traverser^.next);
old_traverser := old_traverser^.next;
new_traverser := new_traverser^.next
end;
new_traverser^.datum := f (old_traverser^.datum);
new_traverser^.next := NIL;
result^.aft := new_traverser
end;
map_list := result
end;
procedure apply_along_list (var ls: list;
procedure p (var arg: element));
var
traverser: link;
{ pointer to successive elements of the list }
begin
traverser := ls^.fore;
while traverser <> NIL do begin
p (traverser^.datum);
traverser := traverser^.next
end
end;
procedure insert_into_list (new_element: element; n: integer;
var ls: list);
var
new_component: link;
{ a pointer to storage for the new list element }
traverser: link;
{ a pointer to successive components of the list }
trailer: link;
{ a similar pointer, one component behind traverser }
position: integer;
{ counts off components of the list as they are reached }
begin
assert ((0 < n) and (n <= ls^.size + 1), INDEX_EXCEPTION,
list_handler);
new (new_component);
new_component^.datum := new_element;
ls^.size := ls^.size + 1;
if n = 1 then begin
new_component^.next := ls^.fore;
ls^.fore := new_component;
if ls^.aft = NIL then
ls^.aft := new_component
end
else begin
traverser := ls^.fore;
for position := 1 to n - 1 do begin
trailer := traverser;
traverser := traverser^.next
end;
new_component^.next := traverser;
trailer^.next := new_component;
if ls^.aft = trailer then
ls^.aft := new_component
end
end;
function behead_list (var ls: list): element;
var
delendum: link;
{ a pointer to the component being removed from the list }
begin
assert (0 < ls^.size, EMPTY_EXCEPTION, list_handler);
ls^.size := ls^.size - 1;
delendum := ls^.fore;
behead_list := delendum^.datum;
ls^.fore := ls^.fore^.next;
if ls^.fore = NIL then
ls^.aft := NIL;
dispose (delendum)
end;
function curtail_list (var ls: list): element;
var
delendum: link;
{ a pointer to the component being removed from the list }
traverser: link;
{ a pointer to successive components of the list }
position: integer;
{ counts off the surviving components of the list }
begin
assert (0 < ls^.size, EMPTY_EXCEPTION, list_handler);
ls^.size := ls^.size - 1;
delendum := ls^.aft;
curtail_list := delendum^.datum;
if ls^.size = 0 then begin
ls^.fore := NIL;
ls^.aft := NIL
end
else begin
traverser := ls^.fore;
for position := 1 to ls^.size - 1 do
traverser := traverser^.next;
traverser^.next := NIL;
ls^.aft := traverser
end;
dispose (delendum)
end;
function remove_from_list (var ls: list; n: integer): element;
var
traverser: link;
{ a pointer to successive components of the list }
trailer: link;
{ a similar pointer, one component behind traverser }
position: integer;
{ counts off the surviving components of the list }
begin
assert ((0 < n) and (n <= ls^.size), INDEX_EXCEPTION, list_handler);
traverser := ls^.fore;
if n = 1 then begin
ls^.fore := traverser^.next;
if ls^.fore = NIL then
ls^.aft := NIL
end
else begin
for position := 1 to n - 1 do begin
trailer := traverser;
traverser := traverser^.next
end;
trailer^.next := traverser^.next;
if traverser^.next = NIL then
ls^.aft := trailer
end;
remove_from_list := traverser^.datum;
dispose (traverser);
ls^.size := ls^.size - 1;
end;
function concatenate_lists (first, second: list): list;
var
base, catenand: list;
{ copies of first and second, respectively, but occupying entirely
new storage }
begin
if first^.size = 0 then
concatenate_lists := copy_list (second)
else if second^.size = 0 then
concatenate_lists := copy_list (first)
else begin
base := copy_list (first);
catenand := copy_list (second);
base^.size := first^.size + second^.size;
base^.aft^.next := catenand^.fore;
base^.aft := catenand^.aft;
concatenate_lists := base;
dispose (catenand)
end
end;
procedure attach_list (var base: list; var catenand: list);
begin
if base^.size = 0 then begin
dispose (base);
base := catenand
end
else begin
base^.size := base^.size + catenand^.size;
base^.aft^.next := catenand^.fore;
if catenand^.aft <> NIL then
base^.aft := catenand^.aft;
dispose (catenand)
end;
catenand := NIL
end;
procedure reverse_list (var ls: list);
var
opposite: link;
{ a pointer that advances through the list during the process of
exiting from a sequence of recursive calls }
procedure reverse_helper (left: link; var right: link);
var
temp: element;
{ temporary storage for a copy of the element to which left
points }
begin
if left = NIL then
right := ls^.fore
else begin
temp := left^.datum;
reverse_helper (left^.next, right);
right^.datum := temp;
right := right^.next
end
end;
begin { reverse_list }
reverse_helper (ls^.fore, opposite)
end;
function reversal_of_list (ls: list): list;
var
result: list;
{ the value to be returned by the function, once it is fully
constructed }
traverser: link;
{ pointer to successive elements of the original list }
new_component: link;
{ a pointer to storage for the new list element }
begin
new (result);
result^.size := ls^.size;
if ls^.size = 0 then begin
result^.fore := NIL;
result^.aft := NIL
end
else begin
new (result^.aft);
result^.aft^.datum := ls^.fore^.datum;
result^.aft^.next := NIL;
result^.fore := result^.aft;
traverser := ls^.fore^.next;
while traverser <> NIL do begin
new (new_component);
new_component^.datum := traverser^.datum;
new_component^.next := result^.fore;
result^.fore := new_component;
traverser := traverser^.next
end
end;
reversal_of_list := result
end;
function all_of_list (ls: list;
function test (arg: element): Boolean): Boolean;
var
result: Boolean;
{ the value to be returned by the function }
traverser: link;
{ pointer to successive elements of the list }
begin
result := TRUE;
traverser := ls^.fore;
while result and (traverser <> NIL) do begin
result := test (traverser^.datum);
traverser := traverser^.next
end;
all_of_list := result
end;
function any_of_list (ls: list;
function test (arg: element): Boolean): Boolean;
var
result: Boolean;
{ the value to be returned by the function }
traverser: link;
{ pointer to successive elements of the list }
begin
result := FALSE;
traverser := ls^.fore;
while (not result) and (traverser <> NIL) do begin
result := test (traverser^.datum);
traverser := traverser^.next
end;
any_of_list := result
end;
function tally_along_list (ls: list;
function test (arg: element): Boolean): integer;
var
result: integer;
{ the value to be returned by the function }
traverser: link;
{ pointer to successive elements of the list }
begin
result := 0;
traverser := ls^.fore;
while traverser <> NIL do begin
if test (traverser^.datum) then
result := result + 1;
traverser := traverser^.next
end;
tally_along_list := result
end;
function filter_list (ls: list;
function test (arg: element): Boolean): list;
var
result: list;
{ the value to be returned by the function, once it is fully
constructed }
count: integer;
{ the number of elements of the original list that have met the
condition expressed by the Boolean function }
old_traverser: link;
{ pointer to successive elements of the original list }
new_traverser: link;
{ pointer to successive elements of the new list as it is
constructed }
begin
new (result);
count := 0;
old_traverser := ls^.fore;
while old_traverser <> NIL do begin
if test (old_traverser^.datum) then begin
if count = 0 then begin
new (result^.fore);
new_traverser := result^.fore;
end
else begin
new (new_traverser^.next);
new_traverser := new_traverser^.next
end;
count := count + 1;
new_traverser^.datum := old_traverser^.datum
end;
old_traverser := old_traverser^.next
end;
if count = 0 then begin
result^.fore := NIL;
result^.aft := NIL
end
else begin
new_traverser^.next := NIL;
result^.aft := new_traverser
end;
result^.size := count;
filter_list := result
end;
procedure prune_list (var ls: list;
function test (arg: element): Boolean);
var
count: integer;
{ the number of elements of the original list that have met the
condition expressed by the Boolean function }
traverser: link;
{ pointer to successive elements of the original list }
trailer: link;
{ pointer to the most recently encountered non-pruned element of the
original list }
delendum: link;
{ a pointer to a component to be removed from the list }
begin
count := 0;
traverser := ls^.fore;
while traverser <> NIL do
if test (traverser^.datum) then begin
trailer := traverser;
count := count + 1;
traverser := traverser^.next
end
else begin
delendum := traverser;
traverser := traverser^.next;
if count = 0 then
ls^.fore := traverser
else
trailer^.next := traverser;
dispose (delendum)
end;
if count = 0 then
ls^.aft := NIL
else
ls^.aft := trailer;
ls^.size := count
end;
{ This function is defined and used only during debugging.
function structure_check (ls: list): Boolean;
var
count: integer;
traverser: link;
trailer: link;
begin
if ls = NIL then begin
writeln (stderr, 'Headerless list');
structure_check := FALSE
end
else if ls^.size = 0 then begin
structure_check := TRUE;
if ls^.fore <> NIL then begin
writeln (stderr, 'Non-NIL pointer in fore field of size 0 list');
structure_check := FALSE
end;
if ls^.aft <> NIL then begin
writeln (stderr, 'Non-NIL pointer in aft field of size 0 list');
structure_check := FALSE
end
end
else begin
structure_check := TRUE;
traverser := ls^.fore;
count := 0;
while (traverser <> NIL) and (count < ls^.size) do begin
count := count + 1;
trailer := traverser;
traverser := traverser^.next
end;
if count < ls^.size then begin
writeln (stderr,
'List with fewer components than size field specifies');
structure_check := FALSE
end
else if traverser <> NIL then begin
if trailer = ls^.aft then
writeln (stderr, 'List improperly terminated')
else begin
writeln (stderr,
'List with more components than size field specifies');
while traverser <> NIL do begin
trailer := traverser;
traverser := traverser^.next
end
end;
structure_check := FALSE
end;
if trailer <> ls^.aft then begin
writeln (stderr, 'Incorrect pointer in aft field of list');
structure_check := FALSE
end
end
end; }
end.
This document is available on the World Wide Web as
http://www.math.grin.edu/~stone/courses/fundamentals/lists.html