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. They are accesible through a factory object. =head1 DESCRIPTION This class is intended to not be directly used but through the L and L modules. =head2 EXPORT None by default. =head1 SEE ALSO L, L and L. =head1 AUTHOR Salvador Fandiņo, Esfandino@yahoo.comE =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