diff --git a/lib/check.ml b/lib/check.ml index 13c9203..46c3f10 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -4777,6 +4777,70 @@ and named_call ctx ~want loc name args = [ file_guard ctx loc ~path_slot:ps ~op:1 steps ]))) | _ -> assert false) + (* ── the three that change the filesystem ────────────────────────── + [delete-file], [rename-file] and [make-directory] are [barf]'s shape with + a different runtime call, and they are here rather than as prelude + [declare]s for the one thing a declare cannot do: signal [FileError] with + the two restarts the compiler emits. A declare could only answer a bool, + and "the delete failed, here is a boolean" is the shape decision 5 exists + to keep out of this language — a handler that made the parent directory + and wants [retry], or that has another path and wants [use-value], has + nothing to hold onto. + + Each answers [()] and not a bool for the same reason [barf] does: the + failure is the condition, so a return value would only ever be true. The + questions that are *not* failures — does this exist, how big is it — + answer a value instead, and those two are prelude functions over one + [declare] because nothing about them needs a restart. + + [op] continues the FileError numbering the prelude names: 0 read, 1 write, + and 2, 3, 4 here. A handler matching on it is matching on the prelude's + [file-op-delete] and friends, not on a literal. *) + | "delete-file" | "make-directory" -> + arity loc name 1 args; + let sym, op = + if String.equal name "delete-file" then "flan_file_delete", 2 + else "flan_file_mkdir", 4 + in + let path = check ctx ~want:Types.String (List.hd args) in + let ps = fresh_slot ctx Types.String in + let steps try_ = + [ try_ (rt loc (Types.Int Types.I8) sym + [ mk loc Types.String (Tast.Local ps) ]) ] + in + expect loc ~want + (mk loc Types.Unit + (Tast.Let ([ (ps, path) ], + [ file_guard ctx loc ~path_slot:ps ~op steps ]))) + + (* Two paths and one restart slot, so the guard holds the *source*: a + [use-value] renames a different file to the same destination. That is the + direction a handler can act on — the destination it asked for is the one + thing it already knows — and it is written down here because the other + reading is equally plausible until somebody says which it is. + + The destination is bound before the loop, exactly as [barf] binds its + data, so a retry re-attempts the rename and not the expression that + computed where to. *) + | "rename-file" -> + arity loc name 2 args; + (match args with + | [ from_; to_ ] -> + let from_ = check ctx ~want:Types.String from_ in + let to_ = check ctx ~want:Types.String to_ in + let ps = fresh_slot ctx Types.String in + let ds = fresh_slot ctx Types.String in + let steps try_ = + [ try_ (rt loc (Types.Int Types.I8) "flan_file_rename" + [ mk loc Types.String (Tast.Local ps); + mk loc Types.String (Tast.Local ds) ]) ] + in + expect loc ~want + (mk loc Types.Unit + (Tast.Let ([ (ps, from_); (ds, to_) ], + [ file_guard ctx loc ~path_slot:ps ~op:3 steps ]))) + | _ -> assert false) + (* ── containers ────────────────────────────────────────────────── *) (* [at] and [len] were already the names for a fixed array and a slice, so a Vec extends them rather than adding a parallel pair — which is the diff --git a/lib/emit.ml b/lib/emit.ml index c9e771a..7f7eb1e 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -2809,6 +2809,14 @@ declare i64 @flan_hash_combine(i64, i64) ; here. `embed` needs none of these: it is a compile-time constant. declare i8 @flan_file_size(ptr, i64, ptr) declare i8 @flan_file_write(ptr, i64, ptr, i64) +; The three that change the filesystem. flan_file_stat is not here for the +; reason flan_file_read is not: nothing emitted calls it. It is reached from +; the prelude through a `declare`, because file-exists? and file-size answer a +; value rather than signalling and so need none of the guard machinery these +; three do. +declare i8 @flan_file_delete(ptr, i64) +declare i8 @flan_file_rename(ptr, i64, ptr, i64) +declare i8 @flan_file_mkdir(ptr, i64) declare i64 @flan_file_fail_reason() declare i8 @flan_slurp_into(ptr, ptr, i64) |} diff --git a/lib/prelude.ml b/lib/prelude.ml index ff16762..30d6435 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -1691,6 +1691,9 @@ let source = {flan| (defconst file-op-read i32 0) (defconst file-op-write i32 1) +(defconst file-op-delete i32 2) +(defconst file-op-rename i32 3) +(defconst file-op-mkdir i32 4) (defconst file-missing i32 1) (defconst file-denied i32 2) @@ -1699,9 +1702,45 @@ let source = {flan| ;; desktop-only, and it signals rather than refusing at build time (Flan has no ;; conditional compilation, so isolating code to desktop is not expressible) or ;; silently doing nothing (which is how a save file disappears with nothing -;; said). +;; said). `delete-file`, `rename-file` and `make-directory` carry the same +;; decision: all three change the filesystem, so all three signal this on the +;; web rather than quietly succeeding into a filesystem the page throws away. (defconst file-unsupported i32 4) +;; The two file questions that are not failures, and they are prelude +;; functions rather than builtins because of that: nothing here needs a +;; restart, so nothing here needs the compiler. +;; +;; That is the line the whole file surface is drawn on. `slurp`, `barf`, +;; `delete-file`, `rename-file` and `make-directory` can fail in ways a +;; handler can *answer* — make the parent and retry, supply another path — so +;; each signals FileError with those two restarts. "Is it there" and "how big +;; is it" have no such answer: absence is the reply, not a fault, and a +;; condition would make the ordinary case cost a handler search. +(declare file-stat-raw [path string out-size (Ptr i64)] i8 "flan_file_stat") + +;; True for anything the path resolves to — a file, a directory, a device — +;; because that is what the question asks and a caller wanting "and it is a +;; regular file" is asking a second question this does not pretend to answer. +;; +;; **It is a reading and not a guarantee.** Between this answering true and the +;; next line opening the file, anything may have removed it; the race is +;; unavoidable and is the reason `slurp` signals rather than requiring this +;; first. Reach for it when the answer is the point — choosing a config path, +;; deciding whether to write a default — and not as a guard in front of an +;; operation that already reports its own failure properly. +(defn file-exists? [path string] bool + (let [n (i64 0)] + (= (file-stat-raw path (addr n)) 1))) + +;; None for a path that does not resolve, which folds every reason into one +;; answer — that is the trade a caller makes by asking a question with no +;; restart on it. A caller that needs to tell "missing" from "denied" wants +;; `slurp`, whose FileError carries the reason. +(defn file-size [path string] (Option i64) + (let [n (i64 0)] + (if (= (file-stat-raw path (addr n)) 1) (Some n) None))) + ;; ── Form: what a macro takes and what it answers ────────────────────── ;; ;; The reader's output, mirrored on the Flan side, because a macro is a diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 33c0424..db27a46 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -2871,3 +2871,123 @@ const uint8_t *flan_getenv(const uint8_t *name, int64_t n, int64_t *len) { *len = (int64_t)strlen(v); return (const uint8_t *)v; } + +/* ── The rest of the file surface ────────────────────────────────────── + * + * Four more POSIX-shaped calls under the same rules as flan_file_size, + * flan_file_read and flan_file_write above: a path as ptr+len, 1 or 0, and the + * reason in flan_file_fail where the compiler's file_guard reads it. Nothing + * here holds a descriptor between calls, so a second target implements four + * functions and inherits the Flan that sits on them. + * + * The errno mapping is flan_errno_reason's and is not extended. Its three + * buckets — missing, denied, io — are what a *handler* can act on: retry after + * making the directory, use-value with another path, or give up. EEXIST and + * ENOTEMPTY land in io along with everything else, and that is the honest + * place for them until conditions have a hierarchy to hang a fourth reason + * off (see the FileError note in the prelude). */ + +#include +#include + +/* One call behind both file-exists? and file-size, because they are one + * question: stat answers whether the path resolves and how big it is in the + * same breath, and two entry points would be two chances for them to disagree. + * + * stat and not the fopen-plus-ftell that flan_file_size uses. That one is + * shaped by slurp's needs — it is about to read the file, so opening it is the + * test that matters — and it is wrong as a general size: fopen on a directory + * succeeds on Linux and ftell then answers a number that is not a file size. + * The two coexist deliberately and answer different questions. */ +int8_t flan_file_stat(const uint8_t *path, int64_t n, int64_t *size) { + char buf[FLAN_PATH_MAX]; + struct stat st; + *size = 0; + if (!flan_path_cstr(path, n, buf)) { + flan_file_fail = FLAN_FILE_MISSING; + return 0; + } + errno = 0; + if (stat(buf, &st) != 0) { flan_file_fail = flan_errno_reason(); return 0; } + *size = (int64_t)st.st_size; + flan_file_fail = FLAN_FILE_OK; + return 1; +} + +/* The three that change the filesystem, and they carry flan_file_write's + * decision 2 unchanged: on the web they signal, every time, with the path in + * the condition. Not a build-time refusal, because Flan has no conditional + * compilation and "isolate this to desktop" is therefore not expressible in + * source; and not a silent no-op, because that is how a save directory fails + * to appear with nothing said. */ + +int8_t flan_file_delete(const uint8_t *path, int64_t n) { +#if defined(__EMSCRIPTEN__) + (void)path; (void)n; + flan_file_fail = FLAN_FILE_UNSUPPORTED; + return 0; +#else + char buf[FLAN_PATH_MAX]; + if (!flan_path_cstr(path, n, buf)) { + flan_file_fail = FLAN_FILE_MISSING; + return 0; + } + errno = 0; + /* remove(), so that an empty directory is deletable by the same call a file + * is — it is unlink or rmdir depending on what the path names, which is the + * distinction a caller of a language with one `delete-file` does not want to + * have to make. A non-empty directory fails, and that is deliberate: + * recursive deletion is a loop the caller writes and sees. */ + if (remove(buf) != 0) { flan_file_fail = flan_errno_reason(); return 0; } + flan_file_fail = FLAN_FILE_OK; + return 1; +#endif +} + +/* Two paths, so two conversions, and the failure of either is reported as a + * missing path — the same answer flan_path_cstr's refusal gets everywhere + * else. rename() is atomic within one filesystem and fails with EXDEV across + * two rather than copying, which lands in the io bucket; a caller that wants + * a move across devices writes slurp and barf, and sees that it did. */ +int8_t flan_file_rename(const uint8_t *from, int64_t fn, const uint8_t *to, + int64_t tn) { +#if defined(__EMSCRIPTEN__) + (void)from; (void)fn; (void)to; (void)tn; + flan_file_fail = FLAN_FILE_UNSUPPORTED; + return 0; +#else + char a[FLAN_PATH_MAX], b[FLAN_PATH_MAX]; + if (!flan_path_cstr(from, fn, a) || !flan_path_cstr(to, tn, b)) { + flan_file_fail = FLAN_FILE_MISSING; + return 0; + } + errno = 0; + if (rename(a, b) != 0) { flan_file_fail = flan_errno_reason(); return 0; } + flan_file_fail = FLAN_FILE_OK; + return 1; +#endif +} + +/* 0777 and not 0755, because the process umask is what decides: a program that + * hardcodes 0755 has overridden a user's umask for no reason it could know. + * One level only — an intervening directory that does not exist is ENOENT, + * which reaches the caller as `missing` and is answerable by a handler that + * makes the parent and takes `retry`, which is the restart that path exists + * for. */ +int8_t flan_file_mkdir(const uint8_t *path, int64_t n) { +#if defined(__EMSCRIPTEN__) + (void)path; (void)n; + flan_file_fail = FLAN_FILE_UNSUPPORTED; + return 0; +#else + char buf[FLAN_PATH_MAX]; + if (!flan_path_cstr(path, n, buf)) { + flan_file_fail = FLAN_FILE_MISSING; + return 0; + } + errno = 0; + if (mkdir(buf, 0777) != 0) { flan_file_fail = flan_errno_reason(); return 0; } + flan_file_fail = FLAN_FILE_OK; + return 1; +#endif +} diff --git a/test/programs/files.flan b/test/programs/files.flan new file mode 100644 index 0000000..adf8178 --- /dev/null +++ b/test/programs/files.flan @@ -0,0 +1,107 @@ +;;;; The file surface beyond slurp and barf: file-exists?, file-size, +;;;; delete-file, rename-file and make-directory. +;;;; +;;;; The split down the middle of that list is the whole design and this file +;;;; is arranged to show it. The two that ask a *question* — is it there, how +;;;; big is it — answer a value, because absence is a reply and not a fault; +;;;; they are prelude functions over one declare and the compiler knows +;;;; nothing about them. The three that *change* the filesystem answer () and +;;;; signal FileError with the two restarts slurp and barf already establish, +;;;; because each of their failures is one a handler can act on: make the +;;;; parent directory and retry, or supply another path. +;;;; +;;;; Everything is made and removed inside this program, so it leaves the +;;;; directory as it found it — checked at the end rather than assumed. + +;; Handlers cannot see the locals of the function that established them, so the +;; observations are globals, as in slurp.flan. +(defvar seen i64) +(defvar last-reason i32) +(defvar last-op i32) + +(defn main [] i32 + ;; ── The questions ───────────────────────────────────────────────── + (println (file-exists? "programs/assets/a.txt")) ; true + (println (file-exists? "programs/assets/nope")) ; false + ;; A directory resolves, which is what the name asks and not "is a regular + ;; file" — a caller wanting the narrower question is asking a second one. + (println (file-exists? "programs/assets")) ; true + + (match (file-size "programs/assets/a.txt") + (Some n) (println n) ; 13 + None (println "missing")) + ;; None folds every reason into one answer, which is the trade a question + ;; with no restart on it makes. + (match (file-size "programs/assets/nope") + (Some n) (println n) + None (println "none")) + + ;; ── make-directory, rename-file, delete-file ────────────────────── + (make-directory "files-tmp") + (println (file-exists? "files-tmp")) ; true + + (barf "files-tmp/one.txt" (bytes "0123456789")) + (match (file-size "files-tmp/one.txt") + (Some n) (println n) ; 10 + None (println "missing")) + + (rename-file "files-tmp/one.txt" "files-tmp/two.txt") + (println (file-exists? "files-tmp/one.txt")) ; false + (println (file-exists? "files-tmp/two.txt")) ; true + + (delete-file "files-tmp/two.txt") + (println (file-exists? "files-tmp/two.txt")) ; false + + ;; ── retry, after the handler made the parent ────────────────────── + ;; The restart this family exists for. Writing into a directory that is not + ;; there is ENOENT, which arrives as `missing`; the handler makes the + ;; directory and takes `retry`, and the second attempt succeeds. Nothing in + ;; the failing code knows any of that happened. + (handler-bind + [(FileError [c] + (set seen (+ seen 1)) + (set last-reason (.reason c)) + (set last-op (.op c)) + (make-directory "files-tmp/sub") + (invoke-restart 'retry))] + (barf "files-tmp/sub/deep.txt" (bytes "deep"))) + (println seen) ; 1 + (println (= last-reason file-missing)) ; true + (println (= last-op file-op-write)) ; true + (println (file-exists? "files-tmp/sub/deep.txt")) ; true + + ;; ── use-value, on a delete ──────────────────────────────────────── + ;; The same restart slurp's read offers, on an operation that writes: the + ;; handler names a path that is there and the delete resumes against it. + (set seen 0) + (handler-bind + [(FileError [c] + (set seen (+ seen 1)) + (set last-op (.op c)) + (invoke-restart 'use-value "files-tmp/sub/deep.txt"))] + (delete-file "files-tmp/sub/not-there.txt")) + (println seen) ; 1 + (println (= last-op file-op-delete)) ; true + (println (file-exists? "files-tmp/sub/deep.txt")) ; false + + ;; ── A non-empty directory does not delete ───────────────────────── + ;; remove() is unlink or rmdir depending on what the path names, so an empty + ;; directory goes by the same call a file does — and a full one does not, + ;; which is deliberate: a recursive delete is a loop the caller writes and + ;; sees. Here the handler declines to answer, which is what an unhandled + ;; condition would do, so it counts and lets the program carry on by + ;; supplying the child path instead. + (set seen 0) + (handler-bind + [(FileError [c] + (set seen (+ seen 1)) + (set last-op (.op c)) + (invoke-restart 'use-value "files-tmp/sub"))] + (delete-file "files-tmp")) + (println seen) ; 1 + (println (= last-op file-op-delete)) ; true + + ;; And now it is empty, so it goes. + (delete-file "files-tmp") + (println (file-exists? "files-tmp")) ; false + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 5054422..3b51865 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -850,6 +850,37 @@ let () = end; (try Sys.remove exe with Sys_error _ -> ()); + (* The rest of the file surface. What is being checked as much as the + calls is the line drawn through them: file-exists? and file-size answer + a value because absence is a reply and not a fault, and the three that + change the filesystem signal FileError with the same two restarts slurp + and barf establish. Both restarts are taken here on operations that + write - retry after the handler made the parent directory, and + use-value on a delete - which is what the pair is for and what a bool + return could not have offered. + + The program makes and removes its own tree, so the cleanup below is for + a run that failed part way through and not for a passing one. *) + let clean_dir () = + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) + [ "files-tmp/sub/deep.txt"; "files-tmp/one.txt"; "files-tmp/two.txt" ]; + List.iter (fun d -> try Unix.rmdir d with Unix.Unix_error _ -> ()) + [ "files-tmp/sub"; "files-tmp" ] + in + let files_out = + "true\nfalse\ntrue\n13\nnone\ntrue\n10\nfalse\ntrue\nfalse\n\ + 1\ntrue\ntrue\ntrue\n1\ntrue\nfalse\n1\ntrue\nfalse\n" + in + clean_dir (); + outputs "the rest of the file surface" "programs/files.flan" files_out; + clean_dir (); + outputs ~opt:"-O0" "the rest of the file surface, -O0" "programs/files.flan" + files_out; + clean_dir (); + outputs ~dev:true "the rest of the file surface, dev" "programs/files.flan" + files_out; + clean_dir (); + (* The epoch trap: a container whose allocator has been released. This is spec-memory.md's shipping answer to "Open: catching a use-after-release statically" — detection, loud and immediate, rather than a static rule diff --git a/web/index.html b/web/index.html index 59d57cf..d8d80e5 100644 --- a/web/index.html +++ b/web/index.html @@ -1065,6 +1065,7 @@ over.

UTF-8decode-rune, rune-at, rune-count, rune-size, rune-start?, valid-utf8?, encode-rune! numberssign-f32, lerp, clamp, floor-f32, ceil-f32, round-f32, abs-i32, abs-i64, the constants pi-f32, pi-f64, tau-f32, tau-f64, and libm through a declare at both widths: sqrt, abs, floor, ceil, round, fmod, sin, cos, tan, asin, acos, atan, atan2, log, log2, log10, exp, pow, hypot, cbrt — each spelled -f32 or -f64 timemonotonic-ns, monotonic-seconds, unix-ns, unix-seconds, sleep-ns, sleep-seconds, and ns-per-second and its two smaller siblings +filesfile-exists? and file-size, which answer a value; slurp, barf, delete-file, rename-file and make-directory, which signal FileError under retry and use-value the operating systemgetenv, which answers an (Option [u8]) viewing the process environment randomrand-seed, rand-u32, rand-f32, rand-i32-range, rand-f32-range forms, for macrosform-nil, form-cons, form-append, form-rest, form-items, form-pair, form-sym?, form-is-sym?, gensym, and unless and into, which are macros written here rather than special forms @@ -1117,6 +1118,17 @@ shape raylib's get-time already answers with, so the two mix; it st integer-exact in nanoseconds for a hundred days of process life, which is why the monotonic origin is the first read and not boot.

+

The file surface is split by whether a handler could do anything. +file-exists? and file-size answer a bool and an +(Option i64): absence is the reply, not a fault, and a condition would make +the ordinary case pay for a handler search. slurp, barf, +delete-file, rename-file and make-directory signal +FileError instead, under the two restarts Common Lisp establishes for a +file error — retry, because the handler may have just made the directory, +and use-value with another path. Nothing here returns an error code, which +is the same rule allocation follows. Streaming, stdin and directory listings are not +here; a whole file at a time is the surface.

+

The primitives underneath are few — a primitive is the only thing implemented twice per backend: argv, write-stdout, exit, len, at,