c618dcccab6e6711a9d55672822b1c5d93b53783cfa358a1c36ba5a8360c4676.tri (11287B)
1 !import prelude * 2 !import io * 3 !import source_object * 4 !import source_module * 5 !import source_resolve * 6 !import source_build * 7 !export * 8 9 -- Explicit bootstrap staging map. Each canonical row is: 10 -- KIND<TAB>localAlias<TAB>legacyHeaderName<TAB>relativePath<TAB>comma-separated dependency aliases (or '-' for none) 11 -- KIND is unit (export local definitions only), reexport (also explicitly 12 -- re-export every declared dependency), or native (checked native headers and 13 -- explicit authored exports, staged without rewriting). The legacy name is checked against 14 -- an original !import header only. Paths and dependency edges come exclusively 15 -- from this file, never tricu.workspace. 16 sourceMapHeader = "arboricx.source-map.v1\n" 17 sourceMapSegmentsValid names = 18 lazyList 19 (_ : true) 20 (name rest : andLazy? (sourceModuleAliasValid name) 21 (_ : sourceMapSegmentsValid rest)) 22 names 23 sourceMapLegacyValid name = 24 sourceMapSegmentsValid (splitOnByte 46 name) 25 sourceMapPathValid path = 26 lazyList 27 (_ : false) 28 (stem suffix : lazyList 29 (_ : false) 30 (extension extra : and? (emptyList? extra) 31 (and? (equal? extension "tri") 32 (sourceMapSegmentsValid (splitOnByte 47 stem)))) 33 suffix) 34 (splitOnByte 46 path) 35 sourceMapDependenciesValid deps rows = 36 lazyList 37 (_ : true) 38 (dep rest : andLazy? 39 (and? (sourceModuleAliasValid dep) 40 (and? (not? (emptyList? dep)) 41 (lazyMaybe (_ : false) (_ : true) (sourceFindExternal rows dep)))) 42 (_ : sourceMapDependenciesValid rest rows)) 43 deps 44 sourceMapParseRow row seen = 45 lazyList 46 (_ : err "invalid source map row" t) 47 (tag rest1 : lazyList 48 (_ : err "invalid source map row" t) 49 (name rest2 : lazyList 50 (_ : err "invalid source map row" t) 51 (legacy rest3 : lazyList 52 (_ : err "invalid source map row" t) 53 (path rest4 : lazyList 54 (_ : err "invalid source map row" t) 55 (depString extra : lazyBool 56 (_ : lazyMaybe 57 (_ : ok (pair name 58 (pair legacy (pair path 59 (pair (lazyBool (_ : t) (_ : splitOnByte 44 depString) 60 (equal? depString "-")) tag)))) t) 61 (_ : err "duplicate source map name" t) 62 (sourceFindExternal seen name)) 63 (_ : err "invalid source map name, path or fields" t) 64 (and? (or? (or? (equal? tag "unit") (equal? tag "native")) 65 (and? (equal? tag "reexport") 66 (not? (equal? depString "-")))) 67 (and? (emptyList? extra) 68 (and? (sourceModuleAliasValid name) 69 (and? (sourceMapLegacyValid legacy) 70 (sourceMapPathValid path)))))) 71 rest4) 72 rest3) 73 rest2) 74 rest1) 75 (splitOnByte 9 row) 76 sourceMapParseRows rows seen = 77 lazyList 78 (_ : ok (reverse seen) t) 79 (row rest : lazyList 80 (_ : lazyBool 81 (_ : ok (reverse seen) t) 82 (_ : err "blank source map row" t) 83 (emptyList? rest)) 84 (_ _ : lazyResult 85 (problem unused : err problem t) 86 (entry unused : sourceMapParseRows rest (pair entry seen)) 87 (sourceMapParseRow row seen)) 88 row) 89 rows 90 -- A false dependency check is a Result error, not an implicit lookup. 91 sourceMapValidateDeps rows all = 92 lazyList 93 (_ : ok all t) 94 (row rest : lazyBool 95 (_ : sourceMapValidateDeps rest all) 96 (_ : err "undeclared source map dependency" t) 97 (sourceMapDependenciesValid (fst (snd (snd (snd row)))) all)) 98 rows 99 sourceMapDependencyField deps = 100 lazyList (_ : "-") (_ _ : intercalate "," deps) deps 101 sourceMapEncodeRows rows = 102 lazyList 103 (_ : t) 104 (row rest : append (snd (snd (snd (snd row)))) 105 (append "\t" (append (fst row) 106 (append "\t" (append (fst (snd row)) 107 (append "\t" (append (fst (snd (snd row))) 108 (append "\t" (append 109 (sourceMapDependencyField (fst (snd (snd (snd row))))) 110 (append "\n" (sourceMapEncodeRows rest))))))))))) 111 rows 112 sourceMapEncode rows = append sourceMapHeader (sourceMapEncodeRows rows) 113 sourceMapDecode bytes = 114 lazyList 115 (_ : err "empty source map" t) 116 (header rows : lazyBool 117 (_ : lazyResult 118 (problem unused : err problem t) 119 (entries unused : lazyList 120 (_ : err "source map requires a unit" t) 121 (_ _ : lazyResult 122 (problem unused : err problem t) 123 (validated unused : lazyBool 124 (_ : ok validated t) 125 (_ : err "noncanonical source map" t) 126 (equal? bytes (sourceMapEncode validated))) 127 (sourceMapValidateDeps entries entries)) 128 entries) 129 (sourceMapParseRows rows t)) 130 (_ : err "unsupported source map version" t) 131 (equal? header "arboricx.source-map.v1")) 132 (splitOnByte 10 bytes) 133 134 sourceMapExpectedImport legacy = 135 pair "!import" (pair (append "\"" (append legacy "\"")) 136 (pair "!Local" t)) 137 sourceMapStripHeader original rows map = 138 lazyList 139 (_ : lazyList 140 (_ : ok t t) 141 (line rest : lazyList 142 (_ : ok (unlines (pair line rest)) t) 143 (head tail : lazyBool 144 (_ : err "undeclared bootstrap import" t) 145 (_ : ok (unlines (pair line rest)) t) 146 (equal? "!import" head)) 147 (words line)) 148 original) 149 (dep rest : lazyMaybe 150 (_ : err "undeclared source map dependency" t) 151 (entry : lazyList 152 (_ : err "missing bootstrap import" t) 153 (line tail : lazyBool 154 (_ : sourceMapStripHeader tail rest map) 155 (_ : err "bootstrap import differs from explicit source map" t) 156 (equal? (words line) (sourceMapExpectedImport (fst entry)))) 157 original) 158 (sourceFindExternal map dep)) 159 rows 160 -- Compare derived local edges, not the spelling or layout of declarations. 161 -- Native author bytes, namespaces and exports remain unchanged. 162 sourceMapCheckNativeHeader source deps = (bindResult 163 (sourceModuleHeaderStage source) (staged _ : lazyBool 164 (_ : ok t t) 165 (_ : err "native source differs from explicit source map" t) 166 (equal? (fst staged) deps))) 167 sourceMapPrepareBody row original all = 168 lazyBool 169 (_ : lazyResult 170 (problem unused : err problem t) 171 (_ unused : ok original t) 172 (sourceMapCheckNativeHeader original 173 (fst (snd (snd (snd row)))))) 174 (_ : sourceMapStripHeader (lines original) 175 (fst (snd (snd (snd row)))) all) 176 (equal? (snd (snd (snd (snd row)))) "native") 177 sourceMapUseHeader deps = 178 lazyList 179 (_ : t) 180 (dep rest : append "!import " 181 (append dep (append " *\n" (sourceMapUseHeader rest)))) 182 deps 183 sourceMapReexportHeader deps = 184 lazyList 185 (_ : t) 186 (dep rest : append "!export * from " 187 (append dep (append "\n" (sourceMapReexportHeader rest)))) 188 deps 189 sourceMapLegacyOverlay row body = 190 (append (sourceMapUseHeader (fst (snd (snd (snd row))))) 191 (append "!export *\n" 192 (append (lazyBool 193 (_ : sourceMapReexportHeader (fst (snd (snd (snd row))))) 194 (_ : t) 195 (equal? (snd (snd (snd (snd row)))) "reexport")) 196 body))) 197 sourceMapOverlay row body = (lazyBool 198 (_ : body) 199 (_ : sourceMapLegacyOverlay row body) 200 (equal? (snd (snd (snd (snd row)))) "native")) 201 sourceMapStageOne sourceRoot overlayRoot all row = 202 onResult_ (readFile (append sourceRoot (append "/" 203 (fst (snd (snd row))))) ) 204 (problem : pure (err problem t)) 205 (original : lazyResult 206 (problem unused : pure (err problem t)) 207 (body unused : onOk_ 208 (sourceObjectDigest "arboricx.source.v1" original) 209 (rawDigest : onOk_ 210 (sourceObjectDigest "arboricx.source.v1" 211 (sourceMapOverlay row body)) 212 (overlayDigest : onOk_ 213 (atomicWriteBytes (append overlayRoot 214 (append "/" (append (fst row) ".tri"))) 215 (sourceMapOverlay row body)) 216 (_ : pure (ok 217 (pair (fst row) (pair rawDigest overlayDigest)) t))))) 218 (sourceMapPrepareBody row original all)) 219 sourceMapStageRows rows sourceRoot overlayRoot all records = 220 lazyList 221 (_ : pure (ok (reverse records) t)) 222 (row rest : onResult_ (sourceMapStageOne sourceRoot overlayRoot 223 all row) 224 (problem : pure (err problem t)) 225 (record : sourceMapStageRows rest sourceRoot overlayRoot all 226 (pair record records))) 227 rows 228 sourceMapRecords records = 229 lazyList 230 (_ : t) 231 (record rest : append "input\t" (append (fst record) 232 (append "\t" (append (fst (snd record)) 233 (append "\t" (append (snd (snd record)) 234 (append "\n" (sourceMapRecords rest)))))))) 235 records 236 sourceMapBuildReceipt mapHash compiler rootName result records = 237 append "arboricx.source-map-build.v1\n" 238 (append "map\t" (append mapHash 239 (append "\ncompiler\t" (append compiler 240 (append "\nroot\t" (append rootName 241 (append "\t" (append (fst result) 242 (append "\t" (append (snd result) 243 (append "\n" (sourceMapRecords records)))))))))))) 244 245 -- Prepare a checked overlay from a versioned, content-addressed source map. 246 -- Returns the immutable map ID and input (original, overlay) digest rows. 247 sourceMapStage sourceRoot overlayRoot casRoot mapBytes = 248 lazyResult 249 (problem unused : pure (err problem t)) 250 (rows unused : onResult_ (sourceObjectStore casRoot 251 "arboricx.source-map.v1" mapBytes) 252 (problem : pure (err problem t)) 253 (mapHash : onOk_ (createDirectory overlayRoot) (_ : 254 onResult_ (sourceMapStageRows rows sourceRoot overlayRoot 255 rows t) 256 (problem : pure (err problem t)) 257 (records : pure (ok (pair mapHash (pair rows records)) t))))) 258 (sourceMapDecode mapBytes) 259 260 -- Root build receipt references the complete map and source input snapshot; 261 -- the regular module receipts still describe each generated source unit. 262 sourceMapBuildWith buildGraph sourceRoot overlayRoot casRoot compiler mapBytes rootName = 263 onResult_ (sourceMapStage sourceRoot overlayRoot casRoot mapBytes) 264 (problem : pure (err problem t)) 265 (staged : lazyMaybe 266 (_ : pure (err "root missing from source map" t)) 267 (_ : onResult_ (buildGraph overlayRoot casRoot compiler rootName) 268 (problem : pure (err problem t)) 269 (result : onResult_ (sourceObjectStore casRoot 270 "arboricx.source-map-build.v1" 271 (sourceMapBuildReceipt (fst staged) compiler rootName result 272 (snd (snd staged)))) 273 (problem : pure (err problem t)) 274 (buildReceipt : pure (ok (pair result buildReceipt) t)))) 275 (sourceFindExternal (fst (snd staged)) rootName)) 276 277 -- Explicit generation backends share staging, graph policy and map receipts. 278 -- The selected graph owns its distinct module options identity; neither wrapper 279 -- catches compilation failure or attempts another backend. 280 sourceMapBuild sourceRoot overlayRoot casRoot compiler mapBytes rootName = 281 sourceMapBuildWith sourceBuildGraph sourceRoot overlayRoot casRoot compiler mapBytes rootName 282 sourceMapBuildStable sourceRoot overlayRoot casRoot compiler mapBytes rootName = 283 sourceMapBuildWith sourceBuildGraphStable sourceRoot overlayRoot casRoot compiler mapBytes rootName 284