~ chicken-core (chicken-5) db0f4b0e16e3cf8905acf7bfb4b634aa45bcffde
commit db0f4b0e16e3cf8905acf7bfb4b634aa45bcffde
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Fri Apr 22 12:04:31 2016 +1200
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Mon Apr 25 19:43:14 2016 +0200
Move pathname procedures to new chicken.pathname module
Signed-off-by: Peter Bex <peter@more-magic.net>
diff --git a/README b/README
index 6a846a12..2ae9959d 100644
--- a/README
+++ b/README
@@ -301,6 +301,7 @@
| | |-- chicken.internal.import.so
| | |-- chicken.io.import.so
| | |-- chicken.irregex.import.so
+ | | |-- chicken.pathname.import.so
| | |-- chicken.ports.import.so
| | |-- chicken.posix.import.so
| | |-- chicken.pretty-print.import.so
diff --git a/batch-driver.scm b/batch-driver.scm
index 740238ce..3848f3be 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -29,7 +29,7 @@
;; Same goes for "backend" and "platform".
(declare
(unit batch-driver)
- (uses extras data-structures files
+ (uses extras data-structures pathname
support compiler-syntax compiler optimizer
;; TODO: Backend should be configurable
scrutinizer lfa2 c-platform c-backend user-pass))
@@ -39,9 +39,9 @@
(import chicken scheme
chicken.data-structures
- chicken.files
chicken.format
chicken.gc
+ chicken.pathname
chicken.pretty-print
chicken.time
chicken.compiler.support
diff --git a/chicken-bug.scm b/chicken-bug.scm
index 08b74ab4..7d12338c 100644
--- a/chicken-bug.scm
+++ b/chicken-bug.scm
@@ -26,11 +26,11 @@
(declare (block))
(import chicken.data-structures
- chicken.files
chicken.foreign
chicken.format
chicken.io
chicken.keyword
+ chicken.pathname
chicken.ports
chicken.posix
chicken.time)
diff --git a/chicken-install.scm b/chicken-install.scm
index 1a31c601..a9e25bae 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -34,6 +34,7 @@
chicken.format
chicken.io
chicken.irregex
+ chicken.pathname
chicken.ports
chicken.posix
chicken.pretty-print
@@ -60,6 +61,7 @@
"chicken.keyword.import.so"
"chicken.locative.import.so"
"chicken.lolevel.import.so"
+ "chicken.pathname.import.so"
"chicken.ports.import.so"
"chicken.posix.import.so"
"chicken.pretty-print.import.so"
diff --git a/chicken-status.scm b/chicken-status.scm
index 98c95560..3006fae8 100644
--- a/chicken-status.scm
+++ b/chicken-status.scm
@@ -28,10 +28,10 @@
(import scheme chicken)
(import setup-api)
(import chicken.data-structures
- chicken.files
chicken.foreign
chicken.format
chicken.irregex
+ chicken.pathname
chicken.ports
chicken.posix
chicken.pretty-print)
diff --git a/chicken-uninstall.scm b/chicken-uninstall.scm
index 26eaaa01..19051308 100644
--- a/chicken-uninstall.scm
+++ b/chicken-uninstall.scm
@@ -28,10 +28,10 @@
(import scheme chicken)
(import setup-api)
(import chicken.data-structures
- chicken.files
chicken.foreign
chicken.format
chicken.irregex
+ chicken.pathname
chicken.ports
chicken.posix)
diff --git a/csc.scm b/csc.scm
index 51f4f1c7..d12dba23 100644
--- a/csc.scm
+++ b/csc.scm
@@ -28,9 +28,9 @@
(import chicken.posix
chicken.data-structures
- chicken.files
chicken.foreign
chicken.format
+ chicken.pathname
chicken.utils)
(include "mini-srfi-1.scm")
diff --git a/defaults.make b/defaults.make
index 15d54407..cf8044d3 100644
--- a/defaults.make
+++ b/defaults.make
@@ -268,8 +268,8 @@ DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise fixnum flonum format gc io \
keyword locative posix pretty-print random time
DYNAMIC_CHICKEN_COMPILER_IMPORT_LIBRARIES = user-pass
DYNAMIC_CHICKEN_UNIT_IMPORT_LIBRARIES = continuation data-structures \
- eval expand files internal irregex lolevel ports read-syntax \
- repl tcp utils
+ eval expand files internal irregex lolevel pathname ports \
+ read-syntax repl tcp utils
# targets
diff --git a/distribution/manifest b/distribution/manifest
index 1ba6f9d3..0fcd21b4 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -92,6 +92,7 @@ irregex-utils.scm
lfa2.c
chicken.compiler.lfa2.import.scm
lfa2.scm
+pathname.scm
posixunix.scm
posixwin.scm
posix-common.scm
@@ -287,6 +288,8 @@ chicken.locative.import.scm
chicken.locative.import.c
chicken.lolevel.import.scm
chicken.lolevel.import.c
+chicken.pathname.import.scm
+chicken.pathname.import.c
chicken.ports.import.scm
chicken.ports.import.c
chicken.posix.import.scm
diff --git a/eval.scm b/eval.scm
index e796e192..b426d115 100644
--- a/eval.scm
+++ b/eval.scm
@@ -88,8 +88,8 @@
(define-constant core-units
'(chicken-syntax chicken-ffi-syntax continuation data-structures eval
- expand extras files internal irregex library lolevel ports posix
- srfi-4 tcp repl read-syntax utils))
+ expand extras files internal irregex library lolevel pathname ports
+ posix srfi-4 tcp repl read-syntax utils))
(define-constant cygwin-default-dynamic-load-libraries '("cygchicken-0"))
(define-constant macosx-load-library-extension ".dylib")
diff --git a/files.scm b/files.scm
index 4cb2c77f..00753980 100644
--- a/files.scm
+++ b/files.scm
@@ -1,4 +1,4 @@
-;;;; files.scm - File and pathname operations
+;;;; files.scm - File operations
;
; Copyright (c) 2008-2015, The CHICKEN Team
; Copyright (c) 2000-2007, Felix L. Winkelmann
@@ -36,7 +36,7 @@
(declare
(unit files)
- (uses data-structures extras irregex)
+ (uses extras pathname)
(fixnum)
(disable-interrupts)
(foreign-declare #<<EOF
@@ -52,19 +52,14 @@ EOF
))
(module chicken.files
- (delete-file* file-copy file-move make-pathname directory-null?
- make-absolute-pathname create-temporary-directory
- create-temporary-file decompose-directory decompose-pathname
- absolute-pathname? pathname-directory pathname-extension
- pathname-file pathname-replace-directory pathname-replace-extension
- pathname-replace-file pathname-strip-directory
- pathname-strip-extension normalize-pathname)
+ (delete-file* file-copy file-move
+ create-temporary-directory
+ create-temporary-file)
(import scheme chicken)
-(import chicken.data-structures
- chicken.foreign
+(import chicken.foreign
chicken.io
- chicken.irregex)
+ chicken.pathname)
(include "common-declarations.scm")
@@ -143,175 +138,8 @@ EOF
(write-string s d o)
(loop (read-string! blocksize s i) (fx+ d l)))))))
-;;; Pathname operations:
-;; Platform specific absolute pathname operations:
-;; absolute-pathname-root => #f or (<match> [<origin>] <root>)
-;;
-;; Not for general consumption
-
-(define absolute-pathname-root)
-(define root-origin)
-(define root-directory)
-
-(if ##sys#windows-platform
- (let ((rx (irregex "([A-Za-z]:)?([\\/\\\\]).*")))
- (set! absolute-pathname-root (lambda (pn) (irregex-match rx pn)))
- (set! root-origin (lambda (rt) (and rt (irregex-match-substring rt 1))))
- (set! root-directory (lambda (rt) (and rt (irregex-match-substring rt 2)))) )
- (let ((rx (irregex "(/).*")))
- (set! absolute-pathname-root (lambda (pn) (irregex-match rx pn)))
- (set! root-origin (lambda (rt) #f))
- (set! root-directory (lambda (rt) (and rt (irregex-match-substring rt 1)))) ) )
-
-(define (absolute-pathname? pn)
- (##sys#check-string pn 'absolute-pathname?)
- (irregex-match-data? (absolute-pathname-root pn)) )
-
-(define-inline (*char-pds? ch)
- (if ##sys#windows-platform
- (memq ch '(#\\ #\/))
- (eq? #\/ ch)))
-
-(define (chop-pds str)
- (and str
- (let lp ((len (##sys#size str)))
- (cond ((and (fx>= len 1)
- (*char-pds? (##core#inline "C_subchar" str (fx- len 1))))
- (lp (fx- len 1)))
- ((fx< len (##sys#size str))
- (##sys#substring str 0 len))
- (else str)))))
-
-(define make-pathname)
-(define make-absolute-pathname)
-
-(let ((pds (if ##sys#windows-platform "\\" "/")))
-
- (define (conc-dirs dirs)
- (##sys#check-list dirs 'make-pathname)
- (let loop ((strs dirs))
- (if (null? strs)
- ""
- (let ((s1 (car strs)))
- (if (zero? (string-length s1))
- (loop (cdr strs))
- (string-append
- (chop-pds (car strs))
- pds
- (loop (cdr strs))) ) ) ) ) )
-
- (define (canonicalize-dirs dirs)
- (cond ((or (not dirs) (null? dirs)) "")
- ((string? dirs) (conc-dirs (list dirs)))
- (else (conc-dirs dirs)) ) )
-
- (define (_make-pathname loc dir file ext)
- (let ((ext (or ext ""))
- (file (or file "")))
- (##sys#check-string dir loc)
- (##sys#check-string file loc)
- (##sys#check-string ext loc)
- (string-append
- dir
- (if (and (fx>= (##sys#size dir) 1)
- (fx>= (##sys#size file) 1)
- (*char-pds? (##core#inline "C_subchar" file 0)))
- (##sys#substring file 1 (##sys#size file))
- file)
- (if (and (fx> (##sys#size ext) 0)
- (not (char=? (##core#inline "C_subchar" ext 0) #\.)) )
- "."
- "")
- ext) ) )
-
- (set! make-pathname
- (lambda (dirs file #!optional ext)
- (_make-pathname 'make-pathname (canonicalize-dirs dirs) file ext)))
-
- (set! make-absolute-pathname
- (lambda (dirs file #!optional ext)
- (_make-pathname
- 'make-absolute-pathname
- (let ((dir (canonicalize-dirs dirs)))
- (if (absolute-pathname? dir)
- dir
- (##sys#string-append pds dir)) )
- file ext) ) ) )
-
-(define decompose-pathname
- (let* ((patt1 (if ##sys#windows-platform
- "^(.*[\\/\\\\])?([^\\/\\\\]+)(\\.([^\\/\\\\.]+))$"
- "^(.*/)?([^/]+)(\\.([^/.]+))$"))
- (patt2 (if ##sys#windows-platform
- "^(.*[\\/\\\\])?((\\.)?[^\\/\\\\]+)$"
- "^(.*/)?((\\.)?[^/]+)$"))
- [rx1 (irregex patt1)]
- [rx2 (irregex patt2)]
- [strip-pds
- (lambda (dir)
- (and dir
- (let ((chopped (chop-pds dir)))
- (if (fx> (##sys#size chopped) 0)
- chopped
- (##sys#substring dir 0 1) ) ) ) )] )
- (lambda (pn)
- (##sys#check-string pn 'decompose-pathname)
- (if (fx= 0 (##sys#size pn))
- (values #f #f #f)
- (let ([ms (irregex-search rx1 pn)])
- (if ms
- (values
- (strip-pds (irregex-match-substring ms 1))
- (irregex-match-substring ms 2)
- (irregex-match-substring ms 4))
- (let ([ms (irregex-search rx2 pn)])
- (if ms
- (values
- (strip-pds (irregex-match-substring ms 1))
- (irregex-match-substring ms 2)
- #f)
- (values (strip-pds pn) #f #f) ) ) ) ) ) ) ) )
-
-(define pathname-directory
- (lambda (pn)
- (let-values ([(dir file ext) (decompose-pathname pn)])
- dir) ) )
-
-(define pathname-file
- (lambda (pn)
- (let-values ([(dir file ext) (decompose-pathname pn)])
- file) ) )
-
-(define pathname-extension
- (lambda (pn)
- (let-values ([(dir file ext) (decompose-pathname pn)])
- ext) ) )
-
-(define pathname-strip-directory
- (lambda (pn)
- (let-values ([(dir file ext) (decompose-pathname pn)])
- (make-pathname #f file ext) ) ) )
-
-(define pathname-strip-extension
- (lambda (pn)
- (let-values ([(dir file ext) (decompose-pathname pn)])
- (make-pathname dir file) ) ) )
-
-(define pathname-replace-directory
- (lambda (pn dir)
- (let-values ([(_ file ext) (decompose-pathname pn)])
- (make-pathname dir file ext) ) ) )
-
-(define pathname-replace-file
- (lambda (pn file)
- (let-values ([(dir _ ext) (decompose-pathname pn)])
- (make-pathname dir file ext) ) ) )
-
-(define pathname-replace-extension
- (lambda (pn ext)
- (let-values ([(dir file _) (decompose-pathname pn)])
- (make-pathname dir file ext) ) ) )
+;;; Temporary file creation:
(define create-temporary-file)
(define create-temporary-directory)
@@ -363,110 +191,4 @@ EOF
(##sys#signal-hook
#:file-error 'create-temporary-directory
(##sys#string-append "cannot create temporary directory - " strerror)
- pn) ))))))))
-
-
-;;; normalize pathname for a particular platform
-
-(define normalize-pathname
- (let ((bldplt (if (eq? (build-platform) 'mingw32) 'windows 'unix)) )
- (define (addpart part parts)
- (cond ((string=? "." part) parts)
- ((string=? ".." part)
- (if (or (null? parts)
- (string=? ".." (car parts)))
- (cons part parts)
- (cdr parts)))
- (else (cons part parts) ) ) )
- (lambda (path #!optional (platform bldplt))
- (let ((sep (if (eq? platform 'windows) #\\ #\/)))
- (define (pds? c)
- (if (eq? platform 'windows)
- (memq c '(#\/ #\\))
- (eq? c #\/)))
- (##sys#check-string path 'normalize-pathname)
- (let ((len (##sys#size path))
- (type #f)
- (drive #f))
- (let loop ((i 0) (prev 0) (parts '()))
- (cond ((fx>= i len)
- (when (fx> i prev)
- (set! parts (addpart (##sys#substring path prev i) parts)))
- (if (null? parts)
- (let ((r (if (eq? type 'abs) (string sep) ".")))
- (if drive (##sys#string-append drive r) r))
- (let ((out (open-output-string))
- (parts (##sys#fast-reverse parts)))
- (display (car parts) out)
- (for-each
- (lambda (p)
- (##sys#write-char-0 sep out)
- (display p out) )
- (cdr parts))
- (when (fx= i prev) (##sys#write-char-0 sep out))
- (let ((r (get-output-string out)))
- (when (eq? type 'abs)
- (set! r (##sys#string-append (string sep) r)))
- (when drive
- (set! r (##sys#string-append drive r)))
- r))))
- ((pds? (string-ref path i))
- (when (not type)
- (set! type (if (fx= i prev) 'abs 'rel)))
- (if (fx= i prev)
- (loop (fx+ i 1) (fx+ i 1) parts)
- (loop (fx+ i 1)
- (fx+ i 1)
- (addpart (##sys#substring path prev i) parts))))
- ((and (null? parts)
- (char=? (string-ref path i) #\:)
- (eq? platform 'windows))
- (set! drive (##sys#substring path 0 (fx+ i 1)))
- (loop (fx+ i 1) (fx+ i 1) '()))
- (else (loop (fx+ i 1) prev parts)) ) ) ) ) ) ) )
-
-
-;; directory pathname => list of strings
-;; does arg check
-
-(define split-directory
- (lambda (loc dir keep?)
- (##sys#check-string dir loc)
- (string-split dir (if ##sys#windows-platform "/\\" "/") keep?) ) )
-
-;; Directory string or list only contains path-separators
-;; and/or current-directory (".") names.
-
-(define (directory-null? dir)
- (let loop ((ls (if (list? dir) dir (split-directory 'directory-null? dir #t))))
- (or (null? ls)
- (and (member (car ls) '("" "."))
- (loop (cdr ls)) ) ) ) )
-
-;; Directory string => {<origin> <root> <directory-list>}
-;; where any maybe #f when missing
-
-(define (decompose-directory dir)
- (define (strip-origin-prefix org decomp)
- #;(assert (or (not org) decomp)) ;cannot have an "origin" but no "decomp"
- (if (not org)
- decomp
- (let ((1st (car decomp)))
- (let ((olen (##sys#size org)))
- (if (not (##core#inline "C_substring_compare" org 1st 0 0 olen))
- ; then origin is not a prefix (really shouldn't happen)
- decomp
- ; else is a prefix
- (let ((rst (cdr decomp))
- (elen (##sys#size 1st)) )
- (if (fx= olen (##sys#size elen))
- ; then origin is a list prefix
- rst
- ; else origin is a string prefix
- (cons (##sys#substring 1st olen elen) rst) ) ) ) ) ) ) )
- (let* ((ls (split-directory 'decompose-directory dir #f))
- (rt (absolute-pathname-root dir))
- (org (root-origin rt)) )
- (values org (root-directory rt) (strip-origin-prefix org (and (not (null? ls)) ls))) ) )
-
-)
+ pn))))))))))
diff --git a/pathname.scm b/pathname.scm
new file mode 100644
index 00000000..acbf1c24
--- /dev/null
+++ b/pathname.scm
@@ -0,0 +1,326 @@
+;;;; pathname.scm - Pathname operations
+;
+; Copyright (c) 2008-2016, The CHICKEN Team
+; Copyright (c) 2000-2007, Felix L. Winkelmann
+; All rights reserved.
+;
+; Redistribution and use in source and binary forms, with or without
+; modification, are permitted provided that the following conditions
+; are met:
+;
+; Redistributions of source code must retain the above copyright
+; notice, this list of conditions and the following disclaimer.
+;
+; Redistributions in binary form must reproduce the above copyright
+; notice, this list of conditions and the following disclaimer in
+; the documentation and/or other materials provided with the
+; distribution.
+;
+; Neither the name of the author nor the names of its contributors
+; may be used to endorse or promote products derived from this
+; software without specific prior written permission.
+;
+; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+; COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
+; INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+; STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
+; OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(declare
+ (unit pathname)
+ (uses data-structures irregex)
+ (fixnum)
+ (disable-interrupts))
+
+(module chicken.pathname
+ (absolute-pathname? decompose-directory decompose-pathname
+ directory-null? make-absolute-pathname make-pathname
+ normalize-pathname pathname-directory pathname-extension
+ pathname-file pathname-replace-directory pathname-replace-extension
+ pathname-replace-file pathname-strip-directory
+ pathname-strip-extension)
+
+(import chicken scheme
+ chicken.data-structures
+ chicken.irregex)
+
+(include "common-declarations.scm")
+
+;;; Pathname operations:
+
+;; Platform specific absolute pathname operations:
+;; absolute-pathname-root => #f or (<match> [<origin>] <root>)
+;;
+;; Not for general consumption
+
+(define absolute-pathname-root)
+(define root-origin)
+(define root-directory)
+
+(if ##sys#windows-platform
+ (let ((rx (irregex "([A-Za-z]:)?([\\/\\\\]).*")))
+ (set! absolute-pathname-root (lambda (pn) (irregex-match rx pn)))
+ (set! root-origin (lambda (rt) (and rt (irregex-match-substring rt 1))))
+ (set! root-directory (lambda (rt) (and rt (irregex-match-substring rt 2)))))
+ (let ((rx (irregex "(/).*")))
+ (set! absolute-pathname-root (lambda (pn) (irregex-match rx pn)))
+ (set! root-origin (lambda (rt) #f))
+ (set! root-directory (lambda (rt) (and rt (irregex-match-substring rt 1))))))
+
+(define (absolute-pathname? pn)
+ (##sys#check-string pn 'absolute-pathname?)
+ (irregex-match-data? (absolute-pathname-root pn)))
+
+(define-inline (*char-pds? ch)
+ (if ##sys#windows-platform
+ (memq ch '(#\\ #\/))
+ (eq? #\/ ch)))
+
+(define (chop-pds str)
+ (and str
+ (let lp ((len (##sys#size str)))
+ (cond ((and (fx>= len 1)
+ (*char-pds? (##core#inline "C_subchar" str (fx- len 1))))
+ (lp (fx- len 1)))
+ ((fx< len (##sys#size str))
+ (##sys#substring str 0 len))
+ (else str)))))
+
+(define make-pathname)
+(define make-absolute-pathname)
+
+(let ((pds (if ##sys#windows-platform "\\" "/")))
+
+ (define (conc-dirs dirs)
+ (##sys#check-list dirs 'make-pathname)
+ (let loop ((strs dirs))
+ (if (null? strs)
+ ""
+ (let ((s1 (car strs)))
+ (if (zero? (string-length s1))
+ (loop (cdr strs))
+ (string-append
+ (chop-pds (car strs))
+ pds
+ (loop (cdr strs))))))))
+
+ (define (canonicalize-dirs dirs)
+ (cond ((or (not dirs) (null? dirs)) "")
+ ((string? dirs) (conc-dirs (list dirs)))
+ (else (conc-dirs dirs))))
+
+ (define (_make-pathname loc dir file ext)
+ (let ((ext (or ext ""))
+ (file (or file "")))
+ (##sys#check-string dir loc)
+ (##sys#check-string file loc)
+ (##sys#check-string ext loc)
+ (string-append
+ dir
+ (if (and (fx>= (##sys#size dir) 1)
+ (fx>= (##sys#size file) 1)
+ (*char-pds? (##core#inline "C_subchar" file 0)))
+ (##sys#substring file 1 (##sys#size file))
+ file)
+ (if (and (fx> (##sys#size ext) 0)
+ (not (char=? (##core#inline "C_subchar" ext 0) #\.)))
+ "."
+ "")
+ ext)))
+
+ (set! make-pathname
+ (lambda (dirs file #!optional ext)
+ (_make-pathname 'make-pathname (canonicalize-dirs dirs) file ext)))
+
+ (set! make-absolute-pathname
+ (lambda (dirs file #!optional ext)
+ (_make-pathname
+ 'make-absolute-pathname
+ (let ((dir (canonicalize-dirs dirs)))
+ (if (absolute-pathname? dir)
+ dir
+ (##sys#string-append pds dir)))
+ file ext))))
+
+(define decompose-pathname
+ (let* ((patt1 (if ##sys#windows-platform
+ "^(.*[\\/\\\\])?([^\\/\\\\]+)(\\.([^\\/\\\\.]+))$"
+ "^(.*/)?([^/]+)(\\.([^/.]+))$"))
+ (patt2 (if ##sys#windows-platform
+ "^(.*[\\/\\\\])?((\\.)?[^\\/\\\\]+)$"
+ "^(.*/)?((\\.)?[^/]+)$"))
+ (rx1 (irregex patt1))
+ (rx2 (irregex patt2))
+ (strip-pds
+ (lambda (dir)
+ (and dir
+ (let ((chopped (chop-pds dir)))
+ (if (fx> (##sys#size chopped) 0)
+ chopped
+ (##sys#substring dir 0 1)))))))
+ (lambda (pn)
+ (##sys#check-string pn 'decompose-pathname)
+ (if (fx= 0 (##sys#size pn))
+ (values #f #f #f)
+ (let ((ms (irregex-search rx1 pn)))
+ (if ms
+ (values
+ (strip-pds (irregex-match-substring ms 1))
+ (irregex-match-substring ms 2)
+ (irregex-match-substring ms 4))
+ (let ((ms (irregex-search rx2 pn)))
+ (if ms
+ (values
+ (strip-pds (irregex-match-substring ms 1))
+ (irregex-match-substring ms 2)
+ #f)
+ (values (strip-pds pn) #f #f)))))))))
+
+(define pathname-directory
+ (lambda (pn)
+ (let-values (((dir file ext) (decompose-pathname pn)))
+ dir)))
+
+(define pathname-file
+ (lambda (pn)
+ (let-values (((dir file ext) (decompose-pathname pn)))
+ file)))
+
+(define pathname-extension
+ (lambda (pn)
+ (let-values (((dir file ext) (decompose-pathname pn)))
+ ext)))
+
+(define pathname-strip-directory
+ (lambda (pn)
+ (let-values (((dir file ext) (decompose-pathname pn)))
+ (make-pathname #f file ext))))
+
+(define pathname-strip-extension
+ (lambda (pn)
+ (let-values (((dir file ext) (decompose-pathname pn)))
+ (make-pathname dir file))))
+
+(define pathname-replace-directory
+ (lambda (pn dir)
+ (let-values (((_ file ext) (decompose-pathname pn)))
+ (make-pathname dir file ext))))
+
+(define pathname-replace-file
+ (lambda (pn file)
+ (let-values (((dir _ ext) (decompose-pathname pn)))
+ (make-pathname dir file ext))))
+
+(define pathname-replace-extension
+ (lambda (pn ext)
+ (let-values (((dir file _) (decompose-pathname pn)))
+ (make-pathname dir file ext))))
+
+;;; normalize pathname for a particular platform
+
+(define normalize-pathname
+ (let ((bldplt (if (eq? (build-platform) 'mingw32) 'windows 'unix)))
+ (define (addpart part parts)
+ (cond ((string=? "." part) parts)
+ ((string=? ".." part)
+ (if (or (null? parts)
+ (string=? ".." (car parts)))
+ (cons part parts)
+ (cdr parts)))
+ (else (cons part parts))))
+ (lambda (path #!optional (platform bldplt))
+ (let ((sep (if (eq? platform 'windows) #\\ #\/)))
+ (define (pds? c)
+ (if (eq? platform 'windows)
+ (memq c '(#\/ #\\))
+ (eq? c #\/)))
+ (##sys#check-string path 'normalize-pathname)
+ (let ((len (##sys#size path))
+ (type #f)
+ (drive #f))
+ (let loop ((i 0) (prev 0) (parts '()))
+ (cond ((fx>= i len)
+ (when (fx> i prev)
+ (set! parts (addpart (##sys#substring path prev i) parts)))
+ (if (null? parts)
+ (let ((r (if (eq? type 'abs) (string sep) ".")))
+ (if drive (##sys#string-append drive r) r))
+ (let ((out (open-output-string))
+ (parts (##sys#fast-reverse parts)))
+ (display (car parts) out)
+ (for-each
+ (lambda (p)
+ (##sys#write-char-0 sep out)
+ (display p out))
+ (cdr parts))
+ (when (fx= i prev) (##sys#write-char-0 sep out))
+ (let ((r (get-output-string out)))
+ (when (eq? type 'abs)
+ (set! r (##sys#string-append (string sep) r)))
+ (when drive
+ (set! r (##sys#string-append drive r)))
+ r))))
+ ((pds? (string-ref path i))
+ (when (not type)
+ (set! type (if (fx= i prev) 'abs 'rel)))
+ (if (fx= i prev)
+ (loop (fx+ i 1) (fx+ i 1) parts)
+ (loop (fx+ i 1)
+ (fx+ i 1)
+ (addpart (##sys#substring path prev i) parts))))
+ ((and (null? parts)
+ (char=? (string-ref path i) #\:)
+ (eq? platform 'windows))
+ (set! drive (##sys#substring path 0 (fx+ i 1)))
+ (loop (fx+ i 1) (fx+ i 1) '()))
+ (else (loop (fx+ i 1) prev parts)))))))))
+
+;; directory pathname => list of strings
+;; does arg check
+
+(define split-directory
+ (lambda (loc dir keep?)
+ (##sys#check-string dir loc)
+ (string-split dir (if ##sys#windows-platform "/\\" "/") keep?)))
+
+;; Directory string or list only contains path-separators
+;; and/or current-directory (".") names.
+
+(define (directory-null? dir)
+ (let loop ((ls (if (list? dir) dir (split-directory 'directory-null? dir #t))))
+ (or (null? ls)
+ (and (member (car ls) '("" "."))
+ (loop (cdr ls))))))
+
+;; Directory string => {<origin> <root> <directory-list>}
+;; where any maybe #f when missing
+
+(define (decompose-directory dir)
+ (define (strip-origin-prefix org decomp)
+ #;(assert (or (not org) decomp)) ;cannot have an "origin" but no "decomp"
+ (if (not org)
+ decomp
+ (let ((1st (car decomp)))
+ (let ((olen (##sys#size org)))
+ (if (not (##core#inline "C_substring_compare" org 1st 0 0 olen))
+ ; then origin is not a prefix (really shouldn't happen)
+ decomp
+ ; else is a prefix
+ (let ((rst (cdr decomp))
+ (elen (##sys#size 1st)))
+ (if (fx= olen (##sys#size elen))
+ ; then origin is a list prefix
+ rst
+ ; else origin is a string prefix
+ (cons (##sys#substring 1st olen elen) rst))))))))
+ (let* ((ls (split-directory 'decompose-directory dir #f))
+ (rt (absolute-pathname-root dir))
+ (org (root-origin rt)))
+ (values org (root-directory rt) (strip-origin-prefix org (and (not (null? ls)) ls))))))
diff --git a/posixunix.scm b/posixunix.scm
index ca148f2d..73e52a2a 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -27,7 +27,7 @@
(declare
(unit posix)
- (uses scheduler irregex extras files ports)
+ (uses scheduler irregex pathname ports)
(disable-interrupts)
(not inline ##sys#interrupt-hook ##sys#user-interrupt-hook))
@@ -89,9 +89,9 @@
(import scheme chicken)
(import chicken.bitwise
- chicken.files
chicken.foreign
chicken.irregex
+ chicken.pathname
chicken.ports
chicken.time)
diff --git a/posixwin.scm b/posixwin.scm
index 061e2744..3d60568f 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -63,7 +63,7 @@
(declare
(unit posix)
- (uses data-structures scheduler irregex extras files ports)
+ (uses scheduler data-structures irregex pathname ports)
(disable-interrupts)
(hide $quote-args-list $exec-setup $exec-teardown)
(not inline ##sys#interrupt-hook ##sys#user-interrupt-hook)
@@ -715,9 +715,9 @@ EOF
(import scheme chicken)
(import chicken.bitwise
chicken.data-structures
- chicken.files
chicken.foreign
chicken.irregex
+ chicken.pathname
chicken.ports
chicken.random
chicken.time)
diff --git a/rules.make b/rules.make
index 12b84da3..a32d5c6c 100644
--- a/rules.make
+++ b/rules.make
@@ -36,9 +36,10 @@ VPATH=$(SRCDIR)
SETUP_API_OBJECTS_1 = setup-api setup-download
LIBCHICKEN_SCHEME_OBJECTS_1 = \
- library eval read-syntax repl data-structures ports files extras lolevel utils \
- tcp srfi-4 continuation $(POSIXFILE) internal irregex scheduler debugger-client \
- profiler stub expand modules chicken-syntax chicken-ffi-syntax build-version
+ library eval read-syntax repl data-structures pathname ports files \
+ extras lolevel utils tcp srfi-4 continuation $(POSIXFILE) internal \
+ irregex scheduler debugger-client profiler stub expand modules \
+ chicken-syntax chicken-ffi-syntax build-version
LIBCHICKEN_OBJECTS_1 = $(LIBCHICKEN_SCHEME_OBJECTS_1) runtime
LIBCHICKEN_SHARED_OBJECTS = $(LIBCHICKEN_OBJECTS_1:=$(O))
LIBCHICKEN_STATIC_OBJECTS = $(LIBCHICKEN_OBJECTS_1:=-static$(O))
@@ -547,9 +548,9 @@ batch-driver.c: batch-driver.scm mini-srfi-1.scm \
chicken.compiler.support.import.scm \
chicken.compiler.user-pass.import.scm \
chicken.data-structures.import.scm \
- chicken.files.import.scm \
chicken.format.import.scm \
chicken.gc.import.scm \
+ chicken.pathname.import.scm \
chicken.pretty-print.import.scm \
chicken.time.import.scm
c-platform.c: c-platform.scm mini-srfi-1.scm \
@@ -587,9 +588,9 @@ scrutinizer.c: scrutinizer.scm mini-srfi-1.scm \
chicken.compiler.support.import.scm \
chicken.data-structures.import.scm \
chicken.expand.import.scm \
- chicken.files.import.scm \
chicken.format.import.scm \
chicken.io.import.scm \
+ chicken.pathname.import.scm \
chicken.ports.import.scm \
chicken.pretty-print.import.scm
lfa2.c: lfa2.scm mini-srfi-1.scm \
@@ -612,6 +613,7 @@ support.c: support.scm mini-srfi-1.scm \
chicken.format.import.scm \
chicken.keyword.import.scm \
chicken.io.import.scm \
+ chicken.pathname.import.scm \
chicken.ports.import.scm \
chicken.pretty-print.import.scm \
chicken.random.import.scm \
@@ -623,8 +625,8 @@ modules.c: modules.scm \
csc.c: csc.scm \
chicken.data-structures.import.scm \
chicken.eval.import.scm \
- chicken.files.import.scm \
chicken.format.import.scm \
+ chicken.pathname.import.scm \
chicken.posix.import.scm \
chicken.utils.import.scm
csi.c: csi.scm \
@@ -638,11 +640,11 @@ csi.c: csi.scm \
chicken.pretty-print.import.scm \
chicken.repl.import.scm
chicken-bug.c: chicken-bug.scm \
- chicken.files.import.scm \
chicken.foreign.import.scm \
chicken.format.import.scm \
chicken.io.import.scm \
chicken.keyword.import.scm \
+ chicken.pathname.import.scm \
chicken.ports.import.scm \
chicken.posix.import.scm \
chicken.time.import.scm
@@ -651,10 +653,10 @@ chicken-profile.c: chicken-profile.scm \
chicken.posix.import.scm
chicken-status.c: chicken-status.scm \
chicken.data-structures.import.scm \
- chicken.files.import.scm \
chicken.foreign.import.scm \
chicken.format.import.scm \
chicken.irregex.import.scm \
+ chicken.pathname.import.scm \
chicken.ports.import.scm \
chicken.posix.import.scm \
chicken.pretty-print.import.scm \
@@ -666,6 +668,7 @@ chicken-install.c: chicken-install.scm \
chicken.format.import.scm \
chicken.io.import.scm \
chicken.irregex.import.scm \
+ chicken.pathname.import.scm \
chicken.ports.import.scm \
chicken.posix.import.scm \
chicken.pretty-print.import.scm \
@@ -673,10 +676,10 @@ chicken-install.c: chicken-install.scm \
setup-download.import.scm
chicken-uninstall.c: chicken-uninstall.scm \
chicken.data-structures.import.scm \
- chicken.files.import.scm \
chicken.foreign.import.scm \
chicken.format.import.scm \
chicken.irregex.import.scm \
+ chicken.pathname.import.scm \
chicken.ports.import.scm \
chicken.posix.import.scm \
setup-api.import.scm
@@ -687,6 +690,7 @@ setup-api.c: setup-api.scm \
chicken.format.import.scm \
chicken.io.import.scm \
chicken.irregex.import.scm \
+ chicken.pathname.import.scm \
chicken.posix.import.scm \
chicken.pretty-print.import.scm \
chicken.utils.import.scm
@@ -697,6 +701,7 @@ setup-download.c: setup-download.scm \
chicken.format.import.scm \
chicken.io.import.scm \
chicken.irregex.import.scm \
+ chicken.pathname.import.scm \
chicken.posix.import.scm \
chicken.tcp.import.scm \
chicken.utils.import.scm \
@@ -708,16 +713,16 @@ srfi-4.c: srfi-4.scm \
chicken.gc.import.scm
posixunix.c: posixunix.scm \
chicken.bitwise.import.scm \
- chicken.files.import.scm \
chicken.foreign.import.scm \
chicken.irregex.import.scm \
+ chicken.pathname.import.scm \
chicken.ports.import.scm \
chicken.time.import.scm
posixwin.c: posixwin.scm \
chicken.bitwise.import.scm \
- chicken.files.import.scm \
chicken.foreign.import.scm \
chicken.irregex.import.scm \
+ chicken.pathname.import.scm \
chicken.ports.import.scm \
chicken.time.import.scm
data-structures.c: data-structures.scm \
@@ -739,9 +744,13 @@ files.c: files.scm \
chicken.data-structures.import.scm \
chicken.io.import.scm \
chicken.foreign.import.scm \
- chicken.irregex.import.scm
+ chicken.irregex.import.scm \
+ chicken.pathname.import.scm
lolevel.c: lolevel.scm \
chicken.foreign.import.scm
+pathname.c: pathname.scm \
+ chicken.data-structures.import.scm \
+ chicken.irregex.import.scm
ports.c: ports.scm \
chicken.io.import.scm
tcp.c: tcp.scm \
@@ -753,6 +762,7 @@ utils.c: utils.scm \
chicken.files.import.scm \
chicken.foreign.import.scm \
chicken.format.import.scm \
+ chicken.pathname.import.scm \
chicken.posix.import.scm
define profile-flags
@@ -801,6 +811,8 @@ continuation.c: $(SRCDIR)continuation.scm $(SRCDIR)common-declarations.scm
$(bootstrap-lib) -emit-import-library chicken.continuation
data-structures.c: $(SRCDIR)data-structures.scm $(SRCDIR)common-declarations.scm
$(bootstrap-lib) -emit-import-library chicken.data-structures
+pathname.c: $(SRCDIR)pathname.scm $(SRCDIR)common-declarations.scm
+ $(bootstrap-lib) -emit-import-library chicken.pathname
ports.c: $(SRCDIR)ports.scm $(SRCDIR)common-declarations.scm
$(bootstrap-lib) -emit-import-library chicken.ports
files.c: $(SRCDIR)files.scm $(SRCDIR)common-declarations.scm
diff --git a/scrutinizer.scm b/scrutinizer.scm
index caeec684..433ed2ed 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -26,7 +26,7 @@
(declare
(unit scrutinizer)
- (uses data-structures expand extras files ports support))
+ (uses data-structures expand extras pathname ports support))
(module chicken.compiler.scrutinizer
(scrutinize load-type-database emit-type-file
@@ -36,9 +36,9 @@
chicken.compiler.support
chicken.data-structures
chicken.expand
- chicken.files
chicken.format
chicken.io
+ chicken.pathname
chicken.ports
chicken.pretty-print)
diff --git a/setup-api.scm b/setup-api.scm
index 8e1260c1..b97077be 100644
--- a/setup-api.scm
+++ b/setup-api.scm
@@ -70,6 +70,7 @@
chicken.format
chicken.io
chicken.irregex
+ chicken.pathname
chicken.posix
chicken.pretty-print
chicken.utils)
diff --git a/setup-download.scm b/setup-download.scm
index c751fea7..64967e72 100644
--- a/setup-download.scm
+++ b/setup-download.scm
@@ -39,6 +39,7 @@
chicken.format
chicken.io
chicken.irregex
+ chicken.pathname
chicken.posix
chicken.tcp
chicken.utils)
diff --git a/support.scm b/support.scm
index 03e28c16..a7396c08 100644
--- a/support.scm
+++ b/support.scm
@@ -27,7 +27,7 @@
(declare (unit support)
(not inline ##sys#user-read-hook) ; XXX: Is this needed?
- (uses data-structures extras files internal ports))
+ (uses data-structures extras files internal pathname ports))
(module chicken.compiler.support
(compiler-cleanup-hook bomb collected-debugging-output debugging
@@ -84,6 +84,7 @@
chicken.format
chicken.keyword
chicken.io
+ chicken.pathname
chicken.ports
chicken.pretty-print
chicken.random
diff --git a/tests/executable-tests.scm b/tests/executable-tests.scm
index ef391d58..6d03e7e1 100644
--- a/tests/executable-tests.scm
+++ b/tests/executable-tests.scm
@@ -2,7 +2,9 @@
(include "test.scm")
-(use files posix data-structures)
+(import (chicken pathname)
+ (chicken posix)
+ (chicken data-structures))
(define program-path
(cond-expand
diff --git a/tests/path-tests.scm b/tests/path-tests.scm
index 68ac9024..8160b63d 100644
--- a/tests/path-tests.scm
+++ b/tests/path-tests.scm
@@ -1,4 +1,4 @@
-(use files)
+(import (chicken pathname))
(define-syntax test
(syntax-rules ()
diff --git a/tests/posix-tests.scm b/tests/posix-tests.scm
index e7c456b6..04052ad2 100644
--- a/tests/posix-tests.scm
+++ b/tests/posix-tests.scm
@@ -1,4 +1,7 @@
-(use files posix lolevel)
+(import (chicken pathname)
+ (chicken files)
+ (chicken posix)
+ (chicken lolevel))
(define-syntax assert-error
(syntax-rules ()
diff --git a/tests/private-repository-test.scm b/tests/private-repository-test.scm
index 5db1a0f6..7ee00319 100644
--- a/tests/private-repository-test.scm
+++ b/tests/private-repository-test.scm
@@ -1,7 +1,8 @@
;;;; private-repository-test.scm
-(use files posix)
+(import (chicken pathname)
+ (chicken posix))
(define read-symbolic-link*
(cond-expand
diff --git a/tests/runtests.sh b/tests/runtests.sh
index c5c33b38..99dcf878 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -53,6 +53,7 @@ for x in \
chicken.keyword.import.so \
chicken.locative.import.so \
chicken.lolevel.import.so \
+ chicken.pathname.import.so \
chicken.ports.import.so \
chicken.posix.import.so \
chicken.pretty-print.import.so \
@@ -76,7 +77,7 @@ FAST_OPTIONS="-O5 -d0 -b -disable-interrupts"
COMPILE_OPTIONS="-compiler ${TEST_DIR}/../chicken -v -I${TEST_DIR}/.. -L${TEST_DIR}/.. -rpath ${TEST_DIR}/.. -include-path ${TEST_DIR}/.."
TEST_DIR_SEXPR=`../csi -n -include-path .. -e "(use posix) (write (current-directory))"`
-SETUP_PREFIX="-e (use files setup-api)"
+SETUP_PREFIX="-e (use (chicken pathname) setup-api)"
SETUP_PREFIX="${SETUP_PREFIX} -e (register-program \"csc\" (make-pathname ${TEST_DIR_SEXPR} \"../csc\"))"
SETUP_PREFIX="${SETUP_PREFIX} -e (register-program \"chicken\" (make-pathname ${TEST_DIR_SEXPR} \"../chicken\"))"
SETUP_PREFIX="${SETUP_PREFIX} -e (register-program \"csi\" (make-pathname ${TEST_DIR_SEXPR} \"../csi\"))"
diff --git a/types.db b/types.db
index 045b93fb..35df2302 100644
--- a/types.db
+++ b/types.db
@@ -1573,27 +1573,29 @@
;; files
+(chicken.files#create-temporary-directory (#(procedure #:clean #:enforce) chicken.files#create-temporary-directory () string))
+(chicken.files#create-temporary-file (#(procedure #:clean #:enforce) chicken.files#create-temporary-file (#!optional string) string))
(chicken.files#delete-file* (#(procedure #:clean #:enforce) chicken.files#delete-file* (string) *))
(chicken.files#file-copy (#(procedure #:clean #:enforce) chicken.files#file-copy (string string #!optional * fixnum) fixnum))
(chicken.files#file-move (#(procedure #:clean #:enforce) chicken.files#file-move (string string #!optional * fixnum) fixnum))
-(chicken.files#make-pathname (#(procedure #:clean #:enforce) chicken.files#make-pathname ((or string (list-of string) false) #!optional (or string false) (or string false)) string))
-(chicken.files#directory-null? (#(procedure #:clean #:enforce) chicken.files#directory-null? (string) boolean))
-(chicken.files#make-absolute-pathname (#(procedure #:clean #:enforce) chicken.files#make-absolute-pathname (* #!optional string string) string))
-(chicken.files#create-temporary-directory (#(procedure #:clean #:enforce) chicken.files#create-temporary-directory () string))
-(chicken.files#create-temporary-file (#(procedure #:clean #:enforce) chicken.files#create-temporary-file (#!optional string) string))
-(chicken.files#decompose-directory (#(procedure #:clean #:enforce) chicken.files#decompose-directory (string) * * *))
-(chicken.files#decompose-pathname (#(procedure #:clean #:enforce) chicken.files#decompose-pathname (string) * * *))
-(chicken.files#absolute-pathname? (#(procedure #:clean #:enforce) chicken.files#absolute-pathname? (string) boolean))
-(chicken.files#pathname-directory (#(procedure #:clean #:enforce) chicken.files#pathname-directory (string) *))
-(chicken.files#pathname-extension (#(procedure #:clean #:enforce) chicken.files#pathname-extension (string) *))
-(chicken.files#pathname-file (#(procedure #:clean #:enforce) chicken.files#pathname-file (string) *))
-(chicken.files#pathname-replace-directory (#(procedure #:clean #:enforce) chicken.files#pathname-replace-directory (string string) string))
-(chicken.files#pathname-replace-extension (#(procedure #:clean #:enforce) chicken.files#pathname-replace-extension (string string) string))
-(chicken.files#pathname-replace-file (#(procedure #:clean #:enforce) chicken.files#pathname-replace-file (string string) string))
-(chicken.files#pathname-strip-directory (#(procedure #:clean #:enforce) chicken.files#pathname-strip-directory (string) string))
-(chicken.files#pathname-strip-extension (#(procedure #:clean #:enforce) chicken.files#pathname-strip-extension (string) string))
-(chicken.files#normalize-pathname (#(procedure #:clean #:enforce) chicken.files#normalize-pathname (string #!optional symbol) string))
+;; pathname
+
+(chicken.pathname#absolute-pathname? (#(procedure #:clean #:enforce) chicken.pathname#absolute-pathname? (string) boolean))
+(chicken.pathname#decompose-directory (#(procedure #:clean #:enforce) chicken.pathname#decompose-directory (string) * * *))
+(chicken.pathname#decompose-pathname (#(procedure #:clean #:enforce) chicken.pathname#decompose-pathname (string) * * *))
+(chicken.pathname#directory-null? (#(procedure #:clean #:enforce) chicken.pathname#directory-null? (string) boolean))
+(chicken.pathname#make-absolute-pathname (#(procedure #:clean #:enforce) chicken.pathname#make-absolute-pathname (* #!optional string string) string))
+(chicken.pathname#make-pathname (#(procedure #:clean #:enforce) chicken.pathname#make-pathname ((or string (list-of string) false) #!optional (or string false) (or string false)) string))
+(chicken.pathname#normalize-pathname (#(procedure #:clean #:enforce) chicken.pathname#normalize-pathname (string #!optional symbol) string))
+(chicken.pathname#pathname-directory (#(procedure #:clean #:enforce) chicken.pathname#pathname-directory (string) *))
+(chicken.pathname#pathname-extension (#(procedure #:clean #:enforce) chicken.pathname#pathname-extension (string) *))
+(chicken.pathname#pathname-file (#(procedure #:clean #:enforce) chicken.pathname#pathname-file (string) *))
+(chicken.pathname#pathname-replace-directory (#(procedure #:clean #:enforce) chicken.pathname#pathname-replace-directory (string string) string))
+(chicken.pathname#pathname-replace-extension (#(procedure #:clean #:enforce) chicken.pathname#pathname-replace-extension (string string) string))
+(chicken.pathname#pathname-replace-file (#(procedure #:clean #:enforce) chicken.pathname#pathname-replace-file (string string) string))
+(chicken.pathname#pathname-strip-directory (#(procedure #:clean #:enforce) chicken.pathname#pathname-strip-directory (string) string))
+(chicken.pathname#pathname-strip-extension (#(procedure #:clean #:enforce) chicken.pathname#pathname-strip-extension (string) string))
;; irregex
diff --git a/utils.scm b/utils.scm
index fa474387..ca944255 100644
--- a/utils.scm
+++ b/utils.scm
@@ -27,7 +27,7 @@
(declare
(unit utils)
- (uses data-structures posix files)
+ (uses data-structures posix files pathname)
(fixnum)
(disable-interrupts) )
@@ -42,6 +42,7 @@
chicken.files
chicken.foreign
chicken.format
+ chicken.pathname
chicken.posix)
(include "common-declarations.scm")
Trap