--- /dev/null
+# -*-perl-*-
+#
+# $Id$
+#
+# Abstract groups
+#
+# (c) 2004 Straylight/Edgeware
+#
+
+#----- Licensing notice -----------------------------------------------------
+#
+# This file is part of the Perl interface to Catacomb.
+#
+# Catacomb/Perl is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# Catacomb/Perl is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Catacomb/Perl; if not, write to the Free Software Foundation,
+# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+#----- Abstract groups ------------------------------------------------------
+
+package Catacomb::Group;
+use Carp;
+use Catacomb::Base;
+use Catacomb::Cache;
+
+$cache = Catacomb::Cache->new();
+
+sub intern {
+ croak("Usage: Catacomb::Group::intern(c)") unless @_ == 1;
+ my ($c) = @_;
+ return $cache->intern($c);
+}
+
+sub elt {
+ croak("Usage: Catacomb::Group::elt(g, [x])")
+ unless @_ >= 1 && @_ <= 2;
+ return Catacomb::Group::Elt->new(@_);
+}
+
+sub id {
+ croak("Usage: Catacomb::Group::id(g)") unless @_ == 1;
+ return Catacomb::Group::Elt->new($_[0]);
+}
+
+sub g {
+ croak("Usage: Catacomb::Group::g(g)") unless @_ == 1;
+ return Catacomb::Group::Elt->new($_[0], $_[0]->_g());
+}
+
+sub _cvt {
+ croak("Usage: Catacomb::Group::$_[1](g, x)") unless @_ == 4;
+ my ($op, $name, $g, $x) = @_;
+ $x = &$op(&g, $x);
+ return undef unless defined($x);
+ return elt($g, &$op(&g, $x));
+}
+sub fromint { _cvt(\&_fromint, "fromint", @_); }
+sub fromec { _cvt(\&_fromec, "fromec", @_); }
+
+sub _strcvt {
+ croak("Usage: Catacomb::Group::$_[1](g, sv)") unless @_ == 4;
+ my ($op, $name, $g, $sv) = @_;
+ my ($x, $rest) = &$op($g, $sv);
+ return undef unless defined($x);
+ $x = elt($g, $x);
+ return $x unless wantarray();
+ return ($x, $rest);
+}
+sub frombuf { _strcvt(\&_getbuf, "frombuf", @_); }
+sub fromraw { _strcvt(\&_getraw, "fromraw", @_); }
+sub fromstring { _strcvt(\&_fromstring, "fromstring", @_); }
+
+sub mexp {
+ croak("Usage: Catacomb::Group::mexp(g, x_0, n_0, x_1, n_1, ...)")
+ unless @_ >= 3 && @_ % 2 == 1;
+ my $g = pop(@_);
+ my $i;
+ my @v = ();
+ my $gr;
+ ($g, $gr) = $g->intern();
+ for ($i = 0; $i < @_; $i += 2) {
+ my $x = Catacomb::Group::Elt::_convert($g, $gr, $_[$i]);
+ my $n = $_[$i + 1];
+ push(@v, $x, $n);
+ }
+ return Catacomb::Group::Elt::_elt($g->mexp(@v), $g, $gr);
+}
+
+#----- Group elements -------------------------------------------------------
+
+package Catacomb::Group::Elt;
+use Carp;
+use Catacomb::Base;
+
+sub DESTROY {
+ my ($x) = @_;
+ $x->[1]->_destroyelement($x->[0]);
+ undef $x->[0];
+}
+
+sub _elt { bless [@_], Catacomb::Group::Elt; }
+
+sub new {
+ croak("Usage: Catacomb::Group::Elt::new(me, g, [x])")
+ unless @_ >= 2 && @_ <= 3;
+ my ($me, $g, $x);
+ if (@_ == 2) {
+ ($me, $g) = @_;
+ $x = $g->_i();
+ } else {
+ ($me, $g, $x) = @_;
+ if (UNIVERSAL::isa($x, Catacomb::Group::Elt)) {
+ croak("group mismatch") unless $x->[1] == $g;
+ } elsif (UNIVERSAL::isa($x, Catacomb::EC::Pt)) {
+ my $pt = $x->point();
+ $x = $g->_fromec($pt);
+ } elsif (UNIVERSAL::isa($x, Catacomb::EC::Point)) {
+ $x = $g->_fromec($x);
+ } elsif (UNIVERSAL::isa($x, Catacomb::Group::Element)) {
+ # cool
+ } else {
+ $x = $g->_fromint($x);
+ }
+ return undef unless defined($x);
+ }
+ my $gr;
+ ($g, $gr) = $g->intern();
+ return _elt($x, $g, $gr);
+}
+
+sub _convert {
+ my ($g, $gr, $x) = @_;
+ if (UNIVERSAL::isa($x, Catacomb::Group::Elt)) {
+ $x->[1] == $g or croak("group mismatch");
+ return $x;
+ }
+ $x == 0 and return _elt($g->_i(), $g, $gr);
+ croak("can't convert to group element");
+}
+
+sub _out {
+ croak("Usage: Catacomb::Group::Elt::$_[1](x)") unless @_ == 3;
+ my ($op, $name, $x) = @_;
+ return &$op($x->[1], $x->[0]);
+}
+sub toint { _out(\&Catacomb::Group::_toint, "toint", @_); }
+sub toec { _out(\&Catacomb::Group::_toec, "toec", @_); }
+sub tobuf { _out(\&Catacomb::Group::_putbuf, "tobuf", @_); }
+sub toraw { _out(\&Catacomb::Group::_putraw, "toraw", @_); }
+sub tostring { _out(\&Catacomb::Group::_tostring, "tostring", @_); }
+
+sub group {
+ croak("Usage: Catacomb::Group::Elt::group(x)") unless @_ == 1;
+ return $_[0][1];
+}
+
+sub identp { _out(\&Catacomb::Group::_identp, "identp", @_); }
+sub check { _out(\&Catacomb::Group::_checkelt, "check", @_); }
+
+sub _binop {
+ my ($op, $x, $y, $swap) = @_;
+ my (undef, $g, $gr) = @$x;
+ $y = _convert($g, $gr, $y);
+ my $z = $swap ?
+ &$op($c, $x->[0], $y->[0]) :
+ &$op($c, $y->[0], $x->[0]);
+ return _elt($z, $g, $gr);
+}
+
+sub _unop {
+ my ($op, $x) = @_;
+ my (undef, $g, $gr) = @$x;
+ my $z = &$op($c, $x->[0]);
+ return _elt($z, $g, $gr);
+}
+
+sub _eq {
+ my ($x, $y) = @_;
+ my (undef, $g, $gr) = @$x;
+ $y = _convert($g, $gr, $y);
+ return Catacomb::Group::_eq($x->[0], $y->[0]);
+}
+
+sub exp {
+ croak("Usage: Catacomb::Group::Elt::exp(x, n)") unless @_ == 2;
+ my ($x, $n) = @_;
+ my ($xx, $g, $gr) = @$x;
+ return _elt($g->_exp($xx, $n), $g, $gr);
+}
+
+sub inv {
+ croak("Usage: Catacomb::Group::Elt::inv(x)") unless @_ == 1;
+ _unop(\&Catacomb::Group::inv, @_);
+}
+
+use overload
+ '*' => sub { _binop(\&Catacomb::Group::_mul, @_); },
+ '/' => sub { _binop(\&Catacomb::Group::_div, @_); },
+ '**' => sub { &exp($_[0], $_[1]); },
+ '==' => sub { _eq(@_); },
+ '!=' => sub { !_eq(@_); },
+ 'eq' => sub { _eq(@_); },
+ 'ne' => sub { !_eq(@_); },
+ '""' => sub { tostring($_[0]); },
+ '0+' => sub { toint($_[0]); };
+
+#----- That's all, folks ----------------------------------------------------
~mdw / catacomb-perl / blobdiff