map.tri (11446B)
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_ (readSourceFile (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_ (lazyBool 208 (_ : pure (ok (fst original) t)) 209 (_ : encodeSourceText (sourceMapOverlay row body)) 210 (equal? (snd (snd (snd (snd row)))) "native")) 211 (overlay : onOk_ 212 (sourceObjectDigest "arboricx.source.v1" (fst original)) 213 (rawDigest : onOk_ 214 (sourceObjectDigest "arboricx.source.v1" overlay) 215 (overlayDigest : onOk_ 216 (atomicWriteBytes (append overlayRoot 217 (append "/" (append (fst row) ".tri"))) overlay) 218 (_ : pure (ok 219 (pair (fst row) (pair rawDigest overlayDigest)) t)))))) 220 (sourceMapPrepareBody row (snd original) all)) 221 sourceMapStageRows rows sourceRoot overlayRoot all records = 222 lazyList 223 (_ : pure (ok (reverse records) t)) 224 (row rest : onResult_ (sourceMapStageOne sourceRoot overlayRoot 225 all row) 226 (problem : pure (err problem t)) 227 (record : sourceMapStageRows rest sourceRoot overlayRoot all 228 (pair record records))) 229 rows 230 sourceMapRecords records = 231 lazyList 232 (_ : t) 233 (record rest : append "input\t" (append (fst record) 234 (append "\t" (append (fst (snd record)) 235 (append "\t" (append (snd (snd record)) 236 (append "\n" (sourceMapRecords rest)))))))) 237 records 238 sourceMapBuildReceipt mapHash compiler rootName result records = 239 append "arboricx.source-map-build.v1\n" 240 (append "map\t" (append mapHash 241 (append "\ncompiler\t" (append compiler 242 (append "\nroot\t" (append rootName 243 (append "\t" (append (fst result) 244 (append "\t" (append (snd result) 245 (append "\n" (sourceMapRecords records)))))))))))) 246 247 -- Prepare a checked overlay from a versioned, content-addressed source map. 248 -- Returns the immutable map ID and input (original, overlay) digest rows. 249 sourceMapStage sourceRoot overlayRoot casRoot mapBytes = 250 lazyResult 251 (problem unused : pure (err problem t)) 252 (rows unused : onResult_ (sourceObjectStore casRoot 253 "arboricx.source-map.v1" mapBytes) 254 (problem : pure (err problem t)) 255 (mapHash : onOk_ (createDirectory overlayRoot) (_ : 256 onResult_ (sourceMapStageRows rows sourceRoot overlayRoot 257 rows t) 258 (problem : pure (err problem t)) 259 (records : pure (ok (pair mapHash (pair rows records)) t))))) 260 (sourceMapDecode mapBytes) 261 262 -- Root build receipt references the complete map and source input snapshot; 263 -- the regular module receipts still describe each generated source unit. 264 sourceMapBuildWith buildGraph sourceRoot overlayRoot casRoot compiler mapBytes rootName = 265 onResult_ (sourceMapStage sourceRoot overlayRoot casRoot mapBytes) 266 (problem : pure (err problem t)) 267 (staged : lazyMaybe 268 (_ : pure (err "root missing from source map" t)) 269 (_ : onResult_ (buildGraph overlayRoot casRoot compiler rootName) 270 (problem : pure (err problem t)) 271 (result : onResult_ (sourceObjectStore casRoot 272 "arboricx.source-map-build.v1" 273 (sourceMapBuildReceipt (fst staged) compiler rootName result 274 (snd (snd staged)))) 275 (problem : pure (err problem t)) 276 (buildReceipt : pure (ok (pair result buildReceipt) t)))) 277 (sourceFindExternal (fst (snd staged)) rootName)) 278 279 -- Explicit generation backends share staging, graph policy and map receipts. 280 -- The selected graph owns its distinct module options identity; neither wrapper 281 -- catches compilation failure or attempts another backend. 282 sourceMapBuild sourceRoot overlayRoot casRoot compiler mapBytes rootName = 283 sourceMapBuildWith sourceBuildGraph sourceRoot overlayRoot casRoot compiler mapBytes rootName 284 sourceMapBuildStable sourceRoot overlayRoot casRoot compiler mapBytes rootName = 285 sourceMapBuildWith sourceBuildGraphStable sourceRoot overlayRoot casRoot compiler mapBytes rootName 286