>From 2f8fdf3f157ef82a892618e65ebd629214b28a8f Mon Sep 17 00:00:00 2001
From: Evan Hanson <address@hidden>
Date: Tue, 25 Jul 2017 18:58:39 +1200
Subject: [PATCH] Move `create-directory' into (chicken file)

---
 file.scm         | 18 ++++++++++++++++++
 posix-common.scm | 18 ------------------
 posix.scm        |  2 +-
 posixunix.scm    |  1 -
 posixwin.scm     |  1 -
 types.db         |  2 +-
 6 files changed, 20 insertions(+), 22 deletions(-)

diff --git a/file.scm b/file.scm
index 87579d45..f9f42949 100644
--- a/file.scm
+++ b/file.scm
@@ -113,6 +113,24 @@ EOF
 
 ;;; Directory management:
 
+(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)))
+
+(define create-directory
+  (lambda (name #!optional recursive)
+    (##sys#check-string name 'create-directory)
+    (unless (or (fx= 0 (##sys#size name))
+                (file-exists? name))
+      (if recursive
+	  (let loop ((dir (let-values (((dir file ext) (decompose-pathname name)))
+			    (if file (make-pathname dir file ext) dir))))
+	    (when (and dir (not (directory? dir)))
+	      (loop (pathname-directory dir))
+	      (*create-directory 'create-directory dir)))
+	  (*create-directory 'create-directory name)))
+    name))
+
 (define delete-directory
   (lambda (name #!optional recursive)
     (define (rmdir dir)
diff --git a/posix-common.scm b/posix-common.scm
index ca8136a8..da68a48c 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -507,24 +507,6 @@ EOF
 	     #:file-error
 	     'current-directory "cannot retrieve current directory") ) ) ) )
 
-(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)) )
-
-(define create-directory
-  (lambda (name #!optional parents?)
-    (##sys#check-string name 'create-directory)
-    (unless (or (fx= 0 (##sys#size name))
-                (file-exists? 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? dir)))
-            (loop (pathname-directory dir))
-            (*create-directory 'create-directory dir)) )
-        (*create-directory 'create-directory name) ) )
-    name))
-
 (define directory
   (lambda (#!optional (spec (current-directory)) show-dotfiles?)
     (##sys#check-string spec 'directory)
diff --git a/posix.scm b/posix.scm
index 44cf77b0..ec89380d 100644
--- a/posix.scm
+++ b/posix.scm
@@ -42,7 +42,7 @@
 (module chicken.posix
   (block-device? call-with-input-pipe call-with-output-pipe
    change-directory change-directory* character-device? close-input-pipe
-   close-output-pipe create-directory create-fifo create-pipe
+   close-output-pipe create-fifo create-pipe
    create-session create-symbolic-link current-directory
    current-effective-group-id current-effective-user-id
    current-effective-user-name current-group-id current-process-id
diff --git a/posixunix.scm b/posixunix.scm
index 9203c03a..9376c2bc 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -112,7 +112,6 @@ static C_TLS struct timeval C_timeval;
 static C_TLS char C_hostbuf[ 256 ];
 static C_TLS struct stat C_statbuf;
 
-#define C_mkdir(str)        C_fix(mkdir(C_c_string(str), S_IRWXU | S_IRWXG | S_IRWXO))
 #define C_fchdir(fd)        C_fix(fchdir(C_unfix(fd)))
 #define C_chdir(str)        C_fix(chdir(C_c_string(str)))
 
diff --git a/posixwin.scm b/posixwin.scm
index 2e0819ac..b20ef2e4 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -115,7 +115,6 @@ static C_TLS TCHAR C_username[255 + 1] = "";
 
 /* Directory Operations */
 
-#define C_mkdir(str)	    C_fix(mkdir(C_c_string(str)))
 #define C_chdir(str)	    C_fix(chdir(C_c_string(str)))
 
 /* DIRENT stuff */
diff --git a/types.db b/types.db
index 2b2fb1cc..5412a33d 100644
--- a/types.db
+++ b/types.db
@@ -1586,6 +1586,7 @@
 
 ;; file
 
+(chicken.file#create-directory (#(procedure #:clean #:enforce) chicken.file#create-directory (string #!optional *) string))
 (chicken.file#create-temporary-directory (#(procedure #:clean #:enforce) chicken.file#create-temporary-directory () string))
 (chicken.file#create-temporary-file (#(procedure #:clean #:enforce) chicken.file#create-temporary-file (#!optional string) string))
 (chicken.file#delete-directory (#(procedure #:clean #:enforce) chicken.file#delete-directory (string #!optional *) string))
@@ -1922,7 +1923,6 @@
 (chicken.posix#change-directory* (#(procedure #:clean #:enforce) chicken.posix#change-directory* (fixnum) fixnum))
 (chicken.posix#close-input-pipe (#(procedure #:clean #:enforce) chicken.posix#close-input-pipe (input-port) fixnum))
 (chicken.posix#close-output-pipe (#(procedure #:clean #:enforce) chicken.posix#close-output-pipe (output-port) fixnum))
-(chicken.posix#create-directory (#(procedure #:clean #:enforce) chicken.posix#create-directory (string #!optional *) string))
 (chicken.posix#create-fifo (#(procedure #:clean #:enforce) chicken.posix#create-fifo (string #!optional fixnum) undefined))
 (chicken.posix#create-pipe (procedure chicken.posix#create-pipe (#!optional fixnum) fixnum fixnum))
 (chicken.posix#create-session (#(procedure #:clean) chicken.posix#create-session () fixnum))
-- 
2.11.0