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   149 use v5.26;
  15         40  
7 15     15   69 use Object::Pad 0.41;
  15         177  
  15         64  
8              
9             package Tangence::Meta::Type 0.28;
10             class Tangence::Meta::Type :strict(params);
11              
12 15     15   4839 use Carp;
  15         36  
  15         16377  
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 1413 my $class = shift;
53              
54 1039 100 66     2348 if( @_ == 1 ) {
    100 33        
    50          
55 819         1237 my ( $sig ) = @_;
56 819   66     8099 return $PRIMITIVES{$sig} //=
57             $class->new( member_type => $sig );
58             }
59             elsif( @_ == 2 and $_[0] eq "list" ) {
60 141         271 my ( undef, $membertype ) = @_;
61 141   66     448 return $LISTS{$membertype->sig} //=
62             $class->new( aggregate => "list", member_type => $membertype );
63             }
64             elsif( @_ == 2 and $_[0] eq "dict" ) {
65 79         152 my ( undef, $membertype ) = @_;
66 79   66     159 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         628 sub make_from_sig ( $class, $sig )
83 528     528 0 728 {
  528         689  
  528         552  
84 528 100       1244 $sig =~ m/^list\((.*)\)$/ and
85             return $class->make( list => $class->make_from_sig( $1 ) );
86              
87 474 100       1188 $sig =~ m/^dict\((.*)\)$/ and
88             return $class->make( dict => $class->make_from_sig( $1 ) );
89              
90 429         995 return $class->make( $sig );
91             }
92              
93 1     1 1 2 has $aggregate :param :reader = "prim";
  1         4  
94             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 1523 {
120 396 50       714 die "Cannot return the member type for primitive types" if $aggregate eq "prim";
121 396         1248 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 861 {
134 425         552 return $self->${\"_sig_for_$aggregate"}();
  425         1396  
135             }
136              
137             method _sig_for_prim
138 415     415   660 {
139 415         3933 return $member_type;
140             }
141              
142             method _sig_for_list
143 10     10   25 {
144 10         59 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;