Delete obsolete implementation files

This commit is contained in:
Ray Miller 2025-01-05 19:12:53 +00:00
parent 52f011267b
commit 679d2552a9
Signed by: ray
GPG key ID: 043F786C4CD681B8
6 changed files with 0 additions and 166 deletions

View file

@ -1,17 +0,0 @@
(define-module (ordo prerequisite-data)
#:use-module (oop goops))
(define-class <prerequisite-data> ())
(define-class <local-file> (<prerequisite-data>)
(path #:init-keyword #:path #:getter get-path))
(define-method (equal? (x <local-file>) (y <local-file>))
(equal? (get-path x) (get-path y)))
(define (local-file path)
(make <local-file> #:path path))
(define-class <local-lookup> (<prerequisite-data>)
(handler #:init-keyword #:handler #:getter get-handler)
(args #:init-keyword #:args :getter get-args))

View file

@ -1,17 +0,0 @@
(define-module (ordo task command)
#:use-module (ice-9 format)
#:use-module (srfi srfi-11)
#:use-module (ordo task)
#:use-module (ordo util process)
#:export (command))
(define* (command name cmd #:optional (args '())
#:key (fail-ok? #f) (stdin #f) (cwd #f) (env #f) (skip? #f))
(make-task name
'()
skip?
(lambda ()
(let-values (((exit-code output) (run cmd args #:stdin stdin #:cwd cwd #:env env #:combine-output #t)))
(if (or fail-ok? (zero? exit-code))
(values exit-code output)
(error (format #f "Error running ~a (exit ~d): ~a" cmd exit-code output)))))))

View file

@ -1,4 +0,0 @@
(define-module (ordo task file)
#:use-module (ordo task))
(define (file ))

View file

@ -1,63 +0,0 @@
(define-module (ordo util filesystem)
#:use-module (system foreign)
#:use-module (srfi srfi-11)
#:use-module (ice-9 format)
#:use-module (ice-9 ftw)
#:export (delete-file-recursively
create-temporary-directory
call-with-temporary-directory))
(define* (delete-file-recursively filename #:key (verbose #f))
(define dev (stat:dev (stat filename)))
(define (enter? name stat result)
(= (stat:dev stat) dev))
(define (leaf name stat result)
(if (false-if-exception (delete-file name))
(and verbose (format #t "delete-file ~a OK~%" name))
(format (current-error-port) "warning: delete-file ~a failed~%" name))
result)
(define (down name stat result)
result)
(define (up name stat result)
(if (false-if-exception (rmdir name))
(and verbose (format #t "rmdir ~a OK~%" name))
(format (current-error-port) "warning: rmdir ~a failed~%" name))
result)
(define (skip name state result)
result)
(define (error name stat errno result)
(format (current-error-port) "warning: ~a: ~a~%"
name (strerror errno))
result)
(file-system-fold enter? leaf down up skip error #f filename))
;; This is based on reading guix/build/syscalls.scm but less general
;; than their implementation.
;; TODO: why is this needed? The guile standard library has mkdtemp
;; that seems to do the same thing.
(define mkdtemp!
(let* ((ptr (dynamic-func "mkdtemp" (dynamic-link)))
(proc (pointer->procedure '* ptr '(*) #:return-errno? #t)))
(lambda (tmpl)
(let-values (((result err) (proc (string->pointer tmpl))))
(when (null-pointer? result)
(error (format #f "mkdtemp! ~a: ~a" tmpl (strerror err))))
(pointer->string result)))))
(define (create-temporary-directory)
(let* ((directory (or (getenv "TMPDIR") "/tmp"))
(template (string-append directory "/ordo.XXXXXX")))
(mkdtemp! template)))
;; This is borrowed from guix/util.scm
(define (call-with-temporary-directory proc)
"Call PROC with a name of a temporary directory; close the directory and
delete it when leaving the dynamic extent of this call."
(let ((tmp-dir (create-temporary-directory)))
(dynamic-wind
(const #t)
(lambda ()
(proc tmp-dir))
(lambda ()
(false-if-exception (delete-file-recursively tmp-dir))))))

View file

@ -1,62 +0,0 @@
(define-module (ordo util process)
#:use-module (ice-9 textual-ports)
#:export (with-cwd with-env capture))
(define-syntax with-cwd
(syntax-rules ()
((_ new-dir body ...)
(let ((original-dir (getcwd)))
(dynamic-wind
(lambda () (chdir new-dir))
(lambda () body ...)
(lambda () (chdir original-dir)))))))
;; Not needed for CAPTURE, which supports an environment override,
;; but might be useful for SYSTEM and SYSTEM*
(define-syntax with-env
(syntax-rules ()
((_ new-env body ...)
(let ((original-env (environ)))
(dynamic-wind
(lambda () (environ new-env))
(lambda () body ...)
(lambda () (environ original-env)))))))
;; Run a command and capture the output. Currently this only supports
;; text input and output. If necessary, we could use the (rnrs io ports)
;; module and use PUT-BYTEVECTOR / GET-BYTEVECTOR-ALL and examine the type
;; of STDIN to determine whether to call PUT-STRING or PUT-BYTEVECTOR. For
;; STDOUT, we'd need to add a #:binary argument so the caller could indicate
;; they are expecting binary output. Not implemented yet incase YAGNI.
(define* (capture cmd
#:optional (args '())
#:key (combine-output #f) (env #f) (stdin #f) (cwd #f))
(if cwd
(with-cwd cwd (run cmd args #:combine-output combine-output #:env env #:stdin stdin))
(let* ((input-pipe (pipe))
(output-pipe (pipe))
(pid (spawn cmd (cons cmd args)
#:input (car input-pipe)
#:output (cdr output-pipe)
#:error (if combine-output (cdr output-pipe) (current-error-port))
#:environment (or env (environ)))))
(close-port (cdr output-pipe))
(close-port (car input-pipe))
(when stdin (put-string (cdr input-pipe) stdin))
(close-port (cdr input-pipe))
(let ((output (get-string-all (car output-pipe))))
(close-port (car output-pipe))
(values (cdr (waitpid pid)) output)))))
;; Possibly nicer way to do this, suggested by dsmith on IRC: https://bpa.st/3JYTA
;; (use-modules (ice-9 popen)
;; (ice-9 rdelim)
;; (ice-9 receive))
;; (define (filter text)
;; (receive (from to pids) (pipeline '(("the-command")))
;; (write text to)
;; (close to)
;; (read-line from)))
;; See also https://github.com/ray1729/ordo/blob/main/modules/ordo/util/process.scm

View file

@ -1,3 +0,0 @@
(define x 7)
(lambda () (* x x))