/usr/share/scsh-0.6/env/flatload.scm is in scsh-common-0.6 0.6.7-8.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 | ; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; flatloaded -> load
(define *noisy?* #f)
(define (flatload struct . env-option)
(let ((env (if (null? env-option)
(interaction-environment)
(car env-option)))
(l '())
(set-package-loaded?! set-package-loaded?!))
(walk-packages (list struct)
(lambda (p)
(not (package-loaded? p)))
(lambda (file p)
(let* ((fn (package-file-name p))
(file (namestring file
(if fn
(file-name-directory fn)
#f)
*load-file-type*)))
(if *noisy?*
(begin (display #\space) (display file)))
(set! l (cons (lambda () (apply fload file env-option))
l))))
(lambda (forms p)
(set! l (cons (lambda ()
(for-each (lambda (form)
(eval form env))
forms))
l)))
(lambda (p)
(set! l (cons (lambda ()
(set-package-loaded?! p #t))
l))))
(for-each (lambda (thunk) (thunk)) (reverse l))
(newline)))
(define *source-file-name* "") ;Cf. alt/config.scm
(define (fload filename . rest)
(let ((save filename))
(dynamic-wind (lambda () (set! *source-file-name* filename))
(lambda ()
(apply load filename rest))
(lambda () (set! *source-file-name* save)))))
(define (walk-packages structs process? file-action forms-action after-action)
(let ((seen '()))
(letrec ((recur
(lambda (s)
(let ((p (structure-package s)))
(if (not (memq p seen))
(begin
(set! seen (cons p seen))
(if (process? p)
(begin
(if *noisy?*
(begin (newline)
(display "[")
(write (structure-name s))))
;; (write (structure-name s)) (display " ")
(for-each recur (package-opens p))
(for-each (lambda (name+struct)
(recur (cdr name+struct)))
(package-accesses p))
(for-each (lambda (clause)
(case (car clause)
((files)
(for-each (lambda (f)
(file-action f p))
(cdr clause)))
((begin)
(forms-action (cdr clause) p))))
(package-clauses p))
(after-action p)
(if *noisy?* (display "]"))))))))))
(for-each recur structs))
(if *noisy?* (newline))
seen))
; Return list of names of all files needed to build a particular structure.
; This is handy for creating dependency lists for "make".
(define (all-file-names struct . base-option)
(let ((l '())
(b '()))
(walk-packages base-option
(lambda (p) #t)
(lambda (filename p) #f)
(lambda (forms p) #f)
(lambda (p)
(set! b (cons p b))))
(walk-packages (list struct)
(lambda (p)
(not (memq p b)))
(lambda (filename p)
(let ((dir (file-name-directory (package-file-name p))))
(set! l (cons (namestring filename dir *load-file-type*)
l))))
(lambda (forms p)
(display "Package contains (begin ...) clause: ")
(write forms)
(newline))
(lambda (p) #f))
(reverse l)))
|