~ chicken-core (master) 01495986b1c006cb87e42072af20b9382fa3f905
commit 01495986b1c006cb87e42072af20b9382fa3f905
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Wed Nov 5 18:52:57 2025 +0100
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Wed Nov 5 18:52:57 2025 +0100
This is a modified version of a patch from Mario Goulart,
with version>=? added to extras instead of providing a
separate library unit.
diff --git a/.gitignore b/.gitignore
index 202db4f9..aa42fbe0 100644
--- a/.gitignore
+++ b/.gitignore
@@ -95,6 +95,7 @@
/chicken.eval.import.scm
/chicken.file.import.scm
/chicken.file.posix.import.scm
+/chicken.version.import.scm
/chicken.fixnum.import.scm
/chicken.flonum.import.scm
/chicken.format.import.scm
diff --git a/NEWS b/NEWS
index 7138508f..f3822211 100644
--- a/NEWS
+++ b/NEWS
@@ -81,6 +81,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..4d8ac78e 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..782604b6 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -53,6 +53,7 @@
(import (chicken process-context posix))
(import (chicken pretty-print))
(import (chicken string))
+(import (chicken version))
(import (chicken bytevector))
(import (only (scheme base) open-input-string))
@@ -267,25 +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")
diff --git a/defaults.make b/defaults.make
index 5ff724ce..e9747860 100644
--- a/defaults.make
+++ b/defaults.make
@@ -270,7 +270,7 @@ PRIMITIVE_IMPORT_LIBRARIES = chicken.base chicken.condition \
DYNAMIC_IMPORT_LIBRARIES = srfi-4
DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise bytevector errno file.posix \
fixnum flonum format gc io keyword load locative memory \
- memory.representation platform plist pretty-print \
+ memory.representation platform plist pretty-print version \
process process.signal process-context process-context.posix \
random sort string time.posix number-vector
DYNAMIC_CHICKEN_COMPILER_IMPORT_LIBRARIES = user-pass
diff --git a/distribution/manifest b/distribution/manifest
index d19d2fdd..dc5b7b2b 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -251,6 +251,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 +380,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 +479,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/extras.scm b/extras.scm
index 921706b4..c91a1ba9 100644
--- a/extras.scm
+++ b/extras.scm
@@ -480,3 +480,43 @@
dest))))
)
+
+
+;;; Version comparison (used for egg versions)
+
+(module chicken.version (version>=?)
+
+(import scheme)
+(import (chicken base)
+ (chicken string)
+ (chicken fixnum))
+
+(define (version>=? v1 v2)
+ (define (version->list s)
+ (map (lambda (x) (or (string->number x) x))
+ (let ((len (string-length s)))
+ (let loop ((start 0) (pos 0))
+ (cond ((fx>= pos len) (list (substring s start len)))
+ ((memv (string-ref s pos) '(#\- #\\ #\. #\_ #\/))
+ (cons (substring s start pos)
+ (let ((p2 (fx+ pos 1)))
+ (loop p2 p2))))
+ (else (loop start (fx+ pos 1))))))))
+ (##sys#check-string v1 'version>=?)
+ (##sys#check-string v2 'version>=?)
+ (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)))))))
+
+) ;; end module
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..d585cd53 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 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/manual/module (chicken version) b/manual/module (chicken version)
new file mode 100644
index 00000000..4c146229
--- /dev/null
+++ b/manual/module (chicken version)
@@ -0,0 +1,22 @@
+[[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}},
+where both arguments are assumed to encode version numbers.
+The values can be of any type and will be converted to strings
+(using {{->string}}) if necessary. The comparison accepts
+separators like {{"."}}, {{"-"}}, etc. and compares sub-elements
+numerically, if possible.
+
+---
+Previous: [[Module (chicken type)]]
+
+Next: [[Module srfi-4]]
diff --git a/rules.make b/rules.make
index 659560c1..69d3bc07 100644
--- a/rules.make
+++ b/rules.make
@@ -479,6 +479,7 @@ $(eval $(call declare-emitted-import-lib-dependency,chicken.load,eval))
$(eval $(call declare-emitted-import-lib-dependency,chicken.format,extras))
$(eval $(call declare-emitted-import-lib-dependency,chicken.io,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.pretty-print,extras))
+$(eval $(call declare-emitted-import-lib-dependency,chicken.version,extras))
$(eval $(call declare-emitted-import-lib-dependency,chicken.random,extras))
$(eval $(call declare-emitted-import-lib-dependency,chicken.locative,lolevel))
$(eval $(call declare-emitted-import-lib-dependency,chicken.memory,lolevel))
@@ -681,6 +682,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 \
@@ -843,7 +845,8 @@ extras.c: $(SRCDIR)extras.scm $(SRCDIR)common-declarations.scm
$(bootstrap-lib) \
-emit-import-library chicken.format \
-emit-import-library chicken.pretty-print \
- -emit-import-library chicken.random
+ -emit-import-library chicken.random \
+ -emit-import-library chicken.version
posixunix.c: $(SRCDIR)posix.scm $(SRCDIR)posixunix.scm $(SRCDIR)posix-common.scm $(SRCDIR)common-declarations.scm
$(bootstrap-lib) -feature platform-unix \
-emit-import-library chicken.errno \
diff --git a/tests/runtests.sh b/tests/runtests.sh
index c3ad34a7..7753ae1f 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/version-module-tests.scm b/tests/version-module-tests.scm
new file mode 100644
index 00000000..e5dd000b
--- /dev/null
+++ b/tests/version-module-tests.scm
@@ -0,0 +1,29 @@
+(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 "1.10.2 >= 1.09.2" (version>=? "1.10.2" "1.09.2"))
+
+(test-end "chicken.version")
+
+(test-exit)
diff --git a/types.db b/types.db
index a791fbcb..51fb5fd1 100644
--- a/types.db
+++ b/types.db
@@ -2462,6 +2462,9 @@
(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))
+
;; Undocumented internal module, only here to have the deprecation warning because some eggs use it
(chicken.compiler.support#read/source-info deprecated)
Trap