Hi, The attached patch adds the chicken.version module to CHICKEN, addressing https://bugs.call-cc.org/ticket/1823 .
It basically exposes the version>=? procedure used by chicken-install through a module, as that procedure tends useful for eggs and ends up being copied, as CHICKEN does not make it available. Because it was easy, I've added version<? to the module as well (it's the complement of version>=?). Maybe we can add a more complete set of comparators before releasing C6. All the best. Mario -- https://parenteses.org/mario
>From 97287bcc84d7638b2acc61fb570ae7d41012a7db Mon Sep 17 00:00:00 2001 From: Mario Domenech Goulart <[email protected]> Date: Sun, 28 Sep 2025 10:15:15 +0200 Subject: [PATCH] Add chicken.version module Addresses #1823 --- .gitignore | 2 + NEWS | 1 + README | 1 + chicken-install.scm | 21 +--------- defaults.make | 2 +- distribution/manifest | 6 +++ eval-modules.scm | 1 + eval.scm | 2 +- manual/Included modules | 1 + manual/Module (chicken type) | 2 +- manual/Module (chicken version) | 26 ++++++++++++ manual/Module srfi-4 | 2 +- rules.make | 8 +++- tests/runtests.sh | 3 ++ tests/types-db-consistency.scm | 1 + tests/version-module-tests.scm | 32 +++++++++++++++ types.db | 4 ++ version.scm | 71 +++++++++++++++++++++++++++++++++ 18 files changed, 161 insertions(+), 25 deletions(-) create mode 100644 manual/Module (chicken version) create mode 100644 tests/version-module-tests.scm create mode 100644 version.scm diff --git a/.gitignore b/.gitignore index 202db4f9..fe31a320 100644 --- a/.gitignore +++ b/.gitignore @@ -74,6 +74,7 @@ /support.c /tcp.c /user-pass.c +/version.c # Compiled Scheme modules' imports @@ -123,6 +124,7 @@ /chicken.string.import.scm /chicken.tcp.import.scm /chicken.time.posix.import.scm +/chicken.version.import.scm /chicken.number-vector.import.scm /srfi-4.import.scm /scheme.write.import.scm diff --git a/NEWS b/NEWS index 86c4caf8..ea72b5b7 100644 --- a/NEWS +++ b/NEWS @@ -80,6 +80,7 @@ separation. - Added `expand1' to (chicken syntax) module for expanding a macro only once, also added the ",x1" command to "csi" for this. + - Added the (chicken version) module. - Syntax expander: - `syntax-rules' attempts to better support tail patterns with ellipses diff --git a/README b/README index 7b80992c..4571a3e3 100644 --- a/README +++ b/README @@ -342,6 +342,7 @@ _/ _/ _/ _/ _/ _/ _/ _/ _/ _/_/ | | |-- chicken.tcp.import.so | | |-- chicken.time.import.so | | |-- chicken.time.posix.import.so + | | |-- chicken.version.import.so | | |-- scheme.file.import.so | | |-- scheme.process-context.import.so | | |-- scheme.time.import.so diff --git a/chicken-install.scm b/chicken-install.scm index 32a5bf9f..bfcfa794 100644 --- a/chicken-install.scm +++ b/chicken-install.scm @@ -54,6 +54,7 @@ (import (chicken pretty-print)) (import (chicken string)) (import (chicken bytevector)) +(import (chicken version)) (import (only (scheme base) open-input-string)) (define +defaults-version+ 2) @@ -267,26 +268,6 @@ (apply fprintf port fstr args) (flush-output port) ) ))) -(define (version>=? v1 v2) - (define (version->list v) - (map (lambda (x) (or (string->number x) x)) - (irregex-split "[-\\._]" (->string v)))) - (let loop ((p1 (version->list v1)) - (p2 (version->list v2))) - (cond ((null? p1) (null? p2)) - ((null? p2)) - ((number? (car p1)) - (and (number? (car p2)) - (or (> (car p1) (car p2)) - (and (= (car p1) (car p2)) - (loop (cdr p1) (cdr p2)))))) - ((number? (car p2))) - ((string>? (car p1) (car p2))) - (else - (and (string=? (car p1) (car p2)) - (loop (cdr p1) (cdr p2))))))) - - ;; load defaults file ("setup.defaults") (define (load-defaults) diff --git a/defaults.make b/defaults.make index 5ff724ce..eecc0e0e 100644 --- a/defaults.make +++ b/defaults.make @@ -275,7 +275,7 @@ DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise bytevector errno file.posix \ random sort string time.posix number-vector DYNAMIC_CHICKEN_COMPILER_IMPORT_LIBRARIES = user-pass DYNAMIC_CHICKEN_UNIT_IMPORT_LIBRARIES = continuation eval file \ - internal irregex pathname port read-syntax repl tcp + internal irregex pathname port read-syntax repl tcp version # targets diff --git a/distribution/manifest b/distribution/manifest index d19d2fdd..46ffee41 100644 --- a/distribution/manifest +++ b/distribution/manifest @@ -102,6 +102,8 @@ read-syntax.scm repl.scm runtime.c utf.c +version.c +version.scm scheduler.scm srfi-4.scm stub.scm @@ -251,6 +253,7 @@ tests/reverser/tags/1.1/reverser.egg tests/reverser/tags/1.1/reverser.scm tests/user-pass-tests.scm tests/version-tests.scm +tests/version-module-tests.scm tests/messages-test.scm tests/messages.expected tests/types-db-consistency.scm @@ -379,6 +382,8 @@ chicken.time.import.scm chicken.time.import.c chicken.time.posix.import.scm chicken.time.posix.import.c +chicken.version.import.scm +chicken.version.import.c srfi-4.import.scm srfi-4.import.c scheme.file.import.scm @@ -476,6 +481,7 @@ manual-html/Module (chicken tcp).html manual-html/Module (chicken time).html manual-html/Module (chicken time posix).html manual-html/Module (chicken type).html +manual-html/Module (chicken version).html manual-html/Module scheme.html manual-html/Module (scheme base).html manual-html/Module (scheme case-lambda).html diff --git a/eval-modules.scm b/eval-modules.scm index 5c4ed095..fdae737a 100644 --- a/eval-modules.scm +++ b/eval-modules.scm @@ -92,6 +92,7 @@ (defmod chicken.read-syntax) (defmod chicken.repl) (defmod chicken.tcp) +(defmod chicken.version) (defmod chicken.number-vector) (defmod srfi-4) (defmod scheme.write) diff --git a/eval.scm b/eval.scm index 64a9bbda..1f211f07 100644 --- a/eval.scm +++ b/eval.scm @@ -946,7 +946,7 @@ '(chicken-syntax chicken-ffi-syntax continuation data-structures debugger-client eval eval-modules expand extras file internal irregex library lolevel pathname port posix profiler read-syntax - repl scheduler srfi-4 tcp r7lib)) + repl scheduler srfi-4 tcp r7lib version)) (define-constant cygwin-default-dynamic-load-libraries '("cygchicken-0")) (define-constant macosx-load-library-extension ".dylib") diff --git a/manual/Included modules b/manual/Included modules index b2390d46..db2cffa4 100644 --- a/manual/Included modules +++ b/manual/Included modules @@ -74,6 +74,7 @@ default all exports of the [[Module scheme|scheme]], * [[Module (chicken time)]] : Fetching information about the current time * [[Module (chicken time posix)]] : Manipulating POSIX time * [[Module (chicken type)]] : Defining and using static typing information +* [[Module (chicken version)]] : Version comparison operations * [[Module srfi-4]] : The subset of [[Module (chicken number-vector)]] specified by SRFI-4 In addition to the core modules listed above, the following SRFI modules can be diff --git a/manual/Module (chicken type) b/manual/Module (chicken type) index 9673dde7..46f6b128 100644 --- a/manual/Module (chicken type) +++ b/manual/Module (chicken type) @@ -9,4 +9,4 @@ The functionality in this module is available by default. See --- Previous: [[Module (chicken time posix)]] -Next: [[Module srfi-4]] +Next: [[Module (chicken version)]] diff --git a/manual/Module (chicken version) b/manual/Module (chicken version) new file mode 100644 index 00000000..2b5a1369 --- /dev/null +++ b/manual/Module (chicken version) @@ -0,0 +1,26 @@ +[[tags: manual]] +[[toc:]] + +== Module (chicken version) + +This module contains procedures for version comparison operations. + +=== version>=? + +<procedure>(version>=? v1 v2)</procedure> + +Return {{#t}} if {{v1}} is greater than or equal to {{v2}}. Arguments +can be of any type and internally will be converted to strings. + +=== version<? + +<procedure>(version<? v1 v2)</procedure> + +The complement of {{version>=?}}. Return {{#t}} if {{v1}} is less +than {{v2}}. Arguments can be of any type and internally will be +converted to strings. + +--- +Previous: [[Module (chicken type)]] + +Next: [[Module srfi-4]] diff --git a/manual/Module srfi-4 b/manual/Module srfi-4 index dcd18afb..6493af03 100644 --- a/manual/Module srfi-4 +++ b/manual/Module srfi-4 @@ -93,7 +93,7 @@ The module exports the following identifiers: <procedure>(list->f64vector F64LIST)</procedure><br> --- -Previous: [[Module (chicken type)]] +Previous: [[Module (chicken version)]] Next: [[Interface to external functions and variables]] diff --git a/rules.make b/rules.make index 86a5e7eb..ce8f9701 100644 --- a/rules.make +++ b/rules.make @@ -37,7 +37,7 @@ LIBCHICKEN_SCHEME_OBJECTS_1 = \ library eval read-syntax repl data-structures pathname port file \ extras lolevel tcp srfi-4 continuation $(POSIXFILE) internal \ irregex scheduler debugger-client profiler stub expand modules \ - chicken-syntax chicken-ffi-syntax build-version r7lib + chicken-syntax chicken-ffi-syntax build-version r7lib version LIBCHICKEN_OBJECTS_1 = $(LIBCHICKEN_SCHEME_OBJECTS_1) runtime utf LIBCHICKEN_SHARED_OBJECTS = $(LIBCHICKEN_OBJECTS_1:=$(O)) LIBCHICKEN_STATIC_OBJECTS = $(LIBCHICKEN_OBJECTS_1:=-static$(O)) \ @@ -681,6 +681,7 @@ chicken-install.c: chicken-install.scm \ chicken.process-context.import.scm \ chicken.sort.import.scm \ chicken.string.import.scm \ + chicken.version.import.scm \ chicken.tcp.import.scm chicken-uninstall.c: chicken-uninstall.scm \ chicken.file.import.scm \ @@ -779,6 +780,9 @@ tcp.c: tcp.scm \ chicken.foreign.import.scm \ chicken.port.import.scm \ chicken.time.import.scm +version.c: version.scm \ + chicken.irregex.import.scm \ + chicken.string.import.scm eval-modules.c: eval-modules.scm $(DYNAMIC_IMPORT_LIBRARIES:=.import.scm) \ $(foreach lib,$(DYNAMIC_CHICKEN_IMPORT_LIBRARIES),chicken.$(lib).import.scm) \ $(foreach lib,$(DYNAMIC_CHICKEN_UNIT_IMPORT_LIBRARIES),$(lib).c) @@ -887,6 +891,8 @@ lolevel.c: $(SRCDIR)lolevel.scm $(SRCDIR)common-declarations.scm -emit-import-library chicken.memory.representation tcp.c: $(SRCDIR)tcp.scm $(SRCDIR)common-declarations.scm $(bootstrap-lib) -emit-import-library chicken.tcp +version.c: $(SRCDIR)version.scm $(SRCDIR)common-declarations.scm + $(bootstrap-lib) -emit-import-library chicken.version srfi-4.c: $(SRCDIR)srfi-4.scm $(SRCDIR)common-declarations.scm $(bootstrap-lib) -emit-import-library srfi-4 \ -emit-import-library chicken.number-vector diff --git a/tests/runtests.sh b/tests/runtests.sh index c3ad34a7..1422ce51 100755 --- a/tests/runtests.sh +++ b/tests/runtests.sh @@ -554,4 +554,7 @@ $interpret -s multiple-values.scm $compile multiple-values.scm ./a.out +echo "======================================== version module tests ..." +$interpret -bnq version-module-tests.scm + echo "======================================== done. All tests passed." diff --git a/tests/types-db-consistency.scm b/tests/types-db-consistency.scm index a7e391ed..8e00004c 100644 --- a/tests/types-db-consistency.scm +++ b/tests/types-db-consistency.scm @@ -14,6 +14,7 @@ (chicken process-context posix) (chicken tcp) (chicken number-vector) + (chicken version) (scheme write)) (define ignored-symbols diff --git a/tests/version-module-tests.scm b/tests/version-module-tests.scm new file mode 100644 index 00000000..a309fc5a --- /dev/null +++ b/tests/version-module-tests.scm @@ -0,0 +1,32 @@ +(import (chicken eval) + (chicken load) + (chicken version)) + +(cond-expand + (compiling + (include "test.scm") ) + (else + (load-relative "test.scm"))) + +(test-begin "chicken.version") + +(test-assert "0 >= 0" (version>=? "0" "0")) +(test-assert "1 >= 0" (version>=? "1" "0")) +(test-assert "1.0 >= 0.0.1" (version>=? "1.0" "0.0.1")) +(test-assert "1.0 >= 0.1.1" (version>=? "1.0" "0.1.1")) +(test-assert "0.0.0 >= 0.0.0" (version>=? "0.0.0" "0.0.0")) +(test-assert "0.0.0 >= 0.0" (version>=? "0.0.0" "0.0")) +(test-assert "0.0.1 >= 0.0.0" (version>=? "0.0.1" "0.0.0")) +(test-assert "1.0.0 >= 0.0.0" (version>=? "1.0.0" "0.0.0")) +(test-assert "1.0.0 >= 0.0.0b" (version>=? "1.0.0" "0.0.0b")) +(test-assert "1.0.0b >= 1.0.0" (version>=? "1.0.0b" "1.0.0")) +(test-assert "1.0.0 >= 0.9.9-rc1" (version>=? "1.0.0" "0.9.9-rc1")) +(test-assert "1.10 >= 1.09" (version>=? "1.10" "1.09")) +(test-assert "(numbers) 0 >= 0" (version>=? 0 0)) +(test-assert "(numbers) 1 >= 0" (version>=? 1 0)) +(test-assert "(numbers) 1.09 >= 1.10" (version>=? 1.09 1.10)) + +;; Just to make sure that the module exports this procedure +(test-assert "0 < 1" (version<? "0" "1")) + +(test-end "chicken.version") diff --git a/types.db b/types.db index fba0eaa6..5278fc88 100644 --- a/types.db +++ b/types.db @@ -2461,6 +2461,10 @@ (chicken.tcp#tcp-read-timeout (#(procedure #:clean #:enforce) chicken.tcp#tcp-read-timeout (#!optional (or false integer)) (or false integer))) (chicken.tcp#tcp-write-timeout (#(procedure #:clean #:enforce) chicken.tcp#tcp-write-timeout (#!optional (or false integer)) (or false integer))) +;; version +(chicken.version#version>=? (#(procedure #:pure #:foldable) chicken.version#version>=? (* *) boolean)) +(chicken.version#version<? (#(procedure #:pure #:foldable) chicken.version#version<? (* *) boolean)) + ;; Undocumented internal module, only here to have the deprecation warning because some eggs use it (chicken.compiler.support#read/source-info deprecated) diff --git a/version.scm b/version.scm new file mode 100644 index 00000000..c3aea035 --- /dev/null +++ b/version.scm @@ -0,0 +1,71 @@ +;;;; version.scm +; +; Copyright (c) 2025, The CHICKEN Team +; All rights reserved. +; +; Redistribution and use in source and binary forms, with or without +; modification, are permitted provided that the following conditions +; are met: +; +; Redistributions of source code must retain the above copyright +; notice, this list of conditions and the following disclaimer. +; +; Redistributions in binary form must reproduce the above copyright +; notice, this list of conditions and the following disclaimer in +; the documentation and/or other materials provided with the +; distribution. +; +; Neither the name of the author nor the names of its contributors +; may be used to endorse or promote products derived from this +; software without specific prior written permission. +; +; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS +; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +; COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, +; INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +; STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED +; OF THE POSSIBILITY OF SUCH DAMAGE. + +(declare + (unit version) + (uses data-structures irregex) + (fixnum) + (disable-interrupts)) + +(module chicken.version (version>=? version<?) + +(import scheme) +(import (chicken base) + (chicken irregex) + (chicken string)) + +(include "common-declarations.scm") + +(define (version>=? v1 v2) + (define (version->list v) + (map (lambda (x) (or (string->number x) x)) + (irregex-split "[-\\._]" (->string v)))) + (let loop ((p1 (version->list v1)) + (p2 (version->list v2))) + (cond ((null? p1) (null? p2)) + ((null? p2)) + ((number? (car p1)) + (and (number? (car p2)) + (or (> (car p1) (car p2)) + (and (= (car p1) (car p2)) + (loop (cdr p1) (cdr p2)))))) + ((number? (car p2))) + ((string>? (car p1) (car p2))) + (else + (and (string=? (car p1) (car p2)) + (loop (cdr p1) (cdr p2))))))) + +(define version<? (complement version>=?)) + +) ;; end module -- 2.47.3
