File Coverage

blib/lib/Tangence/Meta/Type.pm
Criterion Covered Total %
statement 35 38 92.1
branch 10 12 83.3
condition 9 15 60.0
subroutine 10 11 90.9
pod 4 5 80.0
total 68 81 83.9


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2012-2021 -- leonerd@leonerd.org.uk
5              
6 15     15   140 use v5.26;
  15         44  
7 15     15   63 use Object::Pad 0.41;
  15         146  
  15         59  
8              
9             package Tangence::Meta::Type 0.29;
10             class Tangence::Meta::Type :strict(params);
11              
12 15     15   4188 use Carp;
  15         29  
  15         15570  
13              
14             =head1 NAME
15              
16             C - structure representing one C value type
17              
18             =head1 DESCRIPTION
19              
20             This data structure object represents information about a type, such as a
21             method or event argument, a method return value, or a property element type.
22              
23             Due to their simple contents and immutable nature, these objects may be
24             implemented as singletons. Repeated calls to the constructor method for the
25             same type name will yield the same instance.
26              
27             =cut
28              
29             =head1 CONSTRUCTOR
30              
31             =cut
32              
33             =head2 make
34              
35             $type = Tangence::Meta::Type->make( $primitive )
36              
37             Returns an instance to represent the given primitive type signature.
38              
39             $type = Tangence::Meta::Type->make( $aggregate => $member_type )
40              
41             Returns an instance to represent the given aggregation of the given type
42             instance.
43              
44             =cut
45              
46             our %PRIMITIVES;
47             our %LISTS;
48             our %DICTS;
49              
50             sub make
51             {
52 1039     1039 1 1346 my $class = shift;
53              
54 1039 100 66     2265 if( @_ == 1 ) {
    100 33        
    50          
55 819         1137 my ( $sig ) = @_;
56 819   66     7782 return $PRIMITIVES{$sig} //=
57             $class->new( member_type => $sig );
58             }
59             elsif( @_ == 2 and $_[0] eq "list" ) {
60 141         251 my ( undef, $membertype ) = @_;
61 141   66     372 return $LISTS{$membertype->sig} //=
62             $class->new( aggregate => "list", member_type => $membertype );
63             }
64             elsif( @_ == 2 and $_[0] eq "dict" ) {
65 79         138 my ( undef, $membertype ) = @_;
66 79   66     146 return $DICTS{$membertype->sig} //=
67             $class->new( aggregate => "dict", member_type => $membertype );
68             }
69              
70 0         0 die "TODO: @_";
71             }
72              
73             =head2 make _from_sig
74              
75             $type = Tangence::Meta::Type->make_from_sig( $sig )
76              
77             Parses the given full Tangence type signature and returns an instance to
78             represent it.
79              
80             =cut
81              
82 528         652 sub make_from_sig ( $class, $sig )
83 528     528 0 697 {
  528         659  
  528         566  
84 528 100       1631 $sig =~ m/^list\((.*)\)$/ and
85             return $class->make( list => $class->make_from_sig( $1 ) );
86              
87 474 100       1115 $sig =~ m/^dict\((.*)\)$/ and
88             return $class->make( dict => $class->make_from_sig( $1 ) );
89              
90 429         911 return $class->make( $sig );
91             }
92              
93 1     1 1 2 has $aggregate :param :reader = "prim";
94 1         4 has $member_type :param;
95              
96             =head1 ACCESSORS
97              
98             =cut
99              
100             =head2 aggregate
101              
102             $agg = $type->aggregate
103              
104             Returns C<"prim"> for primitive types, or the aggregation name for list and
105             dict aggregate types.
106              
107             =cut
108              
109             =head2 member_type
110              
111             $member_type = $type->member_type
112              
113             Returns the member type for aggregation types. Throws an exception for
114             primitive types.
115              
116             =cut
117              
118             method member_type
119 396     396 1 630 {
120 396 50       1350 die "Cannot return the member type for primitive types" if $aggregate eq "prim";
121 396         675 return $member_type;
122             }
123              
124             =head2 sig
125              
126             $sig = $type->sig
127              
128             Returns the Tangence type signature for the type.
129              
130             =cut
131              
132             method sig
133 425     425 1 796 {
134 425         520 return $self->${\"_sig_for_$aggregate"}();
  425         1308  
135             }
136              
137             method _sig_for_prim
138 415     415   608 {
139 415         3619 return $member_type;
140             }
141              
142             method _sig_for_list
143 10     10   31 {
144 10         55 return "list(" . $member_type->sig . ")";
145             }
146              
147             method _sig_for_dict
148 0     0     {
149 0           return "dict(" . $member_type->sig . ")";
150             }
151              
152             =head1 AUTHOR
153              
154             Paul Evans
155              
156             =cut
157              
158             0x55AA;