this code now uses version/utils

svn: r10780
This commit is contained in:
Eli Barzilay 2008-07-15 19:15:45 +00:00
parent 0cd54c9e33
commit e4a66b0d11

View File

@ -1,30 +1,18 @@
#lang scheme/base #lang scheme/base
;; This module provides the string that should replace xxxxxxx's in ;; This module provides the string that should replace xxxxxxx's in
;; file names. The version number is combined to a single integer, ;; file names. The version number is combined into a single integer,
;; and converted to a string in base 36. The version is X.Y.Z.W, with ;; and converted to a string in base 36.
;; 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) (provide filename-version-part)
(require version/utils) (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 (define filename-version-part
(let loop ([n 0] (let* ([ver (version->integer (version))]
[l (version->list (version))] [digits "0123456789abcdefghijklmnopqrstuvwxyz"]
[radix '(200 100 1000 1000)]) [radix (string-length digits)])
(cond [(null? l) (let loop ([n ver] [r '()])
(let ([s (num->str n "0123456789abcdefghijklmnopqrstuvwxyz")]) (cond [(> n 0) (loop (quotient n radix)
(string-append (make-string (- 7 (string-length s)) #\_) s))] (cons (string-ref digits (modulo n radix)) r))]
[(not (< -1 (car l) (car radix))) [(< (length r) 7) (loop n (cons #\_ r))]
(error 'version "internal error, see dynext/filename-version.ss")] [else (list->string r)]))))
[else (loop (+ (car l) (* (car radix) n)) (cdr l) (cdr radix))])))