Support lstat and fstat.

* stream.h (statf): Declaration removed.

* sysif.c (w_stat): Function takes val instead of const wchar_t *
as leftmost argument.
(w_lstat, w_fstat): New static functions, with same interface as w_stat.
(stat_to_list, stat_impl): New static functions.
(statp, statl): New static functions.
(statf): Function removed, name re-used for new static function.
(sysif_init): stat intrinsic registered to statp function, not statf.
lstat and fstat intrinsics registered to statl and statf.

* txr.1: Documented lstat and fstat.

4 files changed, 106 insertions, 14 deletions

diff --git a/ChangeLog b/ChangeLog
index 7a734328..8c6be763 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,20 @@
+2015-08-02  Kaz Kylheku  <kaz@kylheku.com>
+
+	Support lstat and fstat.
+
+	* stream.h (statf): Declaration removed.
+
+	* sysif.c (w_stat): Function takes val instead of const wchar_t *
+	as leftmost argument.
+	(w_lstat, w_fstat): New static functions, with same interface as w_stat.
+	(stat_to_list, stat_impl): New static functions.
+	(statp, statl): New static functions.
+	(statf): Function removed, name re-used for new static function.
+	(sysif_init): stat intrinsic registered to statp function, not statf.
+	lstat and fstat intrinsics registered to statl and statf.
+
+	* txr.1: Documented lstat and fstat.
+
 2015-08-01  Kaz Kylheku  <kaz@kylheku.com>
 
 	Pass pretty flag to cobj print operation.
diff --git a/stream.h b/stream.h
index 862874cd..911ebb47 100644
--- a/stream.h
+++ b/stream.h
@@ -143,7 +143,6 @@ val set_indent(val stream, val indent);
 val inc_indent(val stream, val delta);
 val width_check(val stream, val alt);
 val get_string(val stream, val nchars, val close_after_p);
-val statf(val path);
 val open_directory(val path);
 val open_file(val path, val mode_str);
 val open_fileno(val fd, val mode_str);
diff --git a/sysif.c b/sysif.c
index 6c0cb547..6761b912 100644
--- a/sysif.c
+++ b/sysif.c
@@ -519,25 +519,40 @@ static val exit_star_wrap(val status)
 #endif
 
 #if HAVE_SYS_STAT
-static int w_stat(const wchar_t *wpath, struct stat *buf)
+static int w_stat(val wpath, struct stat *buf)
 {
-  char *path = utf8_dup_to(wpath);
+  char *path = utf8_dup_to(c_str(wpath));
   int res = stat(path, buf);
   free(path);
   return res;
 }
-#endif
 
-val statf(val path)
+static int w_lstat(val wpath, struct stat *buf)
 {
-#if HAVE_SYS_STAT
-  struct stat st;
-  int res = w_stat(c_str(path), &st);
+  char *path = utf8_dup_to(c_str(wpath));
+  int res = lstat(path, buf);
+  free(path);
+  return res;
+}
 
-  if (res == -1)
-    uw_throwf(file_error_s, lit("unable to stat ~a: ~a/~s"),
-              path, num(errno), string_utf8(strerror(errno)), nao);
+static int w_fstat(val stream, struct stat *buf)
+{
+  val fd = stream_get_prop(stream, fd_k);
 
+  if (fd) {
+    int res = fstat(c_num(fd), buf);
+    return res;
+  }
+
+  uw_throwf(file_error_s,
+            lit("cannot fstat stream ~s: it has no :fd property"),
+            stream, nao);
+}
+#endif
+
+#if HAVE_SYS_STAT
+static val stat_to_list(struct stat st)
+{
   return list(dev_k, num(st.st_dev),
               ino_k, num(st.st_ino),
               mode_k, num(st.st_mode),
@@ -557,11 +572,42 @@ val statf(val path)
               mtime_k, num(st.st_mtime),
               ctime_k, num(st.st_ctime),
               nao);
+}
+
+#endif
+
+static val stat_impl(val obj, int (*statfn)(val, struct stat *),
+                     val name)
+{
+#if HAVE_SYS_STAT
+  struct stat st;
+  int res = statfn(obj, &st);
+
+  if (res == -1)
+    uw_throwf(file_error_s, lit("unable to ~a ~a: ~a/~s"),
+              name, obj, num(errno), string_utf8(strerror(errno)), nao);
+
+  return stat_to_list(st);
 #else
-  uw_throwf(file_error_s, lit("stat is not implemented"), nao);
+  uw_throwf(file_error_s, lit("~a is not implemented"), name, nao);
 #endif
 }
 
+static val statp(val path)
+{
+  return stat_impl(path, w_stat, lit("stat"));
+}
+
+static val statl(val path)
+{
+  return stat_impl(path, w_lstat, lit("lstat"));
+}
+
+static val statf(val stream)
+{
+  return stat_impl(stream, w_fstat, lit("lstat"));
+}
+
 #if HAVE_PIPE
 
 static val pipe_wrap(void)
@@ -723,7 +769,9 @@ void sysif_init(void)
   reg_fun(intern(lit("readlink"), user_package), func_n1(readlink_wrap));
 #endif
 
-  reg_fun(intern(lit("stat"), user_package), func_n1(statf));
+  reg_fun(intern(lit("stat"), user_package), func_n1(statp));
+  reg_fun(intern(lit("lstat"), user_package), func_n1(statl));
+  reg_fun(intern(lit("fstat"), user_package), func_n1(statf));
 
 #if HAVE_SYS_STAT
 #ifndef S_IFSOCK
diff --git a/txr.1 b/txr.1
index 2e6be395..6bf1344f 100644
--- a/txr.1
+++ b/txr.1
@@ -29074,9 +29074,11 @@ attempt.
 
 .SS* Unix Filesystem Manipulation
 
-.coNP Function @ stat
+.coNP Functions @, stat @, lstat and @ fstat
 .synb
 .mets (stat << path )
+.mets (lstat << path )
+.mets (fstat << stream )
 .syne
 .desc
 The
@@ -29106,6 +29108,32 @@ property has the same value as the
 .code st_dev
 field.
 
+If
+.meta path
+refers to a symbolic link, the
+.code stat
+function retrieves information about the target of the link, if it exists,
+or else throws an exception of type
+.codn file-error .
+
+The
+.code lstat
+function behaves the same as
+.code stat
+or objects which are not symbolic links. For a symbolic link, it retrieves
+information about the link itself, rather than its target.
+
+The
+.code fstat
+function retrieves information about the file system object associated with
+the open stream
+.metn stream .
+The stream must be of a kind from which the
+.code fileno
+function can retrieve a file descriptor, otherwise an exception of type
+.code file-error
+is thrown.
+
 .coNP Special variables @, s-ifmt @, s-iflnk @, s-ifreg @, s-ifblk ... , @ s-ixoth
 
 The following variables exist, having integer values. These are bitmasks