SHA1-based shortcut for compiler/cm
This commit is contained in:
Matthew Flatt
parent
85fad33c4c
commit
3db8dd7c26
|
|
@ -5,7 +5,9 @@
|
|||
unstable/file
|
||||
scheme/file
|
||||
scheme/list
|
||||
scheme/path)
|
||||
scheme/path
|
||||
racket/promise
|
||||
openssl/sha1)
|
||||
|
||||
(provide make-compilation-manager-load/use-compiled-handler
|
||||
managed-compile-zo
|
||||
|
|
@ -13,8 +15,8 @@
|
|||
trust-existing-zos
|
||||
manager-compile-notify-handler
|
||||
manager-skip-file-handler
|
||||
file-date-in-collection
|
||||
file-date-in-paths
|
||||
file-stamp-in-collection
|
||||
file-stamp-in-paths
|
||||
(rename-out [trace manager-trace-handler]))
|
||||
|
||||
(define manager-compile-notify-handler (make-parameter void))
|
||||
|
|
@ -23,10 +25,10 @@
|
|||
(define trust-existing-zos (make-parameter #f))
|
||||
(define manager-skip-file-handler (make-parameter (λ (x) #f)))
|
||||
|
||||
(define (file-date-in-collection p)
|
||||
(file-date-in-paths p (current-library-collection-paths)))
|
||||
(define (file-stamp-in-collection p)
|
||||
(file-stamp-in-paths p (current-library-collection-paths)))
|
||||
|
||||
(define (file-date-in-paths p paths)
|
||||
(define (file-stamp-in-paths p paths)
|
||||
(let ([p-eles (explode-path (simplify-path p))])
|
||||
(let c-loop ([paths paths])
|
||||
(cond
|
||||
|
|
@ -47,11 +49,16 @@
|
|||
#f
|
||||
(lambda () #f)))]
|
||||
[date (or p-date alt-date)]
|
||||
[get-path (lambda ()
|
||||
(if p-date
|
||||
p
|
||||
(rkt->ss p)))]
|
||||
[mode (car (use-compiled-file-paths))]
|
||||
[get-zo-date (lambda (name)
|
||||
(file-or-directory-modify-seconds
|
||||
(build-path
|
||||
base
|
||||
(car (use-compiled-file-paths))
|
||||
mode
|
||||
(path-add-suffix name #".zo"))
|
||||
#f
|
||||
(lambda () #f)))]
|
||||
|
|
@ -62,12 +69,21 @@
|
|||
(not alt-date)
|
||||
(not main-zo-date)))
|
||||
(get-zo-date (rkt->ss name)))]
|
||||
[zo-date (or main-zo-date alt-zo-date)])
|
||||
(or (and date
|
||||
zo-date
|
||||
(max date zo-date))
|
||||
date
|
||||
zo-date)))]
|
||||
[zo-date (or main-zo-date alt-zo-date)]
|
||||
[get-zo-path (lambda ()
|
||||
(if main-zo-date
|
||||
(path-add-suffix name #".zo")
|
||||
(path-add-suffix (rkt->ss name) #".zo")))])
|
||||
(cond
|
||||
[(and zo-date
|
||||
(or (not date)
|
||||
(zo-date . > . date)))
|
||||
(cons zo-date
|
||||
(delay (get-compiled-sha1 mode (get-zo-path))))]
|
||||
[date
|
||||
(cons date
|
||||
(delay (get-source-sha1 (get-path))))]
|
||||
[else #f])))]
|
||||
[(null? p-eles)
|
||||
;; this case shouldn't happen... I think.
|
||||
(c-loop (cdr paths))]
|
||||
|
|
@ -107,7 +123,11 @@
|
|||
dir))
|
||||
|
||||
(define (touch path)
|
||||
(close-output-port (open-output-file path #:exists 'append)))
|
||||
(file-or-directory-modify-seconds
|
||||
path
|
||||
(current-seconds)
|
||||
(lambda ()
|
||||
(close-output-port (open-output-file path #:exists 'append)))))
|
||||
|
||||
(define (try-file-time path)
|
||||
(file-or-directory-modify-seconds path #f (lambda () #f)))
|
||||
|
|
@ -148,20 +168,57 @@
|
|||
(rename-file-or-directory tmp-path path #t)
|
||||
(try-delete-file tmp-path))))))
|
||||
|
||||
(define (write-deps code mode path external-deps reader-deps)
|
||||
(define (get-source-sha1 p)
|
||||
(with-handlers ([exn:fail:filesystem? (lambda (exn) #f)])
|
||||
(call-with-input-file* p sha1)))
|
||||
|
||||
(define (get-dep-sha1s deps up-to-date read-src-syntax mode must-exist?)
|
||||
(let ([l (for/fold ([l null]) ([dep (in-list deps)])
|
||||
(and l
|
||||
;; (cons 'ext rel-path) => a non-module file, check source
|
||||
;; rel-path => a module file name, check cache
|
||||
(let* ([ext? (and (pair? dep) (eq? 'ext (car dep)))]
|
||||
[p (main-collects-relative->path (if ext? (cdr dep) dep))])
|
||||
(cond
|
||||
[ext? (let ([v (get-source-sha1 p)])
|
||||
(cond
|
||||
[v (cons (cons (delay v) dep) l)]
|
||||
[must-exist? (error 'cm "cannot find external-dependency file: ~v" p)]
|
||||
[else #f]))]
|
||||
[(or (hash-ref up-to-date (simplify-path (cleanse-path p)) #f)
|
||||
;; Use `compiler-root' with `sha1-only?' as #t:
|
||||
(compile-root mode p up-to-date read-src-syntax #t))
|
||||
=> (lambda (sh)
|
||||
(cons (cons (cdr sh) dep) l))]
|
||||
[must-exist?
|
||||
(error 'cm "internal error?; cannot find sha1 for module: ~v" p)]
|
||||
[else #f]))))])
|
||||
(and l
|
||||
(let ([p (open-output-string)]
|
||||
[l (map (lambda (v) (cons (force (car v)) (cdr v))) l)])
|
||||
;; sort by sha1s so that order doesn't matter
|
||||
(write (sort l string<? #:key car) p)
|
||||
;; compute one hash from all hashes
|
||||
(sha1 (open-input-bytes (get-output-bytes p)))))))
|
||||
|
||||
(define (write-deps code mode path src-sha1 external-deps reader-deps up-to-date read-src-syntax)
|
||||
(let ([dep-path (path-add-suffix (get-compilation-path mode path) #".dep")]
|
||||
[deps (remove-duplicates (append (get-deps code path)
|
||||
reader-deps))]
|
||||
[external-deps (remove-duplicates external-deps)])
|
||||
(with-compile-output dep-path
|
||||
(lambda (op tmp-path)
|
||||
(write `(,(version)
|
||||
,@(map path->main-collects-relative deps)
|
||||
,@(map (lambda (x)
|
||||
(cons 'ext (path->main-collects-relative x)))
|
||||
external-deps))
|
||||
(let ([deps (append
|
||||
(map path->main-collects-relative deps)
|
||||
(map (lambda (x)
|
||||
(cons 'ext (path->main-collects-relative x)))
|
||||
external-deps))])
|
||||
(write (list* (version)
|
||||
(cons (or src-sha1 (get-source-sha1 path))
|
||||
(get-dep-sha1s deps up-to-date read-src-syntax mode #t))
|
||||
deps)
|
||||
op)
|
||||
(newline op)))))
|
||||
(newline op))))))
|
||||
|
||||
(define (format-time sec)
|
||||
(let ([d (seconds->date sec)])
|
||||
|
|
@ -188,7 +245,7 @@
|
|||
#:property prop:procedure (struct-field-index proc))
|
||||
(define-struct file-dependency (path) #:prefab)
|
||||
|
||||
(define (compile-zo* mode path read-src-syntax zo-name)
|
||||
(define (compile-zo* mode path src-sha1 read-src-syntax zo-name up-to-date)
|
||||
;; The `path' argument has been converted to .rkt or .ss form,
|
||||
;; as appropriate.
|
||||
;; External dependencies registered through reader guard and
|
||||
|
|
@ -278,7 +335,7 @@
|
|||
;; Note that we check time and write .deps before returning from
|
||||
;; with-compile-output...
|
||||
(verify-times path tmp-name)
|
||||
(write-deps code mode path external-deps reader-deps)))))
|
||||
(write-deps code mode path src-sha1 external-deps reader-deps up-to-date read-src-syntax)))))
|
||||
|
||||
(define depth (make-parameter 0))
|
||||
|
||||
|
|
@ -290,31 +347,60 @@
|
|||
alt-path
|
||||
path))))
|
||||
|
||||
(define (compile-zo mode path orig-path read-src-syntax)
|
||||
(define (maybe-compile-zo sha1-only? deps mode path orig-path read-src-syntax up-to-date)
|
||||
(let ([actual-path (actual-source-path orig-path)])
|
||||
((manager-compile-notify-handler) actual-path)
|
||||
(trace-printf "compiling: ~a" actual-path)
|
||||
(parameterize ([indent (string-append " " (indent))])
|
||||
(let* ([zo-name (path-add-suffix (get-compilation-path mode path) #".zo")]
|
||||
[zo-exists? (file-exists? zo-name)])
|
||||
(if (and zo-exists? (trust-existing-zos))
|
||||
(touch zo-name)
|
||||
(begin (when zo-exists? (delete-file zo-name))
|
||||
(log-info (format "cm: ~acompiling ~a"
|
||||
(build-string
|
||||
(depth)
|
||||
(λ (x) (if (= 2 (modulo x 3)) #\| #\space)))
|
||||
actual-path))
|
||||
(parameterize ([depth (+ (depth) 1)])
|
||||
(with-handlers
|
||||
([exn:get-module-code?
|
||||
(lambda (ex)
|
||||
(compilation-failure mode path zo-name
|
||||
(exn:get-module-code-path ex)
|
||||
(exn-message ex))
|
||||
(raise ex))])
|
||||
(compile-zo* mode path read-src-syntax zo-name)))))))
|
||||
(trace-printf "end compile: ~a" actual-path)))
|
||||
(unless sha1-only?
|
||||
((manager-compile-notify-handler) actual-path)
|
||||
(trace-printf "compiling: ~a" actual-path))
|
||||
(begin0
|
||||
(parameterize ([indent (string-append " " (indent))])
|
||||
(let* ([zo-name (path-add-suffix (get-compilation-path mode path) #".zo")]
|
||||
[zo-exists? (file-exists? zo-name)])
|
||||
(if (and zo-exists? (trust-existing-zos))
|
||||
(begin
|
||||
(log-info (format "cm: ~atrusting ~a"
|
||||
(build-string
|
||||
(depth)
|
||||
(λ (x) (if (= 2 (modulo x 3)) #\| #\space)))
|
||||
zo-name))
|
||||
(touch zo-name)
|
||||
#f)
|
||||
(let ([src-sha1 (and zo-exists?
|
||||
deps
|
||||
(cadr deps)
|
||||
(get-source-sha1 path))])
|
||||
(if (and zo-exists?
|
||||
src-sha1
|
||||
(equal? src-sha1 (caadr deps))
|
||||
(equal? (get-dep-sha1s (cddr deps) up-to-date read-src-syntax mode #f)
|
||||
(cdadr deps)))
|
||||
(begin
|
||||
(log-info (format "cm: ~ahash-equivalent ~a"
|
||||
(build-string
|
||||
(depth)
|
||||
(λ (x) (if (= 2 (modulo x 3)) #\| #\space)))
|
||||
zo-name))
|
||||
(touch zo-name)
|
||||
#f)
|
||||
((if sha1-only? values (lambda (build) (build) #f))
|
||||
(lambda ()
|
||||
(when zo-exists? (delete-file zo-name))
|
||||
(log-info (format "cm: ~acompiling ~a"
|
||||
(build-string
|
||||
(depth)
|
||||
(λ (x) (if (= 2 (modulo x 3)) #\| #\space)))
|
||||
actual-path))
|
||||
(parameterize ([depth (+ (depth) 1)])
|
||||
(with-handlers
|
||||
([exn:get-module-code?
|
||||
(lambda (ex)
|
||||
(compilation-failure mode path zo-name
|
||||
(exn:get-module-code-path ex)
|
||||
(exn-message ex))
|
||||
(raise ex))])
|
||||
(compile-zo* mode path src-sha1 read-src-syntax zo-name up-to-date))))))))))
|
||||
(unless sha1-only?
|
||||
(trace-printf "end compile: ~a" actual-path)))))
|
||||
|
||||
(define (get-compiled-time mode path)
|
||||
(define-values (dir name) (get-compilation-dir+name mode path))
|
||||
|
|
@ -324,16 +410,33 @@
|
|||
(try-file-time (build-path dir (path-add-suffix name #".zo")))
|
||||
-inf.0))
|
||||
|
||||
(define (try-file-sha1 path dep-path)
|
||||
(with-handlers ([exn:fail:filesystem? (lambda (exn) #f)])
|
||||
(string-append
|
||||
(call-with-input-file* path sha1)
|
||||
(with-handlers ([exn:fail:filesystem? (lambda (exn) "")])
|
||||
(call-with-input-file* dep-path (lambda (p) (cdadr (read p))))))))
|
||||
|
||||
(define (get-compiled-sha1 mode path)
|
||||
(define-values (dir name) (get-compilation-dir+name mode path))
|
||||
(let ([dep-path (build-path dir (path-add-suffix name #".dep"))])
|
||||
(or (try-file-sha1 (build-path dir "native" (system-library-subpath)
|
||||
(path-add-suffix name (system-type
|
||||
'so-suffix)))
|
||||
dep-path)
|
||||
(try-file-sha1 (build-path dir (path-add-suffix name #".zo"))
|
||||
dep-path))))
|
||||
|
||||
(define (rkt->ss p)
|
||||
(let ([b (path->bytes p)])
|
||||
(if (regexp-match? #rx#"[.]rkt$" b)
|
||||
(path-replace-suffix p #".ss")
|
||||
p)))
|
||||
|
||||
(define (compile-root mode path0 up-to-date read-src-syntax)
|
||||
(define (compile-root mode path0 up-to-date read-src-syntax sha1-only?)
|
||||
(define orig-path (simplify-path (cleanse-path path0)))
|
||||
(define (read-deps path)
|
||||
(with-handlers ([exn:fail:filesystem? (lambda (ex) (list (version)))])
|
||||
(with-handlers ([exn:fail:filesystem? (lambda (ex) (list (version) '#f))])
|
||||
(call-with-input-file
|
||||
(path-add-suffix (get-compilation-path mode path) #".dep")
|
||||
read)))
|
||||
|
|
@ -350,41 +453,59 @@
|
|||
(cond
|
||||
[(not path-time)
|
||||
(trace-printf "~a does not exist" orig-path)
|
||||
path-zo-time]
|
||||
(or (and up-to-date (hash-ref up-to-date orig-path #f))
|
||||
(let ([stamp (cons path-zo-time
|
||||
(delay (get-compiled-sha1 mode path)))])
|
||||
(hash-set! up-to-date main-path stamp)
|
||||
(unless (eq? main-path alt-path)
|
||||
(hash-set! up-to-date alt-path stamp))
|
||||
stamp))]
|
||||
[else
|
||||
(cond
|
||||
[(> path-time path-zo-time)
|
||||
(trace-printf "newer src...")
|
||||
(compile-zo mode path orig-path read-src-syntax)]
|
||||
[else
|
||||
(let ([deps (read-deps path)])
|
||||
(let ([deps (read-deps path)])
|
||||
(define build
|
||||
(cond
|
||||
[(not (and (pair? deps) (equal? (version) (car deps))))
|
||||
(trace-printf "newer version...")
|
||||
(compile-zo mode path orig-path read-src-syntax)]
|
||||
[(ormap
|
||||
(lambda (p)
|
||||
;; (cons 'ext rel-path) => a non-module file (check date)
|
||||
;; rel-path => a module file name (check transitive dates)
|
||||
(define ext? (and (pair? p) (eq? 'ext (car p))))
|
||||
(define d (main-collects-relative->path (if ext? (cdr p) p)))
|
||||
(define t
|
||||
(if ext?
|
||||
(try-file-time d)
|
||||
(compile-root mode d up-to-date read-src-syntax)))
|
||||
(and t (> t path-zo-time)
|
||||
(begin (trace-printf "newer: ~a (~a > ~a)..."
|
||||
d t path-zo-time)
|
||||
#t)))
|
||||
(cdr deps))
|
||||
(compile-zo mode path orig-path read-src-syntax)]))])
|
||||
(let ([stamp (get-compiled-time mode path)])
|
||||
(hash-set! up-to-date main-path stamp)
|
||||
(unless (eq? main-path alt-path)
|
||||
(hash-set! up-to-date alt-path stamp))
|
||||
stamp)])))
|
||||
[(not (and (pair? deps) (equal? (version) (car deps))))
|
||||
(lambda ()
|
||||
(trace-printf "newer version...")
|
||||
(maybe-compile-zo #f #f mode path orig-path read-src-syntax up-to-date))]
|
||||
[(> path-time path-zo-time)
|
||||
(lambda ()
|
||||
(trace-printf "newer src...")
|
||||
(maybe-compile-zo #f deps mode path orig-path read-src-syntax up-to-date))]
|
||||
[(ormap
|
||||
(lambda (p)
|
||||
;; (cons 'ext rel-path) => a non-module file (check date)
|
||||
;; rel-path => a module file name (check transitive dates)
|
||||
(define ext? (and (pair? p) (eq? 'ext (car p))))
|
||||
(define d (main-collects-relative->path (if ext? (cdr p) p)))
|
||||
(define t
|
||||
(if ext?
|
||||
(cons (try-file-time d) #f)
|
||||
(compile-root mode d up-to-date read-src-syntax #f)))
|
||||
(and (car t)
|
||||
(> (car t) path-zo-time)
|
||||
(begin (trace-printf "newer: ~a (~a > ~a)..."
|
||||
d (car t) path-zo-time)
|
||||
#t)))
|
||||
(cddr deps))
|
||||
;; If `sha1-only?', then `maybe-compile-zo' returns a #f or thunk:
|
||||
(maybe-compile-zo sha1-only? deps mode path orig-path read-src-syntax up-to-date)]
|
||||
[else #f]))
|
||||
(cond
|
||||
[(and build sha1-only?) #f]
|
||||
[else
|
||||
(when build (build))
|
||||
(let ([stamp (cons (get-compiled-time mode path)
|
||||
(delay (get-compiled-sha1 mode path)))])
|
||||
(hash-set! up-to-date main-path stamp)
|
||||
(unless (eq? main-path alt-path)
|
||||
(hash-set! up-to-date alt-path stamp))
|
||||
stamp)]))])))
|
||||
(or (and up-to-date (hash-ref up-to-date orig-path #f))
|
||||
((manager-skip-file-handler) orig-path)
|
||||
(let ([v ((manager-skip-file-handler) orig-path)])
|
||||
(and v
|
||||
(hash-set! up-to-date orig-path v)
|
||||
v))
|
||||
(begin (trace-printf "checking: ~a" orig-path)
|
||||
(do-check))))
|
||||
|
||||
|
|
@ -400,7 +521,8 @@
|
|||
(compile-root (car (use-compiled-file-paths))
|
||||
(path->complete-path src)
|
||||
cache
|
||||
read-src-syntax)
|
||||
read-src-syntax
|
||||
#f)
|
||||
(void)))))
|
||||
|
||||
(define (make-compilation-manager-load/use-compiled-handler)
|
||||
|
|
@ -444,7 +566,7 @@
|
|||
(namespace-module-registry (current-namespace)))]
|
||||
[else
|
||||
(trace-printf "processing: ~a" path)
|
||||
(compile-root (car modes) path cache read-syntax)
|
||||
(compile-root (car modes) path cache read-syntax #f)
|
||||
(trace-printf "done: ~a" path)])
|
||||
(default-handler path mod-name))
|
||||
(when (null? modes)
|
||||
|
|
|
|||
|
|
@ -171,7 +171,7 @@
|
|||
[len (bytes-length skip-path)])
|
||||
(and ((bytes-length b) . > . len)
|
||||
(bytes=? (subbytes b 0 len) skip-path)))
|
||||
-inf.0))])
|
||||
(list -inf.0 "")))])
|
||||
(let* ([sses (append
|
||||
;; Find all .rkt/.ss/.scm files:
|
||||
(filter extract-base-filename/ss (directory-list))
|
||||
|
|
|
|||
|
|
@ -213,7 +213,7 @@
|
|||
|
||||
(current-load/use-compiled (make-compilation-manager-load/use-compiled-handler))
|
||||
(manager-skip-file-handler
|
||||
(λ (p) (file-date-in-paths
|
||||
(λ (p) (file-stamp-in-paths
|
||||
p
|
||||
(cons (CACHE-DIR) (current-library-collection-paths)))))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -463,7 +463,7 @@
|
|||
[`(ext collects ,(and (? bytes?) s) ...) (pltpath s)]
|
||||
[_ (error 'dependencies "bad dependency item in ~s: ~s"
|
||||
file x)]))
|
||||
(cdr x))))
|
||||
(cddr x))))
|
||||
(dprintf "Reading dependencies...")
|
||||
(let loop ([tree (tree-filter "*.dep" *plt-tree*)])
|
||||
(if (pair? tree)
|
||||
|
|
|
|||
55
collects/openssl/sha1.rkt
Normal file
55
collects/openssl/sha1.rkt
Normal file
|
|
@ -0,0 +1,55 @@
|
|||
#lang racket/base
|
||||
(require ffi/unsafe
|
||||
racket/runtime-path
|
||||
(for-syntax racket/base))
|
||||
|
||||
(provide sha1
|
||||
sha1-bytes
|
||||
bytes->hex-string)
|
||||
|
||||
(define-runtime-path libcrypto-so
|
||||
(case (system-type)
|
||||
[(windows) '(so "libeay32")]
|
||||
[else '(so "libcrypto")]))
|
||||
|
||||
(define libcrypto
|
||||
(ffi-lib libcrypto-so '("" "0.9.8b" "0.9.8" "0.9.7")))
|
||||
|
||||
(define _SHA_CTX-pointer _pointer)
|
||||
|
||||
(define SHA1_Init
|
||||
(get-ffi-obj 'SHA1_Init libcrypto (_fun _SHA_CTX-pointer -> _int)))
|
||||
(define SHA1_Update
|
||||
(get-ffi-obj 'SHA1_Update libcrypto (_fun _SHA_CTX-pointer _pointer _long -> _int)))
|
||||
(define SHA1_Final
|
||||
(get-ffi-obj 'SHA1_Final libcrypto (_fun _pointer _SHA_CTX-pointer -> _int)))
|
||||
|
||||
(define (sha1-bytes in)
|
||||
(let ([ctx (malloc 256)]
|
||||
[tmp (make-bytes 4096)]
|
||||
[result (make-bytes 20)])
|
||||
(SHA1_Init ctx)
|
||||
(let loop ()
|
||||
(let ([n (read-bytes-avail! tmp in)])
|
||||
(unless (eof-object? n)
|
||||
(SHA1_Update ctx tmp n)
|
||||
(loop))))
|
||||
(SHA1_Final result ctx)
|
||||
result))
|
||||
|
||||
(define (sha1 in)
|
||||
(bytes->hex-string (sha1-bytes in)))
|
||||
|
||||
(define (bytes->hex-string bstr)
|
||||
(let* ([len (bytes-length bstr)]
|
||||
[bstr2 (make-bytes (* len 2))]
|
||||
[digit
|
||||
(lambda (v)
|
||||
(if (v . < . 10)
|
||||
(+ v (char->integer #\0))
|
||||
(+ v (- (char->integer #\a) 10))))])
|
||||
(for ([i (in-range len)])
|
||||
(let ([c (bytes-ref bstr i)])
|
||||
(bytes-set! bstr2 (* 2 i) (digit (arithmetic-shift c -4)))
|
||||
(bytes-set! bstr2 (+ (* 2 i) 1) (digit (bitwise-and c #xF)))))
|
||||
(bytes->string/latin-1 bstr2)))
|
||||
|
|
@ -264,9 +264,9 @@
|
|||
(eq? '#:extra-constructor-name (syntax-e (car p))))
|
||||
(check-exprs 1 p "identifier")
|
||||
(when (lookup config '#:constructor-name)
|
||||
(bad "multiple #:constructor-name or #:extra-constructor-name keys" (car p)))
|
||||
(bad "multiple" "#:constructor-name or #:extra-constructor-name keys" (car p)))
|
||||
(unless (identifier? (cadr p))
|
||||
(bad "need an identifier after #:constructor-name" (cadr p)))
|
||||
(bad "need an identifier after" (car p) (cadr p)))
|
||||
(loop (cddr p)
|
||||
(extend-config (extend-config config '#:constructor-name (cadr p))
|
||||
'#:only-constructor?
|
||||
|
|
|
|||
|
|
@ -241,26 +241,28 @@ A parameter for a procedure of one argument that is called to report
|
|||
compilation-manager actions, such as checking a file. The argument to
|
||||
the procedure is a string.}
|
||||
|
||||
@defparam[manager-skip-file-handler proc (-> path? (or/c number? #f))]{
|
||||
@defparam[manager-skip-file-handler proc (-> path? (or/c (cons/c number? promise?) #f))]{
|
||||
|
||||
A parameter whose value is called for each file that is loaded and
|
||||
needs recompilation. If the procedure returns a number, then the file
|
||||
is skipped (i.e., not compiled), and the number is used as the
|
||||
timestamp for the file's bytecode. If the procedure returns
|
||||
needs recompilation. If the procedure returns a pair, then the file
|
||||
is skipped (i.e., not compiled); the number in the pair is used as
|
||||
the timestamp for the file's bytecode, and the promise may be
|
||||
@scheme[force]d to obtain a string that is used as hash of the
|
||||
compiled file plus its dependencies. If the procedure returns
|
||||
@scheme[#f], then the file is compiled as usual. The default is
|
||||
@scheme[(lambda (x) #f)].}
|
||||
|
||||
@defproc[(file-date-in-collection [p path?]) (or/c number? #f)]{
|
||||
Calls @scheme[file-date-in-paths] with @scheme[p] and
|
||||
@defproc[(file-stamp-in-collection [p path?]) (or/c (cons/c number? promise?) #f)]{
|
||||
Calls @scheme[file-stamp-in-paths] with @scheme[p] and
|
||||
@scheme[(current-library-collection-paths)].}
|
||||
|
||||
@defproc[(file-date-in-paths [p path?] [paths (listof path?)]) (or/c number? #f)]{
|
||||
@defproc[(file-stamp-in-paths [p path?] [paths (listof path?)]) (or/c (cons/c number? promise?) #f)]{
|
||||
|
||||
Returns the file-modification date of @scheme[p] or its bytecode form
|
||||
(i.e., @filepath{.zo} file), whichever exists and is newer, if
|
||||
@scheme[p] is an extension of any path in @scheme[paths] (i.e.,
|
||||
exists in the directory, a subdirectory, etc.). Otherwise, the result
|
||||
is @scheme[#f].
|
||||
Returns the file-modification date and @scheme[delay]ed hash of
|
||||
@scheme[p]or its bytecode form (i.e., @filepath{.zo} file), whichever
|
||||
exists and is newer, if @scheme[p] is an extension of any path in
|
||||
@scheme[paths] (i.e., exists in the directory, a subdirectory,
|
||||
etc.). Otherwise, the result is @scheme[#f].
|
||||
|
||||
This function is intended for use with @scheme[manager-skip-file-handler].}
|
||||
|
||||
|
|
|
|||
|
|
@ -113,7 +113,7 @@
|
|||
(unless (and (pair? dep)
|
||||
(eq? (car dep) 'ext))
|
||||
(dynamic-require (main-collects-relative->path dep) #f)))
|
||||
(cdr deps))))
|
||||
(cddr deps))))
|
||||
;; Not a .zo! Don't use .zo files at all...
|
||||
(escape (lambda ()
|
||||
;; Try again without .zo
|
||||
|
|
|
|||
|
|
@ -12,6 +12,6 @@
|
|||
[make-print-reasons #f]
|
||||
[make-print-checking #f])
|
||||
(make/proc
|
||||
`((,(build-path dir "gl-info_ss.zo")
|
||||
`((,(build-path dir "gl-info_rkt.zo")
|
||||
("make-gl-info.rkt" ,(build-path (find-include-dir) "schvers.h"))
|
||||
,(lambda () (make-gl-info dir)))))))
|
||||
|
|
|
|||
|
|
@ -13,12 +13,12 @@
|
|||
consistently.)
|
||||
*/
|
||||
|
||||
#define MZSCHEME_VERSION "4.2.5.12"
|
||||
#define MZSCHEME_VERSION "4.2.5.13"
|
||||
|
||||
#define MZSCHEME_VERSION_X 4
|
||||
#define MZSCHEME_VERSION_Y 2
|
||||
#define MZSCHEME_VERSION_Z 5
|
||||
#define MZSCHEME_VERSION_W 12
|
||||
#define MZSCHEME_VERSION_W 13
|
||||
|
||||
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
|
||||
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user