From e9902c952b488adf7de5c2464d416810ce222955 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Tue, 11 Sep 2012 20:11:40 -0700 Subject: * configure: Added test for * eval.c: New intrinsic functions "stat" and "prop". * stream.c: Include if we have it. (w_stat, statf): New functions. (val dev_k, ino_k, mode_k, nlink_k, uid_k, val gid_k, rdev_k, size_k, blksize_k, blocks_k; val atime_k, mtime_k, ctime_k): New sybol variables. (stream_init): Intern new keywords symbols. * stream.h (statf): Declared. * txr.1: prop documented. Stub for stat created. --- ChangeLog | 17 +++++++++++++++++ configure | 24 ++++++++++++++++++++++++ eval.c | 2 ++ stream.c | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ stream.h | 1 + txr.1 | 26 ++++++++++++++++++++++++++ 6 files changed, 132 insertions(+) diff --git a/ChangeLog b/ChangeLog index 708bf2c3..dc92bba9 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,20 @@ +2012-09-11 Kaz Kylheku + + * configure: Added test for + + * eval.c: New intrinsic functions "stat" and "prop". + + * stream.c: Include if we have it. + (w_stat, statf): New functions. + (val dev_k, ino_k, mode_k, nlink_k, uid_k, + val gid_k, rdev_k, size_k, blksize_k, blocks_k; + val atime_k, mtime_k, ctime_k): New sybol variables. + (stream_init): Intern new keywords symbols. + + * stream.h (statf): Declared. + + * txr.1: prop documented. Stub for stat created. + 2012-09-11 Kaz Kylheku * eval.c (eval_init): new instrinsic function /= registered. diff --git a/configure b/configure index 1c556808..786ff655 100755 --- a/configure +++ b/configure @@ -1141,6 +1141,30 @@ else printf "#define HAVE_SYS_WAIT 1\n" >> config.h fi +# +# sys/stat.h +# + +printf "Checking whether we have ... " + +cat > conftest.c < + +int main(void) +{ + struct stat s; + return 0; +} +! +rm -f conftest +if ! $make conftest > conftest.err 2>&1 || ! [ -x conftest ] ; then + printf "no\n" +else + printf "yes\n" + printf "#define HAVE_SYS_STAT 1\n" >> config.h +fi + + # # environ # diff --git a/eval.c b/eval.c index 9266846b..f7ecd06d 100644 --- a/eval.c +++ b/eval.c @@ -2291,6 +2291,7 @@ void eval_init(void) reg_fun(intern(lit("put-char"), user_package), func_n2o(put_char, 1)); reg_fun(intern(lit("put-byte"), user_package), func_n2o(put_byte, 1)); reg_fun(intern(lit("flush-stream"), user_package), func_n1(flush_stream)); + reg_fun(intern(lit("stat"), user_package), func_n1(statf)); reg_fun(intern(lit("open-directory"), user_package), func_n1(open_directory)); reg_fun(intern(lit("open-file"), user_package), func_n2(open_file)); reg_fun(intern(lit("open-command"), user_package), func_n2(open_command)); @@ -2381,6 +2382,7 @@ void eval_init(void) reg_fun(intern(lit("alist-nremove"), user_package), func_n1v(alist_nremove)); reg_fun(intern(lit("copy-cons"), user_package), func_n1(copy_cons)); reg_fun(intern(lit("copy-alist"), user_package), func_n1(copy_alist)); + reg_fun(intern(lit("prop"), user_package), func_n2(getplist)); reg_fun(intern(lit("merge"), user_package), func_n4o(merge, 2)); reg_fun(intern(lit("sort"), user_package), func_n3o(sort, 2)); reg_fun(intern(lit("find"), user_package), func_n4o(find, 2)); diff --git a/stream.c b/stream.c index 8d37bc72..e3d8d962 100644 --- a/stream.c +++ b/stream.c @@ -40,6 +40,9 @@ #if HAVE_SYS_WAIT #include #endif +#if HAVE_SYS_STAT +#include +#endif #include "lib.h" #include "gc.h" #include "unwind.h" @@ -49,6 +52,10 @@ val std_input, std_output, std_debug, std_error; val output_produced; +val dev_k, ino_k, mode_k, nlink_k, uid_k; +val gid_k, rdev_k, size_k, blksize_k, blocks_k; +val atime_k, mtime_k, ctime_k; + struct strm_ops { struct cobj_ops cobj_ops; val (*put_string)(val, val); @@ -1475,6 +1482,46 @@ val flush_stream(val stream) } } +#if HAVE_SYS_STAT +static int w_stat(const wchar_t *wpath, struct stat *buf) +{ + char *path = utf8_dup_to(wpath); + int res = stat(path, buf); + free(path); + return res; +} +#endif + +val statf(val path) +{ +#if HAVE_SYS_STAT + struct stat st; + int res = w_stat(c_str(path), &st); + + if (res == -1) + uw_throwf(file_error_s, lit("unable to stat ~a: ~a/~s"), + path, num(errno), string_utf8(strerror(errno)), nao); + + return list(dev_k, num(st.st_dev), + dev_k, num(st.st_dev), + ino_k, num(st.st_ino), + mode_k, num(st.st_mode), + nlink_k, num(st.st_nlink), + uid_k, num(st.st_uid), + gid_k, num(st.st_gid), + rdev_k, num(st.st_rdev), + size_k, num(st.st_size), + blksize_k, num(st.st_blksize), + blocks_k, num(st.st_blocks), + atime_k, num(st.st_atime), + mtime_k, num(st.st_mtime), + ctime_k, num(st.st_ctime), + nao); +#else + uw_throwf(file_error_s, lit("stat is not implemented"), nao); +#endif +} + static DIR *w_opendir(const wchar_t *wname) { char *name = utf8_dup_to(wname); @@ -1483,6 +1530,7 @@ static DIR *w_opendir(const wchar_t *wname) return d; } + val open_directory(val path) { DIR *d = w_opendir(c_str(path)); @@ -1673,4 +1721,18 @@ void stream_init(void) std_debug = make_stdio_stream(stdout, string(L"debug"), nil, t); std_error = make_stdio_stream(stderr, string(L"stderr"), nil, t); detect_format_string(); + + dev_k = intern(lit("dev"), keyword_package); + ino_k = intern(lit("ino"), keyword_package); + mode_k = intern(lit("mode"), keyword_package); + nlink_k = intern(lit("nlink"), keyword_package); + uid_k = intern(lit("uid"), keyword_package); + gid_k = intern(lit("gid"), keyword_package); + rdev_k = intern(lit("rdev"), keyword_package); + size_k = intern(lit("size"), keyword_package); + blksize_k = intern(lit("blksize"), keyword_package); + blocks_k = intern(lit("blocks"), keyword_package); + atime_k = intern(lit("atime"), keyword_package); + mtime_k = intern(lit("mtime"), keyword_package); + ctime_k = intern(lit("ctime"), keyword_package); } diff --git a/stream.h b/stream.h index 38b10eda..10937c76 100644 --- a/stream.h +++ b/stream.h @@ -50,6 +50,7 @@ val put_line(val string, val stream); val put_char(val ch, val stream); val put_byte(val byte, val stream); val flush_stream(val stream); +val statf(val path); val open_directory(val path); val open_file(val path, val mode_str); val open_command(val path, val mode_str); diff --git a/txr.1 b/txr.1 index c4ede065..23af993b 100644 --- a/txr.1 +++ b/txr.1 @@ -6947,6 +6947,30 @@ cell of the input alist. That is to say, each element of the output list is produced as if by the copy-cons function applied to the corresponding element of the input list. +.SH PROPERTY LISTS + +.SS Function prop + +.TP +Syntax: + + (prop ) + +.TP +Description: + +A property list a flat list of even length consisting of interleaved +pairs of property names (usually symbols) and their values (arbitrary +objects). An example property list is (:a 1 :b "two") which contains +two properties, :a having value 1, and :b having value "two". + +The prop function searches property list for key . If +the key is found, then the value next to it is returned. Otherwise +nil is returned. + +It is ambiguous whether nil is returned due to the property not being +found, or due to the property being present with a nil value. + .SH LIST SORTING .SS Function merge @@ -9437,6 +9461,8 @@ meaningful, it does nothing. .SH FILESYSTEM ACCESS +.SS Function stat + .SS Function open-directory .SS Functions open-file -- cgit v1.2.3