guile-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Forwarded patch for modular exponentiation support (GMP powm)


From: Rob Browning
Subject: Forwarded patch for modular exponentiation support (GMP powm)
Date: Wed, 28 Jan 2004 11:22:27 -0600
User-agent: Gnus/5.1006 (Gnus v5.10.6) Emacs/21.3 (gnu/linux)

Eric has tried to send this to guile-devel, but for some reason his
messages aren't getting through, so I offered to forward it myself.

Thanks

--- Begin Message --- Subject: [PATCH]: modular exponentation function Date: Fri, 23 Jan 2004 15:01:52 -0800 User-agent: Gnus/5.1006 (Gnus v5.10.6) Emacs/21.3.50 (gnu/linux)
I've (almost) never written code for guile before, so I'm probably
doing a bunch of things wrong.  But it works for me, and I think it'd
be useful.

Index: libguile/numbers.c
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/libguile/numbers.c,v
retrieving revision 1.221
diff -w -u -r1.221 numbers.c
--- libguile/numbers.c  6 Jan 2004 21:55:29 -0000       1.221
+++ libguile/numbers.c  10 Jan 2004 21:58:24 -0000
@@ -1519,6 +1519,46 @@
 }
 #undef FUNC_NAME
 
+static SCM
+coerce_to_big(SCM n)
+{
+  if (SCM_BIGP(n))
+    return n;
+  else if (SCM_INUMP(n))
+    {
+      SCM bigger = scm_i_mkbig();
+      mpz_init_set_ui(SCM_I_BIG_MPZ(bigger), SCM_INUM(n));
+      return bigger;
+    }
+  else
+    scm_wrong_type_arg("mexpt", 1, n);
+}
+
+SCM_DEFINE(scm_modular_expt, "mexpt", 3, 0, 0,
+           (SCM n, SCM k, SCM m),
+            "Return @var{n} raised to the non-negative integer exponent\n"
+           "@var{k}, modulo @var{m}.\n"
+           "\n"
+           "@lisp\n"
+           "(mexpt 2 3 5)\n"
+           "   @result{} 3\n"
+           "@end lisp")
+#define FUNC_NAME s_scm_modular_expt
+{
+  SCM result = scm_i_mkbig();
+  n = coerce_to_big(n);
+  k = coerce_to_big(k);
+  m = coerce_to_big(m);
+
+  mpz_powm (SCM_I_BIG_MPZ (result),
+            SCM_I_BIG_MPZ (n),
+            SCM_I_BIG_MPZ (k),
+            SCM_I_BIG_MPZ (m));
+  
+  return scm_i_normbig (result);
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_integer_expt, "integer-expt", 2, 0, 0,
             (SCM n, SCM k),
            "Return @var{n} raised to the non-negative integer exponent\n"
Index: libguile/numbers.h
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/libguile/numbers.h,v
retrieving revision 1.77
diff -w -u -r1.77 numbers.h
--- libguile/numbers.h  18 Nov 2003 19:59:51 -0000      1.77
+++ libguile/numbers.h  10 Jan 2004 21:58:24 -0000
@@ -201,6 +201,7 @@
 SCM_API SCM scm_logtest (SCM n1, SCM n2);
 SCM_API SCM scm_logbit_p (SCM n1, SCM n2);
 SCM_API SCM scm_lognot (SCM n);
+SCM_API SCM scm_modular_expt (SCM n, SCM k, SCM m);
 SCM_API SCM scm_integer_expt (SCM z1, SCM z2);
 SCM_API SCM scm_ash (SCM n, SCM cnt);
 SCM_API SCM scm_bit_extract (SCM n, SCM start, SCM end);
--- /dev/null   1969-12-31 16:00:00.000000000 -0800
+++ mexp.test   2004-01-10 13:54:58.000000000 -0800
@@ -0,0 +1,27 @@
+;;;; mexp.test --- test suite for Guile's modular exponentiation functions    
-*- scheme -*-
+;;;; Eric Hanchrow <address@hidden> --- January 2004
+;;;;
+;;;; Copyright (C) 2004 Free Software Foundation, Inc.
+;;;; 
+;;;; This program 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, or (at your option)
+;;;; any later version.
+;;;; 
+;;;; This program 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 this software; see the file COPYING.  If not, write to
+;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+;;;; Boston, MA 02111-1307 USA
+
+(with-test-prefix "mexpt"
+   (pass-if "right answer with fixnums"
+     (= 1 (mexpt 17 23 47)))
+   
+   (pass-if "right answer with bignums"
+              (= 508153794507026 (mexpt 111122223333444455556666 
111122223333444455556666 1234123412341234)))
+)

-- 
Always code as if the guy who ends up maintaining your code will
    be a violent psychopath who knows where you live.  John F. Woods

-- 
If you can't change your underwear, can you be sure you have any?

--- End Message ---

-- 
Rob Browning
rlb @defaultvalue.org and @debian.org; previously @cs.utexas.edu
GPG starting 2002-11-03 = 14DD 432F AE39 534D B592  F9A0 25C8 D377 8C7E 73A4

reply via email to

[Prev in Thread] Current Thread [Next in Thread]