1#lang racket/base 2(require racket/list 3 syntax/modread 4 syntax/private/modresolve-noctc 5 compiler/private/dep 6 "cm-path.rkt" 7 "cm-file.rkt" 8 "cm-log.rkt") 9 10(provide (all-defined-out)) 11 12;; Format in a ".dep" file is: 13;; (list <version> 14;; <machine> ; symbol or #f for machine-independent 15;; <sha1s> 16;; <dep> ...) 17;; where <sha1> = (cons <src-sha1> <imports-sha1>) 18;; | (cons <src-sha1> (cons <imports-sha1> <assume-cmopiled-sha1>)) 19;; An <assume-compiled-sha1> is for the case where a machine-independent 20;; bytecode file is recompiled, and the original machine-independent hash 21;; should be preserved. 22 23(define deps-has-version? pair?) 24(define deps-version car) 25(define (deps-has-machine? p) (and (pair? p) (pair? (cdr p)))) 26(define deps-machine cadr) 27(define deps-sha1s caddr) 28(define deps-src-sha1 caaddr) 29(define (deps-imports-sha1 deps) 30 (define p (cdaddr deps)) 31 (if (pair? p) (car p) p)) 32(define (deps-assume-compiled-sha1 deps) 33 ;; Returns #f if ".dep" doesn't record a sha1 to assume for the compiled code 34 (define p (cdaddr deps)) 35 (and (pair? p) (cdr p))) 36(define deps-imports cdddr) 37 38(define (get-deps code path) 39 (define ht 40 (let loop ([code code] [ht (hash)]) 41 (define new-ht 42 (for*/fold ([ht ht]) ([imports (in-list (module-compiled-imports code))] 43 [x (in-list (cdr imports))]) 44 (let* ([r (resolve-module-path-index x path)] 45 [r (if (pair? r) (cadr r) r)]) 46 (if (and (path? r) 47 (not (equal? path r)) 48 (not (equal? path r)) 49 (not (equal? path (rkt->ss r)))) 50 (hash-set ht (path->bytes r) #t) 51 ht)))) 52 (for*/fold ([ht new-ht]) ([non-star? (in-list '(#f #t))] 53 [subcode (in-list (module-compiled-submodules code non-star?))]) 54 (loop subcode ht)))) 55 (for/list ([k (in-hash-keys ht)]) k)) 56 57(define (read-deps-file dep-path) 58 (with-handlers ([exn:fail:filesystem? (lambda (ex) 59 (trace-printf "failed reading ~a" dep-path) 60 (list #f "none" '(#f . #f)))]) 61 (with-module-reading-parameterization 62 (lambda () 63 (call-with-input-file* dep-path read))))) 64 65