From 8d8fee2e506806d9c117b17432ef3a5ec0d6f457 Mon Sep 17 00:00:00 2001 From: "Paul A. Patience" Date: Fri, 9 Jul 2021 21:09:24 -0400 Subject: compiler: use short-suffix. * stdlib/compiler.tl (open-compile-streams): Replace usage of %file-suff-rx% with a call to short-suffix. Streamline (subjectively) the obtention of ip-nosuff. Replace calls to ends-with with a casequal on the suffix. Actually make use of ip-nosuff. (%file-suff-rx%): Delete (now unused) variable. --- stdlib/compiler.tl | 25 ++++++++++--------------- 1 file changed, 10 insertions(+), 15 deletions(-) (limited to 'stdlib') diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl index 8e053061..deb0397f 100644 --- a/stdlib/compiler.tl +++ b/stdlib/compiler.tl @@ -2150,8 +2150,6 @@ (whenlet ((fun (symbol-function sym))) (param-check form nargs (get-param-info sym)))))) -(defvarl %file-suff-rx% #/[.][^\\\/.]+/) - (defvar *emit*) (defvar *eval*) @@ -2169,23 +2167,20 @@ (defun open-compile-streams (in-path out-path test-fn) (let* ((parent (or *load-path* "")) (sep [path-sep-chars 0]) + (in-path (trim-right #/[\/\\]+/ in-path)) (in-path (if (and (pure-rel-path-p in-path) (not (empty parent))) `@(dir-name parent)@sep@{in-path}` in-path)) - (rsuff (r$ %file-suff-rx% in-path)) - (suff (if rsuff [in-path rsuff])) - (ip-nosuff (if rsuff [in-path 0..(from rsuff)] in-path)) + (suff (short-suffix in-path)) + (ip-nosuff (trim-right in-path suff)) in-stream out-stream) - (cond - ((ends-with ".txr" in-path) - (error "~s: cannot compile TXR files" 'compile-file)) - ((ends-with ".tl" in-path) - (set in-stream (ignerr (open-file in-path)) - out-path (or out-path `@{in-path [0..-3]}.tlo`))) - (t - (set in-stream (or (ignerr (open-file `@{in-path}.tl`)) - (ignerr (open-file in-path))) - out-path (or out-path `@{in-path}.tlo`)))) + (casequal suff + (".txr" (error "~s: cannot compile TXR files" 'compile-file)) + (".tl" (set in-stream (ignerr (open-file in-path)) + out-path (or out-path `@{ip-nosuff}.tlo`))) + (t (set in-stream (or (ignerr (open-file `@{in-path}.tl`)) + (ignerr (open-file in-path))) + out-path (or out-path `@{in-path}.tlo`)))) (unless in-stream (error "~s: unable to open input file ~s" 'compile-file in-path)) -- cgit v1.2.3