Replace (stat) with (exists?)

core/bootstrap/primitives.factor

@@ -91,8 +91,9 @@ call
 } [ create-vocab drop ] each
 
 H{ } clone source-files set
-H{ } clone class<map set
 H{ } clone update-map set
+H{ } clone class<map set
+H{ } clone class-map set
 
 ! Builtin classes
 : builtin-predicate-quot ( class -- quot )
@@ -547,7 +548,7 @@ builtins get num-tags get tail f union-class define-class
     { "eq?" "kernel" }
     { "getenv" "kernel.private" }
     { "setenv" "kernel.private" }
-    { "(stat)" "io.files.private" }
+    { "(exists?)" "io.files.private" }
     { "(directory)" "io.files.private" }
     { "data-gc" "memory" }
     { "code-gc" "memory" }

core/io/files/files-docs.factor

@@ -54,9 +54,7 @@ ARTICLE: "fs-meta" "File meta-data"
 { $subsection file-info }
 { $subsection link-info }
 { $subsection exists? }
-{ $subsection directory? }
+{ $subsection directory? } ;
-! { $subsection file-modified }
-{ $subsection stat } ;
 
 ARTICLE: "delete-move-copy" "Deleting, moving, copying files"
 "Operations for deleting and copying files come in two forms:"
@@ -216,14 +214,6 @@ HELP: with-directory
 { $description "Changes the current working directory for the duration of a quotation's execution." }
 { $errors "Windows CE has no concept of ``current directory'', so this word throws an error there." } ;
 
-HELP: stat ( path -- directory? permissions length modified )
-{ $values { "path" "a pathname string" } { "directory?" "boolean indicating if the file is a directory" } { "permissions" "a Unix permission bitmap (0 on Windows)" } { "length" "the length in bytes as an integer" } { "modified" "the last modification time, as milliseconds since midnight, January 1st 1970 GMT" } }
-{ $description
-    "Queries the file system for file meta data. If the file does not exist, outputs " { $link f } " for all four values."
-} ;
-
-{ stat exists? directory? } related-words
-
 HELP: append-path
 { $values { "str1" "a string" } { "str2" "a string" } { "str" "a string" } }
 { $description "Concatenates two pathnames." } ;
@@ -273,7 +263,7 @@ HELP: normalize-directory
 
 HELP: normalize-pathname
 { $values { "str" "a pathname string" } { "newstr" "a new pathname string" } }
-{ $description "Called by the " { $link stat } " word, and possibly " { $link <file-reader> } " and " { $link <file-writer> } ", to prepare a pathname before passing it to underlying code." } ;
+{ $description "Called by words such as " { $link <file-reader> } " and " { $link <file-writer> } " to prepare a pathname before passing it to underlying code." } ;
 
 HELP: <pathname> ( str -- pathname )
 { $values { "str" "a pathname string" } { "pathname" pathname } }

core/io/files/files.factor

@@ -86,14 +86,11 @@ SYMBOL: +socket+
 SYMBOL: +unknown+
 
 ! File metadata
-: stat ( path -- directory? permissions length modified )
+: exists? ( path -- ? )
-    normalize-pathname (stat) ;
+    normalize-pathname (exists?) ;
 
-: file-modified ( path -- n ) stat >r 3drop r> ;
+: directory? ( path -- ? )
-
+    file-info file-info-type +directory+ = ;
-: exists? ( path -- ? ) file-modified >boolean ;
-
-: directory? ( path -- ? ) file-info file-info-type +directory+ = ;
 
 ! Current working directory
 HOOK: cd io-backend ( path -- )

vm/io.h

@@ -12,5 +12,5 @@ DECLARE_PRIMITIVE(fclose);
 
 /* Platform specific primitives */
 DECLARE_PRIMITIVE(open_file);
-DECLARE_PRIMITIVE(stat);
+DECLARE_PRIMITIVE(existsp);
 DECLARE_PRIMITIVE(read_dir);

vm/os-unix.c

@@ -41,24 +41,10 @@ void ffi_dlclose(F_DLL *dll)
 	dll->dll = NULL;
 }
 
