Hi, this is a draft for moving min and max to Scheme, because I found that min was a bottleneck for a filename-focused levenshtein implementation I wrote last year.
I optimized that implementation to the brink, down to fibers for parallelization, to be able to do editing difference based filesystem traversal, but for levenshtein, three-element min is in a hot inner loop. That’s why this implementation unrolls manually to three elements. Missing for potential viability to merge: figuring out how to replace min and max for calls from C, too. And implementing that. Or deciding that a parallel implementation is OK for a procedure that has to follow a fixed standard, and only replacing min and max when used from Scheme. Also it needs more testing by number-theory people to ensure that the implementation is correct. A simplified version that depends on match is already in use in hoot. Please have a look whether we should go that path – and if yes, it would be great if you could give me a hint how to provide the missing pieces. Best wishes, Arne From 444d69651cf0a0c40220a3cd5305e2b60efd59d7 Mon Sep 17 00:00:00 2001 From: Arne Babenhauserheide <[email protected]> Date: Thu, 8 Oct 2026 21:02:19 +0200 Subject: [PATCH] draft: implement min and max in Scheme * module/ice-9/boot-9.scm: import min and max from (ice-9 numbers) * module/ice-9/numbers.scm: implement min and max as syntax rules with case-lambda Thanks to compile time optimization this significantly outperforms the C-implementation. --- module/ice-9/boot-9.scm | 8 +++ module/ice-9/numbers.scm | 111 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 119 insertions(+) create mode 100644 module/ice-9/numbers.scm diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index cf8867739..b78da18bf 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -4807,6 +4807,14 @@ R7RS." +;;; Pull (ice-9 numbers) into the root and default environment to get more efficient math +;;; + +(let ((numbers (resolve-interface '(ice-9 numbers)))) + (module-use! the-root-module numbers) + (module-use! the-scm-module numbers)) + + ;;; SRFI-4 in the default environment. FIXME: we should figure out how ;;; to deprecate this. ;;; diff --git a/module/ice-9/numbers.scm b/module/ice-9/numbers.scm new file mode 100644 index 000000000..b86465a0b --- /dev/null +++ b/module/ice-9/numbers.scm @@ -0,0 +1,111 @@ +;;;; numbers.scm --- optimized number operations in scheme +;;;; +;;;; Copyright (C) 2025, 2026 Free Software Foundation, Inc. +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library 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 +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +(define-module (ice-9 numbers) + :export (max min)) + +;; min and max in Scheme +(define-syntax-rule (define-minmax-expansion f %f compare) + (begin + (define %f + (case-lambda + (() (scm-error 'wrong-number-of-args f "Wrong number of arguments" '() '())) + ((x) x) + ((x y) + (cond ((compare x y) (if (inexact? y) (exact->inexact x) x)) + ((compare y x) (if (inexact? x) (exact->inexact y) y)) + ((eqv? x y) x );; not for -0. 0. + ((= x y) (if (zero? x) 0. x ));; -0. and 0. + (else (nan)))) + ((x . rest) + (let lp + ((m x) + (rest rest) + (inex? (inexact? x))) + (if (null? rest) + (if (real? m) + (if inex? (exact->inexact m) m) + (scm-error f "Wrong type ~A" 'wrong-type-arg (list m) '()))) + (let ((x (car rest)) (rest (cdr rest))) + (cond + ((compare x m) (lp x rest (or inex? (inexact? x)))) + ((compare m x) (lp m rest (or inex? (inexact? x)))) + ((eqv? m x) (lp m rest (or inex? (inexact? x ))));; not for -0. 0., but yes for 0 and -0 + ((= m x) + (lp + (if (zero? m) + (cond ((and inex? (exact? m)) x) + ((and inex? (exact? x)) m );; can’t both be exact + ;; for min return -0. + ((or (compare m 1) (compare x 1)) -0.) + (else 0.))) + rest + (or inex? (inexact? x ))));; -0. and 0. + ;; neither > nor < nor = means (nan): nothing more to do + (else (nan)))))))) + (define-syntax f + (lambda (stx) + (syntax-case stx () + (f (identifier? #'f) #'%f) + ((_) #'(scm-error 'wrong-number-of-args f "Wrong number of arguments" '() '())) + ((_ x) #'(if (real? x) x (scm-error f "Wrong type ~A" 'wrong-type-arg (list x) '()))) + ((_ x y) + #'(let + ((x* x) + (y* y) + (inex? (or (inexact? x) (inexact? y)))) + (cond ((compare x* y*) (if (real? x*) (if inex? (exact->inexact x*) x*) (scm-error f "Wrong type ~A" 'wrong-type-arg (list x*) '()))) + ((compare y* x*) (if (real? y*) (if inex? (exact->inexact y*) y*) (scm-error f "Wrong type ~A" 'wrong-type-arg (list y*) '()))) + ((eqv? x* y*) x* );; not for -0. 0. + ((= x* y*) + (if (zero? x*) + (cond ;; details: (and (eqv? 0.0 (min 0.0 0)) (eqv? 0.0 (max -0.0 0))) + ;; for max return 0. + ((or (compare x* -1) (compare y* -1)) 0.) + ;; return inexact if in doubt + ((and inex? (exact? x*)) y*) + ((and inex? (exact? y*)) x* );; can’t both be exact + ;; for min return -0. + ((or (compare x* 1) (compare y* 1)) -0.) + (else 0.)) + x*)) + (else (nan))))) + ((_ x y z) + #'(let + ((x* x) + (y* y) + (z* z) + (inex? (or (inexact? x) (inexact? y) (inexact? z)))) + (cond + ((compare x* y*) + (if (compare x* z*) + (if inex? (exact->inexact x*) x*) + (if inex? (exact->inexact z*) z*))) + ((compare y* x*) + (if (compare y* z*) + (if inex? (exact->inexact y*) y*) + (if inex? (exact->inexact z*) z*))) + ((= x* y*) (f x* z*)) + ((= x* z*) (f y* z*)) + ((= y* z*) (f x* y*)) + (else (nan))))) + ((_ x y . z) + #'(f x y (f . z)))))))) + +(define-minmax-expansion max %max >) +(define-minmax-expansion min %min <) -- 2.54.0 -- Unpolitisch sein heißt politisch sein, ohne es zu merken. https://www.draketo.de
signature.asc
Description: PGP signature
