| 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 ---------------------------------------------------- |