From 35e78942bed148e1a23ffc7eaa50dc38d81f1af9 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sun, 4 Jun 2023 08:24:32 -0700
Subject: compiler: new function, clean-file.

This function simplifies cleaning, by allowing a file to
be cleaned to be identified in much the same way as an input
file to load or compile-file.

* autoload.c (compiler_set_entries): The clean-file symbol
is interned and becomes an autoload trigger for the
compiler module.

* stdlib/compiler.tl (clean-file): New function.

* txr.1: Documented.

* stdlib/doc-syms.tl: Updated.
---
 autoload.c         |  2 +-
 stdlib/compiler.tl | 16 ++++++++++++
 stdlib/doc-syms.tl |  1 +
 txr.1              | 74 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 92 insertions(+), 1 deletion(-)

diff --git a/autoload.c b/autoload.c
index 2784dd4c..a8b5de56 100644
--- a/autoload.c
+++ b/autoload.c
@@ -658,7 +658,7 @@ static val compiler_set_entries(val fun)
   };
   val name[] = {
     lit("compile-toplevel"), lit("compile"), lit("compile-file"),
-    lit("compile-update-file"),
+    lit("compile-update-file"), lit("clean-file"),
     lit("with-compilation-unit"), lit("dump-compiled-objects"),
     lit("with-compile-opts"), lit("compiler-let"),
     nil
diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl
index 62893e94..ea8124e8 100644
--- a/stdlib/compiler.tl
+++ b/stdlib/compiler.tl
@@ -2425,6 +2425,22 @@
 
     (list in-stream out-stream out-path)))
 
+(defun clean-file (path)
+  (let* ((parent *load-path*)
+         (path (if (and parent (pure-rel-path-p path))
+                 (path-cat (dir-name parent) path)
+                 path)))
+    (match-case path
+      (@(or `@base.tlo`
+            `@base.tlo.gz`)
+        (ignore base)
+        (remove-path path))
+      (@(or `@base.txr`
+            `@base.tl`
+            `@base`)
+        (or (remove-path `@base.tlo` nil)
+            (remove-path `@base.tlo.gz` nil))))))
+
 (defun list-from-vm-desc (vd)
   (list (sys:vm-desc-nlevels vd)
         (sys:vm-desc-nregs vd)
diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl
index a3d5434d..49e7cb9f 100644
--- a/stdlib/doc-syms.tl
+++ b/stdlib/doc-syms.tl
@@ -329,6 +329,7 @@
       ("chr-xdigit" "N-021C89F4")
       ("chrp" "N-02C6CEED")
       ("clamp" "N-03B940D4")
+      ("clean-file" "N-001939D4")
       ("clear-cflags" "N-02061924")
       ("clear-dirty" "N-03AB857D")
       ("clear-error" "D-000C")
diff --git a/txr.1 b/txr.1
index b8265fe1..c9268249 100644
--- a/txr.1
+++ b/txr.1
@@ -88069,6 +88069,80 @@ by merging some identical code blocks, or improving some more rarely
 occurring instruction patterns.
 .RE
 
+.coNP Function @ clean-file
+.synb
+.mets (compile-file << path )
+.syne
+.desc
+The
+.code clean-file
+function removes a previously compiled file associated with
+.metn path ,
+if such a file exists. In situations when it successfully removes
+a file, it returns
+.codn t ,
+otherwise
+.codn nil .
+The function may also throw an exception, in situations such as
+encountering a nonexistent directory component or permission problem.
+
+First, if
+.meta path
+specifies a pure relative pathname, as defined by the
+.code pure-rel-path-p
+function, and if the
+.code *load-path*
+variable contains a value other than
+.codn nil ,
+then
+.code clean-file
+calculates the directory name of
+.code *load-path*
+as if by using
+.code dir-name
+and catenates that directory name with
+.meta path
+to produce an intermediate path.
+Otherwise
+.meta path
+is considered to be the intermediate path.
+
+Next, the suffix of the intermediate path is examined.
+If it ends with
+.str .tlo
+or
+.strn .tlo.gz ,
+then an attempt is made to remove that path,
+and the function terminates.
+
+If the intermediate path ends with
+.str .tl
+or
+.strn .txr ,
+then two attempts are made to remove a file: first,
+the suffix is replaced with
+.str .tlo
+and that is attempted to be removed. If that fails
+due to non-existence, then the suffix
+.str .tlo.gz
+is tried.
+
+Otherwise, if the intermediate path doesn't have
+any of the above suffixes, then an attempt is made
+to remove the path with the
+.str .tlo
+suffix added, and then with the
+.str .tlo.gz
+suffix added.
+
+Note: no attempt is made to remove the unmodified
+intermediate path itself, except in the cases when it ends with
+.str .tlo
+or
+.strn .tlo.gz ,
+because that risks removing a source file rather than
+a compiled file.
+
 .coNP Macro @ with-compilation-unit
 .synb
 .mets (with-compilation-unit << form *)
-- 
cgit v1.2.3