~ chicken-core (chicken-5) 63b393d42f0431cf3cce852e6e2367c108690fbd

commit 63b393d42f0431cf3cce852e6e2367c108690fbd
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Fri Sep 1 16:09:04 2017 -0400
Commit:     Peter Bex <peter@more-magic.net>
CommitDate: Sat Sep 2 13:35:56 2017 +0200

    Make `current-directory` a pure getter with associated setter
    
    This adds a SRFI-17 setter for `current-directory` and drops the
    optional argument that could previously be passed to cause it to change
    directories.
    
    This makes it behave more like the other procedures in the posix unit,
    and makes for a better API since the current directory is a
    process-level variable and not a SRFI-39 parameter object (and it can't
    be made into one, since the CWD is not thread-local).
    
    Signed-off-by: Peter Bex <peter@more-magic.net>

diff --git a/posix-common.scm b/posix-common.scm
index e07dd5af..b0a8b5be 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -508,18 +508,21 @@ EOF
     (posix-error #:file-error 'change-directory* "cannot change current directory" fd))
   fd)
 
-(define (current-directory #!optional dir)
-  (if dir
-      (change-directory dir)
-      (let* ((buffer (make-string 1024))
-	     (len (##core#inline "C_curdir" buffer)) )
-	#+(or unix cygwin)
-	(##sys#update-errno)
-	(if len
-	    (##sys#substring buffer 0 len)
-	    (##sys#signal-hook
-	     #:file-error
-	     'current-directory "cannot retrieve current directory") ) ) ) )
+(define current-directory
+  (getter-with-setter
+   (lambda ()
+     (let* ((buffer (make-string 1024))
+	   (len (##core#inline "C_curdir" buffer)))
+      #+(or unix cygwin)
+      (##sys#update-errno)
+      (if len
+	  (##sys#substring buffer 0 len)
+	  (##sys#signal-hook
+	   #:file-error
+	   'current-directory "cannot retrieve current directory"))))
+   (lambda (dir)
+     ((if (fixnum? dir) change-directory* change-directory) dir))
+  "(current-directory)"))
 
 (define directory
   (lambda (#!optional (spec (current-directory)) show-dotfiles?)
diff --git a/types.db b/types.db
index 0fb983f8..ab17cb9b 100644
--- a/types.db
+++ b/types.db
@@ -1903,8 +1903,7 @@
 (chicken.posix#create-session (#(procedure #:clean) chicken.posix#create-session () fixnum))
 (chicken.posix#create-symbolic-link (#(procedure #:clean #:enforce) chicken.posix#create-symbolic-link (string string) undefined))
 
-;; extra arg for "parameterize" - ugh, what a hack...
-(chicken.posix#current-directory (#(procedure #:clean #:enforce) chicken.posix#current-directory (#!optional string *) string))
+(chicken.posix#current-directory (#(procedure #:clean #:enforce) chicken.posix#current-directory () string))
 
 (chicken.posix#current-effective-group-id (#(procedure #:clean) chicken.posix#current-effective-group-id () fixnum))
 (chicken.posix#current-effective-user-id (#(procedure #:clean) chicken.posix#current-effective-user-id () fixnum))