# You may distribute under the terms of either the GNU General Public License
# or the Artistic License (the same terms as Perl itself)
#
# (C) Paul Evans, 2012 -- leonerd@leonerd.org.uk
package Tangence::Meta::Type;
use strict;
use warnings;
use Carp;
our $VERSION = '0.24';
=head1 NAME
C<Tangence::Meta::Type> - structure representing one C<Tangence> value type
=head1 DESCRIPTION
This data structure object represents information about a type, such as a
method or event argument, a method return value, or a property element type.
Due to their simple contents and immutable nature, these objects may be
implemented as singletons.
=cut
=head1 CONSTRUCTOR
=cut
=head2 $type = Tangence::Meta::Type->new( $primitive )
Returns an instance to represent the given primitive type signature.
=head2 $type = Tangence::Meta::Type->new( $aggregate => $member_type )
Returns an instance to represent the given aggregation of the given type
instance.
=cut
our %PRIMITIVES;
our %LISTS;
our %DICTS;
sub new
{
my $class = shift;
if( @_ == 1 ) {
my ( $sig ) = @_;
return $PRIMITIVES{$sig} ||= bless [ prim => $sig ], $class;
}
elsif( @_ == 2 and $_[0] eq "list" ) {
my ( undef, $membertype ) = @_;
return $LISTS{$membertype->sig} ||= bless [ list => $membertype ], $class;
}
elsif( @_ == 2 and $_[0] eq "dict" ) {
my ( undef, $membertype ) = @_;
return $DICTS{$membertype->sig} ||= bless [ dict => $membertype ], $class;
}
die "TODO: @_";
}
=head2 $type = Tangence::Meta::Type->new_from_sig( $sig )
Parses the given full Tangence type signature and returns an instance to
represent it.
=cut
sub new_from_sig
{
my $class = shift;
my ( $sig ) = @_;
$sig =~ m/^list\((.*)\)$/ and
return $class->new( list => $class->new_from_sig( $1 ) );
$sig =~ m/^dict\((.*)\)$/ and
return $class->new( dict => $class->new_from_sig( $1 ) );
return $class->new( $sig );
}
=head1 ACCESSORS
=cut
=head2 $agg = $type->aggregate
Returns C<"prim"> for primitive types, or the aggregation name for list and
dict aggregate types.
=cut
sub aggregate
{
my $self = shift;
return $self->[0];
}
=head2 $member_type = $type->member_type
Returns the member type for aggregation types. Throws an exception for
primitive types.
=cut
sub member_type
{
my $self = shift;
die "Cannot return the member type for primitive types" if $self->[0] eq "prim";
return $self->[1];
}
=head2 $sig = $type->sig
Returns the Tangence type signature for the type.
=cut
sub sig
{
my $self = shift;
$self->${\"_sig_for_$self->[0]"}();
}
sub _sig_for_prim
{
my $self = shift;
return $self->[1];
}
sub _sig_for_list
{
my $self = shift;
return "list(" . $self->[1]->sig . ")";
}
sub _sig_for_dict
{
my $self = shift;
return "dict(" . $self->[1]->sig . ")";
}
=head1 AUTHOR
Paul Evans <leonerd@leonerd.org.uk>
=cut
0x55AA;