Doubly-Linked List

#!/usr/bin/perl

package double;

# $node = double->new( $val );
#
# Create a new double element with value $val.
sub new {
    my $class = shift;
    $class = ref($class) || $class;
    my $self = { val=>shift };
    bless $self, $class;
    return $self->_link_to( $self );
}

# $elem1->_link_to( $elem2 )
#
# Join this node to another, return self.
# (This is for internal use only, it doesn't not care whether
# the elements linked are linked into any sort of correct
# list order.)
sub _link_to {
    my ( $node, $next ) = @_;

    $node->next( $next );
    return $next->prev( $node );
}

sub destroy {
    my $node = shift;
    while( $node ) {
        my $next = $node->next;
        $node->prev(undef);
        $node->next(undef);
        $node = $next;
    }
}

# $cur = $node->next
# $new = $node->next( $new )
#
#    Get next link, or set (and return) a new value in next link.
sub next {
    my $node = shift;
    return @_ ? ($node->{next} = shift) : $node->{next};
}

# $cur = $node->prev
# $new = $node->prev( $new )
#
#    Get prev link, or set (and return) a new value in prev link.
sub prev {
    my $node = shift;
    return @_ ? ($node->{prev} = shift) : $node->{prev};
}


# this node, return self.
sub append {
    my ( $node, $add ) = @_;
    if ( $add = $add->content ) {
        $add->prev->_link_to( $node->next );
        $node->_link_to( $add );
    }
    return $node;
}

# Insert before this node, return self.
sub prepend {
    my ( $node, $add ) = @_;
    if ( $add = $add->content ) {
        $node->prev->_link_to( $add->next );
        $add->_link_to( $node );
    }
    return $node;
}

# Content of a node is itself unchanged
# (needed because for a list head, content must remove all of
# the elements from the list and return them, leaving the head
# containing an empty list).
sub content {
    return shift;
}

# Remove one or more nodes from their current list and return the
# first of them.
# The caller must ensure that there is still some reference
# to the remaining other elements.
sub remove {
    my $first = shift;
    my $last = shift || $first;

    # Remove it from the old list.
    $first->prev->_link_to( $last->next );

    # Make the extracted nodes a closed circle.
    $last->_link_to( $first );
    return $first;
}

package double_head;

sub new {
    my $class = shift;
    my $info = shift;
    my $dummy = double->new;

    bless [ $dummy, $info ], $class;
}

sub DESTROY {
    my $self = shift;
    my $dummy = $self->[0];

    $dummy->destroy;
}

# Prepend to the dummy header to append to the list.
sub append {
    my $self = shift;
    $self->[0]->prepend( shift );
    return $self;
}

# Append to the dummy header to prepend to the list.
sub prepend {
    my $self = shift;
    $self->[0]->append( shift );
    return $self;
}

sub first {
    my $self = shift;
    my $dummy = $self->[0];
    my $first = $dummy->next;

    return $first == $dummy ? undef : $first;
}

# Return a reference to the last element.
sub last {
    my $self = shift;
    my $dummy = $self->[0];
    my $last = $dummy->prev;

    return $last == $dummy ? undef : $last;
}

# When an append or prepend operation uses this list,
# give it all of the elements (and remove them from this list
# since they are going to be added to the other list).
sub content {
    my $self = shift;
    my $dummy = $self->[0];
    my $first = $dummy->next;
    return undef if $first eq $dummy;
    $dummy->remove;
    return $first;
}

sub ldump {
    my $self = shift;
    my $start = $self->[0];
    my $cur = $start->next;
    print "list($self->[1]) [";
    my $sep = "";

    while( $cur ne $start ) {
        print $sep, $cur->{val};
        $sep = ",";
        $cur = $cur->next;
    }
    print "]\n";
}

# Use the packages
#
{
    my $sq = double_head->new( "squares" );
    my $cu = double_head->new( "cubes" );
    my $three;

    for( $i = 0; $i < 5; ++$i ) {
        my $new = double->new( $i*$i );
        $sq->append($new);
        $sq->ldump;
        $new = double->new( $i*$i*$i );
        $three = $new if $i == 3;
        $cu->append($new);
        $cu->ldump;
    }

    # $sq is a list of squares from 0*0 .. 5*5
    # $cu is a list of cubes from 0*0*0 .. 5*5*5

    # Move the first cube to the end of the squares list.
    $sq->append($cu->first->remove);

    # Move 3*3*3 from the cubes list to the front of the squares list.
    $sq->prepend($cu->first->remove( $three ) );

    $sq->ldump;
    $cu->ldump;
}

# $cu and $sq and all of the double elements have been freed when
# the program gets here. 

• « Previous page
• Next page »