Initial commit

lang/go/src/version.sld

@@ -0,0 +1,46 @@
+(define-library (zilch lang go version)
+  (import
+    (scheme base) (srfi 152))
+
+  (export parse-version version<?)
+  (begin
+    (define (parse-version vstr)
+      (unless (char=? (string-ref vstr 0) #\v) (error "not a valid version" vstr))
+      (define first-period (string-index vstr (lambda (ch) (char=? ch #\.)) 1))
+      (define second-period (string-index vstr (lambda (ch) (char=? ch #\.)) (+ 1 first-period)))
+      (define prerelease-dash (string-index vstr (lambda (ch) (char=? ch #\-)) (+ 1 second-period)))
+      (define build-dash (string-index vstr (lambda (ch) (char=? ch #\+)) (+ 1 (or prerelease-dash second-period))))
+      (define major (string->number (string-copy vstr 1 first-period)))
+      (define minor (string->number (string-copy vstr (+ first-period 1) second-period)))
+      (define patch (string->number (string-copy vstr (+ second-period 1) (or prerelease-dash build-dash (string-length vstr)))))
+      (define prerelease (and prerelease-dash (string-copy vstr (+ prerelease-dash 1) (or build-dash (string-length vstr)))))
+      (define build (and build-dash (string-copy vstr (+ build-dash 1))))
+      (list major minor patch prerelease build))
+
+    (define (version<? left right)
+      (set! left (parse-version left))
+      (set! right (parse-version right))
+      (or
+       ; left.major < right.major, or
+       (< (list-ref left 0) (list-ref right 0))
+       (and
+        ; left.major = right.major, and
+        (= (list-ref left 0) (list-ref right 0))
+        (or
+         ; left.minor < right.minor, or
+         (< (list-ref left 1) (list-ref right 1))
+         (and
+          ; left.minor = right.minor, and
+          (= (list-ref left 1) (list-ref right 1))
+          (or
+           ; left.patch < right.patch, or
+           (< (list-ref left 2) (list-ref right 2))
+           (and
+            ; left.patch = right.patch, and
+            (= (list-ref left 2) (list-ref right 2))
+            (or
+             ; left has prerelease, right doesn't
+             (and (list-ref left 3) (not (list-ref right 3)))
+             ; or both have a prerelease and it's comparable
+             (and (list-ref left 3) (string<? (list-ref left 3) (list-ref right 3)))))))))))))
+