imitive-load is unaffected. Returns #f if ;; auto-compilation failed or was disabled. ;; ;; NB: Unless we need to compile the file, this function should not ;; cause (system base compile) to be loaded up. For that reason ;; compiled-file-name partially duplicates functionality from (system ;; base compile). (define (fresh-compiled-thunk name scmstat go-file-name) ;; Return GO-FILE-NAME after making sure that it contains a freshly ;; compiled version of source file NAME with stat SCMSTAT; return #f ;; on failure. (false-if-exception (let ((gostat (and (not %fresh-auto-compile) (stat go-file-name #f)))) (if (and gostat (more-recent? gostat scmstat)) (load-thunk-from-file go-file-name) (begin (when gostat (format (current-warning-port) ";;; note: source file ~a\n;;; newer than compiled ~a\n" name go-file-name)) (cond (%load-should-auto-compile (%warn-auto-compilation-enabled) (format (current-warning-port) ";;; compiling ~a\n" name) (let ((cfn (compile name))) (format (current-warning-port) ";;; compiled ~a\n" cfn) (load-thunk-from-file cfn))) (else #f))))) #:warning "WARNING: compilation of ~a failed:\n" name)) (define (sans-extension file) (let ((dot (string-rindex file #\.))) (if dot (substring file 0 dot) file))) (define (load-absolute abs-file-name) ;; Load from ABS-FILE-NAME, using a compiled file or auto-compiling ;; if needed. (define scmstat (false-if-exception (stat abs-file-name) #:warning "Stat of ~a failed:\n" abs-file-name)) (define (pre-compiled) (or-map (lambda (dir) (or-map (lambda (ext) (let ((candidate (string-append (in-vicinity dir file-name) ext))) (let ((gostat (stat candidate #f))) (and gostat (more-recent? gostat scmstat) (false-if-exception (load-thunk-from-file candidate) #:warning "WARNING: failed to load compiled file ~a:\n" candidate))))) %load-compiled-extensions)) %load-compiled-path)) (define (fallback) (and=> (false-if-exception (canonicalize-path abs-file-name)) (lambda (canon) (and=> (fallback-file-name canon) (lambda (go-file-name) (fresh-compiled-thunk abs-file-name scmstat go-file-name)))))) (let ((compiled (and scmstat (or (pre-compiled) (fallback))))) (if compiled (begin (if %load-hook (%load-hook abs-file-name)) (compiled)) (start-stack 'load-stack (primitive-load abs-file-name))))) (save-module-excursion (lambda () (with-fluids ((current-reader reader) (%file-port-name-canonicalization 'relative)) (cond ((absolute-file-name? file-name) (load-absolute file-name)) ((absolute-file-name? dir) (load-absolute (in-vicinity dir file-name))) (else (load-from-path (in-vicinity dir file-name)))))))) (define-syntax load (make-variable-transformer (lambda (x) (let* ((src (syntax-source x)) (file (and src (assq-ref src 'filename))) (dir (and (string? file) (dirname file)))) (syntax-case x () ((_ arg ...) #`(load-in-vicinity #,(or dir #'(getcwd)) arg ...)) (id (identifier? #'id) #`(lambda args (apply load-in-vicinity #,(or dir #'(getcwd)) args))))))))