fcd15e0b |
1 | # -*-perl-*- |
2 | # |
3 | # $Id$ |
4 | # |
5 | # Abstract groups |
6 | # |
7 | # (c) 2004 Straylight/Edgeware |
8 | # |
9 | |
10 | #----- Licensing notice ----------------------------------------------------- |
11 | # |
12 | # This file is part of the Perl interface to Catacomb. |
13 | # |
14 | # Catacomb/Perl is free software; you can redistribute it and/or modify |
15 | # it under the terms of the GNU General Public License as published by |
16 | # the Free Software Foundation; either version 2 of the License, or |
17 | # (at your option) any later version. |
18 | # |
19 | # Catacomb/Perl is distributed in the hope that it will be useful, |
20 | # but WITHOUT ANY WARRANTY; without even the implied warranty of |
21 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
22 | # GNU General Public License for more details. |
23 | # |
24 | # You should have received a copy of the GNU General Public License |
25 | # along with Catacomb/Perl; if not, write to the Free Software Foundation, |
26 | # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
27 | |
28 | #----- Abstract groups ------------------------------------------------------ |
29 | |
30 | package Catacomb::Group; |
31 | use Carp; |
32 | use Catacomb::Base; |
33 | use Catacomb::Cache; |
34 | |
35 | $cache = Catacomb::Cache->new(); |
36 | |
37 | sub intern { |
38 | croak("Usage: Catacomb::Group::intern(c)") unless @_ == 1; |
39 | my ($c) = @_; |
40 | return $cache->intern($c); |
41 | } |
42 | |
43 | sub elt { |
44 | croak("Usage: Catacomb::Group::elt(g, [x])") |
45 | unless @_ >= 1 && @_ <= 2; |
46 | return Catacomb::Group::Elt->new(@_); |
47 | } |
48 | |
49 | sub id { |
50 | croak("Usage: Catacomb::Group::id(g)") unless @_ == 1; |
51 | return Catacomb::Group::Elt->new($_[0]); |
52 | } |
53 | |
54 | sub g { |
55 | croak("Usage: Catacomb::Group::g(g)") unless @_ == 1; |
56 | return Catacomb::Group::Elt->new($_[0], $_[0]->_g()); |
57 | } |
58 | |
59 | sub _cvt { |
60 | croak("Usage: Catacomb::Group::$_[1](g, x)") unless @_ == 4; |
61 | my ($op, $name, $g, $x) = @_; |
62 | $x = &$op(&g, $x); |
63 | return undef unless defined($x); |
64 | return elt($g, &$op(&g, $x)); |
65 | } |
66 | sub fromint { _cvt(\&_fromint, "fromint", @_); } |
67 | sub fromec { _cvt(\&_fromec, "fromec", @_); } |
68 | |
69 | sub _strcvt { |
70 | croak("Usage: Catacomb::Group::$_[1](g, sv)") unless @_ == 4; |
71 | my ($op, $name, $g, $sv) = @_; |
72 | my ($x, $rest) = &$op($g, $sv); |
73 | return undef unless defined($x); |
74 | $x = elt($g, $x); |
75 | return $x unless wantarray(); |
76 | return ($x, $rest); |
77 | } |
78 | sub frombuf { _strcvt(\&_getbuf, "frombuf", @_); } |
79 | sub fromraw { _strcvt(\&_getraw, "fromraw", @_); } |
80 | sub fromstring { _strcvt(\&_fromstring, "fromstring", @_); } |
81 | |
82 | sub mexp { |
83 | croak("Usage: Catacomb::Group::mexp(g, x_0, n_0, x_1, n_1, ...)") |
84 | unless @_ >= 3 && @_ % 2 == 1; |
85 | my $g = pop(@_); |
86 | my $i; |
87 | my @v = (); |
88 | my $gr; |
89 | ($g, $gr) = $g->intern(); |
90 | for ($i = 0; $i < @_; $i += 2) { |
91 | my $x = Catacomb::Group::Elt::_convert($g, $gr, $_[$i]); |
92 | my $n = $_[$i + 1]; |
93 | push(@v, $x, $n); |
94 | } |
95 | return Catacomb::Group::Elt::_elt($g->mexp(@v), $g, $gr); |
96 | } |
97 | |
98 | #----- Group elements ------------------------------------------------------- |
99 | |
100 | package Catacomb::Group::Elt; |
101 | use Carp; |
102 | use Catacomb::Base; |
103 | |
104 | sub DESTROY { |
105 | my ($x) = @_; |
106 | $x->[1]->_destroyelement($x->[0]); |
107 | undef $x->[0]; |
108 | } |
109 | |
110 | sub _elt { bless [@_], Catacomb::Group::Elt; } |
111 | |
112 | sub new { |
113 | croak("Usage: Catacomb::Group::Elt::new(me, g, [x])") |
114 | unless @_ >= 2 && @_ <= 3; |
115 | my ($me, $g, $x); |
116 | if (@_ == 2) { |
117 | ($me, $g) = @_; |
118 | $x = $g->_i(); |
119 | } else { |
120 | ($me, $g, $x) = @_; |
121 | if (UNIVERSAL::isa($x, Catacomb::Group::Elt)) { |
122 | croak("group mismatch") unless $x->[1] == $g; |
123 | } elsif (UNIVERSAL::isa($x, Catacomb::EC::Pt)) { |
124 | my $pt = $x->point(); |
125 | $x = $g->_fromec($pt); |
126 | } elsif (UNIVERSAL::isa($x, Catacomb::EC::Point)) { |
127 | $x = $g->_fromec($x); |
128 | } elsif (UNIVERSAL::isa($x, Catacomb::Group::Element)) { |
129 | # cool |
130 | } else { |
131 | $x = $g->_fromint($x); |
132 | } |
133 | return undef unless defined($x); |
134 | } |
135 | my $gr; |
136 | ($g, $gr) = $g->intern(); |
137 | return _elt($x, $g, $gr); |
138 | } |
139 | |
140 | sub _convert { |
141 | my ($g, $gr, $x) = @_; |
142 | if (UNIVERSAL::isa($x, Catacomb::Group::Elt)) { |
143 | $x->[1] == $g or croak("group mismatch"); |
144 | return $x; |
145 | } |
146 | $x == 0 and return _elt($g->_i(), $g, $gr); |
147 | croak("can't convert to group element"); |
148 | } |
149 | |
150 | sub _out { |
151 | croak("Usage: Catacomb::Group::Elt::$_[1](x)") unless @_ == 3; |
152 | my ($op, $name, $x) = @_; |
153 | return &$op($x->[1], $x->[0]); |
154 | } |
155 | sub toint { _out(\&Catacomb::Group::_toint, "toint", @_); } |
156 | sub toec { _out(\&Catacomb::Group::_toec, "toec", @_); } |
157 | sub tobuf { _out(\&Catacomb::Group::_putbuf, "tobuf", @_); } |
158 | sub toraw { _out(\&Catacomb::Group::_putraw, "toraw", @_); } |
159 | sub tostring { _out(\&Catacomb::Group::_tostring, "tostring", @_); } |
160 | |
161 | sub group { |
162 | croak("Usage: Catacomb::Group::Elt::group(x)") unless @_ == 1; |
163 | return $_[0][1]; |
164 | } |
165 | |
166 | sub identp { _out(\&Catacomb::Group::_identp, "identp", @_); } |
167 | sub check { _out(\&Catacomb::Group::_checkelt, "check", @_); } |
168 | |
169 | sub _binop { |
170 | my ($op, $x, $y, $swap) = @_; |
171 | my (undef, $g, $gr) = @$x; |
172 | $y = _convert($g, $gr, $y); |
173 | my $z = $swap ? |
174 | &$op($c, $x->[0], $y->[0]) : |
175 | &$op($c, $y->[0], $x->[0]); |
176 | return _elt($z, $g, $gr); |
177 | } |
178 | |
179 | sub _unop { |
180 | my ($op, $x) = @_; |
181 | my (undef, $g, $gr) = @$x; |
182 | my $z = &$op($c, $x->[0]); |
183 | return _elt($z, $g, $gr); |
184 | } |
185 | |
186 | sub _eq { |
187 | my ($x, $y) = @_; |
188 | my (undef, $g, $gr) = @$x; |
189 | $y = _convert($g, $gr, $y); |
190 | return Catacomb::Group::_eq($x->[0], $y->[0]); |
191 | } |
192 | |
193 | sub exp { |
194 | croak("Usage: Catacomb::Group::Elt::exp(x, n)") unless @_ == 2; |
195 | my ($x, $n) = @_; |
196 | my ($xx, $g, $gr) = @$x; |
197 | return _elt($g->_exp($xx, $n), $g, $gr); |
198 | } |
199 | |
200 | sub inv { |
201 | croak("Usage: Catacomb::Group::Elt::inv(x)") unless @_ == 1; |
202 | _unop(\&Catacomb::Group::inv, @_); |
203 | } |
204 | |
205 | use overload |
206 | '*' => sub { _binop(\&Catacomb::Group::_mul, @_); }, |
207 | '/' => sub { _binop(\&Catacomb::Group::_div, @_); }, |
208 | '**' => sub { &exp($_[0], $_[1]); }, |
209 | '==' => sub { _eq(@_); }, |
210 | '!=' => sub { !_eq(@_); }, |
211 | 'eq' => sub { _eq(@_); }, |
212 | 'ne' => sub { !_eq(@_); }, |
213 | '""' => sub { tostring($_[0]); }, |
214 | '0+' => sub { toint($_[0]); }; |
215 | |
216 | #----- That's all, folks ---------------------------------------------------- |