From d6b97dfa43193ee4e1cc645831464f9c159e156a Mon Sep 17 00:00:00 2001 From: David Thompson Date: Tue, 6 Dec 2022 08:10:59 -0500 Subject: Commit some previously uncommitted files. --- assets/images/lightness.xcf | Bin 0 -> 2623 bytes shake-tree.scm | 96 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 96 insertions(+) create mode 100644 assets/images/lightness.xcf create mode 100644 shake-tree.scm diff --git a/assets/images/lightness.xcf b/assets/images/lightness.xcf new file mode 100644 index 0000000..db09c0c Binary files /dev/null and b/assets/images/lightness.xcf differ diff --git a/shake-tree.scm b/shake-tree.scm new file mode 100644 index 0000000..88e34ec --- /dev/null +++ b/shake-tree.scm @@ -0,0 +1,96 @@ +(use-modules (ice-9 match) + (srfi srfi-1) + (test-subject game)) + +(define (root-module) + (resolve-module '() #f #f #:ensure #f)) + +(define (loaded-modules) + (define (scan-submodules module) + (hash-fold (lambda (k m memo) + (if (module-filename m) + (cons (module-filename m) + (append (scan-submodules m) + memo)) + (append (scan-submodules m) memo))) + '() + (module-submodules module))) + (delete-duplicates (cons* "ice-9/eval.scm" + "ice-9/i18n.scm" + "ice-9/posix.scm" + "ice-9/psyntax-pp.scm" + "ice-9/quasisyntax.scm" + "ice-9/match.upstream.scm" + "ice-9/networking.scm" + "ice-9/r6rs-libraries.scm" + "ice-9/r7rs-libraries.scm" + (scan-submodules (root-module))) + string=?)) + +(define (in-load-path path file-name) + (let loop ((path path)) + (match path + (() #f) + ((dir . rest) + (let ((f (string-append dir "/" file-name))) + (if (file-exists? f) + f + (loop rest))))))) + +(define (scm->go file-name) + (string-append (substring file-name 0 (- (string-length file-name) 4)) ".go")) + +(define (shake-tree) + (map (lambda (f) + (list f + (in-load-path %load-path f) + (in-load-path %load-compiled-path + (scm->go f)))) + (sort (loaded-modules) string<))) + +;; Snarfed from Guix +(define (mkdir-p dir) + "Create directory DIR and all its ancestors." + (define absolute? + (string-prefix? "/" dir)) + + (define not-slash + (char-set-complement (char-set #\/))) + + (let loop ((components (string-tokenize dir not-slash)) + (root (if absolute? + "" + "."))) + (match components + ((head tail ...) + (let ((path (string-append root "/" head))) + (catch 'system-error + (lambda () + (mkdir path) + (loop tail path)) + (lambda args + (if (= EEXIST (system-error-errno args)) + (loop tail path) + (apply throw args)))))) + (() #t)))) + +(define (install-modules spec prefix) + (let ((v (string-append (major-version) ".0"))) + (for-each (match-lambda + ((suffix source compiled) + (let ((scm-dest (string-append prefix "/share/guile/" v "/" + suffix)) + (go-dest (string-append prefix "/lib/guile/" v "/ccache/" + (scm->go suffix)))) + (mkdir-p (dirname scm-dest)) + (mkdir-p (dirname go-dest)) + (display (string-append "copy " source " to " scm-dest)) + (newline) + (copy-file source scm-dest) + (when compiled + (display (string-append "copy " compiled " to " go-dest)) + (newline) + (copy-file compiled go-dest))))) + spec))) + +(install-modules (shake-tree) "/home/dthompson/Code/bundle2/the-test-subject") -- cgit v1.2.3