export-cache.tri (4315B)
1 !import prelude * 2 !import compiler_io * 3 !import io as RuntimeIO 4 !import io_text as Text 5 !import source_object * 6 !import source_module * 7 !import source_lock * 8 !import source_build * 9 !import source_unit * 10 !import source_resolve * 11 !export * 12 13 -- Opt-in bootstrap acceleration. The runner supplies its compiler identity; 14 -- rewritten source fixes exact imported manifests. Indices are hints, not CAS. 15 sourceExportCacheLog line = RuntimeIO.require 16 (Text.writeText RuntimeIO.stdout (append line "\n")) 17 18 sourceExportCacheOne root scope name tree = 19 onOk_ (sourceObjectDigest "arboricx.source-export-name.v1" name) (nameHash : 20 (path : thenIO (sourceExportCacheLog (append "export-start=" name)) 21 (onOk_ (fileExists path) (exists : lazyBool 22 (_ : onOk_ (readFile path) (hash : 23 onOk_ (sourceObjectGetTree root hash) (_ : 24 thenIO (sourceExportCacheLog (append "export-reused=" name)) 25 (pure (ok hash t))))) 26 (_ : onOk_ (sourceObjectPutTree root tree) (hash : 27 onOk_ (atomicWriteBytes path hash) (_ : 28 thenIO (sourceExportCacheLog (append "export-complete=" 29 (append name (append "\t" hash)))) (pure (ok hash t))))) 30 exists))) (append scope (append "/" nameHash))) 31 32 sourceExportCacheAll entries root scope selected = 33 lazyList 34 (_ : pure (ok selected t)) 35 (entry rest : lazyMaybe 36 (_ : onOk_ (sourceExportCacheOne root scope (fst entry) (snd entry)) 37 (hash : sourceExportCacheAll rest root scope (pair (pair (fst entry) hash) selected))) 38 (_ : pure (err "duplicate export" t)) 39 (sourceFindExternal selected (fst entry))) 40 entries 41 42 sourceExportCacheSelect pending root scope definitions selected = 43 lazyList 44 (_ : sourceModulePutManifest root (reverse selected)) 45 (words rest : lazyResult 46 (problem unused : pure (err problem t)) 47 (request unused : lazyBool 48 (_ : onOk_ (sourceModuleGetRefManifest root (snd request)) (entries : 49 onOk_ (sourceModuleAddEntries root entries selected) 50 (next : sourceExportCacheSelect rest root scope definitions next))) 51 (_ : lazyBool 52 (_ : onOk_ (sourceExportCacheAll definitions root scope selected) 53 (next : sourceExportCacheSelect rest root scope definitions next)) 54 (_ : lazyMaybe 55 (_ : pure (err "undeclared local export" t)) 56 (tree : lazyMaybe 57 (_ : onOk_ (sourceExportCacheOne root scope (fst request) tree) 58 (hash : sourceExportCacheSelect rest root scope definitions 59 (pair (pair (fst request) hash) selected))) 60 (_ : pure (err "duplicate export" t)) 61 (sourceFindExternal selected (fst request))) 62 (sourceFindExternal definitions (fst request))) 63 (equal? (fst request) "*")) 64 (equal? (fst request) "from")) 65 (sourceModuleExportShape words)) 66 pending 67 68 sourceExportCacheBuild root source compiler = 69 onOk_ (encodeSourceText source) (sourceBytes : 70 onOk_ (sourceObjectDigest "arboricx.source-export-build.v1" 71 (append compiler (pair 0 sourceBytes))) (key : 72 (scope : onOk_ (createDirectory root) (_ : 73 onOk_ (createDirectory (append root "/cache")) (_ : 74 onOk_ (createDirectory (append root "/cache/source-export")) (_ : 75 onOk_ (createDirectory scope) (_ : lazyResult 76 (problem unused : pure (err problem t)) 77 (staged unused : onOk_ (sourceModuleExtendUses root (fst staged)) 78 (environment : lazyResult 79 (problem unused : pure (err problem t)) 80 (definitions unused : sourceExportCacheSelect 81 (fst (snd staged)) root scope definitions t) 82 (compileModuleDefinitions environment (snd (snd staged))))) 83 (sourceModuleStage source)))))) 84 (append root (append "/cache/source-export/" key)))) 85 86 sourceExportCacheCompile root clean groups compiler = 87 lazyResult 88 (problem unused : pure (err problem t)) 89 (rewritten unused : sourceExportCacheBuild root rewritten compiler) 90 (sourceLockRewriteSource clean groups) 91 sourceExportCacheProfile compiler = 92 pair (workspace name : sourceBuildReadTri workspace name) 93 (pair (root clean groups : sourceExportCacheCompile root clean groups compiler) 94 "source-module.reference.v1")