load.c uses same logic as boot-9 for file names

* libguile/load.c (is_file_name_separator, is_drive_letter):
  (is_absolute_file_name): New helpers, like the ones in boot-9.
  Perhaps we should just define them in C.
  (search_path, scm_try_auto_compile, canonical_suffix): Rewrite using
  the new helpers.

libguile/load.c

@@ -447,6 +447,58 @@ scm_c_string_has_an_ext (char *str, size_t len, SCM extensions)
   return 0;
 }
 
+#ifdef __MINGW32__
+#define FILE_NAME_SEPARATOR_STRING "\\"
+#else
+#define FILE_NAME_SEPARATOR_STRING "/"
+#endif
+
+static int
+is_file_name_separator (SCM c)
+{
+  if (c == SCM_MAKE_CHAR ('/'))
+    return 1;
+#ifdef __MINGW32__
+  if (c == SCM_MAKE_CHAR ('\\'))
+    return 1;
+#endif
+  return 0;
+}
+
+static int
+is_drive_letter (SCM c)
+{
+#ifdef __MINGW32__
+  if (SCM_CHAR (c) >= 'a' && SCM_CHAR (c) <= 'z')
+    return 1;
+  else if (SCM_CHAR (c) >= 'A' && SCM_CHAR (c) <= 'Z')
+    return 1;
+#endif
+  return 0;
+}
+
+static int
+is_absolute_file_name (const char *filename_chars, size_t filename_len)
+{
+  if (filename_len >= 1
+      && is_file_name_separator (SCM_MAKE_CHAR (filename_chars[0]))
+#ifdef __MINGW32__
+      /* On Windows, one initial separator indicates a drive-relative
+         path.  Two separators indicate a Universal Naming Convention
+         (UNC) path.  UNC paths are always absolute.  */
+      && filename_len >= 2
+      && is_file_name_separator (SCM_MAKE_CHAR (filename_chars[1]))
+#endif
+      )
+    return 1;
+  if (filename_len >= 3
+      && is_drive_letter (SCM_MAKE_CHAR (filename_chars[0]))
+      && filename_chars[1] == ':'
+      && is_file_name_separator (SCM_MAKE_CHAR (filename_chars[2])))
+    return 1;
+  return 0;
+}
+
 /* Search PATH for a directory containing a file named FILENAME.
    The file must be readable, and not a directory.
    If we find one, return its full pathname; otherwise, return #f.
@@ -477,16 +529,7 @@ search_path (SCM path, SCM filename, SCM extensions, SCM require_exts,
   scm_dynwind_free (filename_chars);
 
   /* If FILENAME is absolute and is still valid, return it unchanged.  */
-#ifdef __MINGW32__
+  if (is_absolute_file_name (filename_chars, filename_len))
-  if (((filename_len >= 1) && 
-       (filename_chars[0] == '/' || filename_chars[0] == '\\')) ||
-      ((filename_len >= 3) && filename_chars[1] == ':' &&
-       ((filename_chars[0] >= 'a' && filename_chars[0] <= 'z') ||
-	(filename_chars[0] >= 'A' && filename_chars[0] <= 'Z')) &&
-       (filename_chars[2] == '/' || filename_chars[2] == '\\')))
-#else
-  if (filename_len >= 1 && filename_chars[0] == '/')
-#endif
     {
       if ((scm_is_false (require_exts) ||
            scm_c_string_has_an_ext (filename_chars, filename_len,
@@ -520,11 +563,7 @@ search_path (SCM path, SCM filename, SCM extensions, SCM require_exts,
 	    extensions = SCM_EOL;
 	    break;
 	  }
-#ifdef __MINGW32__
+	else if (is_file_name_separator (SCM_MAKE_CHAR (*endp)))
-	else if (*endp == '/' || *endp == '\\')
-#else
-	else if (*endp == '/')
-#endif
 	  /* This filename has no extension, so keep the current list
              of extensions.  */
 	  break;
@@ -553,12 +592,9 @@ search_path (SCM path, SCM filename, SCM extensions, SCM require_exts,
 	
       /* Concatenate the path name and the filename. */
       
-#ifdef __MINGW32__
+      if (buf.ptr > buf.buf
-      if ((buf.ptr > buf.buf) && (buf.ptr[-1] != '/') && (buf.ptr[-1] != '\\'))
+          && !is_file_name_separator (SCM_MAKE_CHAR (buf.ptr[-1])))
-#else
+	stringbuf_cat (&buf, FILE_NAME_SEPARATOR_STRING);
-      if ((buf.ptr > buf.buf) && (buf.ptr[-1] != '/'))
-#endif
-	stringbuf_cat (&buf, "/");
 
       stringbuf_cat (&buf, filename_chars);
       sans_ext_len = buf.ptr - buf.buf;
@@ -823,23 +859,35 @@ scm_try_auto_compile (SCM source)
                       NULL, NULL);
 }
 
-/* See also (system base compile):compiled-file-name. */
+/* The auto-compilation code will residualize a .go file in the cache
+   dir: by default, $HOME/.cache/guile/2.0/ccache/PATH.go.  This
+   function determines the PATH to use as a key into the compilation
+   cache.  See also (system base compile):compiled-file-name. */
 static SCM
 canonical_suffix (SCM fname)
 {
   SCM canon;
-  size_t len;
 
+  /* CANON should be absolute.  */
   canon = scm_canonicalize_path (fname);
-  len = scm_c_string_length (canon);
   
-  if (len > 1 && scm_is_eq (scm_c_string_ref (canon, 0), SCM_MAKE_CHAR ('/')))
+#ifdef __MINGW32__
-    return canon;
+  {
-  else if (len > 2 && scm_is_eq (scm_c_string_ref (canon, 1), SCM_MAKE_CHAR (':')))
+    size_t len = scm_c_string_length (canon);
-    return scm_string_append (scm_list_3 (scm_from_latin1_string ("/"),
+
+    /* On Windows, an absolute file name that doesn't start with a
+       separator starts with a drive component.  Transform the drive
+       component to a file name element: c:\foo -> \c\foo. */
+    if (len >= 2
+        && is_absolute_file_name (canon)
+        && !is_file_name_separator (scm_c_string_ref (canon, 0)))
+      return scm_string_append
+        (scm_list_3 (scm_from_latin1_string (FILE_NAME_SEPARATOR_STRING),
                      scm_c_substring (canon, 0, 1),
                      scm_c_substring (canon, 2, len)));
-  else
+  }
+#endif
+
   return canon;
 }