Move directory code to C

...and remove the scheme support for it on the way

libs/base/System/Directory.idr

@@ -3,37 +3,46 @@ module System.Directory
 import public System.File
 
 public export
-data DirPtr : Type where
+DirPtr : Type
+DirPtr = AnyPtr
 
-toFileError : Int -> FileError
-toFileError 1 = FileReadError
-toFileError 2 = FileWriteError
-toFileError 3 = FileNotFound
-toFileError 4 = PermissionDenied
-toFileError 5 = FileExists
-toFileError x = GenericFileError (x - 256)
+support : String -> String
+support fn = "C:" ++ fn ++ ", libidris2_support"
 
-fpure : Either Int a -> IO (Either FileError a)
-fpure (Left err) = pure (Left (toFileError err))
-fpure (Right x) = pure (Right x)
+%foreign support "idris2_fileErrno"
+prim_fileErrno : PrimIO Int
 
-%foreign "scheme:blodwen-current-directory"
-prim_currentDir : PrimIO String
+returnError : IO (Either FileError a)
+returnError
+    = do err <- primIO prim_fileErrno
+         case err of
+              0 => pure $ Left FileReadError
+              1 => pure $ Left FileWriteError
+              2 => pure $ Left FileNotFound
+              3 => pure $ Left PermissionDenied
+              4 => pure $ Left FileExists
+              _ => pure $ Left (GenericFileError (err-5))
 
-%foreign "scheme:blodwen-change-directory"
+ok : a -> IO (Either FileError a)
+ok x = pure (Right x)
+
+%foreign support "idris2_currentDirectory"
+prim_currentDir : PrimIO (Ptr String)
+
+%foreign support "idris2_changeDir"
 prim_changeDir : String -> PrimIO Int
 
-%foreign "scheme:blodwen-create-directory"
-prim_createDir : String -> PrimIO (Either Int ())
+%foreign support "idris2_createDir"
+prim_createDir : String -> PrimIO Int
 
-%foreign "scheme:blodwen-open-directory"
-prim_openDir : String -> PrimIO (Either Int DirPtr)
+%foreign support "idris2_dirOpen"
+prim_openDir : String -> PrimIO DirPtr
 
-%foreign "scheme:blodwen-close-directory"
+%foreign support "idris2_dirClose"
 prim_closeDir : DirPtr -> PrimIO ()
 
-%foreign "scheme:blodwen-next-dir-entry"
-prim_dirEntry : DirPtr -> PrimIO (Either Int String)
+%foreign support "idris2_nextDirEntry"
+prim_dirEntry : DirPtr -> PrimIO (Ptr String)
 
 export
 data Directory : Type where
@@ -42,8 +51,10 @@ data Directory : Type where
 export
 createDir : String -> IO (Either FileError ())
 createDir dir
-    = do ok <- primIO (prim_createDir dir)
-         fpure ok
+    = do res <- primIO (prim_createDir dir)
+         if res == 0
+            then ok ()
+            else returnError
 
 export
 changeDir : String -> IO Bool
@@ -52,14 +63,20 @@ changeDir dir
          pure (ok /= 0)
 
 export
-currentDir : IO String
-currentDir = primIO prim_currentDir
+currentDir : IO (Maybe String)
+currentDir
+    = do res <- primIO prim_currentDir
+         if prim__nullPtr res /= 0
+            then pure Nothing
+            else pure (Just (prim__getString res))
 
 export
 dirOpen : String -> IO (Either FileError Directory)
 dirOpen d
     = do res <- primIO (prim_openDir d)
-         fpure (map MkDir res)
+         if prim__nullAnyPtr res /= 0
+            then returnError
+            else ok (MkDir res)
 
 export
 dirClose : Directory -> IO ()
@@ -69,4 +86,6 @@ export
 dirEntry : Directory -> IO (Either FileError String)
 dirEntry (MkDir d)
     = do res <- primIO (prim_dirEntry d)
-         fpure res
+         if prim__nullPtr res /= 0
+            then returnError
+            else ok (prim__getString res)

support/c/Makefile

@@ -3,7 +3,9 @@ DYLIBTARGET = libidris2_support.so
 
 .PHONY: build clean install
 
-OBJS = getline.o idris_buffer.o idris_file.o idris_support.o
+OBJS = getline.o idris_buffer.o idris_directory.o idris_file.o \
+       idris_support.o
+
 CFLAGS := -fPIC -O2 ${CFLAGS}
 
 build : $(LIBTARGET) $(DYLIBTARGET)

support/c/idris_directory.c

