File Coverage

blib/lib/Language/Prolog/Types/Internal.pm

Criterion	Covered	Total	%
statement	37	143	25.8
branch	0	18	0.0
condition			n/a
subroutine	12	50	24.0
pod	0	7	0.0
total	49	218	22.4

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__