From ba354a40a203103a4cf16cd3d21f89f707ba5205 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Fri, 16 May 2003 12:55:15 +0000 Subject: [PATCH] r4981: Auto commit for Debian build --- functions.lisp | 13 ++++++------- strings.lisp | 14 ++++++-------- 2 files changed, 12 insertions(+), 15 deletions(-) diff --git a/functions.lisp b/functions.lisp index ffc8ac6..3bc09bc 100644 --- a/functions.lisp +++ b/functions.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: functions.lisp,v 1.1 2003/04/28 23:51:59 kevin Exp $ +;;;; $Id: functions.lisp,v 1.2 2003/05/16 12:55:15 kevin Exp $ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -18,18 +18,17 @@ (in-package :kmrcl) -(defun memo-proc (fn) +(defun memo-proc (fn &optional (test 'equal)) "Memoize results of call to fn, returns a closure with hash-table" - (let ((cache (make-hash-table :test #'equal))) + (let ((cache (make-hash-table :test test))) #'(lambda (&rest args) (multiple-value-bind (val foundp) (gethash args cache) (if foundp val - (setf (gethash args cache) - (apply fn args))))))) + (setf (gethash args cache) (apply fn args))))))) -(defun memoize (fn-name) - (setf (fdefinition fn-name) (memo-proc (fdefinition fn-name)))) +(defun memoize (fn-name &optional (test 'equal)) + (setf (fdefinition fn-name) (memo-proc (fdefinition fn-name) test))) (defmacro defun-memo (fn args &body body) "Define a memoized function" diff --git a/strings.lisp b/strings.lisp index 046b357..da39d48 100644 --- a/strings.lisp +++ b/strings.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: strings.lisp,v 1.31 2003/05/16 12:50:05 kevin Exp $ +;;;; $Id: strings.lisp,v 1.32 2003/05/16 12:51:11 kevin Exp $ ;;;; ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -38,13 +38,11 @@ (i 0 (1+ i))) ((= i len) n-words) (declare (fixnum i)) - (let ((ch (schar str i))) - (declare (character ch)) - (if (alphanumericp ch) - (unless in-word - (incf n-words) - (setq in-word t)) - (setq in-word nil)))))) + (if (alphanumericp (schar str i)) + (unless in-word + (incf n-words) + (setq in-word t)) + (setq in-word nil))))) ;; From Larry Hunter with modifications (defun position-char (char string start max) -- 2.34.1