-DEFINE_PRIMITIVE(stat)
+DEFINE_PRIMITIVE(existsp)
 {
 	struct stat sb;
-
+	box_boolean(stat(unbox_char_string(),&sb) < 0);
-	if(stat(unbox_char_string(),&sb) < 0)
-	{
-		dpush(F);
-		dpush(F);
-		dpush(F);
-		dpush(F);
-	}
-	else
-	{
-		box_boolean(S_ISDIR(sb.st_mode));
-		box_signed_4(sb.st_mode & ~S_IFMT);
-		box_unsigned_8(sb.st_size);
-		box_unsigned_8(sb.st_mtime);
-	}
 }
 
 /* Allocates memory */

vm/os-windows.c

@@ -87,14 +87,6 @@ const F_CHAR *vm_executable_path(void)
 	return safe_strdup(full_path);
 }
 
-void stat_not_found(void)
-{
-	dpush(F);
-	dpush(F);
-	dpush(F);
-	dpush(F);
-}
-
 void find_file_stat(F_CHAR *path)
 {
 	// FindFirstFile is the only call that can stat c:\pagefile.sys
@@ -102,56 +94,45 @@ void find_file_stat(F_CHAR *path)
 	HANDLE h;
 
 	if(INVALID_HANDLE_VALUE == (h = FindFirstFile(path, &st)))
-		stat_not_found();
+		dpush(F);
 	else
 	{
-		box_boolean(st.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY);
-		dpush(tag_fixnum(0));
-		box_unsigned_8(
-			(u64)st.nFileSizeLow | (u64)st.nFileSizeHigh << 32);
-
-		u64 lo = st.ftLastWriteTime.dwLowDateTime;
-		u64 hi = st.ftLastWriteTime.dwHighDateTime;
-		u64 modTime = (hi << 32) + lo;
-
-		box_unsigned_8((modTime - EPOCH_OFFSET) / 10000000);
 		FindClose(h);
+		dpush(T);
 	}
 }
 
-DEFINE_PRIMITIVE(stat)
+DEFINE_PRIMITIVE(existsp)
 {
-	HANDLE h;
 	BY_HANDLE_FILE_INFORMATION bhfi;
 
 	F_CHAR *path = unbox_u16_string();
 	//wprintf(L"path = %s\n", path);
-	h = CreateFileW(path,
+	HANDLE h = CreateFileW(path,
 			GENERIC_READ,
 			FILE_SHARE_READ,
 			NULL,
 			OPEN_EXISTING,
 			FILE_FLAG_BACKUP_SEMANTICS,
 			NULL);
+
 	if(h == INVALID_HANDLE_VALUE)
 	{
-		find_file_stat(path);
+		// FindFirstFile is the only call that can stat c:\pagefile.sys
+		WIN32_FIND_DATA st;
+		HANDLE h;
+
+		if(INVALID_HANDLE_VALUE == (h = FindFirstFile(path, &st)))
+			dpush(F);
+		else
+		{
+			FindClose(h);
+			dpush(T);
+		}
 		return;
 	}
 
-	if(!GetFileInformationByHandle(h, &bhfi))
+	box_boolean(GetFileInformationByHandle(h, &bhfi));
-		stat_not_found();
-	else {
-		box_boolean(bhfi.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY);
-		dpush(tag_fixnum(0));
-		box_unsigned_8(
-			(u64)bhfi.nFileSizeLow | (u64)bhfi.nFileSizeHigh << 32);
-		u64 lo = bhfi.ftLastWriteTime.dwLowDateTime;
-		u64 hi = bhfi.ftLastWriteTime.dwHighDateTime;
-		u64 modTime = (hi << 32) + lo;
-
-		box_unsigned_8((modTime - EPOCH_OFFSET) / 10000000);
-	}
 	CloseHandle(h);
 }
 

vm/primitives.c

@@ -88,7 +88,7 @@ void *primitives[] = {
 	primitive_eq,
 	primitive_getenv,
 	primitive_setenv,
-	primitive_stat,
+	primitive_existsp,
 	primitive_read_dir,
 	primitive_data_gc,
 	primitive_code_gc,