#420 add function to create directories

src/hvm.c

@@ -809,7 +809,7 @@ static inline Port enter(Net* net, Port var) {
 }
 
 // Atomically Links `A ~ B`.
-static inline void link(Net* net, TM* tm, Port A, Port B) {
+static inline void link_ports(Net* net, TM* tm, Port A, Port B) {
   // Attempts to directionally point `A ~> B`
   while (true) {
     // If `A` is NODE: swap `A` and `B`, and continue
@@ -842,7 +842,7 @@ static inline void link(Net* net, TM* tm, Port A, Port B) {
 
 // Links `A ~ B` (as a pair).
 static inline void link_pair(Net* net, TM* tm, Pair AB) {
-  link(net, tm, get_fst(AB), get_snd(AB));
+  link_ports(net, tm, get_fst(AB), get_snd(AB));
 }
 
 // Interactions

src/run.c

@@ -3,7 +3,7 @@
 #include <stdio.h>
 #include <dirent.h>
 #include <sys/stat.h>
-// #include <unistd.h>
+#include <unistd.h>
 #include "hvm.c"
 
 // Readback: λ-Encoded Ctr
@@ -780,7 +780,7 @@ int delete_directory_recursive(const char* path) {
   }
 
   if (!r) {
-    r = remove(path);
+    r = rmdir(path);
   }
 
   return r;
@@ -806,7 +806,7 @@ Port io_delete_directory(Net* net, Book* book, Port argm) {
     res = delete_directory_recursive(path.buf);
     free(path.buf);
   } else {
-    res = remove(path.buf);
+    res = rmdir(path.buf);
     free(path.buf);
   }
 
@@ -817,6 +817,20 @@ Port io_delete_directory(Net* net, Book* book, Port argm) {
   }
 }
 
+Port io_mkdir(Net* net, Book* book, Port argm) {
+  Str name = readback_str(net, book, argm);
+
+  const mode_t mode = 0777;
+  int status = mkdir(name.buf, mode);
+  free(name.buf);
+
+  if (status) {
+    return inject_io_err_inner(net, new_port(NUM, new_i24(errno)));
+  } else {
+    return inject_ok(net, new_port(ERA, 0));
+  }
+}
+
 // Book Loader
 // -----------
 
@@ -834,6 +848,7 @@ void book_init(Book* book) {
   book->ffns_buf[book->ffns_len++] = (FFn){"DL_CLOSE", io_dl_open};
   book->ffns_buf[book->ffns_len++] = (FFn){"DELETE_FILE", io_delete_file};
   book->ffns_buf[book->ffns_len++] = (FFn){"DELETE_DIRECTORY", io_delete_directory};
+  book->ffns_buf[book->ffns_len++] = (FFn){"MKDIR", io_mkdir};
 }
 
 // Monadic IO Evaluator

tests/programs/io/create_directory.bend

@@ -0,0 +1,21 @@
+#{
+  Creates the batata directory and then deletes it.
+#}
+
+test-io = 1
+
+IO/FS/mkdir path =
+  (call "MKDIR" path)
+
+IO/FS/delete_directory path recursive =
+  (call "DELETE_DIRECTORY" (path, recursive))
+
+False = 0
+
+main =
+  let path = "./batata"
+  with IO {
+    ask * = (IO/FS/mkdir path)
+    ask s = (IO/FS/delete_directory path False)
+    (wrap s)
+  }

tests/programs/io/create_directory.hvm

@@ -0,0 +1,86 @@
+@False = 0
+
+@IO/Call = (a (b (c (d ((@IO/Call/tag (a (b (c (d e))))) e)))))
+
+@IO/Call/tag = 1
+
+@IO/Done = (a (b ((@IO/Done/tag (a (b c))) c)))
+
+@IO/Done/tag = 0
+
+@IO/FS/delete_directory = (q (r s))
+  & @call ~ (p ((q r) s))
+  & @String/Cons ~ (68 (o p))
+  & @String/Cons ~ (69 (n o))
+  & @String/Cons ~ (76 (m n))
+  & @String/Cons ~ (69 (l m))
+  & @String/Cons ~ (84 (k l))
+  & @String/Cons ~ (69 (j k))
+  & @String/Cons ~ (95 (i j))
+  & @String/Cons ~ (68 (h i))
+  & @String/Cons ~ (73 (g h))
+  & @String/Cons ~ (82 (f g))
+  & @String/Cons ~ (69 (e f))
+  & @String/Cons ~ (67 (d e))
+  & @String/Cons ~ (84 (c d))
+  & @String/Cons ~ (79 (b c))
+  & @String/Cons ~ (82 (a b))
+  & @String/Cons ~ (89 (@String/Nil a))
+
+@IO/FS/mkdir = f
+  & @call ~ (e f)
+  & @String/Cons ~ (77 (d e))
+  & @String/Cons ~ (75 (c d))
+  & @String/Cons ~ (68 (b c))
+  & @String/Cons ~ (73 (a b))
+  & @String/Cons ~ (82 (@String/Nil a))
+
+@IO/MAGIC = (13683217 16719857)
+
+@IO/bind = ((@IO/bind__C2 a) a)
+
+@IO/bind__C0 = (* (b (a c)))
+  & @undefer ~ (a (b c))
+
+@IO/bind__C1 = (* (* (a (b ((c d) (e g))))))
+  & @IO/Call ~ (@IO/MAGIC (a (b ((c f) g))))
+  & @IO/bind ~ (d (e f))
+
+@IO/bind__C2 = (?((@IO/bind__C0 @IO/bind__C1) a) a)
+
+@IO/wrap = a
+  & @IO/Done ~ (@IO/MAGIC a)
+
+@String/Cons = (a (b ((@String/Cons/tag (a (b c))) c)))
+
+@String/Cons/tag = 1
+
+@String/Nil = ((@String/Nil/tag a) a)
+
+@String/Nil/tag = 0
+
+@call = (a (b c))
+  & @IO/Call ~ (@IO/MAGIC (a (b (@call__C0 c))))
+
+@call__C0 = a
+  & @IO/Done ~ (@IO/MAGIC a)
+
+@main = s
+  & @IO/bind ~ (i ((((j (n (* p))) (q (@IO/wrap r))) r) s))
+  & @String/Cons ~ (46 (g {h q}))
+  & @String/Cons ~ (47 (f g))
+  & @String/Cons ~ (98 (e f))
+  & @String/Cons ~ (97 (d e))
+  & @String/Cons ~ (116 (c d))
+  & @String/Cons ~ (97 (b c))
+  & @String/Cons ~ (116 (a b))
+  & @String/Cons ~ (97 (@String/Nil a))
+  & @IO/FS/mkdir ~ (h i)
+  & @IO/bind ~ (k ((((l l) (n o)) o) p))
+  & @IO/FS/delete_directory ~ (j (@False k))
+
+@test-io = 1
+
+@undefer = (((a a) b) b)
+
+

tests/programs/io/delete_dir_file.bend

@@ -0,0 +1,16 @@
+#{
+  Calls the delete_directory function with a file path as argument.
+#}
+
+test-io = 1
+
+IO/FS/delete_directory path recursive =
+  (call "DELETE_DIRECTORY" (path, recursive))
+
+False = 0
+
+main =
+  with IO {
+    ask s = (IO/FS/delete_directory "./delete_dir_file.bend" False)
+    (wrap s)
+  }

tests/programs/io/delete_dir_file.hvm

@@ -0,0 +1,90 @@
+@False = 0
+
+@IO/Call = (a (b (c (d ((@IO/Call/tag (a (b (c (d e))))) e)))))
+
+@IO/Call/tag = 1
+
+@IO/Done = (a (b ((@IO/Done/tag (a (b c))) c)))
+
+@IO/Done/tag = 0
+
+@IO/FS/delete_directory = (q (r s))
+  & @call ~ (p ((q r) s))
+  & @String/Cons ~ (68 (o p))
+  & @String/Cons ~ (69 (n o))
+  & @String/Cons ~ (76 (m n))
+  & @String/Cons ~ (69 (l m))
+  & @String/Cons ~ (84 (k l))
+  & @String/Cons ~ (69 (j k))
+  & @String/Cons ~ (95 (i j))
+  & @String/Cons ~ (68 (h i))
+  & @String/Cons ~ (73 (g h))
+  & @String/Cons ~ (82 (f g))
+  & @String/Cons ~ (69 (e f))
+  & @String/Cons ~ (67 (d e))
+  & @String/Cons ~ (84 (c d))
+  & @String/Cons ~ (79 (b c))
+  & @String/Cons ~ (82 (a b))
+  & @String/Cons ~ (89 (@String/Nil a))
+
+@IO/MAGIC = (13683217 16719857)
+
+@IO/bind = ((@IO/bind__C2 a) a)
+
+@IO/bind__C0 = (* (b (a c)))
+  & @undefer ~ (a (b c))
+
+@IO/bind__C1 = (* (* (a (b ((c d) (e g))))))
+  & @IO/Call ~ (@IO/MAGIC (a (b ((c f) g))))
+  & @IO/bind ~ (d (e f))
+
+@IO/bind__C2 = (?((@IO/bind__C0 @IO/bind__C1) a) a)
+
+@IO/wrap = a
+  & @IO/Done ~ (@IO/MAGIC a)
+
+@String/Cons = (a (b ((@String/Cons/tag (a (b c))) c)))
+
+@String/Cons/tag = 1
+
+@String/Nil = ((@String/Nil/tag a) a)
+
+@String/Nil/tag = 0
+
+@call = (a (b c))
+  & @IO/Call ~ (@IO/MAGIC (a (b (@call__C0 c))))
+
+@call__C0 = a
+  & @IO/Done ~ (@IO/MAGIC a)
+
+@main = ab
+  & @IO/bind ~ (w ((((x x) (@IO/wrap z)) z) ab))
+  & @IO/FS/delete_directory ~ (v (@False w))
+  & @String/Cons ~ (46 (u v))
+  & @String/Cons ~ (47 (t u))
+  & @String/Cons ~ (100 (s t))
+  & @String/Cons ~ (101 (r s))
+  & @String/Cons ~ (108 (q r))
+  & @String/Cons ~ (101 (p q))
+  & @String/Cons ~ (116 (o p))
+  & @String/Cons ~ (101 (n o))
+  & @String/Cons ~ (95 (m n))
+  & @String/Cons ~ (100 (l m))
+  & @String/Cons ~ (105 (k l))
+  & @String/Cons ~ (114 (j k))
+  & @String/Cons ~ (95 (i j))
+  & @String/Cons ~ (102 (h i))
+  & @String/Cons ~ (105 (g h))
+  & @String/Cons ~ (108 (f g))
+  & @String/Cons ~ (101 (e f))
+  & @String/Cons ~ (46 (d e))
+  & @String/Cons ~ (98 (c d))
+  & @String/Cons ~ (101 (b c))
+  & @String/Cons ~ (110 (a b))
+  & @String/Cons ~ (100 (@String/Nil a))
+
+@test-io = 1
+
+@undefer = (((a a) b) b)
+
+

tests/programs/io/delete_dir_recursive.bend

@@ -0,0 +1,32 @@
+#{
+  Creates the following tree structure and then deletes A and its children.
+  A
+  |-- a.txt
+  |-- AA
+  |   `-- aa.txt
+  `-- AB
+      `-- ab.txt
+#}
+
+test-io = 1
+
+IO/FS/mkdir path =
+  (call "MKDIR" path)
+
+IO/FS/delete_directory path recursive =
+  (call "DELETE_DIRECTORY" (path, recursive))
+
+True = 1
+
+main =
+  with IO {
+    ask * = (IO/FS/mkdir "A")
+    ask * = (IO/FS/mkdir "A/AA")
+    ask * = (IO/FS/mkdir "A/AB")
+    ask * = (IO/FS/write_file "A/a.txt" (String/encode_utf8 "a"))
+    ask * = (IO/FS/write_file "A/AA/aa.txt" (String/encode_utf8 "aa"))
+    ask * = (IO/FS/write_file "A/AB/ab.txt" (String/encode_utf8 "ab"))
+
+    ask s = (IO/FS/delete_directory "A" True)
+    (wrap s)
+  }