From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Rob Browning Newsgroups: gmane.lisp.guile.devel Subject: Forwarded patch for modular exponentiation support (GMP powm) Date: Wed, 28 Jan 2004 11:22:27 -0600 Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Message-ID: <87k73cng30.fsf@raven.i.defaultvalue.org> NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: sea.gmane.org 1075310786 8424 80.91.224.253 (28 Jan 2004 17:26:26 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Wed, 28 Jan 2004 17:26:26 +0000 (UTC) Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Wed Jan 28 18:26:14 2004 Return-path: Original-Received: from monty-python.gnu.org ([199.232.76.173]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1AltS9-00081i-00 for ; Wed, 28 Jan 2004 18:26:14 +0100 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.24) id 1AltS0-0000LD-Mi for guile-devel@m.gmane.org; Wed, 28 Jan 2004 12:26:04 -0500 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.24) id 1AltQV-0007ZC-7C for guile-devel@gnu.org; Wed, 28 Jan 2004 12:24:31 -0500 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.24) id 1AltPj-0006zC-Hh for guile-devel@gnu.org; Wed, 28 Jan 2004 12:24:15 -0500 Original-Received: from [66.93.216.237] (helo=defaultvalue.org) by monty-python.gnu.org with esmtp (Exim 4.24) id 1AltOY-0006AJ-1o for guile-devel@gnu.org; Wed, 28 Jan 2004 12:22:30 -0500 Original-Received: from raven.i.defaultvalue.org (raven.i.defaultvalue.org [192.168.1.7]) by defaultvalue.org (Postfix) with ESMTP id 8730B403D for ; Wed, 28 Jan 2004 11:22:28 -0600 (CST) Original-Received: by raven.i.defaultvalue.org (Postfix, from userid 1000) id B30972CF062; Wed, 28 Jan 2004 11:22:27 -0600 (CST) Original-To: guile-devel@gnu.org User-Agent: Gnus/5.1006 (Gnus v5.10.6) Emacs/21.3 (gnu/linux) X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.2 Precedence: list List-Id: Developers list for Guile, the GNU extensibility library List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: main.gmane.org gmane.lisp.guile.devel:3330 X-Report-Spam: http://spam.gmane.org/gmane.lisp.guile.devel:3330 --=-=-= 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 --=-=-= Content-Type: message/rfc822 Content-Disposition: inline X-From-Line: nobody Fri Jan 23 15:01:52 2004 To: guile-devel@gnu.org Subject: [PATCH]: modular exponentation function X-Draft-From: ("nnfolder+archive:sent" 1123) References: <87zncvfopk.fsf@offby1.atm01.sea.blarg.net> From: Eric Hanchrow Date: Fri, 23 Jan 2004 15:01:52 -0800 In-Reply-To: <87zncvfopk.fsf@offby1.atm01.sea.blarg.net> (Eric Hanchrow's message of "Sat, 10 Jan 2004 14:01:11 -0800") Message-ID: <87vfn2i80v.fsf@offby1.atm01.sea.blarg.net> User-Agent: Gnus/5.1006 (Gnus v5.10.6) Emacs/21.3.50 (gnu/linux) Lines: 111 Xref: debian sent:1218 MIME-Version: 1.0 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 --- 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? --=-=-= -- 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 --=-=-= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Guile-devel mailing list Guile-devel@gnu.org http://mail.gnu.org/mailman/listinfo/guile-devel --=-=-=--