Much wider support for Catacomb in all its glory.

[catacomb-perl] / Catacomb / Group.pm

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