diff --git a/collects/dynext/filename-version.ss b/collects/dynext/filename-version.ss index 43d50d0fef..4e3def5a06 100644 --- a/collects/dynext/filename-version.ss +++ b/collects/dynext/filename-version.ss @@ -1,30 +1,30 @@ #lang scheme/base -;; This module provides the string that should replace xxxxxxx's in file names. -;; The version number is compacted representing alternate sets of digits by -;; letters, and then dropping "."s: -;; 3.99.1.5 => 3.jj.1.f => 3jj1f +;; This module provides the string that should replace xxxxxxx's in +;; file names. The version number is combined to a single integer, +;; and converted to a string in base 36. The version is X.Y.Z.W, with +;; the general restrictions that Y<100 and Z<1000. This code further +;; assumes X<200, W<1000 and will throw an error if not -- if that +;; happens it's time to change the naming scheme or add more x's. (provide filename-version-part) +(require version/utils) + +(define (num->str n digits) + (let ([radix (string-length digits)]) + (let loop ([n n] [r '()]) + (if (<= n 0) + (list->string r) + (loop (quotient n radix) + (cons (string-ref digits (modulo n radix)) r)))))) (define filename-version-part - (let* ([l (map string->number (regexp-split #rx"[.]" (version)))] - [s (apply - string-append - (let loop ([l l][alpha? #f]) - (cond - [(null? l) null] - [else (let ([s (number->string (car l))]) - (cons (if alpha? - (list->string - (map (lambda (c) - (integer->char - (+ (char->integer c) - (- (char->integer #\a) - (char->integer #\0))))) - (string->list s))) - s) - (loop (cdr l) (not alpha?))))])))]) - (string-append (make-string (max 0 (- 7 (string-length s))) - #\_) - s))) + (let loop ([n 0] + [l (version->list (version))] + [radix '(200 100 1000 1000)]) + (cond [(null? l) + (let ([s (num->str n "0123456789abcdefghijklmnopqrstuvwxyz")]) + (string-append (make-string (- 7 (string-length s)) #\_) s))] + [(not (< -1 (car l) (car radix))) + (error 'version "internal error, see dynext/filename-version.ss")] + [else (loop (+ (car l) (* (car radix) n)) (cdr l) (cdr radix))])))