From 01d9d2d09c75cdaf4cd5cd78da35b9a7509e8151 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Wed, 20 Jul 2011 09:24:18 -0700 Subject: [PATCH] Added ->simple-pathname for c-including ../../whatnot. --- src/ffi/cdecls.scm | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/src/ffi/cdecls.scm b/src/ffi/cdecls.scm index 956e59eb2..4ec536028 100644 --- a/src/ffi/cdecls.scm +++ b/src/ffi/cdecls.scm @@ -71,9 +71,9 @@ USA. ;; FILENAME relative to CWD (current working directory). ;; Abbreviates namestrings under TWD (topmost working, build directory). - (let* ((pathname (pathname-simplify - (merge-pathnames - (pathname-default-type filename "cdecl") cwd))) + (let* ((pathname (->simple-pathname + (merge-pathnames (pathname-default-type filename "cdecl") + cwd))) (new-cwd (directory-pathname pathname)) (namestring (enough-namestring pathname twd)) (modtime (file-modification-time-indirect namestring)) @@ -100,6 +100,14 @@ USA. kernel) (kernel)))))) +(define (->simple-pathname pathname) + (let loop ((count 0) + (simpler (pathname-simplify pathname))) + (let ((again (pathname-simplify simpler))) + (cond ((fix:> count 100) (error "Could not simplify:" pathname)) + ((pathname=? again simpler) again) + (else (loop again (fix:1+ count))))))) + (define read-environment (make-top-level-environment '(*PARSER-CANONICALIZE-SYMBOLS?*) '(#f))) -- 2.25.1