diff --git a/c/builtins.c b/c/builtins.c index 761e3cc..c71487f 100644 --- a/c/builtins.c +++ b/c/builtins.c @@ -526,4 +526,5 @@ void builtins_init(void) table_init(); iostream_init(); print_init(); + os_init(); } diff --git a/c/libraries.c b/c/libraries.c index 261abe7..2bb5d2a 100644 --- a/c/libraries.c +++ b/c/libraries.c @@ -80,6 +80,10 @@ static struct builtin_procedure builtin_procedures[] = { { "color-name->rgb24", builtin_color_name_to_rgb24, UP_2019 }, + { "open-directory", builtin_os_open_directory, SRFI_170 | UP_2019 }, + { "read-directory", builtin_os_read_directory, SRFI_170 | UP_2019 }, + { "close-directory", builtin_os_close_directory, SRFI_170 | UP_2019 }, + { 0, 0, 0 }, }; diff --git a/c/os_unix.c b/c/os_unix.c index e7bfe8c..19cb73b 100644 --- a/c/os_unix.c +++ b/c/os_unix.c @@ -4,6 +4,7 @@ #include #include +#include #include #include #include @@ -18,6 +19,9 @@ #include "scheme.h" +static value_t dirsym; +struct fltype *dirtype; + void path_to_dirname(char *path) { char *p; @@ -114,6 +118,105 @@ void os_setenv(const char *name, const char *value) } } +int isdirvalue(value_t v) +{ + return iscvalue(v) && cv_class((struct cvalue *)ptr(v)) == dirtype; +} + +static DIR **todirhandleptr(value_t v, const char *fname) +{ + if (!isdirvalue(v)) + type_error(fname, "dir", v); + return value2c(DIR **, v); +} + +value_t builtin_os_open_directory(value_t *args, uint32_t nargs) +{ + const char *path; + DIR *dirhandle; + DIR **dirhandleptr; + value_t dirvalue; + + argcount("open-directory", nargs, 1); + path = tostring(args[0], "path"); + if (!(dirhandle = opendir(path))) { + lerror(IOError, "cannot open directory"); + } + dirvalue = cvalue(dirtype, sizeof(DIR *)); + dirhandleptr = value2c(DIR **, dirvalue); + *dirhandleptr = dirhandle; + return dirvalue; +} + +value_t builtin_os_read_directory(value_t *args, uint32_t nargs) +{ + DIR *dirhandle; + DIR **dirhandleptr; + struct dirent *d; + + argcount("read-directory", nargs, 1); + dirhandleptr = todirhandleptr(args[0], "dir"); + dirhandle = *dirhandleptr; + for (;;) { + errno = 0; + if (!(d = readdir(dirhandle))) { + break; + } + if (!strcmp(d->d_name, ".") || !strcmp(d->d_name, "..")) { + continue; + } + break; + } + if (!d && errno) { + lerror(IOError, "cannot read directory"); + } + return d ? string_from_cstr(d->d_name) : FL_EOF; +} + +value_t builtin_os_close_directory(value_t *args, uint32_t nargs) +{ + DIR *dirhandle; + DIR **dirhandleptr; + + argcount("read-directory", nargs, 1); + dirhandleptr = todirhandleptr(args[0], "dir"); + dirhandle = *dirhandleptr; + if (dirhandle) { + if (closedir(dirhandle) == -1) { + lerror(IOError, "cannot close directory"); + } + *dirhandleptr = dirhandle = 0; + } + return FL_F; +} + +static void print_dir(value_t v, struct ios *f) +{ + (void)v; + fl_print_str("#", f); +} + +static void free_dir(value_t self) +{ + DIR *dirhandle; + DIR **dirhandleptr; + + dirhandleptr = todirhandleptr(self, "dir"); + dirhandle = *dirhandleptr; + if (dirhandle) { + if (closedir(dirhandle) == -1) { + // lerror(IOError, "cannot close directory"); + } + *dirhandleptr = dirhandle = 0; + } +} + +static void relocate_dir(value_t oldv, value_t newv) +{ + (void)oldv; + (void)newv; +} + // TODO: cleanup static struct termios term_mode_orig; static struct termios term_mode_raw; @@ -146,3 +249,11 @@ value_t builtin_term_exit(value_t *args, uint32_t nargs) tcsetattr(0, TCSAFLUSH, &term_mode_orig); return FL_T; } + +struct cvtable dir_vtable = { print_dir, relocate_dir, free_dir, NULL }; + +void os_init(void) +{ + dirsym = symbol("dir"); + dirtype = define_opaque_type(dirsym, sizeof(DIR *), &dir_vtable, NULL); +} diff --git a/c/scheme.h b/c/scheme.h index 917e4c6..3ffae13 100644 --- a/c/scheme.h +++ b/c/scheme.h @@ -471,6 +471,11 @@ char *get_exename(char *buf, size_t size); int os_path_exists(const char *path); void os_setenv(const char *name, const char *value); +value_t builtin_os_open_directory(value_t *args, uint32_t nargs); +value_t builtin_os_read_directory(value_t *args, uint32_t nargs); +value_t builtin_os_close_directory(value_t *args, uint32_t nargs); +void os_init(void); + //// #include "random.h" #define random() genrand_int32() diff --git a/scheme-core/aliases.scm b/scheme-core/aliases.scm index 1fc4710..e78510b 100644 --- a/scheme-core/aliases.scm +++ b/scheme-core/aliases.scm @@ -23,6 +23,17 @@ (define-macro (begin0 first . rest) `(prog1 ,first ,@rest)) +(define (fold-proc cons_ nil_ proc) + (let loop ((acc nil_)) + (let ((value (proc))) + (if (eof-object? value) acc (loop (cons_ value acc)))))) + +(define (directory-names path) + (let ((d (open-directory path))) + (unwind-protect + (fold-proc cons '() (λ () (read-directory d))) + (close-directory d)))) + (define vector-ref aref) (define vector-set! aset!) (define vector-length length)