some work on directory listing in cfactor

library/cross-compiler.factor

@@ -61,6 +61,7 @@ IN: io-internals
 DEFER: port?
 DEFER: open-file
 DEFER: stat
+DEFER: read-dir
 DEFER: client-socket
 DEFER: server-socket
 DEFER: close-port
@@ -220,6 +221,7 @@ IN: cross-compiler
         setenv
         open-file
         stat
+        read-dir
         garbage-collection
         save-image
         datastack

library/platform/native/files.factor

@@ -32,13 +32,48 @@ USE: kernel
 USE: lists
 USE: logic
 USE: math
+USE: namespaces
 USE: stack
+USE: strings
+
+: <file> ( path -- file )
+    #! Create an empty file object. Do not use this directly.
+    <namespace> [
+        "path" set
+        f "exists" set
+        f "directory" set
+        0 "permissions" set
+        0 "size" set
+        0 "mod-time" set
+    ] extend ;
+
+: path>file ( path -- file )
+    dup <file> [
+        stat [
+            "exists" on
+            [
+                "directory"
+                "permissions"
+                "size"
+                "mod-time"
+            ] [
+                set
+            ] 2each
+        ] when*
+    ] extend ;
+
+: ?path>file ( path/file -- file )
+    dup string? [ path>file ] when ;
 
 : exists? ( file -- ? )
-    stat >boolean ;
-
-: dir-mode
-    OCT: 40000 ;
+    ?path>file "exists" swap get* ;
 
 : directory? ( file -- ? )
-    stat dup [ car dir-mode bitand 0 = not ] when ;
+    ?path>file "directory" swap get* ;
+
+: dirent>file ( parent name dir? -- file )
+    -rot "/" swap cat3 <file> [ "directory" set ] extend ;
+
+: directory ( file -- list )
+    #! Push a list of file objects in the directory.
+    dup read-dir [ dupd uncons dirent>file ] map nip ;

native/factor.h

@@ -1,6 +1,7 @@
 #ifndef __FACTOR_H__
 #define __FACTOR_H__
 
+#include <dirent.h>
 #include <errno.h>
 #include <fcntl.h>
 #include <limits.h>

native/file.c

@@ -33,14 +33,42 @@ void primitive_stat(void)
 		dpush(F);
 	else
 	{
-		CELL mode = tag_integer(sb.st_mode);
+		CELL dirp = tag_boolean(S_ISDIR(sb.st_mode));
+		CELL mode = tag_fixnum(sb.st_mode & ~S_IFMT);
 		CELL size = tag_object(s48_long_long_to_bignum(sb.st_size));
 		CELL mtime = tag_integer(sb.st_mtime);
 		dpush(tag_cons(cons(
-			mode,
+			dirp,
 			tag_cons(cons(
-				size,
+				mode,
 				tag_cons(cons(
-					mtime,F)))))));
+					size,
+					tag_cons(cons(
+						mtime,F)))))))));
 	}
 }
+
+void primitive_read_dir(void)
+{
+	STRING* path = untag_string(dpop());
+	DIR* dir = opendir(to_c_string(path));
+	CELL result = F;
+	if(dir != NULL)
+	{
+		struct dirent* file;
+
+		while(file = readdir(dir))
+		{
+			CELL name = tag_object(from_c_string(
+				file->d_name));
+			CELL dirp = tag_boolean(
+				file->d_type == DT_DIR);
+			CELL entry = tag_cons(cons(name,dirp));
+			result = tag_cons(cons(entry,result));
+		}
+
+		closedir(dir);
+	}
+
+	dpush(result);
+}

native/file.h

@@ -2,3 +2,4 @@
 
 void primitive_open_file(void);
 void primitive_stat(void);
+void primitive_read_dir(void);

native/primitives.c

@@ -109,6 +109,7 @@ XT primitives[] = {
 	primitive_setenv,
 	primitive_open_file,
 	primitive_stat,
+	primitive_read_dir,
 	primitive_gc,
 	primitive_save_image,
 	primitive_datastack,

native/primitives.h

@@ -1,4 +1,4 @@
 extern XT primitives[];
-#define PRIMITIVE_COUNT 146
+#define PRIMITIVE_COUNT 147
 
 CELL primitive_to_xt(CELL primitive);