Much wider support for Catacomb in all its glory.
[catacomb-perl] / Catacomb / Group.pm
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 ----------------------------------------------------