The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Language::Prolog::Types::Internal;

our $VERSION=0.09;

use strict;
use warnings;

use Carp;

# factory class methods:

sub new_factory {
    my $class=shift;
    my $self= \ "I'm a $class prolog factory";
    bless $self, $class;
    $self
}

sub new_nil {
    shift;
    Language::Prolog::Types::Internal::nil->new(@_)
}

sub new_list {
    shift;
    Language::Prolog::Types::Internal::list->new(@_)
}

sub new_ulist {
    shift;
    Language::Prolog::Types::Internal::ulist->new(@_)
}

sub new_functor {
    shift;
    Language::Prolog::Types::Internal::functor->new(@_)
}

sub new_variable {
    shift;
    Language::Prolog::Types::Internal::variable->new(@_)
}

sub new_opaque {
    shift;
    Language::Prolog::Types::Internal::opaque->new(@_)
}

# internal types implementation:

package Language::Prolog::Types::Internal::nil;
our @ISA=qw(Language::Prolog::Types::Nil);

use Carp;
use Language::Prolog::Types::Factory;

sub largs { () }
sub larg { croak "larg index $_[1] is out of range" }
sub length { 0 }
sub tail { prolog_nil }

sub new {
    my $class=shift;
    my $self=[];
    bless $self, $class;
    return $self;
}


package Language::Prolog::Types::Internal::functor;
our @ISA=qw(Language::Prolog::Types::Functor);

use Carp;
use Language::Prolog::Types::Factory;

sub fargs {
    my $self=shift;
    return @{$self}[1..(@$self-1)]
}

sub farg {
    my ($self, $index)=@_;
    $index=@$self-1+$index
	if $index<0;
    croak sprintf( "farg index %d out of range for %s/%d",
		   $index, $self->[0], @$self-1 )
	if $index > @$self-2;
    $self->[$index+1];
}

sub functor { $_[0]->[0] }

sub arity { @{$_[0]} - 1 }

sub new {
    my $class=shift;
    my $self=[@_];
    bless $self, $class;
    return $self;
}


package Language::Prolog::Types::Internal::list;
our @ISA=qw( Language::Prolog::Types::List);

use Carp;
use Language::Prolog::Types::Factory;

sub car {
    my $self=shift;
    return undef if $self->is_nil;
    $_[0]->[0];
}

sub cdr {
    my $self=shift;
    return prolog_nil if @$self<2;
    my $cdr=[ @{$self} ];
    shift @{$cdr};
    bless $cdr, ref $self;
    return $cdr;
}

sub car_cdr {
    my $self=shift;
    return prolog_nil if @$self<2;
    my $cdr=[ @{$self} ];
    my $car=shift @{$cdr};
    bless $cdr, ref $self;
    return $car, $cdr;
}

sub new {
    my $class=shift;
    my $self=[@_];
    bless $self, $class;
    return $self;
}

sub larg {
    my ($self, $index)=@_;
    $index=@{$self}+$index
	if $index<0;
    croak "larg index $index is out of range"
	if $index >= @{$self};
    $self->[$index];
}

sub largs { @{$_[0]} }

sub length { scalar @{$_[0]} }

sub tail { prolog_nil }

package Language::Prolog::Types::Internal::ulist;
our @ISA=qw(Language::Prolog::Types::UList);

use Carp;
use Language::Prolog::Types::Factory;

sub car { $_[0]->[0] }

sub cdr {
    my $self=shift;
    return prolog_ulist(@{$self}[1..@$self-1])
}

sub car_cdr {
    my $self=shift;
    return ($self->[0], prolog_ulist(@{$self}[1..@$self-1]))
}

sub new {
    my $class=shift;
    my $self=[@_];
    bless $self, $class;
    return $self;
}

sub largs { @{$_[0]}[0..@{$_[0]}-2] }

sub larg {
    my ($self, $index)=@_;
    $index=@{$self}-1+$index
	if $index<0;
    croak "larg index $index is out of range"
	if $index >= @{$self}-1;
    $self->[$index];
}

sub tail { $_[0]->[-1] };

sub length { @{$_[0]} - 1 }

package Language::Prolog::Types::Internal::variable;
our @ISA=qw(Language::Prolog::Types::Variable);

sub new {
    my ($class, $name)=@_;
    my $self=\$name;
    bless $self, $class;
    return $self;
}

sub name { $ {$_[0]} }

sub rename { ${$_[0]}=$_[1] }


package Language::Prolog::Types::Internal::opaque;
our @ISA=qw(Language::Prolog::Types::Opaque);

sub new {
    my ($class, $ref)=@_;
    my $self=\$ref;
    bless $self, $class;
    return $self
}

sub opaque_reference {
    my $self=shift;
    return $$self;
}

sub opaque_class { ref shift->opaque_reference }


1;
__END__
# Below is stub documentation for your module. You'd better edit it!

=head1 NAME

Language::Prolog::Types::Internal - Prolog terms implementation

=head1 SYNOPSIS

  use Language::Prolog::Types::Internal;
  
  $fty=Language::Prolog::Types::Internal->new_factory;

  $nil=$fty->new_nil
  $functor=$fty->new_functor(qw(foo, bar))

=head1 ABSTRACT

This class presents an implementation for the abstract classes defined
in L<Language::Prolog::Types::Abstract>.

They are accesible through a factory object.



=head1 DESCRIPTION

This class is intended to not be directly used but through the
L<Language::Prolog::Types> and L<Language::Prolog::Types::Factory>
modules.

=head2 EXPORT

None by default.

=head1 SEE ALSO

L<Language::Prolog::Types::Abstract>, L<Language::Prolog::Types> and
L<Language::Prolog::Types::Factory>.

=head1 AUTHOR

Salvador Fandiño, E<lt>sfandino@yahoo.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2005 by Salvador Fandiño.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut