8b2e1cd6ef5acc8454a690875d2e8415869892f84c3fb5198c18fc8e665d0f32.tri (9065B)
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 close handle = request "resource" 1 "close" handle 97 98 openStage owner directory = request "stage" 1 "open" (B.pair owner directory) 99 sealStage stage = request "stage" 1 "seal" stage 100 publishNew stage destination = request "stage" 1 "publish" (B.pair stage (B.pair 0 destination)) 101 publishReplace stage destination = request "stage" 1 "publish" (B.pair stage (B.pair 1 destination)) 102 103 openDigest owner algorithm = request "digest" 1 "open" (B.pair owner algorithm) 104 updateDigest digest bytes = request "digest" 1 "update" (B.pair digest bytes) 105 finishDigest digest = request "digest" 1 "finish" digest 106 107 onOk action next = bind action (reply : case reply of 108 ((t t), (value, t)) = next value 109 (t, (_, t)) = pure reply 110 _ = fail "Invalid operation Result") 111 112 -- Nonrecursive initialization for caller-ordered store directory creation. 113 -- stat follows an existing symlink and accepts it when its target is a directory. 114 ensureDirectory path = bind (createDirectory path) (reply : case reply of 115 (t, (["already-exists" _ _ _], t)) = onOk (statPath path) (status : case status of 116 ["directory"] = pure (B.ok t t) 117 _ = pure (B.err ["not-directory" "directory/ensure" "" "none"] t)) 118 _ = pure reply) 119 120 -- Explicit sequential fallback policy, separate from native connect/resolve. 121 -- Stop on the first success; preserve the last ordinary failure unchanged. 122 connectFirstTCP owner addresses = connectCandidates owner addresses 123 (B.err ["not-found" "tcp/connect-first" "No endpoint candidates" "none"] t) 124 connectCandidates _ [] previous = pure previous 125 connectCandidates owner [address | rest] _ = bind (connectTCP owner address) (reply : case reply of 126 ((t t), (_, t)) = pure reply 127 (t, (_, t)) = connectCandidates owner rest reply 128 _ = fail "Invalid connection Result") 129 connectCandidates _ _ _ = pure (B.err ["invalid-argument" "tcp/connect-first" "Invalid endpoint list" "none"] t) 130 131 -- Turn an explicitly selected operation failure into terminal task failure. 132 -- Ordinary Results elsewhere remain values. 133 require action next = bind action (reply : case reply of 134 ((t t), (value, t)) = next value 135 (t, (problem, t)) = fail problem 136 _ = fail "Invalid operation Result") 137 138 -- Whole-chunk convenience over the native positive-progress contract. Failure 139 -- stops immediately, preserving partial or uncertain progress for the caller. 140 dropWritten 0 bytes = bytes 141 dropWritten count [_ | rest] = dropWritten (N.predecessor count) rest 142 dropWritten _ _ = [] 143 -- Failure carries confirmed progress BEFORE the failing writeSome, plus its 144 -- unchanged diagnostic (whose own progress can be unknown). Composite progress 145 -- includes earlier successful writes even when the last operation reports "none". 146 writeAll writer bytes = let rec 147 walk accepted remaining = case remaining of 148 [] = pure (B.ok t t) 149 _ = bind (writeSome writer remaining) (reply : case reply of 150 ((t t), (count, t)) = walk (N.add accepted count) (dropWritten count remaining) 151 (t, (problem, t)) = pure (B.err ["write-all" accepted problem] t) 152 _ = fail "Invalid operation Result") 153 in walk 0 bytes 154 155 -- Sequential bounded pumping, without acquiring or closing either endpoint. 156 -- Errors retain writeAll's confirmed prefix and original uncertain progress. 157 copyStream reader writer = do onOk 158 received <- readSome reader 4096 159 case received of 160 ("eof", t) = pure (B.ok t t) 161 ("data", bytes) = do onOk 162 writeAll writer bytes 163 copyStream reader writer 164 _ = fail "Invalid read reply" 165 166 -- Relative waits and native monotonic observations. Scheduler latency can extend 167 -- waits; yield offers a scheduling opportunity with scheduler-selected ordering. 168 monotonicNanoseconds = request "clock" 1 "monotonic" t 169 sleepMilliseconds milliseconds = request "clock" 1 "sleep" milliseconds 170 yield = request "scheduler" 1 "yield" t 171 172 -- Returns Result [task joinTicket stdinWriter stdoutReader stderrReader]. 173 -- cwd: ["inherit"] or ["at" path]; env: ["inherit"] or ["replace" [[key value] ...]]. 174 -- Normal scope exit waits. Close stdin for EOF; drain stdout/stderr concurrently. 175 -- Join completion holds ["exit" code] or ["signal" number]. 176 spawnProcess executable arguments directory environment graceMilliseconds = 177 request "process" 1 "spawn" [executable arguments directory environment graceMilliseconds] 178 179 -- Read-only host context. Environment query returns ["missing"] or ["value" text]; empty and absent remain distinct. 180 workingDirectory = request "process" 1 "working-directory" t 181 environmentVariable name = request "process" 1 "environment-variable" name