5172ac74e40e63f4b0647202ba6fa4bc2b0c2cd2640561a6c61c303a3d5fe5de.tri (16376B)
1 !import prelude * 2 !import io * 3 !import source_object * 4 !import source_module * 5 !import source_lock * 6 !import source_bundle * 7 !import source_resolve * 8 !import source_unit * 9 !export * 10 11 -- Local imports/re-exports acquire workspaceRoot/NAME.tri; !source is build-only. 12 -- Other profiles supply read/compile steps over the same graph and receipts. 13 -- References resolve only through selected locals or immutable full hashes. 14 sourceBuildSourcePath workspace name = 15 append workspace (append "/" (append name ".tri")) 16 sourceBuildContains_ self names name = 17 lazyList 18 (_ : false) 19 (item rest : lazyBool 20 (_ : true) 21 (_ : self rest name) 22 (equal? item name)) 23 names 24 -- Graph acquisition and binding use the same interpreter as module compilation. 25 sourceBuildStage source = (bindResult (sourceModuleHeaderStage source) 26 (staged _ : ok (pair (fst staged) source) t)) 27 28 -- Lock rewriting is reused as a pure immutable-ref substitution, not as a 29 -- lockfile read. The groups below are selected from this build's local graph 30 -- or explicit full hashes; no moving module alias is consulted. 31 -- Per-graph memo = (completed locals, authenticated manifests by full hash). 32 -- It starts empty, belongs to one root/graph invocation, and never stores errors 33 -- or mutable aliases. CAS manifests are immutable during a build, just as local 34 -- graph memoization already requires; a new invocation reauthenticates them. 35 -- Entries enter only through sourceModuleGetManifest, including canonical bytes, 36 -- digest, export names, tree kind and ABI validation. Tree reads remain verified. 37 sourceBuildGetManifest root hash memo = (lazyMaybe 38 (_ : onResult_ (sourceModuleGetManifest root hash) 39 (problem : pure (err problem t)) 40 (entries : pure (ok (pair entries (pair (fst memo) 41 (pair (pair hash entries) (snd memo)))) t))) 42 (entries : pure (ok (pair entries memo) t)) 43 (sourceFindExternal (snd memo) hash)) 44 sourceBuildDone name manifest receipt memo = 45 pure (ok (pair (pair manifest receipt) 46 (pair (pair (pair name (pair manifest receipt)) (fst memo)) (snd memo))) t) 47 48 sourceBuildResolveRefs_ self refs root groups memo = 49 lazyList 50 (_ : pure (ok (pair groups memo) t)) 51 (ref rest : lazyMaybe 52 (_ : lazyBool 53 (_ : onResult_ (sourceBuildGetManifest root ref memo) 54 (problem : pure (err problem t)) 55 (loaded : self rest root (pair 56 (pair ref (pair ref (fst loaded))) groups) (snd loaded))) 57 (_ : pure (err "undeclared local source reference" t)) 58 (sourceObjectHashValid ref)) 59 (_ : self rest root groups memo) 60 (sourceFindExternal groups ref)) 61 refs 62 sourceBuildGroupsFromLocals_ self locals root groups memo = 63 lazyList 64 (_ : pure (ok (pair (reverse groups) memo) t)) 65 (dep rest : onResult_ (sourceBuildGetManifest root 66 (fst (snd dep)) memo) 67 (problem : pure (err problem t)) 68 (loaded : self rest root (pair 69 (pair (fst dep) (pair (fst (snd dep)) (fst loaded))) groups) (snd loaded))) 70 locals 71 72 -- Rewritten headers contain immutable hashes. Resolve only from the graph's 73 -- authenticated groups; do not reread aliases or reparse the same manifest. 74 sourceBuildGroupManifest_ self groups hash = (lazyList 75 (_ : pure (err "unresolved build manifest" t)) 76 (group rest : lazyBool 77 (_ : pure (ok (snd (snd group)) t)) 78 (_ : self rest hash) 79 (equal? (fst (snd group)) hash)) 80 groups) 81 sourceBuildGroupManifest groups hash = y sourceBuildGroupManifest_ groups hash 82 sourceBuildLocalRows_ self locals = 83 lazyList 84 (_ : t) 85 (dep rest : append "local\t" 86 (append (fst dep) (append "\t" 87 (append (fst (snd dep)) (append "\t" 88 (append (snd (snd dep)) 89 (append "\n" (self rest)))))))) 90 locals 91 sourceBuildPinRows_ self exports ref manifest = 92 lazyList 93 (_ : t) 94 (entry rest : append "pin\t" 95 (append ref (append "\t" 96 (append manifest (append "\t" 97 (append (sourceModuleEscape (fst entry)) 98 (append "\t" (append (snd entry) 99 (append "\n" (self rest ref manifest)))))))))) 100 exports 101 sourceBuildAllPinRows_ self groups = 102 lazyList 103 (_ : t) 104 (group rest : append 105 (y sourceBuildPinRows_ (snd (snd group)) (fst group) 106 (fst (snd group))) 107 (self rest)) 108 groups 109 sourceBuildReceiptBytes sourceDigest compilerDigest optionsDigest manifestHash locals groups = 110 append "arboricx.build-receipt.v1\n" 111 (append "source\t" (append sourceDigest 112 (append "\ncompiler\t" (append compilerDigest 113 (append "\noptions\t" (append optionsDigest 114 (append "\noutput\t" (append manifestHash 115 (append "\n" (append (y sourceBuildLocalRows_ locals) 116 (y sourceBuildAllPinRows_ groups))))))))))) 117 sourceBuildPutReceipt root source compiler optionsDigest manifestHash locals groups = 118 onOk_ (sourceObjectDigest "arboricx.source.v1" source) (sourceDigest : 119 sourceObjectStore root "arboricx.build-receipt.v1" 120 (sourceBuildReceiptBytes sourceDigest compiler optionsDigest 121 manifestHash locals groups)) 122 123 -- A mutable local index is only an acceleration hint. CAS manifests, receipts, 124 -- and tree objects remain the authoritative outputs. The key fixes the staged 125 -- source, declared compiler/options, ordered local receipts, and exact import 126 -- pins. A changed input must miss even if the old checkpoint still exists. 127 sourceBuildCacheKeyBytes sourceHash compiler options locals groups = 128 append "arboricx.source-build-key.v1\nsource\t" (append sourceHash 129 (append "\ncompiler\t" (append compiler 130 (append "\noptions\t" (append options 131 (append "\n" (append (y sourceBuildLocalRows_ locals) 132 (y sourceBuildAllPinRows_ groups)))))))) 133 sourceBuildCachePath root name = 134 append root (append "/cache/source-build/" name) 135 sourceBuildCacheBytes key manifest receipt = 136 append "arboricx.source-build-cache.v1\t" (append key 137 (append "\t" (append manifest (append "\t" receipt)))) 138 sourceBuildCacheDecode bytes = 139 lazyList 140 (_ : err "invalid build cache checkpoint" t) 141 (version rest1 : lazyList 142 (_ : err "invalid build cache checkpoint" t) 143 (key rest2 : lazyList 144 (_ : err "invalid build cache checkpoint" t) 145 (manifest rest3 : lazyList 146 (_ : err "invalid build cache checkpoint" t) 147 (receipt extra : lazyBool 148 (_ : ok (pair key (pair manifest receipt)) t) 149 (_ : err "invalid build cache checkpoint" t) 150 (and? (equal? version "arboricx.source-build-cache.v1") 151 (and? (emptyList? extra) 152 (and? (sourceObjectHashValid key) 153 (and? (sourceObjectHashValid manifest) 154 (and? (sourceObjectHashValid receipt) 155 (equal? bytes (sourceBuildCacheBytes key manifest receipt)))))))) 156 rest3) 157 rest2) 158 rest1) 159 (splitOnByte 9 bytes) 160 sourceBuildCachePublish root name key manifest receipt = 161 onOk_ (createDirectory root) (_ : 162 onOk_ (createDirectory (append root "/cache")) (_ : 163 onOk_ (createDirectory (append root "/cache/source-build")) (_ : 164 atomicWriteBytes (sourceBuildCachePath root name) 165 (sourceBuildCacheBytes key manifest receipt)))) 166 167 sourceBuildCacheVerifyGroups_ self groups root locals = 168 lazyList 169 (_ : pure (ok t t)) 170 (group rest : lazyMaybe 171 (_ : onOk_ (sourceLockCheckTrees root (snd (snd group))) 172 (_ : self rest root locals)) 173 (_ : self rest root locals) 174 (sourceFindExternal locals (fst group))) 175 groups 176 sourceBuildCacheVerifyGroups root groups locals = 177 y sourceBuildCacheVerifyGroups_ groups root locals 178 179 -- A checkpoint whose key matches current inputs must be complete and valid. 180 -- Local dependencies were verified by the graph walker before this lookup; 181 -- check full-hash external imports here as well as this unit's own exports. 182 -- An unused imported tree may be corrupted even when the output still exists. 183 -- Reject corruption instead of silently rebuilding and concealing it. 184 sourceBuildCacheUse root sourceHash options compiler locals groups memo name entry = 185 onResult_ (sourceObjectGet root "arboricx.build-receipt.v1" 186 (snd (snd entry))) 187 (problem : pure (err problem t)) 188 (receiptBytes : lazyBool 189 (_ : onOk_ (sourceBuildCacheVerifyGroups root groups locals) (_ : 190 onResult_ (sourceBuildGetManifest root (fst (snd entry)) memo) 191 (problem : pure (err problem t)) 192 (loaded : onOk_ (sourceLockCheckTrees root (fst loaded)) (_ : 193 sourceBuildDone name (fst (snd entry)) (snd (snd entry)) (snd loaded))))) 194 (_ : pure (err "build cache receipt mismatch" t)) 195 (equal? receiptBytes 196 (sourceBuildReceiptBytes sourceHash compiler options 197 (fst (snd entry)) locals groups))) 198 199 sourceBuildCached root source unit compiler locals groups memo name build optionsName = 200 onOk_ (sourceObjectDigest "arboricx.source.v1" source) (sourceHash : 201 onOk_ (sourceObjectDigest "arboricx.build-options.v1" 202 optionsName) (options : 203 onOk_ (sourceObjectDigest "arboricx.source-build-key.v1" 204 (sourceBuildCacheKeyBytes sourceHash compiler options locals groups)) 205 (key : onResult_ (fileExists (sourceBuildCachePath root name)) 206 (problem : pure (err problem t)) 207 (exists : lazyBool 208 (_ : onResult_ (readFile (sourceBuildCachePath root name)) 209 (problem : pure (err problem t)) 210 (bytes : lazyResult 211 (problem unused : pure (err problem t)) 212 (entry unused : lazyBool 213 (_ : sourceBuildCacheUse root sourceHash options compiler 214 locals groups memo name entry) 215 (_ : sourceBuildCompile root source unit compiler locals 216 groups memo name key build options) 217 (equal? (fst entry) key)) 218 (sourceBuildCacheDecode bytes))) 219 (_ : sourceBuildCompile root source unit compiler locals 220 groups memo name key build options) 221 exists)))) 222 223 sourceBuildCompile root source unit compiler locals groups memo name key build options = 224 onResult_ (build root unit groups) 225 (problem : pure (err problem t)) 226 (manifestHash : onResult_ (sourceBuildPutReceipt root source 227 compiler options manifestHash locals groups) 228 (problem : pure (err problem t)) 229 (receiptHash : onOk_ 230 (sourceBuildCachePublish root name key manifestHash receiptHash) 231 (_ : onResult_ (sourceBuildGetManifest root manifestHash memo) 232 (problem : pure (err problem t)) 233 (loaded : sourceBuildDone name manifestHash receiptHash (snd loaded))))) 234 sourceBuildFinish root source unit refs compiler locals memo name build options = 235 onResult_ (y sourceBuildGroupsFromLocals_ locals root t memo) 236 (problem : pure (err problem t)) 237 (localGroups : onResult_ (y sourceBuildResolveRefs_ refs root 238 (fst localGroups) (snd localGroups)) 239 (problem : pure (err problem t)) 240 (resolved : sourceBuildCached root source unit compiler 241 locals (fst resolved) (snd resolved) name build options)) 242 243 -- The recursive walker is explicitly passed to the dependency-list helper: 244 -- top-level definitions remain nonrecursive for fresh bootstrap stores. 245 -- The walker uses (read/stage, (compile, unit -> options bytes)); the public 246 -- compatibility API adapts constant options names. The shared walker owns 247 -- dependencies, immutable pins, receipts, checkpoints and cycles. 248 -- read/stage returns (fingerprint bytes, (dependencies, (refs, unit))). 249 sourceBuildReadTriPath path = 250 onResult_ (readFile path) 251 (problem : pure (err problem t)) 252 (source : lazyResult 253 (problem unused : pure (err problem t)) 254 (staged unused : lazyResult 255 (problem unused : pure (err problem t)) 256 (refs unused : pure (ok (pair source 257 (pair (fst staged) (pair refs (snd staged)))) t)) 258 (sourceLockSourceRefs (snd staged))) 259 (sourceBuildStage source)) 260 sourceBuildReadTri workspace name = 261 sourceBuildReadTriPath (sourceBuildSourcePath workspace name) 262 sourceBuildCompileTriWith compileDefinitions root source groups = (lazyResult 263 (problem unused : pure (err problem t)) 264 (staged unused : sourceModuleBuildResolvedWith (sourceBuildGroupManifest groups) compileDefinitions root staged) 265 (sourceLockRewriteStaged source groups)) 266 267 sourceBuildCompileTri root clean groups = 268 sourceBuildCompileTriWith compileModuleDefinitions root clean groups 269 sourceBuildStableTriProfile = 270 pair (workspace name : sourceBuildReadTri workspace name) 271 (pair (root unit groups : sourceBuildCompileTriWith compileStableModuleDefinitions root unit groups) 272 "source-module.stable.v1") 273 sourceBuildTriProfile = 274 pair (workspace name : sourceBuildReadTri workspace name) 275 (pair (root unit groups : sourceBuildCompileTri root unit groups) 276 "source-module.reference.v1") 277 sourceBuildDeps_ self deps walk workspace root compiler stack memo profile locals = 278 lazyList 279 (_ : pure (ok (pair (reverse locals) memo) t)) 280 (name rest : onResult_ (walk name workspace root compiler stack memo profile) 281 (problem : pure (err problem t)) 282 (out : self rest walk workspace root compiler stack (snd out) profile 283 (pair (pair name (fst out)) locals))) 284 deps 285 sourceBuildWalk_ self name workspace root compiler stack memo profile = 286 lazyBool 287 (_ : lazyMaybe 288 (_ : lazyMaybe 289 (_ : onResult_ ((fst profile) workspace name) 290 (problem : pure (err problem t)) 291 (staged : onResult_ 292 (y sourceBuildDeps_ (fst (snd staged)) self workspace root compiler 293 (pair (pair name t) stack) memo profile t) 294 (problem : pure (err problem t)) 295 (built : sourceBuildFinish root (fst staged) 296 (snd (snd (snd staged))) (fst (snd (snd staged))) 297 compiler (fst built) (snd built) name 298 (fst (snd profile)) 299 ((snd (snd profile)) (snd (snd (snd staged))))))) 300 (_ : pure (err "local-source dependency cycle" t)) 301 (sourceFindExternal stack name)) 302 (cached : pure (ok (pair cached memo) t)) 303 (sourceFindExternal (fst memo) name)) 304 (_ : pure (err "invalid local source name" t)) 305 (sourceModuleAliasValid name) 306 307 -- Unit-sensitive options select cache/receipt identity, not graph policy. 308 -- Profile = (read/stage, (compile, unit -> options bytes)). This permits 309 -- explicit mixed frontend/path selection without changing source identity. 310 -- Returns (moduleManifestHash, buildReceiptHash). Compiler identity remains 311 -- runner-declared reproducibility metadata, not proof. 312 sourceBuildGraphUnitProfile workspace root compilerDigest name profile = 313 lazyBool 314 (_ : onResult_ (y sourceBuildWalk_ name workspace root compilerDigest t (pair t t) 315 profile) 316 (problem : pure (err problem t)) 317 (output : pure (ok (fst output) t))) 318 (_ : pure (err "invalid compiler artifact digest" t)) 319 (sourceObjectHashValid compilerDigest) 320 -- Compatibility adapter: existing profiles keep their constant options name. 321 sourceBuildGraphProfile workspace root compilerDigest name profile = 322 (sourceBuildGraphUnitProfile workspace root compilerDigest name 323 (pair (workspace name : (fst profile) workspace name) 324 (pair (root unit groups : (fst (snd profile)) root unit groups) 325 (unit : snd (snd profile))))) 326 sourceBuildGraph workspace root compilerDigest name = 327 sourceBuildGraphProfile workspace root compilerDigest name sourceBuildTriProfile 328 329 -- One portable IO action drives local dependency builds, their separate 330 -- receipts, immutable manifest selection, and the final indexed bundle. 331 -- Returns (manifestHash, (receiptHash, bundleFileHash)). 332 sourceBuildGraphBundle workspace root compilerDigest name outputPath = 333 onResult_ (sourceBuildGraph workspace root compilerDigest name) 334 (problem : pure (err problem t)) 335 (built : onResult_ (sourceBundlePack root (fst built) outputPath) 336 (problem : pure (err problem t)) 337 (bundleHash : pure (ok (pair (fst built) 338 (pair (snd built) bundleHash)) t))) 339 340 -- Same graph/IO/publication ABI; distinct backend options and artifact identity. 341 sourceBuildGraphStable workspace root compilerDigest name = 342 sourceBuildGraphProfile workspace root compilerDigest name sourceBuildStableTriProfile 343