X-Git-Url: https://git.distorted.org.uk/~mdw/catacomb-perl/blobdiff_plain/f9952aec1cf6c64a5681308eea817b6113a37433..fcd15e0b7a3d0f0ca2f30953573f8d1f6b8e8bd2:/Catacomb/Group.pm

diff --git a/Catacomb/Group.pm b/Catacomb/Group.pm
new file mode 100644
index 0000000..ae28b7e
--- /dev/null
+++ b/Catacomb/Group.pm
@@ -0,0 +1,216 @@
+# -*-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 ----------------------------------------------------