cgit.sxemacs.org Git - packages/blob - xemacs-packages/zenirc/src/zenirc-prime-p.el

   1 ;;; zenirc-prime-p.el --- flag prime numbers
   2
   3 ;; Copyright (C) 1997, 1998 Ray Jones
   4
   5 ;; Author: Ray Jones <rjones@pobox.com>
   6 ;; Maintainer: rjones@pobox.com
   7 ;; Keywords: zenirc, extensions, oink, "mmmm, primes"
   8 ;; Created: 1997-11-13
   9
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15 ;;
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20 ;;
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program; if not, you can either send email to this
  23 ;; program's maintainer or write to: The Free Software Foundation,
  24 ;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary: mmm, primes
  27
  28 ;;; Code:
  29
  30 (require 'zenirc)
  31 (require 'zenirc-trigger)
  32
  33 ;; the method to find primes isn't fancy, just the sieve of erasthonese
  34
  35 (defvar *zenirc-prime-list* '(2)
  36   "List of numbers already determined to be prime.")
  37 (defvar *zenirc-prime-list-end* *zenirc-prime-list*
  38   "Last pair in *zenirc-prime-list*, kept for efficiency reasons.")
  39
  40 (defconst *zenirc-recent-count* 10
  41   "Number of primes to remember in *zenirc-recent-primes*.")
  42 (defvar *zenirc-recent-primes* (make-list *zenirc-recent-count* 0)
  43   "Primes recently seen, kept to keep from flagging the same prime over and over.")
  44
  45 (defvar *zenirc-next-test* 3
  46   "Smallest number not yet tested for insertion into *zenirc-prime-list*.")
  47
  48 ;; lest this get really out of control
  49 (defconst *zenirc-max-to-store* 10000
  50   "Maximum value to ever insert into *zenirc-prime-list*.")
  51
  52 (defun zenirc-primep (n)
  53   (if (< n *zenirc-max-to-store*)
  54       (if (<= *zenirc-next-test* n)
  55           (zenirc-expand-prime-list n)
  56         (member n *zenirc-prime-list*))
  57     (let ((test-limit (truncate (sqrt n)))
  58           (l *zenirc-prime-list*)
  59           (lastmod 1))
  60       ;; if *zenirc-max-to-store* is less than (sqrt most-positive-fixnum),
  61       ;; this could expand the list more than *zenirc-max-to-store* should
  62       ;; allow.
  63       (zenirc-expand-prime-list test-limit)
  64       (while (and l
  65                   (not (= lastmod 0))
  66                   (<= (car l) test-limit))
  67         (setq lastmod (mod n (car l)))
  68         (setq l (cdr l)))
  69       (not (= lastmod 0)))))
  70
  71 (defun zenirc-expand-prime-list (n)
  72   (while (<= *zenirc-next-test* n)
  73     (let ((test-limit (truncate (sqrt *zenirc-next-test*)))
  74           (l *zenirc-prime-list*)
  75           (lastmod 1))
  76       (while (and (not (= lastmod 0))
  77                   (<= (car l) test-limit))
  78         (setq lastmod (mod *zenirc-next-test* (car l)))
  79         (setq l (cdr l)))
  80       (if (not (= lastmod 0))
  81           (progn
  82             (setcdr *zenirc-prime-list-end* `(,*zenirc-next-test*))
  83             (setq *zenirc-prime-list-end* (cdr *zenirc-prime-list-end*)))))
  84     (setq *zenirc-next-test* (+ 1 *zenirc-next-test*)))
  85   (= (car *zenirc-prime-list-end*) n))
  86
  87
  88 (defun zenirc-primep-filter (str)
  89   (let ((num (string-to-int str)))
  90     (if (and (not (member num *zenirc-recent-primes*))
  91              (zenirc-primep num))
  92         (progn
  93           (setq *zenirc-recent-primes* (cons num *zenirc-recent-primes*))
  94           (setcdr (nthcdr (- *zenirc-recent-count* 1) *zenirc-recent-primes*) nil)
  95           (format "%s is prime." str))
  96       nil)))
  97
  98 (zenirc-trigger-register "primep" 'zenirc-primep-filter
  99                          "[1-9][0-9][0-9][0-9]*" t)
 100
 101 ;;; zenirc-prime-p.el ends here.
 102