Much wider support for Catacomb in all its glory.

[catacomb-perl] / Catacomb / MP.pm

# -*-perl-*-
#
# $Id$
#
# Catacomb multiprecision integer interface
#
# (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.

#----- Multiprecision arithmetic --------------------------------------------

package Catacomb::MP;
use Catacomb::Base;
use Catacomb::Rand;
use Catacomb::Field;
use Carp;

sub mp { new(Catacomb::MP, $_[0]); }
sub mp_loadb { loadb(Catacomb::MP, $_[0]); }
sub mp_loadl { loadl(Catacomb::MP, $_[0]); }
sub mp_loadb2c { loadb2c(Catacomb::MP, $_[0]); }
sub mp_loadl2c { loadl2c(Catacomb::MP, $_[0]); }
sub mp_fromstring { fromstring(Catacomb::MP, $_[0]); }

sub mod { (&div($_[0], $_[1]))[1]; }

sub _binop {
  my ($func, $a, $b, $flag) = @_;
  return $flag ? &$func($b, $a) : &$func($a, $b);
}

sub _mul {
  my ($a, $b, $flag) = @_;
  if (UNIVERSAL::isa($b, Catacomb::EC::Pt)) {
    return $b->mul($a);
  }
  mul($a, $b);
}

use overload
  '+' => sub { _binop(\&add, @_); },
  '-' => sub { _binop(\&sub, @_); },
  '*' => \&_mul,
  '/' => sub { _binop(\&div, @_); },
  '%' => sub { _binop(\&mod, @_); },
  '&' => sub { _binop(\&and2c, @_); },
  '|' => sub { _binop(\&or2c, @_); },
  '^' => sub { _binop(\&xor2c, @_); },
  '**' => sub { _binop(\&exp, @_); },
  '>>' => sub { &lsr2c(@_[0, 1]); },
  '<<' => sub { &lsl2c(@_[0, 1]); },
  '~' => sub { &not2c($_[0]) },
  '==' => sub { _binop(\&eq, @_); },
  'eq' => sub { _binop(\&eq, @_); },
  '<=>' => sub { _binop(\&cmp, @_); },
  'cmp' => sub { _binop(\&cmp, @_); },
  '""' => sub { &tostring($_[0]); },,
  '0+' => sub { &toint($_[0]); },
  'sqrt' => sub { &sqrt($_[0]); },
  'neg' => sub { &neg($_[0]); };

sub import {
  my ($me, @imp) = @_;
  for my $i (@imp) {
    if ($i eq ":constant") {
      overload::constant integer => sub { new(undef, $_[0]); };
    } else {
      croak("unknown import for Catacomb::MP: `$i'");
    }
  }
}

sub modexp {
  croak("Usage: Catacomb::MP::modexp(p, g, x)") unless @_ == 3;
  my ($p, $g, $x) = @_;
  $g = $p - $g if $g < 0;
  $g = $g % $p if $g > $p;
  if ($p & 1) {
    my $mm = $p->mont();
    return $mm->exp($g, $x);
  } else {
    my $mb = $p->barrett();
    return $mb->exp($g, $x);
  }
}

sub primefield {
  croak("Usage: Catacomb::MP::primefield(p)") unless @_ == 1;
  return Catacomb::Field->prime($_[0]);
}

sub niceprimefield {
  croak("Usage: Catacomb::MP::niceprimefield(p)") unless @_ == 1;
  return Catacomb::Field->niceprime($_[0]);
}

sub primegroup {
  croak("Usage: Catacomb::MP::primegroup(p, g, q)") unless @_ == 3;
  return Catacomb::Group->prime(@_);
}

sub filter {
  croak("Usage: Catacomb::MP::filter(p)") unless @_ == 1;
  return Catacomb::MP::Prime::Filter->new($_[0]);
}

sub modinv {
  croak("Usage: Catacomb::MP::modinv(p, x)") unless @_ == 2;
  my ($g, undef, $i) = gcd($_[0], $_[1]);
  croak("Arguments aren't coprime in Catacomb::MP::modinv") unless $g == 1;
  return $i;
}

sub jac {
  # Reverse arguments for object-oriented syntax.
  croak("Usage: Catacomb::MP::jac(n, a)") unless @_ == 2;
  jacobi($_[1], $_[0]);
}

sub mont {
  croak("Usage: Catacomb::MP::mont(x)") unless @_ == 1;
  return Catacomb::MP::Mont->new($_[0]);
}

sub barrett {
  croak("Usage: Catacomb::MP::barrett(x)") unless @_ == 1;
  return Catacomb::MP::Mont->new($_[0]);
}

sub mkreduce {
  croak("Usage: Catacomb::MP::mkreduce(x)") unless @_ == 1;
  return Catacomb::MP::Reduce->new($_[0]);
}

sub rabin {
  croak("Usage: Catacomb::MP::rabin(x)") unless @_ == 1;
  return Catacomb::MP::Prime::Rabin->new($_[0]);
}

sub newprime {
  croak("Usage: Catacomb::MP::newprime(nbits, [rng]")
    unless @_ >= 1 && @_ <= 2;
  my ($nbits, $rng) = @_;
  $rng ||= $Catacomb::random;
  return Catacomb::MP::Prime->gen
    ("p", $rng->mp($nbits, 1), 0,
     Catacomb::MP::Prime::Filter->stepper(2),
     Catacomb::MP::Prime::Rabin->ntests($nbits),
     Catacomb::MP::Prime::Rabin->tester());
}

sub jumper {
  croak("Usage: Catacomb::MP::jumper(p)") unless @_ == 1;
  return Catacomb::MP::Prime::Filter->jumper($_[0]);
}

package Catacomb::MP::Mont;

*out = \&reduce;

package Catacomb::MP::Prime::Filter;

package Catacomb::MP::Prime::Filter;

sub filterstepper { &stepper(Catacomb::MP::Prime::Filter, @_); }
sub filterjumper { &jumper(Catacomb::MP::Prime::Filter, @_); }

package Catacomb::MP::Prime;

sub primegen { &gen(Catacomb::MP::Prime, @_); }
sub limleegen { &limlee(Catacomb::MP::Prime, @_); }

package Catacomb::MP::Prime::Rabin;

sub rabintester { &tester(Catacomb::MP::Prime::Rabin, @_); }

{
  my $cmpg = "Catacomb::MP::Prime::Gen";
  foreach my $i (qw(FilterStepper JumpStepper RabinTester)) {
    @{"${cmpg}::${i}::ISA"} = ("${cmpg}::MagicProc");
  }
  @{"${cmpg}::MagicProc::ISA"} = ("${cmpg}::Proc");
}

#----- That's all, folks ----------------------------------------------------

1;