5c24cc853df42e433916b1528fc8cd56334bd393606f54e7b12efb6a7069be0d.tri (16439B)
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 names name = 17 lazyList 18 (_ : false) 19 (item rest : lazyBool 20 (_ : true) 21 (_ : sourceBuildContains 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 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 : sourceBuildResolveRefs 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 (_ : sourceBuildResolveRefs rest root groups memo) 60 (sourceFindExternal groups ref)) 61 refs 62 sourceBuildGroupsFromLocals 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 : sourceBuildGroupsFromLocals 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 groups hash = (lazyList 75 (_ : pure (err "unresolved build manifest" t)) 76 (group rest : lazyBool 77 (_ : pure (ok (snd (snd group)) t)) 78 (_ : sourceBuildGroupManifest rest hash) 79 (equal? (fst (snd group)) hash)) 80 groups) 81 sourceBuildLocalRows locals = 82 lazyList 83 (_ : t) 84 (dep rest : append "local\t" 85 (append (fst dep) (append "\t" 86 (append (fst (snd dep)) (append "\t" 87 (append (snd (snd dep)) 88 (append "\n" (sourceBuildLocalRows rest)))))))) 89 locals 90 sourceBuildPinRows exports ref manifest = 91 lazyList 92 (_ : t) 93 (entry rest : append "pin\t" 94 (append ref (append "\t" 95 (append manifest (append "\t" 96 (append (sourceModuleEscape (fst entry)) 97 (append "\t" (append (snd entry) 98 (append "\n" (sourceBuildPinRows rest ref manifest)))))))))) 99 exports 100 sourceBuildAllPinRows groups = 101 lazyList 102 (_ : t) 103 (group rest : append 104 (sourceBuildPinRows (snd (snd group)) (fst group) 105 (fst (snd group))) 106 (sourceBuildAllPinRows rest)) 107 groups 108 sourceBuildReceiptBytes sourceDigest compilerDigest optionsDigest manifestHash locals groups = 109 append "arboricx.build-receipt.v1\n" 110 (append "source\t" (append sourceDigest 111 (append "\ncompiler\t" (append compilerDigest 112 (append "\noptions\t" (append optionsDigest 113 (append "\noutput\t" (append manifestHash 114 (append "\n" (append (sourceBuildLocalRows locals) 115 (sourceBuildAllPinRows groups))))))))))) 116 sourceBuildPutReceipt root source compiler optionsDigest manifestHash locals groups = 117 onOk_ (sourceObjectDigest "arboricx.source.v1" source) (sourceDigest : 118 sourceObjectStore root "arboricx.build-receipt.v1" 119 (sourceBuildReceiptBytes sourceDigest compiler optionsDigest 120 manifestHash locals groups)) 121 122 -- A mutable local index is only an acceleration hint. CAS manifests, receipts, 123 -- and tree objects remain the authoritative outputs. The key fixes the staged 124 -- source, declared compiler/options, ordered local receipts, and exact import 125 -- pins. A changed input must miss even if the old checkpoint still exists. 126 sourceBuildCacheKeyBytes sourceHash compiler options locals groups = 127 append "arboricx.source-build-key.v1\nsource\t" (append sourceHash 128 (append "\ncompiler\t" (append compiler 129 (append "\noptions\t" (append options 130 (append "\n" (append (sourceBuildLocalRows locals) 131 (sourceBuildAllPinRows groups)))))))) 132 sourceBuildCachePath root name = 133 append root (append "/cache/source-build/" name) 134 sourceBuildCacheBytes key manifest receipt = 135 append "arboricx.source-build-cache.v1\t" (append key 136 (append "\t" (append manifest (append "\t" receipt)))) 137 sourceBuildCacheDecode bytes = 138 lazyList 139 (_ : err "invalid build cache checkpoint" t) 140 (version rest1 : lazyList 141 (_ : err "invalid build cache checkpoint" t) 142 (key rest2 : lazyList 143 (_ : err "invalid build cache checkpoint" t) 144 (manifest rest3 : lazyList 145 (_ : err "invalid build cache checkpoint" t) 146 (receipt extra : lazyBool 147 (_ : ok (pair key (pair manifest receipt)) t) 148 (_ : err "invalid build cache checkpoint" t) 149 (and? (equal? version "arboricx.source-build-cache.v1") 150 (and? (emptyList? extra) 151 (and? (sourceObjectHashValid key) 152 (and? (sourceObjectHashValid manifest) 153 (and? (sourceObjectHashValid receipt) 154 (equal? bytes (sourceBuildCacheBytes key manifest receipt)))))))) 155 rest3) 156 rest2) 157 rest1) 158 (splitOnByte 9 bytes) 159 sourceBuildCachePublish root name key manifest receipt = 160 onOk_ (createDirectory root) (_ : 161 onOk_ (createDirectory (append root "/cache")) (_ : 162 onOk_ (createDirectory (append root "/cache/source-build")) (_ : 163 atomicWriteBytes (sourceBuildCachePath root name) 164 (sourceBuildCacheBytes key manifest receipt)))) 165 166 sourceBuildVerifyGroups groups root locals = 167 lazyList 168 (_ : pure (ok t t)) 169 (group rest : lazyMaybe 170 (_ : onOk_ (sourceLockCheckTrees root (snd (snd group))) 171 (_ : sourceBuildVerifyGroups rest root locals)) 172 (_ : sourceBuildVerifyGroups rest root locals) 173 (sourceFindExternal locals (fst group))) 174 groups 175 sourceBuildCacheVerifyGroups root groups locals = 176 sourceBuildVerifyGroups groups root locals 177 178 -- A checkpoint whose key matches current inputs must be complete and valid. 179 -- Local dependencies were verified by the graph walker before this lookup; 180 -- check full-hash external imports here as well as this unit's own exports. 181 -- An unused imported tree may be corrupted even when the output still exists. 182 -- Reject corruption instead of silently rebuilding and concealing it. 183 sourceBuildCacheUse root sourceHash options compiler locals groups memo name entry = 184 onResult_ (sourceObjectGet root "arboricx.build-receipt.v1" 185 (snd (snd entry))) 186 (problem : pure (err problem t)) 187 (receiptBytes : lazyBool 188 (_ : onOk_ (sourceBuildCacheVerifyGroups root groups locals) (_ : 189 onResult_ (sourceBuildGetManifest root (fst (snd entry)) memo) 190 (problem : pure (err problem t)) 191 (loaded : onOk_ (sourceLockCheckTrees root (fst loaded)) (_ : 192 sourceBuildDone name (fst (snd entry)) (snd (snd entry)) (snd loaded))))) 193 (_ : pure (err "build cache receipt mismatch" t)) 194 (equal? receiptBytes 195 (sourceBuildReceiptBytes sourceHash compiler options 196 (fst (snd entry)) locals groups))) 197 198 sourceBuildCached root source unit compiler locals groups memo name build optionsName = 199 onOk_ (sourceObjectDigest "arboricx.source.v1" source) (sourceHash : 200 onOk_ (sourceObjectDigest "arboricx.build-options.v1" 201 optionsName) (options : 202 onOk_ (sourceObjectDigest "arboricx.source-build-key.v1" 203 (sourceBuildCacheKeyBytes sourceHash compiler options locals groups)) 204 (key : onResult_ (fileExists (sourceBuildCachePath root name)) 205 (problem : pure (err problem t)) 206 (exists : lazyBool 207 (_ : onResult_ (readFile (sourceBuildCachePath root name)) 208 (problem : pure (err problem t)) 209 (bytes : lazyResult 210 (problem unused : pure (err problem t)) 211 (entry unused : lazyBool 212 (_ : sourceBuildCacheUse root sourceHash options compiler 213 locals groups memo name entry) 214 (_ : sourceBuildCompile root source unit compiler locals 215 groups memo name key build options) 216 (equal? (fst entry) key)) 217 (sourceBuildCacheDecode bytes))) 218 (_ : sourceBuildCompile root source unit compiler locals 219 groups memo name key build options) 220 exists)))) 221 222 sourceBuildCompile root source unit compiler locals groups memo name key build options = 223 onResult_ (build root unit groups) 224 (problem : pure (err problem t)) 225 (manifestHash : onResult_ (sourceBuildPutReceipt root source 226 compiler options manifestHash locals groups) 227 (problem : pure (err problem t)) 228 (receiptHash : onOk_ 229 (sourceBuildCachePublish root name key manifestHash receiptHash) 230 (_ : onResult_ (sourceBuildGetManifest root manifestHash memo) 231 (problem : pure (err problem t)) 232 (loaded : sourceBuildDone name manifestHash receiptHash (snd loaded))))) 233 sourceBuildFinish root source unit refs compiler locals memo name build options = 234 onResult_ (sourceBuildGroupsFromLocals locals root t memo) 235 (problem : pure (err problem t)) 236 (localGroups : onResult_ (sourceBuildResolveRefs refs root 237 (fst localGroups) (snd localGroups)) 238 (problem : pure (err problem t)) 239 (resolved : sourceBuildCached root source unit compiler 240 locals (fst resolved) (snd resolved) name build options)) 241 242 -- The recursive walker is explicitly passed to the dependency-list helper: 243 -- its callback keeps the graph walk direct-self-recursive, not mutual. 244 -- The walker uses (read/stage, (compile, unit -> options bytes)); the public 245 -- compatibility API adapts constant options names. The shared walker owns 246 -- dependencies, immutable pins, receipts, checkpoints and cycles. 247 -- read/stage returns (fingerprint bytes, (dependencies, (refs, unit))). 248 sourceBuildReadTriPath path = 249 onResult_ (readSourceFile path) 250 (problem : pure (err problem t)) 251 (source : lazyResult 252 (problem unused : pure (err problem t)) 253 (staged unused : lazyResult 254 (problem unused : pure (err problem t)) 255 (refs unused : pure (ok (pair (fst source) 256 (pair (fst staged) (pair refs (snd staged)))) t)) 257 (sourceLockSourceRefs (snd staged))) 258 (sourceBuildStage (snd source))) 259 sourceBuildReadTri workspace name = 260 sourceBuildReadTriPath (sourceBuildSourcePath workspace name) 261 sourceBuildCompileTriWith compileDefinitions root source groups = (lazyResult 262 (problem unused : pure (err problem t)) 263 (staged unused : sourceModuleBuildResolvedWith (sourceBuildGroupManifest groups) compileDefinitions root staged) 264 (sourceLockRewriteStaged source groups)) 265 266 sourceBuildCompileTri root clean groups = 267 sourceBuildCompileTriWith compileModuleDefinitions root clean groups 268 sourceBuildStableTriProfile = 269 pair (workspace name : sourceBuildReadTri workspace name) 270 (pair (root unit groups : sourceBuildCompileTriWith compileStableModuleDefinitions root unit groups) 271 "source-module.stable.v1") 272 sourceBuildTriProfile = 273 pair (workspace name : sourceBuildReadTri workspace name) 274 (pair (root unit groups : sourceBuildCompileTri root unit groups) 275 "source-module.reference.v1") 276 sourceBuildDependencies deps walk workspace root compiler stack memo profile locals = 277 lazyList 278 (_ : pure (ok (pair (reverse locals) memo) t)) 279 (name rest : onResult_ (walk name workspace root compiler stack memo profile) 280 (problem : pure (err problem t)) 281 (out : sourceBuildDependencies rest walk workspace root compiler stack (snd out) profile 282 (pair (pair name (fst out)) locals))) 283 deps 284 sourceBuildWalk name workspace root compiler stack memo profile = 285 lazyBool 286 (_ : lazyMaybe 287 (_ : lazyMaybe 288 (_ : onResult_ ((fst profile) workspace name) 289 (problem : pure (err problem t)) 290 (staged : onResult_ 291 (sourceBuildDependencies (fst (snd staged)) sourceBuildWalk workspace root compiler 292 (pair (pair name t) stack) memo profile t) 293 (problem : pure (err problem t)) 294 (built : sourceBuildFinish root (fst staged) 295 (snd (snd (snd staged))) (fst (snd (snd staged))) 296 compiler (fst built) (snd built) name 297 (fst (snd profile)) 298 ((snd (snd profile)) (snd (snd (snd staged))))))) 299 (_ : pure (err "local-source dependency cycle" t)) 300 (sourceFindExternal stack name)) 301 (cached : pure (ok (pair cached memo) t)) 302 (sourceFindExternal (fst memo) name)) 303 (_ : pure (err "invalid local source name" t)) 304 (sourceModuleAliasValid name) 305 306 -- Unit-sensitive options select cache/receipt identity, not graph policy. 307 -- Profile = (read/stage, (compile, unit -> options bytes)). This permits 308 -- explicit mixed frontend/path selection without changing source identity. 309 -- Returns (moduleManifestHash, buildReceiptHash). Compiler identity remains 310 -- runner-declared reproducibility metadata, not proof. 311 sourceBuildGraphUnitProfile workspace root compilerDigest name profile = 312 lazyBool 313 (_ : onResult_ (sourceBuildWalk name workspace root compilerDigest t (pair t t) 314 profile) 315 (problem : pure (err problem t)) 316 (output : pure (ok (fst output) t))) 317 (_ : pure (err "invalid compiler artifact digest" t)) 318 (sourceObjectHashValid compilerDigest) 319 -- Compatibility adapter: existing profiles keep their constant options name. 320 sourceBuildGraphProfile workspace root compilerDigest name profile = 321 (sourceBuildGraphUnitProfile workspace root compilerDigest name 322 (pair (workspace name : (fst profile) workspace name) 323 (pair (root unit groups : (fst (snd profile)) root unit groups) 324 (unit : snd (snd profile))))) 325 sourceBuildGraph workspace root compilerDigest name = 326 sourceBuildGraphProfile workspace root compilerDigest name sourceBuildTriProfile 327 328 -- One portable IO action drives local dependency builds, their separate 329 -- receipts, immutable manifest selection, and the final indexed bundle. 330 -- Returns (manifestHash, (receiptHash, bundleFileHash)). 331 sourceBuildGraphBundle workspace root compilerDigest name outputPath = 332 onResult_ (sourceBuildGraph workspace root compilerDigest name) 333 (problem : pure (err problem t)) 334 (built : onResult_ (sourceBundlePack root (fst built) outputPath) 335 (problem : pure (err problem t)) 336 (bundleHash : pure (ok (pair (fst built) 337 (pair (snd built) bundleHash)) t))) 338 339 -- Same graph/IO/publication ABI; distinct backend options and artifact identity. 340 sourceBuildGraphStable workspace root compilerDigest name = 341 sourceBuildGraphProfile workspace root compilerDigest name sourceBuildStableTriProfile 342