mzscheme -> scheme

svn: r16240
This commit is contained in:
Eli Barzilay 2009-10-05 04:36:22 +00:00
parent b0e8fac1f8
commit e499c32435

View File

@ -8,15 +8,15 @@
;; running MzScheme.exe on Windows -- "winvers.ss" uses a trick of making a
;; copy of the binary and restarting that copy for the actual change.
(module winvers-change mzscheme
#lang scheme
(define verbose? #t)
(define binary-extensions '("exe" "dll" "lib" "so" "def" "exp" #|"obj" "o"|#))
(define xxxs #"xxxxxxx")
(define xxxs-re
(define verbose? #t)
(define binary-extensions '("exe" "dll" "lib" "so" "def" "exp" #|"obj" "o"|#))
(define xxxs #"xxxxxxx")
(define xxxs-re
(bytes-append #"(?:lib(?:mzsch|mzgc|mred)(?:|3m))(" xxxs #")"))
(define renaming (regexp (format "^~a[.](?:dll|lib|exp)$" xxxs-re)))
(define substitutions
(define renaming (regexp (format "^~a[.](?:dll|lib|exp)$" xxxs-re)))
(define substitutions
(map (lambda (s) (byte-regexp (regexp-replace #rx#"~a" s xxxs-re)))
;; pdb not needed, but this way we can expect no
;; `xxxxxxx's when we finish.
@ -26,15 +26,15 @@
#"__head_~a_lib\0"
#"__~a_lib_iname\0")))
(require dynext/filename-version)
(define version-bytes (string->bytes/utf-8 filename-version-part))
(require dynext/filename-version)
(define version-bytes (string->bytes/utf-8 filename-version-part))
(define (binary-file? filename)
(define (binary-file? filename)
(cond [(regexp-match #rx"[.]([^.]+)$" filename) =>
(lambda (m) (member (string-downcase (cadr m)) binary-extensions))]
[else #f]))
(define (do-file file)
(define (do-file file)
(define (full-path) ; proc since `file' can change
(build-path (current-directory) file))
(let ([dfile (string-downcase file)])
@ -51,7 +51,7 @@
"Warning: ~a was not renamed!\n" (full-path))]))
(let-values ([(i o) (open-input-output-file file 'update)])
(define print? verbose?)
(for-each (lambda (subst)
(for ([subst (in-list substitutions)])
(file-position i 0)
(let loop ([pos 0])
(cond [(regexp-match-positions subst i) =>
@ -64,7 +64,6 @@
(flush-output o)
(file-position i (+ pos (cdar m)))
(loop (+ pos (cdar m))))])))
substitutions)
(file-position i 0)
(when (regexp-match-positions xxxs i)
(fprintf (current-error-port)
@ -72,15 +71,12 @@
(close-input-port i)
(close-output-port o)))
(let loop ([paths (if (zero? (vector-length (current-command-line-arguments)))
(let loop ([paths (if (zero? (vector-length (current-command-line-arguments)))
'(".")
(vector->list (current-command-line-arguments)))])
(for-each (lambda (path)
(for ([path (in-list paths)])
(cond [(file-exists? path)
(when (binary-file? path) (do-file path))]
[(directory-exists? path)
(parameterize ([current-directory path])
(loop (map path->string (directory-list))))]))
paths))
)
(loop (map path->string (directory-list))))])))