~ chicken-core (chicken-5) 63eedb246fd40830008e685a7bb3452fc60f7e3d


commit 63eedb246fd40830008e685a7bb3452fc60f7e3d
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Sun Jul 4 00:27:49 2010 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sun Jul 4 00:27:49 2010 +0200

    some posix refactoring; added file-type; file-type testers now accept file-descriptors

diff --git a/manual/Unit posix b/manual/Unit posix
index 7e907ee5..74b8c9be 100644
--- a/manual/Unit posix	
+++ b/manual/Unit posix	
@@ -115,11 +115,10 @@ Files beginning with {{.}} are included only if {{SHOW-DOTFILES?}} is given and
 
 ==== directory?
 
-<procedure>(directory? NAME)</procedure>
+<procedure>(directory? FILE)</procedure>
 
-Returns {{#t}} if there exists a file with the name {{NAME}}
-and if that file is a directory or a symbolic link pointing
-to a directory.  Otherwise, it returns {{#f}}.
+Returns {{#t}} if {{FILE}} designates directory. Otherwise, it returns {{#f}}.
+{{FILE}} may be a pathname or a file-descriptor.
 
 ==== glob
 
@@ -239,10 +238,10 @@ Creates a FIFO with the name {{FILENAME}} and the permission bits
 
 ==== fifo?
 
-<procedure>(fifo? FILENAME)</procedure>
+<procedure>(fifo? FILE)</procedure>
 
-Returns {{#t}} if the file with the name {{FILENAME}} names
-a FIFO.
+Returns {{#t}} if {{FILE}} names a FIFO. {{FILE}} may be a filename
+or a file-descriptor.
 
 
 === File descriptors and low-level I/O
@@ -452,18 +451,35 @@ These procedures return {{#t}} if the current user has read,
 write or execute permissions on the file named {{FILENAME}}.
 
 
+==== file-type
+
+<procedure>(file-type FILE [LINK])</procedure>
+
+Returns the file-type for {{FILE}}, which should be a filename or
+file-descriptor. If {{LINK}} is given and true, symbolic-links are
+not followed:
+
+  regular-file
+  directory
+  fifo
+  socket
+  symbolic-link
+  character-device
+  block-device
+
+Note that not all types are supported on every platform.
+
+
 ==== character-device?
 ==== block-device?
-==== fifo?
 ==== socket?
 
-<procedure>(character-device? FILENAME)</procedure><br>
-<procedure>(block-device? FILENAME)</procedure><br>
-<procedure>(fifo? FILENAME)</procedure><br>
-<procedure>(socket? FILENAME)</procedure>
+<procedure>(character-device? FILE)</procedure><br>
+<procedure>(block-device? FILE)</procedure><br>
+<procedure>(socket? FILE)</procedure>
 
-These procedures return {{#t}} if the {{FILENAME}} given is of the 
-appropriate type.
+These procedures return {{#t}} if {{FILE}} given is of the 
+appropriate type. {{FILE}} may be a filename or a file-descriptor.
 
 
 === Changing file attributes
diff --git a/posix-common.scm b/posix-common.scm
index 50e5e066..248f6c27 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -25,17 +25,91 @@
 
 
 (declare 
+  (hide ##sys#stat posix-error check-time-vector)
   (foreign-declare #<<EOF
 
+#include <signal.h>
+#include <errno.h>
+#include <math.h>
+
+#include <sys/types.h>
+#include <sys/stat.h>
+
+static int C_not_implemented(void);
+int C_not_implemented() { return -1; }
+
 #define C_curdir(buf)       (getcwd(C_c_string(buf), 1024) ? C_fix(strlen(C_c_string(buf))) : C_SCHEME_FALSE)
 
+static C_TLS struct stat C_statbuf;
+
+#define C_stat_type         (C_statbuf.st_mode & S_IFMT)
+#define C_stat(fn)          C_fix(stat((char *)C_data_pointer(fn), &C_statbuf))
+#define C_fstat(f)          C_fix(fstat(C_unfix(f), &C_statbuf))
+
+#ifndef S_IFSOCK
+# define S_IFSOCK           0140000
+#endif
+
 EOF
 ))
 
 
 ;;; File properties
 
-(define (file-size f) (##sys#stat f #f 'file-size) _stat_st_size)
+(define-foreign-variable _stat_st_ino unsigned-int "C_statbuf.st_ino")
+(define-foreign-variable _stat_st_nlink unsigned-int "C_statbuf.st_nlink")
+(define-foreign-variable _stat_st_gid unsigned-int "C_statbuf.st_gid")
+(define-foreign-variable _stat_st_size integer64 "C_statbuf.st_size")
+(define-foreign-variable _stat_st_mtime double "C_statbuf.st_mtime")
+(define-foreign-variable _stat_st_atime double "C_statbuf.st_atime")
+(define-foreign-variable _stat_st_ctime double "C_statbuf.st_ctime")
+(define-foreign-variable _stat_st_uid unsigned-int "C_statbuf.st_uid")
+(define-foreign-variable _stat_st_mode unsigned-int "C_statbuf.st_mode")
+(define-foreign-variable _stat_st_dev unsigned-int "C_statbuf.st_dev")
+(define-foreign-variable _stat_st_rdev unsigned-int "C_statbuf.st_rdev")
+(define-foreign-variable _stat_st_blksize unsigned-int "C_statbuf.st_blksize")
+(define-foreign-variable _stat_st_blocks unsigned-int "C_statbuf.st_blocks")
+
+(define-syntax (stat-mode x r c)
+  ;; no need to rename here
+  (let ((name (cadr x)))
+    `(##core#begin
+      (declare
+	(foreign-declare
+	 ,(sprintf "#ifndef ~a~%#define ~a S_IFREG~%#endif~%" name name)))
+      (define-foreign-variable ,name unsigned-int))))
+
+(stat-mode S_IFLNK)
+(stat-mode S_IFREG)
+(stat-mode S_IFDIR)
+(stat-mode S_IFCHR)
+(stat-mode S_IFBLK)
+(stat-mode S_IFSOCK)
+(stat-mode S_IFIFO)
+
+(define (##sys#stat file link loc)
+  (let ((r (cond ((fixnum? file) (##core#inline "C_fstat" file))
+                 ((string? file)
+                  (let ((path (##sys#make-c-string
+			       (##sys#platform-fixup-pathname
+				(##sys#expand-home-path file))
+			       loc)))
+		    (if link
+			(##core#inline "C_lstat" path)
+			(##core#inline "C_stat" path) ) ) )
+                 (else
+		  (##sys#signal-hook
+		   #:type-error loc "bad argument type - not a fixnum or string" file)) ) ) )
+    (when (fx< r 0)
+      (posix-error #:file-error loc "cannot access file" file) ) ) )
+
+(define (file-stat f #!optional link)
+  (##sys#stat f link 'file-stat)
+  (vector _stat_st_ino _stat_st_mode _stat_st_nlink
+          _stat_st_uid _stat_st_gid _stat_st_size
+          _stat_st_atime _stat_st_ctime _stat_st_mtime
+          _stat_st_dev _stat_st_rdev
+          _stat_st_blksize _stat_st_blocks) )
 
 (define file-modification-time
   (getter-with-setter 
@@ -55,11 +129,39 @@ EOF
 (define (file-change-time f) (##sys#stat f #f 'file-change-time) _stat_st_ctime)
 (define (file-owner f) (##sys#stat f #f 'file-owner) _stat_st_uid)
 (define (file-permissions f) (##sys#stat f #f 'file-permissions) _stat_st_mode)
+(define (file-size f) (##sys#stat f #f 'file-size) _stat_st_size)
+
+(define (file-type file #!optional link)
+  (##sys#stat file link 'file-type)
+  (select (foreign-value "C_stat_type" unsigned-int)
+    ((S_IFLNK) 'symbolic-link)
+    ((S_IFDIR) 'directory)
+    ((S_IFCHR) 'character-device)
+    ((S_IFBLK) 'block-device)
+    ((S_IFIFO) 'fifo)
+    ((S_IFSOCK) 'socket)
+    (else 'regular-file)))
+
+(define (regular-file? file)
+  (eq? 'regular-file (file-type file)))
+
+(define (symbolic-link? file)
+  (eq? 'symbolic-link (file-type file)))
+
+(define (block-device? file)
+  (eq? 'block-device (file-type file)))
+
+(define (character-device? file)
+  (eq? 'character-device (file-type file)))
+
+(define (fifo? file)
+  (eq? 'fifo (file-type file)))
+
+(define (socket? file)
+  (eq? 'socket (file-type file)))
 
-(define (regular-file? fname)
-  (##sys#check-string fname 'regular-file?)
-  (let ((info (##sys#file-info (##sys#expand-home-path fname))))
-    (and info (fx= 0 (##sys#slot info 4))) ) )
+(define (directory? file)
+  (eq? 'directory (file-type file)))
 
 
 ;;; Set or get current directory:
@@ -84,7 +186,6 @@ EOF
   (let ((regexp regexp)
         (string-match string-match)
         (glob->regexp glob->regexp)
-        (directory directory)
         (make-pathname make-pathname)
         (decompose-pathname decompose-pathname) )
     (lambda paths
@@ -95,7 +196,7 @@ EOF
               (let-values (((dir fil ext) (decompose-pathname path)))
                 (let* ((patt (glob->regexp (make-pathname #f (or fil "*") ext)))
                        (rx (regexp patt)))
-                  (let loop ((fns (directory (or dir ".") #t)))
+                  (let loop ((fns (##sys#directory (or dir ".") #t)))
                     (cond ((null? fns) (conc-loop (cdr paths)))
                           ((string-match rx (car fns))
                            => (lambda (m) (cons (make-pathname dir (car m)) (loop (cdr fns)))) )
diff --git a/posixunix.scm b/posixunix.scm
index a7127ecb..ae437aa0 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -29,26 +29,23 @@
   (unit posix)
   (uses scheduler regex extras utils files ports)
   (disable-interrupts)
-  (hide ##sys#stat group-member _get-groups _ensure-groups posix-error
-        ##sys#terminal-check
-        check-time-vector)
-  (not inline ##sys#interrupt-hook ##sys#user-interrupt-hook)
-  (foreign-declare #<<EOF
-#include <signal.h>
-#include <errno.h>
-#include <math.h>
+  (hide group-member _get-groups _ensure-groups posix-error ##sys#terminal-check)
+  (not inline ##sys#interrupt-hook ##sys#user-interrupt-hook))
+
 
-static int C_not_implemented(void);
-int C_not_implemented() { return -1; }
+;;; common code
+
+(include "posix-common.scm")
 
+
+(declare
+  (foreign-declare #<<EOF
 static C_TLS int C_wait_status;
 
 #include <unistd.h>
-#include <sys/types.h>
 #include <sys/time.h>
 #include <sys/wait.h>
 #include <sys/utsname.h>
-#include <sys/stat.h>
 #include <sys/ioctl.h>
 #include <fcntl.h>
 #include <dirent.h>
@@ -197,21 +194,7 @@ static C_TLS struct stat C_statbuf;
 #define C_close(fd)         C_fix(close(C_unfix(fd)))
 #define C_sleep             sleep
 
-#define C_stat(fn)          C_fix(stat((char *)C_data_pointer(fn), &C_statbuf))
 #define C_lstat(fn)         C_fix(lstat((char *)C_data_pointer(fn), &C_statbuf))
-#define C_fstat(f)          C_fix(fstat(C_unfix(f), &C_statbuf))
-
-#define C_islink            ((C_statbuf.st_mode & S_IFMT) == S_IFLNK)
-#define C_isreg             ((C_statbuf.st_mode & S_IFMT) == S_IFREG)
-#define C_isdir             ((C_statbuf.st_mode & S_IFMT) == S_IFDIR)
-#define C_ischr             ((C_statbuf.st_mode & S_IFMT) == S_IFCHR)
-#define C_isblk             ((C_statbuf.st_mode & S_IFMT) == S_IFBLK)
-#define C_isfifo            ((C_statbuf.st_mode & S_IFMT) == S_IFIFO)
-#ifdef S_IFSOCK
-#define C_issock            ((C_statbuf.st_mode & S_IFMT) == S_IFSOCK)
-#else
-#define C_issock            ((C_statbuf.st_mode & S_IFMT) == 0140000)
-#endif
 
 #ifdef C_GNU_ENV
 # define C_unsetenv(s)      (unsetenv((char *)C_data_pointer(s)), C_SCHEME_TRUE)
@@ -730,66 +713,6 @@ EOF
 (define seek/end _seek_end)
 (define seek/cur _seek_cur)
 
-(define-foreign-variable _stat_st_ino unsigned-int "C_statbuf.st_ino")
-(define-foreign-variable _stat_st_nlink unsigned-int "C_statbuf.st_nlink")
-(define-foreign-variable _stat_st_gid unsigned-int "C_statbuf.st_gid")
-(define-foreign-variable _stat_st_size integer64 "C_statbuf.st_size")
-(define-foreign-variable _stat_st_mtime double "C_statbuf.st_mtime")
-(define-foreign-variable _stat_st_atime double "C_statbuf.st_atime")
-(define-foreign-variable _stat_st_ctime double "C_statbuf.st_ctime")
-(define-foreign-variable _stat_st_uid unsigned-int "C_statbuf.st_uid")
-(define-foreign-variable _stat_st_mode unsigned-int "C_statbuf.st_mode")
-(define-foreign-variable _stat_st_dev unsigned-int "C_statbuf.st_dev")
-(define-foreign-variable _stat_st_rdev unsigned-int "C_statbuf.st_rdev")
-(define-foreign-variable _stat_st_blksize unsigned-int "C_statbuf.st_blksize")
-(define-foreign-variable _stat_st_blocks unsigned-int "C_statbuf.st_blocks")
-
-(define (##sys#stat file link loc)
-  (let ([r (cond [(fixnum? file) (##core#inline "C_fstat" file)]
-                 [(string? file)
-                  (let ([path (##sys#make-c-string (##sys#expand-home-path file) loc)])
-		    (if link
-			(##core#inline "C_lstat" path)
-			(##core#inline "C_stat" path) ) ) ]
-                 [else
-		  (##sys#signal-hook
-		   #:type-error loc "bad argument type - not a fixnum or string" file)] ) ] )
-    (when (fx< r 0)
-      (posix-error #:file-error loc "cannot access file" file) ) ) )
-
-(define (file-stat f . link)
-  (##sys#stat f (optional link #f) 'file-stat)
-  (vector _stat_st_ino _stat_st_mode _stat_st_nlink
-          _stat_st_uid _stat_st_gid _stat_st_size
-          _stat_st_atime _stat_st_ctime _stat_st_mtime
-          _stat_st_dev _stat_st_rdev
-          _stat_st_blksize _stat_st_blocks) )
-
-(define (symbolic-link? fname)
-  (##sys#check-string fname 'symbolic-link?)
-  (##sys#stat fname #t 'symbolic-link?)
-  (foreign-value "C_islink" bool) )
-
-(define (character-device? fname)
-    (##sys#check-string fname 'character-device?)
-    (##sys#stat fname #f 'character-device?)
-    (foreign-value "C_ischr" bool))
-
-(define (block-device? fname)
-    (##sys#check-string fname 'block-device?)
-    (##sys#stat fname #f 'block-device?)
-    (foreign-value "C_isblk" bool))
-
-(define (fifo? fname)
-    (##sys#check-string fname 'stat-fifo?)
-    (##sys#stat fname #f 'stat-fifo?)
-    (foreign-value "C_isfifo" bool))
-
-(define (socket? fname)
-  (##sys#check-string fname 'socket?)
-  (##sys#stat fname #f 'socket?)
-  (foreign-value "C_issock" bool))
-
 (define set-file-position!
    (lambda (port pos . whence)
      (let ((whence (if (pair? whence) (car whence) _seek_set)))
@@ -826,10 +749,6 @@ EOF
 
 ;;; Directory stuff:
 
-(define-inline (*directory? loc name)
-  (and (fx= 0 (##core#inline "C_stat" (##sys#make-c-string name loc)))
-       (foreign-value "C_isdir" bool) ) )
-
 (define-inline (*create-directory loc name)
   (unless (fx= 0 (##core#inline "C_mkdir" (##sys#make-c-string name loc)))
     (posix-error #:file-error loc "cannot create directory" name)) )
@@ -840,11 +759,11 @@ EOF
     (lambda (name #!optional parents?)
       (##sys#check-string name 'create-directory)
       (let ((name (##sys#expand-home-path name)))
-        (unless (or (fx= 0 (##sys#size name)) (*directory? 'create-directory name))
+        (unless (or (fx= 0 (##sys#size name)) (directory? 'create-directory name))
           (if parents?
               (let loop ((dir (let-values (((dir file ext) (decompose-pathname name)))
                                 (if file (make-pathname dir file ext) dir))))
-                (when (and dir (not (*directory? 'create-directory dir)))
+                (when (and dir (not (directory? 'create-directory dir)))
                   (loop (pathname-directory dir))
                   (*create-directory 'create-directory dir)) )
               (*create-directory 'create-directory name) ) )
@@ -866,10 +785,8 @@ EOF
 	(posix-error #:file-error 'delete-directory "cannot delete directory" name) )
       name)))
 
-(define directory
-  (let ([string-ref string-ref]
-        [make-string make-string]
-        [string string] )
+(define ##sys#directory
+  (let ([make-string make-string])
     (lambda (#!optional (spec (current-directory)) show-dotfiles?)
       (##sys#check-string spec 'directory)
       (let ([buffer (make-string 256)]
@@ -895,9 +812,7 @@ EOF
                         (loop)
                         (cons file (loop)) ) ) ) ) ) ) ) ) )
 
-(define (directory? fname)
-  (##sys#check-string fname 'directory?)
-  (*directory? 'directory? (##sys#expand-home-path fname)) )
+(define directory ##sys#directory)
 
 
 ;;; Pipes:
@@ -2223,8 +2138,3 @@ EOF
       (##sys#check-string dir 'set-root-directory!)
       (when (fx< (chroot dir) 0)
         (posix-error #:file-error 'set-root-directory! "unable to change root directory" dir) ) ) ) )
-
-
-;;; common code
-
-(include "posix-common.scm")
diff --git a/posixwin.scm b/posixwin.scm
index 77827a8f..a3e9af43 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -65,21 +65,13 @@
   (unit posix)
   (uses scheduler regex extras utils files ports)
   (disable-interrupts)
-  (hide ##sys#stat posix-error
-	$quote-args-list $exec-setup $exec-teardown
-	check-time-vector)
+  (hide $quote-args-list $exec-setup $exec-teardown)
   (not inline ##sys#interrupt-hook ##sys#user-interrupt-hook)
   (foreign-declare #<<EOF
 #ifndef WIN32_LEAN_AND_MEAN
 # define WIN32_LEAN_AND_MEAN
 #endif
 
-/*
-MinGW should have winsock2.h and ws2tcpip.h as well.
-The CMake build will set HAVE_WINSOCK2_H and HAVE_WS2TCPIP_H.
-However, the _MSC_VER test is still needed for vcbuild.bat.
-./configure doesn't test for these.  It should, for MinGW.
-*/
 #if (_MSC_VER > 1300) || (defined(HAVE_WINSOCK2_H) && defined(HAVE_WS2TCPIP_H))
 # include <winsock2.h>
 # include <ws2tcpip.h>
@@ -92,16 +84,9 @@ However, the _MSC_VER test is still needed for vcbuild.bat.
 #include <io.h>
 #include <stdio.h>
 #include <process.h>
-
-static int C_not_implemented(void);
-int C_not_implemented() { return -1; }
-
-#include <sys/types.h>
-#include <sys/stat.h>
 #include <fcntl.h>
 #include <direct.h>
 #include <utime.h>
-
 #include <time.h>
 
 #define ARG_MAX		256
@@ -116,7 +101,6 @@ static C_TLS struct group *C_group;
 static C_TLS int C_pipefds[ 2 ];
 static C_TLS time_t C_secs;
 static C_TLS struct tm C_tm;
-static C_TLS struct stat C_statbuf;
 
 /* pipe handles */
 static C_TLS HANDLE C_rd0, C_wr0, C_wr0_, C_rd1, C_wr1, C_rd1_;
@@ -254,8 +238,7 @@ readdir(DIR * dir)
 #define C_getenventry(i)   environ[ i ]
 
 #define C_putenv(s)	    C_fix(putenv((char *)C_data_pointer(s)))
-#define C_stat(fn)	    C_fix(stat((char *)C_data_pointer(fn), &C_statbuf))
-#define C_fstat(f)	    C_fix(fstat(C_unfix(f), &C_statbuf))
+#define C_lstat(fn)	    C_stat(fn)
 
 static C_word C_fcall
 C_setenv(C_word x, C_word y)
@@ -1060,48 +1043,19 @@ EOF
 (define seek/end _seek_end)
 (define seek/cur _seek_cur)
 
-(define-foreign-variable _stat_st_ino unsigned-int "C_statbuf.st_ino")
-(define-foreign-variable _stat_st_nlink unsigned-int "C_statbuf.st_nlink")
-(define-foreign-variable _stat_st_gid unsigned-int "C_statbuf.st_gid")
-(define-foreign-variable _stat_st_size unsigned-int "C_statbuf.st_size")
-(define-foreign-variable _stat_st_mtime double "C_statbuf.st_mtime")
-(define-foreign-variable _stat_st_atime double "C_statbuf.st_atime")
-(define-foreign-variable _stat_st_ctime double "C_statbuf.st_ctime")
-(define-foreign-variable _stat_st_uid unsigned-int "C_statbuf.st_uid")
-(define-foreign-variable _stat_st_mode unsigned-int "C_statbuf.st_mode")
-
-(define (##sys#stat file link loc)	; link is ignored
-  (let ([r (cond [(fixnum? file) (##core#inline "C_fstat" file)]
-		 [(string? file) 
-		  (##core#inline
-		   "C_stat"
-		   (##sys#make-c-string (##sys#expand-home-path file) loc))]
-		 [else
-		  (##sys#signal-hook #:type-error loc "bad argument type - not a fixnum or string" file)] ) ] )
-    (when (fx< r 0)
-      (##sys#update-errno)
-      (##sys#signal-hook #:file-error loc "cannot access file" file) ) ) )
-
-(define (file-stat f #!optional link)
-  (##sys#stat f #f 'file-stat)
-  (vector _stat_st_ino _stat_st_mode _stat_st_nlink
-	  _stat_st_uid _stat_st_gid _stat_st_size
-	  _stat_st_atime _stat_st_ctime _stat_st_mtime
-	  0 0 0 0) )
-
 (define (symbolic-link? fname)
   (##sys#check-string fname 'symbolic-link?)
   #f)
 
 (let ((stat-type
-         (lambda (name)
-             (lambda (fname)
-                 (##sys#check-string fname name)
-                 #f))))
-    (set! character-device? (stat-type 'character-device?))
-    (set! block-device? (stat-type 'block-device?))
-    (set! fifo? (stat-type 'fifo?))
-    (set! socket? (stat-type 'socket?)))
+       (lambda (name)
+	 (lambda (fname)
+	   (##sys#check-string fname name)
+	   #f))))
+  (set! character-device? (stat-type 'character-device?))
+  (set! block-device? (stat-type 'block-device?))
+  (set! fifo? (stat-type 'fifo?))
+  (set! socket? (stat-type 'socket?)))
 
 (define set-file-position!
    (lambda (port pos . whence)
@@ -1140,10 +1094,10 @@ EOF
 ;;; Directory stuff:
 
 (define-inline (create-directory-helper name)
-    (unless (fx= 0 (##core#inline "C_mkdir" (##sys#make-c-string name 'create-directory)))
-            (##sys#update-errno)
-            (##sys#signal-hook #:file-error 'create-directory
-                               "cannot create directory" name)))
+  (unless (fx= 0 (##core#inline "C_mkdir" (##sys#make-c-string name 'create-directory)))
+    (##sys#update-errno)
+    (##sys#signal-hook #:file-error 'create-directory
+		       "cannot create directory" name)))
 
 (define-inline (create-directory-check name)
     (if (file-exists? name)
@@ -1224,12 +1178,6 @@ EOF
 			(loop)
 			(cons file (loop)) ) ) ) ) ) ) ) ) )
 
-(define (directory? fname)
-  (##sys#check-string fname 'directory?)
-  (let ((info (##sys#file-info
-		(##sys#platform-fixup-pathname (##sys#expand-home-path fname)))))
-    (and info (fx= 1 (##sys#slot info 4))) ) )
-
 
 ;;; Pipes:
 
diff --git a/types.db b/types.db
index 2f3bd29e..7ec93738 100644
--- a/types.db
+++ b/types.db
@@ -687,7 +687,7 @@
 (current-user-name (procedure current-user-name () string))
 (delete-directory (procedure delete-directory (string) string))
 (directory (procedure directory (string #!optional *) list))
-(directory? (procedure directory? (string) boolean))
+(directory? (procedure directory? ((or string fixnum)) boolean))
 (duplicate-fileno (procedure duplicate-fileno (fixnum #!optional fixnum) fixnum))
 (errno/2big fixnum)
 (errno/acces fixnum)
@@ -733,7 +733,6 @@
 (fcntl/getfl fixnum)
 (fcntl/setfd fixnum)
 (fcntl/setfl fixnum)
-(fifo? (procedure fifo? (string) boolean))
 (file-access-time (procedure file-access-time ((or string fixnum)) number))
 (file-change-time (procedure file-change-time ((or string fixnum)) number))
 (file-close (procedure file-close (fixnum) undefined))
@@ -755,6 +754,7 @@
 (file-stat (procedure file-stat ((or string fixnum) #!optional *) vector))
 (file-test-lock (procedure file-test-lock (port fixnum #!optional *) boolean))
 (file-truncate (procedure file-truncate ((or string fixnum) fixnum) undefined))
+(file-type (procedure ((or string fixnum) #!optional *) symbol))
 (file-unlock (procedure file-unlock ((struct lock)) undefined))
 (file-write (procedure file-write (fixnum * #!optional fixnum) fixnum))
 (file-write-access? (procedure file-write-access? (string) boolean))
@@ -827,7 +827,7 @@
 (prot/read fixnum)
 (prot/write fixnum)
 (read-symbolic-link (procedure read-symbolic-link (string) string))
-(regular-file? (procedure regular-file? (string) boolean))
+(regular-file? (procedure regular-file? ((or string fixnum)) boolean))
 (seconds->local-time (procedure seconds->local-time (#!optional number) vector))
 (seconds->string (procedure seconds->string (#!optional number) string))
 (seconds->utc-time (procedure seconds->utc-time (#!optional number) vector))
@@ -874,12 +874,12 @@
 (signal/xfsz fixnum)
 (signals-list list)
 (sleep (procedure sleep (fixnum) fixnum))
-(block-device? (procedure block-device? (string) boolean))
-(character-device? (procedure character-device? (string) boolean))
-(fifo? (procedure fifo? (string) boolean))
-(socket? (procedure socket? (string) boolean))
+(block-device? (procedure block-device? ((or string fixnum)) boolean))
+(character-device? (procedure character-device? ((or string fixnum)) boolean))
+(fifo? (procedure fifo? ((or string fixnum)) boolean))
+(socket? (procedure socket? ((or string fixnum)) boolean))
 (string->time (procedure string->time (string #!optional string) vector))
-(symbolic-link? (procedure symbolic-link? (string) boolean))
+(symbolic-link? (procedure symbolic-link? ((or string fixnum)) boolean))
 (system-information (procedure system-information () list))
 (terminal-name (procedure terminal-name (port) string))
 (terminal-port? (procedure terminal-port? (port) boolean))
Trap