Added ->simple-pathname for c-including ../../whatnot.
authorMatt Birkholz <matt@birkholz.chandler.az.us>
Wed, 20 Jul 2011 16:24:18 +0000 (09:24 -0700)
committerMatt Birkholz <matt@birkholz.chandler.az.us>
Wed, 20 Jul 2011 16:24:18 +0000 (09:24 -0700)
src/ffi/cdecls.scm

index 956e59eb29834db4e1019a141216077253ad3fd3..4ec5360284cfaa155ae789d06621c77829d398dd 100644 (file)
@@ -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)))