@@ -0,0 +1,63 @@
+#include "idris_directory.h"
+
+#include <sys/stat.h>
+#include <sys/types.h>
+#include <dirent.h>
+#include <stdlib.h>
+#include <unistd.h>
+
+char* idris2_currentDirectory() {
+   char cwd[1024]; // probably ought to deal with the unlikely event of this being too small
+   return getcwd(cwd, sizeof(cwd)); // freed by RTS
+}
+
+int idris2_changeDir(char* dir) {
+    return chdir(dir);
+}
+
+int idris2_createDir(char* dir) {
+#ifdef _WIN32
+    return mkdir(dir);
+#else
+    return mkdir(dir, S_IRWXU | S_IRGRP | S_IROTH);
+#endif
+}
+
+typedef struct {
+    DIR* dirptr;
+    int error;
+} DirInfo;
+
+void* idris2_dirOpen(char* dir) {
+    DIR *d = opendir(dir);
+    if (d == NULL) {
+        return NULL;
+    } else {
+        DirInfo* di = malloc(sizeof(DirInfo));
+        di->dirptr = d;
+        di->error = 0;
+
+        return (void*)di;
+    }
+}
+
+void idris2_dirClose(void* d) {
+    DirInfo* di = (DirInfo*)d;
+
+    closedir(di->dirptr);
+    free(di);
+}
+
+char* idris2_nextDirEntry(void* d) {
+    DirInfo* di = (DirInfo*)d;
+    struct dirent* de = readdir(di->dirptr);
+
+    if (de == NULL) {
+        di->error = -1;
+        return NULL;
+    } else {
+        return de->d_name;
+    }
+}
+
+

support/c/idris_directory.h

@@ -0,0 +1,11 @@
+#ifndef __IDRIS_DIRECTORY_H
+#define __IDRIS_DIRECTORY_H
+
+char* idris2_currentDirectory();
+int idris2_changeDir(char* dir);
+int idris2_createDir(char* dir);
+void* idris2_dirOpen(char* dir);
+void idris2_dirClose(void* d);
+char* idris2_nextDirEntry(void* d);
+
+#endif

support/chez/support.ss

@@ -73,46 +73,6 @@
                 chr))
         void))
 
-;; Directories
-
-(define (blodwen-error-code x)
-    (cond
-        ((i/o-read-error? x) 1)
-        ((i/o-write-error? x) 2)
-        ((i/o-file-does-not-exist-error? x) 3)
-        ((i/o-file-protection-error? x) 4)
-        (else 255)))
-
-(define (blodwen-file-op op)
-  (guard
-    (x ((i/o-error? x) (either-left (blodwen-error-code x))))
-    (either-right (op))))
-
-(define (blodwen-current-directory)
-  (current-directory))
-
-(define (blodwen-change-directory dir)
-  (if (file-directory? dir)
-      (begin (current-directory dir) 1)
-      0))
-
-(define (blodwen-create-directory dir)
-  (blodwen-file-op (lambda () (mkdir dir) 0)))
-
-; Scheme only gives a primitive for reading all the files in a directory,
-; so this is faking the C interface!
-(define (blodwen-open-directory dir)
-  (blodwen-file-op (lambda () (box (directory-list dir)))))
-
-(define (blodwen-close-directory dir) '()) ; no-op, it's not really open
-
-(define (blodwen-next-dir-entry dir)
-  (let [(dlist (unbox dir))]
-    (if (null? dlist)
-      (either-left 255)
-      (begin (set-box! dir (cdr dlist))
-             (either-right (car dlist))))))
-
 ;; Threads
 
 (define blodwen-thread-data (make-thread-parameter #f))

support/gambit/support.scm

@@ -81,29 +81,6 @@
         (if (eof-object? chr) #\null chr))
       #\null))
 
-;; Directories
-
-(define blodwen-current-directory current-directory)
-
-(define (blodwen-change-directory dir)
-  (with-exception-catcher
-    (lambda (e) 0)
-    (lambda () (current-directory dir) 1)))
-
-(define (blodwen-create-directory dir)
-  (blodwen-file-op (lambda () (create-directory dir) 0)))
-
-(define (blodwen-open-directory dir)
-  (blodwen-file-op (lambda () (open-directory dir))))
-
-(define blodwen-close-directory close-input-port)
-
-(define (blodwen-next-dir-entry dir)
-  (let ((e (read dir)))
-    (if (eof-object? e)
-        (either-left 255)
-        (either-right e))))
-
 ;; Threads
 
 (define (blodwen-thread p)

support/racket/support.rkt

@@ -70,33 +70,6 @@
                 chr))
         void))
 
-;; Directories
-
-(define (blodwen-current-directory)
-  (path->string (current-directory)))
-
-(define (blodwen-change-directory dir)
-  (if (directory-exists? dir)
-      (begin (current-directory dir) 1)
-      0))
-
-(define (blodwen-create-directory dir)
-  (blodwen-file-op (lambda () (make-directory dir))))
-
-; Scheme only gives a primitive for reading all the files in a directory,
-; so this is faking the C interface!
-(define (blodwen-open-directory dir)
-  (blodwen-file-op (lambda () (box (directory-list dir)))))
-
-(define (blodwen-close-directory dir) '()) ; no-op, it's not really open
-
-(define (blodwen-next-dir-entry dir)
-  (let [(dlist (unbox dir))]
-    (if (null? dlist)
-      (either-left 255)
-      (begin (set-box! dir (cdr dlist))
-             (either-right (path->string (car dlist)))))))
-
 ;; Threads
 
 (define blodwen-thread-data (make-thread-cell #f))