io.tri (9830B)
1 !import base as B 2 !import native_math as N 3 !export * 4 5 -- Structured IO with named, versioned facilities. 6 -- Native execution uses OS process authority. 7 io action = B.pair "tricuIO" (B.pair 2 action) 8 pure value = B.pair 0 value 9 bind action next = B.pair 1 (B.pair action next) 10 fail diagnostic = B.pair 2 diagnostic 11 scope body = B.pair 3 body 12 currentScope = B.pair 4 t 13 14 -- Flags are canonical 0/1. Callback receives fresh handles. 15 -- Success is [task joinTicket]; non-result children receive t in the ticket slot. 16 spawn supervised keep handles body = B.pair 5 17 (B.pair supervised (B.pair keep (B.pair handles body))) 18 19 join ticket = B.pair 6 ticket 20 discard ticket = B.pair 7 ticket 21 cancel task reason = B.pair 8 (B.pair task reason) 22 cancelled reason = B.pair 9 reason 23 24 -- Named, independently versioned host facilities; core sequencing stays separate. 25 request group revision operation arguments = B.pair 10 26 (B.pair group (B.pair revision (B.pair operation arguments))) 27 28 capabilities = request "runtime" 1 "capabilities" t 29 inspect action = request "runtime" 1 "inspect" action 30 31 stdin = request "standard" 1 "input" t 32 stdout = request "standard" 1 "output" t 33 stderr = request "standard" 1 "error" t 34 35 openReader owner path = request "file" 1 "open-reader" (B.pair owner path) 36 openWriter owner path = request "file" 1 "open-writer" (B.pair owner path) 37 openAppender owner path = request "file" 1 "open-appender" (B.pair owner path) 38 openUpdate owner path = request "file" 1 "open-update" (B.pair owner path) 39 40 seekFile handle offset = request "file" 1 "seek" (B.pair handle offset) 41 filePosition handle = request "file" 1 "position" handle 42 syncFile handle = request "file" 1 "sync" handle 43 44 syncDirectory path = request "directory" 1 "sync" path 45 46 fileSize handle = request "file" 1 "size" handle 47 resizeFile handle size = request "file" 1 "resize" (B.pair handle size) 48 49 statPath path = request "path" 1 "stat" path 50 lstatPath path = request "path" 1 "lstat" path 51 removeFile path = request "path" 1 "remove-file" path 52 renamePath source destination = request "path" 1 "rename" (B.pair source destination) 53 54 createDirectory path = request "directory" 1 "create" path 55 removeDirectory path = request "directory" 1 "remove" path 56 openDirectory owner path = request "directory" 1 "open" (B.pair owner path) 57 nextDirectory directory = request "directory" 1 "next" directory 58 59 ipv4 octets port = ["ipv4" octets port] 60 ipv6 words scope port = ["ipv6" words scope port] 61 62 resolveTCP host family port limit = request "resolver" 1 "resolve" [host family port limit] 63 64 listenTCP owner address backlog = request "tcp" 1 "listen" (B.pair owner (B.pair address backlog)) 65 connectTCP owner address = request "tcp" 1 "connect" (B.pair owner address) 66 acceptTCP listener owner = request "tcp" 1 "accept" (B.pair listener owner) 67 68 localAddress socket = request "tcp" 1 "local-address" socket 69 peerAddress socket = request "tcp" 1 "peer-address" socket 70 shutdownWrite socket = request "tcp" 1 "shutdown-write" socket 71 72 -- Read exactly one authenticated frame from the current cursor. 73 -- Temporary disk <= size; the caller supplies a per-operation limit. 74 readIndexedTree reader directory limit size digest = request "indexed-tree" 1 "read" 75 [reader directory limit size digest] 76 77 -- Canonical native encoding avoids expanded tree/byte lists. The writer checks 78 -- the size and expected digest before sending. Retry decisions require confirmed 79 -- progress; a failed write can have partial or uncertain effects. 80 hashIndexedTree limit tree = request "indexed-tree" 1 "hash" (B.pair limit tree) 81 82 writeIndexedTree writer limit digest tree = request "indexed-tree" 1 "write" 83 [writer limit digest tree] 84 85 -- Exact canonical-byte comparison consumes precisely one frame. 86 verifyIndexedTree reader limit tree = request "indexed-tree" 1 "verify" [reader limit tree] 87 88 -- Stateless bounded codecs: decode returns [text carry], with carry <=3 octets. 89 -- Set final=1 at EOF to reject incomplete suffixes. NUL and BOM are valid scalars; 90 -- source-file BOM rejection belongs to library/application policy. 91 encodeUTF8 text = request "utf8" 1 "encode" text 92 decodeUTF8 final bytes = request "utf8" 1 "decode" [final bytes] 93 94 readSome reader limit = request "stream" 1 "read" (B.pair reader limit) 95 writeSome writer bytes = request "stream" 1 "write" (B.pair writer bytes) 96 -- Whole-stream SHA-256 authentication into an anonymous read-only file. 97 -- Result: [reader size]. Scope-owned; disk <= limit, native chunks <=4096. 98 -- An EOF probe may consume one byte beyond the limit on failure. 99 snapshotBytes reader directory limit digest = request "stream" 1 "snapshot" 100 [reader directory limit digest] 101 -- Exact native transfer from the current cursor. Failure can follow partial 102 -- writes; callers close the destination rather than retrying uncertain progress. 103 transferBytes reader writer count = request "stream" 1 "transfer" [reader writer count] 104 105 close handle = request "resource" 1 "close" handle 106 107 openStage owner directory = request "stage" 1 "open" (B.pair owner directory) 108 sealStage stage = request "stage" 1 "seal" stage 109 publishNew stage destination = request "stage" 1 "publish" (B.pair stage (B.pair 0 destination)) 110 publishReplace stage destination = request "stage" 1 "publish" (B.pair stage (B.pair 1 destination)) 111 112 openDigest owner algorithm = request "digest" 1 "open" (B.pair owner algorithm) 113 updateDigest digest bytes = request "digest" 1 "update" (B.pair digest bytes) 114 finishDigest digest = request "digest" 1 "finish" digest 115 116 onOk action next = bind action (reply : case reply of 117 ((t t), (value, t)) = next value 118 (t, (_, t)) = pure reply 119 _ = fail "Invalid operation Result") 120 121 -- Nonrecursive initialization for caller-ordered store directory creation. 122 -- stat follows an existing symlink and accepts it when its target is a directory. 123 ensureDirectory path = bind (createDirectory path) (reply : case reply of 124 (t, (["already-exists" _ _ _], t)) = onOk (statPath path) (status : case status of 125 ["directory"] = pure (B.ok t t) 126 _ = pure (B.err ["not-directory" "directory/ensure" "" "none"] t)) 127 _ = pure reply) 128 129 -- Explicit sequential fallback policy, separate from native connect/resolve. 130 -- Stop on the first success; preserve the last ordinary failure unchanged. 131 connectFirstTCP owner addresses = connectCandidates owner addresses 132 (B.err ["not-found" "tcp/connect-first" "No endpoint candidates" "none"] t) 133 connectCandidates _ [] previous = pure previous 134 connectCandidates owner [address | rest] _ = bind (connectTCP owner address) (reply : case reply of 135 ((t t), (_, t)) = pure reply 136 (t, (_, t)) = connectCandidates owner rest reply 137 _ = fail "Invalid connection Result") 138 connectCandidates _ _ _ = pure (B.err ["invalid-argument" "tcp/connect-first" "Invalid endpoint list" "none"] t) 139 140 -- Turn an explicitly selected operation failure into terminal task failure. 141 -- Ordinary Results elsewhere remain values. 142 require action next = bind action (reply : case reply of 143 ((t t), (value, t)) = next value 144 (t, (problem, t)) = fail problem 145 _ = fail "Invalid operation Result") 146 147 -- Whole-chunk convenience over the native positive-progress contract. Failure 148 -- stops immediately, preserving partial or uncertain progress for the caller. 149 dropWritten 0 bytes = bytes 150 dropWritten count [_ | rest] = dropWritten (N.predecessor count) rest 151 dropWritten _ _ = [] 152 -- Failure carries confirmed progress BEFORE the failing writeSome, plus its 153 -- unchanged diagnostic (whose own progress can be unknown). Composite progress 154 -- includes earlier successful writes even when the last operation reports "none". 155 writeAll writer bytes = let rec 156 walk accepted remaining = case remaining of 157 [] = pure (B.ok t t) 158 _ = bind (writeSome writer remaining) (reply : case reply of 159 -- Native writeSome validates at most 4096 input bytes before writing. 160 -- A full-bound acknowledgement therefore exhausts this entire chunk. 161 ((t t), (4096, t)) = pure (B.ok t t) 162 ((t t), (count, t)) = walk (N.add accepted count) (dropWritten count remaining) 163 (t, (problem, t)) = pure (B.err ["write-all" accepted problem] t) 164 _ = fail "Invalid operation Result") 165 in walk 0 bytes 166 167 -- Sequential bounded pumping, without acquiring or closing either endpoint. 168 -- Errors retain writeAll's confirmed prefix and original uncertain progress. 169 copyStream reader writer = do onOk 170 received <- readSome reader 4096 171 case received of 172 ("eof", t) = pure (B.ok t t) 173 ("data", bytes) = do onOk 174 writeAll writer bytes 175 copyStream reader writer 176 _ = fail "Invalid read reply" 177 178 -- Relative waits and native monotonic observations. Scheduler latency can extend 179 -- waits; yield offers a scheduling opportunity with scheduler-selected ordering. 180 monotonicNanoseconds = request "clock" 1 "monotonic" t 181 sleepMilliseconds milliseconds = request "clock" 1 "sleep" milliseconds 182 yield = request "scheduler" 1 "yield" t 183 184 -- Returns Result [task joinTicket stdinWriter stdoutReader stderrReader]. 185 -- cwd: ["inherit"] or ["at" path]; env: ["inherit"] or ["replace" [[key value] ...]]. 186 -- Normal scope exit waits. Close stdin for EOF; drain stdout/stderr concurrently. 187 -- Join completion holds ["exit" code] or ["signal" number]. 188 spawnProcess executable arguments directory environment graceMilliseconds = 189 request "process" 1 "spawn" [executable arguments directory environment graceMilliseconds] 190 191 -- Read-only host context. Environment query returns ["missing"] or ["value" text]; empty and absent remain distinct. 192 workingDirectory = request "process" 1 "working-directory" t 193 environmentVariable name = request "process" 1 "environment-variable" name