+650

docs/plans/2026-02-17-oxcaml-dual-compiler-impl.md

··· 1 1 + # OxCaml Dual-Compiler Support Implementation Plan 2 2 + 3 3 + > **For Claude:** REQUIRED SUB-SKILL: Use superpowers:executing-plans to implement this plan task-by-task. 4 4 + 5 5 + **Goal:** Build the monorepo from a single source tree with both OCaml 5.4.0 (`default` switch) and OxCaml 5.2.0+ox (`5.2.0+ox` switch). 6 6 + 7 7 + **Architecture:** Duplicate dune library stanzas gated by `(enabled_if %{ocaml-config:ox})`. OxCaml stanzas pass `-D "OXCAML"` to cppo. Source files use `#if defined OXCAML` guards around the ~6 API difference sites. Following the pattern established in odoc PR #1399. 8 8 + 9 9 + **Tech Stack:** cppo (C preprocessor for OCaml), dune 3.21+ `%{ocaml-config:ox}`, compiler-libs, merlin-lib. 10 10 + 11 11 + --- 12 12 + 13 13 + ### Task 1: Install oxcaml switch dependencies 14 14 + 15 15 + **Files:** None (opam operations only) 16 16 + 17 17 + **Step 1: Install packages in oxcaml switch** 18 18 + 19 19 + ```bash 20 20 + OPAMSWITCH=5.2.0+ox opam install -y js_of_ocaml-toplevel merlin-lib rpclib-lwt ppxlib ppx_deriving logs crunch uri angstrom fpath astring mime_printer 21 21 + ``` 22 22 + 23 23 + This installs 34+ packages including `js_of_ocaml 6.0.1+ox`, `merlin-lib 5.2.1-502+ox`, `ppxlib 0.33.0+ox`, etc. 24 24 + 25 25 + **Step 2: Verify key packages installed** 26 26 + 27 27 + ```bash 28 28 + OPAMSWITCH=5.2.0+ox opam list --installed js_of_ocaml-toplevel merlin-lib ppxlib rpclib-lwt 29 29 + ``` 30 30 + 31 31 + Expected: All show `+ox` versions. 32 32 + 33 33 + **Step 3: Pin dune fork in oxcaml switch (if not already)** 34 34 + 35 35 + ```bash 36 36 + OPAMSWITCH=5.2.0+ox opam pin --current dune 2>/dev/null || true 37 37 + ``` 38 38 + 39 39 + Verify the custom dune fork with odoc-v3-rules is available: 40 40 + ```bash 41 41 + OPAMSWITCH=5.2.0+ox opam exec -- dune --version 42 42 + ``` 43 43 + 44 44 + Expected: `3.21.0` 45 45 + 46 46 + --- 47 47 + 48 48 + ### Task 2: Bump dune-project to 3.21 and add cppo dependency 49 49 + 50 50 + **Files:** 51 51 + - Modify: `dune-project` (line 1) 52 52 + 53 53 + **Step 1: Bump dune lang version** 54 54 + 55 55 + In `dune-project`, change: 56 56 + ``` 57 57 + (lang dune 3.20) 58 58 + ``` 59 59 + to: 60 60 + ``` 61 61 + (lang dune 3.21) 62 62 + ``` 63 63 + 64 64 + This enables `%{ocaml-config:ox}` variable support. 65 65 + 66 66 + **Step 2: Verify the default switch still builds** 67 67 + 68 68 + ```bash 69 69 + OPAMSWITCH=default dune build js_top_worker/lib/.js_top_worker.objs/byte 2>&1 | head -20 70 70 + ``` 71 71 + 72 72 + Expected: Builds successfully (dune 3.21 is backward compatible). 73 73 + 74 74 + **Step 3: Commit** 75 75 + 76 76 + ```bash 77 77 + git add dune-project 78 78 + git commit -m "build: bump dune lang to 3.21 for ocaml-config:ox support" 79 79 + ``` 80 80 + 81 81 + --- 82 82 + 83 83 + ### Task 3: Duplicate js_top_worker dune stanzas for dual-compiler 84 84 + 85 85 + **Files:** 86 86 + - Modify: `js_top_worker/lib/dune` 87 87 + 88 88 + **Step 1: Replace the js_top_worker library stanza with dual stanzas** 89 89 + 90 90 + The current stanza (lines 3-31) becomes two stanzas. The key differences: 91 91 + - `(enabled_if ...)` gate on each 92 92 + - OxCaml stanza adds `-D "OXCAML"` to cppo 93 93 + - Both stanzas apply cppo to `impl` (the file with compiler-libs API calls) 94 94 + 95 95 + Replace the first library stanza with: 96 96 + 97 97 + ```dune 98 98 + ; Worker library -- upstream OCaml 99 99 + (library 100 100 + (public_name js_top_worker) 101 101 + (enabled_if (not %{ocaml-config:ox})) 102 102 + (modules toplexer ocamltop impl environment) 103 103 + (libraries 104 104 + logs 105 105 + js_top_worker-rpc 106 106 + rpclib-lwt 107 107 + js_of_ocaml-compiler 108 108 + js_of_ocaml-ppx 109 109 + astring 110 110 + mime_printer 111 111 + compiler-libs.common 112 112 + compiler-libs.toplevel 113 113 + merlin-lib.kernel 114 114 + merlin-lib.utils 115 115 + merlin-lib.query_protocol 116 116 + merlin-lib.query_commands 117 117 + merlin-lib.ocaml_parsing 118 118 + ppxlib 119 119 + ppx_deriving.api) 120 120 + (js_of_ocaml 121 121 + (javascript_files stubs.js)) 122 122 + (preprocess 123 123 + (per_module 124 124 + ((action 125 125 + (run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file})) 126 126 + impl)))) 127 127 + 128 128 + ; Worker library -- OxCaml 129 129 + (library 130 130 + (public_name js_top_worker) 131 131 + (enabled_if %{ocaml-config:ox}) 132 132 + (modules toplexer ocamltop impl environment) 133 133 + (libraries 134 134 + logs 135 135 + js_top_worker-rpc 136 136 + rpclib-lwt 137 137 + js_of_ocaml-compiler 138 138 + js_of_ocaml-ppx 139 139 + astring 140 140 + mime_printer 141 141 + compiler-libs.common 142 142 + compiler-libs.toplevel 143 143 + merlin-lib.kernel 144 144 + merlin-lib.utils 145 145 + merlin-lib.query_protocol 146 146 + merlin-lib.query_commands 147 147 + merlin-lib.ocaml_parsing 148 148 + ppxlib 149 149 + ppx_deriving.api) 150 150 + (js_of_ocaml 151 151 + (javascript_files stubs.js)) 152 152 + (preprocess 153 153 + (per_module 154 154 + ((action 155 155 + (run %{bin:cppo} -V OCAML:%{ocaml_version} -D "OXCAML" %{input-file})) 156 156 + impl)))) 157 157 + ``` 158 158 + 159 159 + Note: the old `uTop_complete`, `uTop_compat`, `uTop` cppo modules are removed 160 160 + (they don't exist on disk). Only `impl` gets cppo preprocessing now. 161 161 + 162 162 + **Step 2: Do the same for js_top_worker-web** 163 163 + 164 164 + The `js_top_worker-web` stanza (lines 35-52) also needs duplication. The web 165 165 + library doesn't use compiler-libs directly, but js_of_ocaml-toplevel and 166 166 + js_of_ocaml-lwt may have version differences. Duplicate with `enabled_if`: 167 167 + 168 168 + ```dune 169 169 + ; Web worker library -- upstream OCaml 170 170 + (library 171 171 + (public_name js_top_worker-web) 172 172 + (name js_top_worker_web) 173 173 + (enabled_if (not %{ocaml-config:ox})) 174 174 + (modules worker findlibish jslib) 175 175 + (preprocess 176 176 + (pps js_of_ocaml-ppx)) 177 177 + (libraries 178 178 + js_top_worker 179 179 + js_top_worker-rpc.message 180 180 + js_of_ocaml-ppx 181 181 + js_of_ocaml-toplevel 182 182 + js_of_ocaml-lwt 183 183 + logs.browser 184 184 + uri 185 185 + angstrom 186 186 + findlib 187 187 + fpath 188 188 + rpclib.json)) 189 189 + 190 190 + ; Web worker library -- OxCaml 191 191 + (library 192 192 + (public_name js_top_worker-web) 193 193 + (name js_top_worker_web) 194 194 + (enabled_if %{ocaml-config:ox}) 195 195 + (modules worker findlibish jslib) 196 196 + (preprocess 197 197 + (pps js_of_ocaml-ppx)) 198 198 + (libraries 199 199 + js_top_worker 200 200 + js_top_worker-rpc.message 201 201 + js_of_ocaml-ppx 202 202 + js_of_ocaml-toplevel 203 203 + js_of_ocaml-lwt 204 204 + logs.browser 205 205 + uri 206 206 + angstrom 207 207 + findlib 208 208 + fpath 209 209 + rpclib.json)) 210 210 + ``` 211 211 + 212 212 + **Step 3: Verify default switch still builds** 213 213 + 214 214 + ```bash 215 215 + OPAMSWITCH=default dune clean && OPAMSWITCH=default dune build js_top_worker/lib/.js_top_worker.objs/byte 2>&1 | head -20 216 216 + ``` 217 217 + 218 218 + Expected: Builds successfully. 219 219 + 220 220 + **Step 4: Commit** 221 221 + 222 222 + ```bash 223 223 + git add js_top_worker/lib/dune 224 224 + git commit -m "build(js_top_worker): duplicate dune stanzas for oxcaml dual-compiler" 225 225 + ``` 226 226 + 227 227 + --- 228 228 + 229 229 + ### Task 4: Add cppo guards to impl.ml -- Persistent_env.Persistent_signature.load 230 230 + 231 231 + **Files:** 232 232 + - Modify: `js_top_worker/lib/impl.ml` (lines 278-283, 576-620) 233 233 + 234 234 + This is the largest API difference. On OxCaml 5.2+ox, `unit_name` is 235 235 + `Compilation_unit.Name.t`, requiring a `to_string` converter. On OCaml 5.4, 236 236 + `unit_name` is plain `string`. 237 237 + 238 238 + **Step 1: Guard the `add_dynamic_cmis_sync` loader (around line 280)** 239 239 + 240 240 + Find the section: 241 241 + ```ocaml 242 242 + let open Persistent_env.Persistent_signature in 243 243 + let old_loader = !load in 244 244 + load := fun ~allow_hidden ~unit_name -> 245 245 + let filename = to_cmi_filename unit_name in 246 246 + ``` 247 247 + 248 248 + Wrap with cppo: 249 249 + ```ocaml 250 250 + let open Persistent_env.Persistent_signature in 251 251 + let old_loader = !load in 252 252 + #if defined OXCAML 253 253 + load := fun ~allow_hidden ~unit_name -> 254 254 + let filename = to_cmi_filename (Compilation_unit.Name.to_string unit_name) in 255 255 + #else 256 256 + load := fun ~allow_hidden ~unit_name -> 257 257 + let filename = to_cmi_filename unit_name in 258 258 + #endif 259 259 + ``` 260 260 + 261 261 + **Step 2: Guard the `new_load` function and its callers (around line 576-620)** 262 262 + 263 263 + The current `new_load` function signature uses `unit_name:string`. On OxCaml, 264 264 + it needs to accept `Compilation_unit.Name.t` and convert. 265 265 + 266 266 + Find the `new_load` definition and replace with: 267 267 + ```ocaml 268 268 + #if defined OXCAML 269 269 + let new_load : 270 270 + 'a 'b. 271 271 + s:string -> 272 272 + to_string:('a -> string) -> 273 273 + old_loader:(allow_hidden:bool -> unit_name:'a -> 'b option) -> 274 274 + allow_hidden:bool -> 275 275 + unit_name:'a -> 276 276 + 'b option = 277 277 + fun ~s ~to_string ~old_loader ~allow_hidden ~unit_name -> 278 278 + let unit_name_s = to_string unit_name in 279 279 + let filename = filename_of_module unit_name_s in 280 280 + #else 281 281 + let new_load ~s ~old_loader ~allow_hidden ~unit_name = 282 282 + let filename = filename_of_module unit_name in 283 283 + #endif 284 284 + ``` 285 285 + 286 286 + And the callers become: 287 287 + ```ocaml 288 288 + let open Persistent_env.Persistent_signature in 289 289 + let old_loader = !load in 290 290 + #if defined OXCAML 291 291 + load := new_load ~s:"comp" ~to_string:Compilation_unit.Name.to_string ~old_loader; 292 292 + #else 293 293 + load := new_load ~s:"comp" ~old_loader; 294 294 + #endif 295 295 + 296 296 + let open Ocaml_typing.Persistent_env.Persistent_signature in 297 297 + let old_loader = !load in 298 298 + #if defined OXCAML 299 299 + load := new_load ~s:"merl" ~to_string:Ocaml_typing.Compilation_unit.Name.to_string ~old_loader 300 300 + #else 301 301 + load := new_load ~s:"merl" ~old_loader 302 302 + #endif 303 303 + ``` 304 304 + 305 305 + **Step 3: Verify default switch still builds** 306 306 + 307 307 + ```bash 308 308 + OPAMSWITCH=default dune build js_top_worker/lib/.js_top_worker.objs/byte 2>&1 | head -10 309 309 + ``` 310 310 + 311 311 + **Step 4: Commit** 312 312 + 313 313 + ```bash 314 314 + git add js_top_worker/lib/impl.ml 315 315 + git commit -m "feat(js_top_worker): cppo guards for Persistent_env.load signature" 316 316 + ``` 317 317 + 318 318 + --- 319 319 + 320 320 + ### Task 5: Add cppo guards to impl.ml -- Language_extension, Unit_info, Typemod 321 321 + 322 322 + **Files:** 323 323 + - Modify: `js_top_worker/lib/impl.ml` 324 324 + 325 325 + **Step 1: Guard Language_extension in init (add after Toploop.initialize)** 326 326 + 327 327 + Find the `init` function's initialization section (after `Toploop.initialize_toplevel_env`). 328 328 + Add: 329 329 + ```ocaml 330 330 + #if defined OXCAML 331 331 + Language_extension.(set_universe_and_enable_all Universe.Beta); 332 332 + #endif 333 333 + ``` 334 334 + 335 335 + **Step 2: Guard Unit_info.make (line 989)** 336 336 + 337 337 + Find: 338 338 + ```ocaml 339 339 + let unit_info = Unit_info.make ~source_file:filename Impl prefix in 340 340 + ``` 341 341 + 342 342 + Replace with: 343 343 + ```ocaml 344 344 + #if defined OXCAML 345 345 + let unit_info = Unit_info.make ~source_file:filename Impl prefix 346 346 + ~for_pack_prefix:Compilation_unit.Prefix.empty in 347 347 + #else 348 348 + let unit_info = Unit_info.make ~source_file:filename Impl prefix in 349 349 + #endif 350 350 + ``` 351 351 + 352 352 + **Step 3: Guard Typemod.type_implementation (line 1001)** 353 353 + 354 354 + Find: 355 355 + ```ocaml 356 356 + let _ = Typemod.type_implementation unit_info env ast in 357 357 + ``` 358 358 + 359 359 + Replace with: 360 360 + ```ocaml 361 361 + #if defined OXCAML 362 362 + let _ = Typemod.type_implementation unit_info 363 363 + (Compilation_unit.of_string (modname_of_id id)) env ast in 364 364 + #else 365 365 + let _ = Typemod.type_implementation unit_info env ast in 366 366 + #endif 367 367 + ``` 368 368 + 369 369 + **Step 4: Verify default switch still builds** 370 370 + 371 371 + ```bash 372 372 + OPAMSWITCH=default dune build js_top_worker/lib/.js_top_worker.objs/byte 2>&1 | head -10 373 373 + ``` 374 374 + 375 375 + **Step 5: Commit** 376 376 + 377 377 + ```bash 378 378 + git add js_top_worker/lib/impl.ml 379 379 + git commit -m "feat(js_top_worker): cppo guards for Language_extension, Unit_info, Typemod" 380 380 + ``` 381 381 + 382 382 + --- 383 383 + 384 384 + ### Task 6: Add cppo guards to impl.ml -- Env.Error reporting 385 385 + 386 386 + **Files:** 387 387 + - Modify: `js_top_worker/lib/impl.ml` (lines 688-695, 1007-1008) 388 388 + 389 389 + On OxCaml, `Env.Error` is caught and reported via `Env.report_error`. On OCaml 390 390 + 5.4, it's caught as an exception and reported via `Location.report_exception`. 391 391 + 392 392 + **Step 1: Guard the execute error handler (around line 688)** 393 393 + 394 394 + Find: 395 395 + ```ocaml 396 396 + | Env.Error _ as exn -> 397 397 + Location.report_exception Format.err_formatter exn; 398 398 + let err = Format.asprintf "%a" Location.report_exception exn in 399 399 + failwith ("Error: " ^ err) 400 400 + ``` 401 401 + 402 402 + Replace with: 403 403 + ```ocaml 404 404 + #if defined OXCAML 405 405 + | Env.Error e -> 406 406 + Env.report_error Format.err_formatter e; 407 407 + let err = Format.asprintf "%a" Env.report_error e in 408 408 + failwith ("Error: " ^ err) 409 409 + #else 410 410 + | Env.Error _ as exn -> 411 411 + Location.report_exception Format.err_formatter exn; 412 412 + let err = Format.asprintf "%a" Location.report_exception exn in 413 413 + failwith ("Error: " ^ err) 414 414 + #endif 415 415 + ``` 416 416 + 417 417 + **Step 2: Guard the add_cmi error handler (around line 1007)** 418 418 + 419 419 + Find: 420 420 + ```ocaml 421 421 + | Env.Error _ as exn -> 422 422 + Logs.err (fun m -> m "Env.Error: %a" Location.report_exception exn); 423 423 + ``` 424 424 + 425 425 + Replace with: 426 426 + ```ocaml 427 427 + #if defined OXCAML 428 428 + | Env.Error e -> 429 429 + Logs.err (fun m -> m "Env.Error: %a" Env.report_error e); 430 430 + #else 431 431 + | Env.Error _ as exn -> 432 432 + Logs.err (fun m -> m "Env.Error: %a" Location.report_exception exn); 433 433 + #endif 434 434 + ``` 435 435 + 436 436 + **Step 3: Verify default switch still builds** 437 437 + 438 438 + ```bash 439 439 + OPAMSWITCH=default dune build js_top_worker/lib/.js_top_worker.objs/byte 2>&1 | head -10 440 440 + ``` 441 441 + 442 442 + **Step 4: Commit** 443 443 + 444 444 + ```bash 445 445 + git add js_top_worker/lib/impl.ml 446 446 + git commit -m "feat(js_top_worker): cppo guards for Env.Error reporting" 447 447 + ``` 448 448 + 449 449 + --- 450 450 + 451 451 + ### Task 7: First oxcaml build attempt and fix remaining issues 452 452 + 453 453 + **Files:** 454 454 + - Possibly modify: `js_top_worker/lib/impl.ml`, `js_top_worker/lib/environment.ml` 455 455 + 456 456 + **Step 1: Attempt the oxcaml build** 457 457 + 458 458 + ```bash 459 459 + OPAMSWITCH=5.2.0+ox dune build js_top_worker/lib/.js_top_worker.objs/byte 2>&1 | head -50 460 460 + ``` 461 461 + 462 462 + Expected: Likely some remaining compilation errors due to API differences not 463 463 + yet identified. The 5.2 vs 5.4 compiler-libs gap may surface in: 464 464 + - `Toploop` API (minor signature changes) 465 465 + - `merlin-lib` API (5.2.1-502+ox vs 5.6.1-504 is a large gap) 466 466 + - `ppxlib` API (0.33.0+ox vs 0.36.0) 467 467 + 468 468 + **Step 2: Fix each error with cppo guards** 469 469 + 470 470 + For each error, add appropriate `#if defined OXCAML` / `#else` / `#endif` blocks. 471 471 + The general pattern: 472 472 + 473 473 + ```ocaml 474 474 + #if defined OXCAML 475 475 + (* OxCaml 5.2+ox API *) 476 476 + some_function ~new_param:value arg1 arg2 477 477 + #else 478 478 + (* OCaml 5.4 API *) 479 479 + some_function arg1 arg2 480 480 + #endif 481 481 + ``` 482 482 + 483 483 + **Step 3: Iterate until it compiles** 484 484 + 485 485 + Repeat build/fix cycle until: 486 486 + ```bash 487 487 + OPAMSWITCH=5.2.0+ox dune build js_top_worker/lib/.js_top_worker.objs/byte 488 488 + ``` 489 489 + succeeds with exit code 0. 490 490 + 491 491 + **Step 4: Verify default switch still builds** 492 492 + 493 493 + ```bash 494 494 + OPAMSWITCH=default dune build js_top_worker/lib/.js_top_worker.objs/byte 495 495 + ``` 496 496 + 497 497 + **Step 5: Commit** 498 498 + 499 499 + ```bash 500 500 + git add js_top_worker/lib/impl.ml js_top_worker/lib/environment.ml 501 501 + git commit -m "feat(js_top_worker): fix remaining oxcaml compilation errors" 502 502 + ``` 503 503 + 504 504 + --- 505 505 + 506 506 + ### Task 8: Build js_top_worker-web and full worker JS with oxcaml 507 507 + 508 508 + **Files:** 509 509 + - Possibly modify: `js_top_worker/lib/dune`, web worker source files 510 510 + 511 511 + **Step 1: Build the web library** 512 512 + 513 513 + ```bash 514 514 + OPAMSWITCH=5.2.0+ox dune build js_top_worker/lib/.js_top_worker_web.objs/byte 2>&1 | head -30 515 515 + ``` 516 516 + 517 517 + **Step 2: Build the full rpc_worker.js** 518 518 + 519 519 + ```bash 520 520 + OPAMSWITCH=5.2.0+ox dune build js_top_worker/example/rpc_worker.bc.js 2>&1 | head -30 521 521 + ``` 522 522 + 523 523 + Fix any remaining issues. 524 524 + 525 525 + **Step 3: Verify default switch still works** 526 526 + 527 527 + ```bash 528 528 + OPAMSWITCH=default dune build js_top_worker/example/rpc_worker.bc.js 529 529 + ``` 530 530 + 531 531 + **Step 4: Commit** 532 532 + 533 533 + ```bash 534 534 + git add -A js_top_worker/ 535 535 + git commit -m "feat(js_top_worker): oxcaml worker builds successfully" 536 536 + ``` 537 537 + 538 538 + --- 539 539 + 540 540 + ### Task 9: Apply odoc oxcaml support (from upstream PR #1399) 541 541 + 542 542 + **Files:** 543 543 + - Modify: Multiple files under `odoc/` 544 544 + 545 545 + This is the second major component. The odoc subtree needs cppo guards for 546 546 + OxCaml AST differences (or_null, float32, unboxed types, mixed blocks, etc.). 547 547 + 548 548 + **Step 1: Fetch and study the upstream PR branch** 549 549 + 550 550 + ```bash 551 551 + cd odoc 552 552 + git fetch https://github.com/ocaml/odoc.git upstream-oxcaml 553 553 + git log --oneline FETCH_HEAD..HEAD | head -10 # see what's different 554 554 + ``` 555 555 + 556 556 + **Step 2: Cherry-pick or manually apply the cppo changes** 557 557 + 558 558 + The upstream PR touches ~50 files. The key changes are: 559 559 + - `src/loader/dune` -- duplicate stanza with `(enabled_if %{ocaml-config:ox})` 560 560 + - `src/model/dune` -- duplicate rule for `compat.cppo.ml` 561 561 + - `src/loader/cmi.ml`, `cmt.ml`, `cmti.ml` -- cppo guards for AST patterns 562 562 + - `src/model/compat.cppo.ml` -- type compatibility layer 563 563 + - `src/xref2/shape_tools.cppo.ml` -- shape API differences 564 564 + 565 565 + Since the monorepo uses odoc as a subtree, we can either: 566 566 + a) Apply the diff manually (safest, most control) 567 567 + b) Subtree-merge the upstream-oxcaml branch (faster, but may conflict) 568 568 + 569 569 + **Step 3: Build odoc with both switches** 570 570 + 571 571 + ```bash 572 572 + OPAMSWITCH=default dune build odoc/src/odoc/.odoc.objs/byte 573 573 + OPAMSWITCH=5.2.0+ox dune build odoc/src/odoc/.odoc.objs/byte 574 574 + ``` 575 575 + 576 576 + **Step 4: Commit** 577 577 + 578 578 + ```bash 579 579 + git add odoc/ 580 580 + git commit -m "feat(odoc): apply oxcaml dual-compiler support from upstream PR #1399" 581 581 + ``` 582 582 + 583 583 + --- 584 584 + 585 585 + ### Task 10: Build scrollycode extension and x-ocaml with oxcaml 586 586 + 587 587 + **Files:** 588 588 + - Possibly modify: dune files for these packages 589 589 + 590 590 + **Step 1: Build odoc-scrollycode-extension** 591 591 + 592 592 + ```bash 593 593 + OPAMSWITCH=5.2.0+ox dune build odoc-scrollycode-extension/src/.scrollycode_extension.objs/byte 594 594 + ``` 595 595 + 596 596 + This should work without changes since it only depends on odoc APIs, not 597 597 + compiler-libs directly. 598 598 + 599 599 + **Step 2: Build x-ocaml** 600 600 + 601 601 + ```bash 602 602 + OPAMSWITCH=5.2.0+ox dune build x-ocaml/src/.x_ocaml.objs/byte 603 603 + ``` 604 604 + 605 605 + **Step 3: Verify default switch** 606 606 + 607 607 + ```bash 608 608 + OPAMSWITCH=default dune build odoc-scrollycode-extension/ x-ocaml/ 609 609 + ``` 610 610 + 611 611 + **Step 4: Commit any fixes** 612 612 + 613 613 + ```bash 614 614 + git add odoc-scrollycode-extension/ x-ocaml/ 615 615 + git commit -m "feat: scrollycode and x-ocaml build with oxcaml" 616 616 + ``` 617 617 + 618 618 + --- 619 619 + 620 620 + ### Task 11: End-to-end verification 621 621 + 622 622 + **Step 1: Full build with default switch** 623 623 + 624 624 + ```bash 625 625 + OPAMSWITCH=default dune build @install 2>&1 | tail -5 626 626 + ``` 627 627 + 628 628 + **Step 2: Full build with oxcaml switch** 629 629 + 630 630 + ```bash 631 631 + OPAMSWITCH=5.2.0+ox dune build @install 2>&1 | tail -5 632 632 + ``` 633 633 + 634 634 + **Step 3: Run cram tests on both** 635 635 + 636 636 + ```bash 637 637 + OPAMSWITCH=default dune test 2>&1 | tail -20 638 638 + OPAMSWITCH=5.2.0+ox dune test 2>&1 | tail -20 639 639 + ``` 640 640 + 641 641 + **Step 4: Generate demo HTML and verify** 642 642 + 643 643 + Regenerate the scrollycode demo using each switch's odoc and verify both produce 644 644 + valid HTML. 645 645 + 646 646 + **Step 5: Final commit** 647 647 + 648 648 + ```bash 649 649 + git commit -m "feat: dual-compiler support verified (OCaml 5.4 + OxCaml 5.2+ox)" 650 650 + ```

+139

docs/plans/2026-02-17-oxcaml-dual-compiler-support.md

··· 1 1 + # Dual-Compiler Support: OCaml 5.4 + OxCaml 5.2+ox 2 2 + 3 3 + ## Goal 4 4 + 5 5 + The monorepo builds from the same source tree with both compilers: 6 6 + - `OPAMSWITCH=default dune build` (OCaml 5.4.0) 7 7 + - `OPAMSWITCH=5.2.0+ox dune build` (OxCaml 5.2.0+ox) 8 8 + 9 9 + ## Background 10 10 + 11 11 + OxCaml is Jane Street's extended OCaml compiler (based on 5.2.0) with additional 12 12 + features: fearless concurrency, unboxed types, SIMD, etc. The oxcaml opam 13 13 + repository provides `+ox` variants of key packages. 14 14 + 15 15 + ### Existing Work 16 16 + 17 17 + - **`jonludlam/js_top_worker` oxcaml branch** (66 commits): Port of js_top_worker 18 18 + to oxcaml. Removes cppo guards and hardcodes oxcaml APIs. Contains the same 19 19 + functor architecture, Merlin integration, and cell system as our current code. 20 20 + - **`ocaml/odoc` PR #1399** ("Upstream OxCaml"): Draft PR by art-w adding cppo-based 21 21 + dual-compiler support to odoc. Uses `(enabled_if %{ocaml-config:ox})` dune 22 22 + stanzas and `-D "OXCAML"` cppo flag. 23 23 + - **`ocsigen/js_of_ocaml` PR #2105** ("Oxcaml support"): Vouillon's PR adding oxcaml 24 24 + support to jsoo. Uses `ppx_optcomp_light` with `[@@if oxcaml]`. 25 25 + - **`oxcaml/opam-repository`**: Provides `js_of_ocaml 6.0.1+ox`, 26 26 + `merlin-lib 5.2.1-502+ox`, `ppxlib 0.33.0+ox`. 27 27 + - **`avsm/oxmono`**: Reference oxcaml monorepo with vendored js_of_ocaml (40+ patches). 28 28 + 29 29 + ## Detection Mechanism 30 30 + 31 31 + Following odoc PR #1399's pattern: 32 32 + 33 33 + - **dune level**: `%{ocaml-config:ox}` (available in dune >= 3.21) returns `true` 34 34 + on oxcaml, `false` on OCaml. Used in `(enabled_if ...)` clauses. 35 35 + - **cppo level**: Pass `-D "OXCAML"` via dune's `(preprocess ...)` on oxcaml stanzas. 36 36 + Source files use `#if defined OXCAML` / `#else` / `#endif`. 37 37 + 38 38 + The dune-project lang version needs bumping from 3.20 to 3.21. 39 39 + 40 40 + ## Package Versions 41 41 + 42 42 + | Package | OCaml 5.4 (default) | OxCaml 5.2+ox | 43 43 + |---------|---------------------|---------------| 44 44 + | js_of_ocaml | 6.2.0 | 6.0.1+ox | 45 45 + | merlin-lib | 5.6.1-504 | 5.2.1-502+ox | 46 46 + | ppxlib | 0.36.0 | 0.33.0+ox | 47 47 + | dune | 3.21.0 | 3.21.0+ox | 48 48 + 49 49 + ## Components Requiring Changes 50 50 + 51 51 + ### 1. js_top_worker (lib/) 52 52 + 53 53 + The largest body of work. The compiler-libs APIs differ between 5.4 and 5.2+ox. 54 54 + 55 55 + **API differences requiring cppo guards:** 56 56 + 57 57 + | API | OCaml 5.4 | OxCaml 5.2+ox | 58 58 + |-----|-----------|---------------| 59 59 + | `Language_extension` | Does not exist | `Language_extension.(set_universe_and_enable_all Universe.Beta)` | 60 60 + | `Persistent_env.Persistent_signature.load` | `~unit_name:'a -> 'b option` | `~allow_hidden:bool -> ~unit_name:'a -> 'b option` | 61 61 + | `Ocaml_typing.*` prefix | Not used (merlin-lib uses `Typing_*` directly) | merlin-lib wraps compiler types under `Ocaml_typing.*` | 62 62 + | `Compilation_unit.Name.to_string` | Standard | Used in loader callback | 63 63 + | `Local_store` | Available but not needed | Needed for cell compilation isolation | 64 64 + | `Unit_info.make` | May differ | `~source_file ~for_pack_prefix` | 65 65 + | `Ocaml_typing.Cmi_cache` | Not available | Used for cache clearing | 66 66 + | `Load_path` | Direct | Dual: `Load_path` (compiler) + `Ocaml_utils.Load_path` (merlin) | 67 67 + 68 68 + **Approach**: Files that need conditional compilation (`impl.ml`, `environment.ml`) 69 69 + get cppo preprocessing. The dune file gets duplicate library stanzas: 70 70 + 71 71 + ``` 72 72 + (library 73 73 + (name js_top_worker) 74 74 + (enabled_if (not %{ocaml-config:ox})) 75 75 + (preprocess (per_module 76 76 + ((action (run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file})) 77 77 + impl environment)))) 78 78 + 79 79 + (library 80 80 + (name js_top_worker) 81 81 + (enabled_if %{ocaml-config:ox}) 82 82 + (preprocess (per_module 83 83 + ((action (run %{bin:cppo} -V OCAML:%{ocaml_version} -D "OXCAML" %{input-file})) 84 84 + impl environment)))) 85 85 + ``` 86 86 + 87 87 + ### 2. odoc (subtree) 88 88 + 89 89 + Apply patterns from upstream PR #1399. The key changes are in the loader, model, 90 90 + xref2, document, and search modules where the AST differs for oxcaml-specific 91 91 + types (or_null, float32, unboxed types, mixed blocks, quote/splice). 92 92 + 93 93 + We can either: 94 94 + - Cherry-pick from the PR branch directly 95 95 + - Or subtree-merge the upstream-oxcaml branch 96 96 + 97 97 + ### 3. odoc-scrollycode-extension 98 98 + 99 99 + No compiler-libs usage. Should build unchanged on both compilers once odoc itself 100 100 + builds. 101 101 + 102 102 + ### 4. x-ocaml 103 103 + 104 104 + No compiler-libs usage. The browser-side code is pure js_of_ocaml. Should build 105 105 + once jsoo is available in the switch. 106 106 + 107 107 + ### 5. js_top_worker-web (browser worker) 108 108 + 109 109 + Uses js_of_ocaml-toplevel. The toplevel initialization may differ slightly 110 110 + between jsoo 6.2.0 and 6.0.1+ox. The `Js_of_ocaml_toplevel` module API should 111 111 + be compatible. 112 112 + 113 113 + ## Switch Setup 114 114 + 115 115 + ```bash 116 116 + # Ensure oxcaml switch has required packages 117 117 + opam switch 5.2.0+ox 118 118 + eval $(opam env) 119 119 + opam install js_of_ocaml-toplevel merlin-lib 120 120 + ``` 121 121 + 122 122 + The custom dune fork (with odoc-v3-rules) needs to be pinned in the oxcaml 123 123 + switch too, matching the existing pin in the default switch. 124 124 + 125 125 + ## Testing Strategy 126 126 + 127 127 + Both switches must pass `dune build`. The existing cram tests, node tests, and 128 128 + browser tests should run on both. Some test output may differ (compiler version 129 129 + strings, error message wording) - these get version-specific `.expected` files. 130 130 + 131 131 + ## Risks 132 132 + 133 133 + - **merlin-lib API gap**: 5.6.1-504 vs 5.2.1-502+ox is a large version gap. 134 134 + The `Query_commands`, `Mpipeline`, and `Mconfig` APIs may differ significantly. 135 135 + May need substantial cppo guards in the Merlin integration code. 136 136 + - **jsoo 6.2.0 vs 6.0.1+ox**: Feature/bugfix gap. Any jsoo features used in the 137 137 + monorepo that were added after 6.0.1 will need guards or alternatives. 138 138 + - **dune 3.21 `%{ocaml-config:ox}`**: This is a relatively new feature. May have 139 139 + edge cases with our custom dune fork.

+1 -1

dune-project

··· 1 1 - (lang dune 3.20) 1 1 + (lang dune 3.21) 2 2 (name root) 3 3 4 4 (generate_opam_files true)

+1 -1

dune-workspace

··· 1 1 - (lang dune 3.20) 1 1 + (lang dune 3.21) 2 2 3 3 (env 4 4 (dev

+1 -1

js_top_worker/dune-project

··· 1 1 - (lang dune 3.10) 1 1 + (lang dune 3.21) 2 2 (name js_top_worker) 3 3 (version 0.0.1) 4 4 (using directory-targets 0.1)

+3 -3

js_top_worker/idl/dune

··· 40 40 (name js_top_worker_rpc_def) 41 41 (modules toplevel_api) 42 42 (enabled_if 43 43 - (>= %{ocaml_version} 4.12)) 43 43 + (and (>= %{ocaml_version} 4.12) (not %{ocaml-config:ox}))) 44 44 (package js_top_worker_rpc_def) 45 45 (libraries mime_printer merlin-lib.query_protocol) 46 46 (preprocess ··· 49 49 (rule 50 50 (target toplevel_api_gen.ml.gen) 51 51 (enabled_if 52 52 - (>= %{ocaml_version} 4.12)) 52 52 + (and (>= %{ocaml_version} 4.12) (not %{ocaml-config:ox}))) 53 53 (action 54 54 (with-stderr-to 55 55 %{target} ··· 58 58 (rule 59 59 (alias runtest) 60 60 (enabled_if 61 61 - (>= %{ocaml_version} 4.12)) 61 61 + (and (>= %{ocaml_version} 4.12) (not %{ocaml-config:ox}))) 62 62 (action 63 63 (diff toplevel_api_gen.ml toplevel_api_gen.ml.gen)))

+59 -4

js_top_worker/lib/dune

··· 1 1 - ; Worker library 1 1 + ; Worker library -- upstream OCaml 2 2 3 3 (library 4 4 (public_name js_top_worker) 5 5 + (enabled_if (not %{ocaml-config:ox})) 5 6 (modules toplexer ocamltop impl environment) 6 7 (libraries 7 8 logs ··· 26 27 (per_module 27 28 ((action 28 29 (run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file})) 29 29 - uTop_complete 30 30 - uTop_compat 31 31 - uTop)))) 30 30 + impl)))) 31 31 + 32 32 + ; Worker library -- OxCaml 33 33 + 34 34 + (library 35 35 + (public_name js_top_worker) 36 36 + (enabled_if %{ocaml-config:ox}) 37 37 + (modules toplexer ocamltop impl environment) 38 38 + (libraries 39 39 + logs 40 40 + js_top_worker-rpc 41 41 + rpclib-lwt 42 42 + js_of_ocaml-compiler 43 43 + js_of_ocaml-ppx 44 44 + astring 45 45 + mime_printer 46 46 + compiler-libs.common 47 47 + compiler-libs.toplevel 48 48 + merlin-lib.kernel 49 49 + merlin-lib.utils 50 50 + merlin-lib.query_protocol 51 51 + merlin-lib.query_commands 52 52 + merlin-lib.ocaml_parsing 53 53 + ppxlib 54 54 + ppx_deriving.api) 55 55 + (js_of_ocaml 56 56 + (javascript_files stubs.js)) 57 57 + (preprocess 58 58 + (per_module 59 59 + ((action 60 60 + (run %{bin:cppo} -V OCAML:%{ocaml_version} -D "OXCAML" %{input-file})) 61 61 + impl)))) 32 62 33 63 (ocamllex toplexer) 64 64 + 65 65 + ; Web worker library -- upstream OCaml 34 66 35 67 (library 36 68 (public_name js_top_worker-web) 37 69 (name js_top_worker_web) 70 70 + (enabled_if (not %{ocaml-config:ox})) 71 71 + (modules worker findlibish jslib) 72 72 + (preprocess 73 73 + (pps js_of_ocaml-ppx)) 74 74 + (libraries 75 75 + js_top_worker 76 76 + js_top_worker-rpc.message 77 77 + js_of_ocaml-ppx 78 78 + js_of_ocaml-toplevel 79 79 + js_of_ocaml-lwt 80 80 + logs.browser 81 81 + uri 82 82 + angstrom 83 83 + findlib 84 84 + fpath 85 85 + rpclib.json)) 86 86 + 87 87 + ; Web worker library -- OxCaml 88 88 + 89 89 + (library 90 90 + (public_name js_top_worker-web) 91 91 + (name js_top_worker_web) 92 92 + (enabled_if %{ocaml-config:ox}) 38 93 (modules worker findlibish jslib) 39 94 (preprocess 40 95 (pps js_of_ocaml-ppx))

+55 -1

js_top_worker/lib/impl.ml

··· 279 279 if dcs.dcs_file_prefixes <> [] then begin 280 280 let open Persistent_env.Persistent_signature in 281 281 let old_loader = !load in 282 282 + #if defined OXCAML 283 283 + load := fun ~allow_hidden ~unit_name -> 284 284 + let filename = to_cmi_filename (Compilation_unit.Name.to_string unit_name) in 285 285 + #else 282 286 load := fun ~allow_hidden ~unit_name -> 283 287 let filename = to_cmi_filename unit_name in 288 288 + #endif 284 289 let fs_name = Filename.(concat path filename) in 285 290 if (not (Sys.file_exists fs_name)) 286 291 && List.exists ··· 573 578 dcs.dcs_toplevel_modules 574 579 in 575 580 581 581 + #if defined OXCAML 582 582 + let new_load : 583 583 + 'a 'b. 584 584 + s:string -> 585 585 + to_string:('a -> string) -> 586 586 + old_loader:(allow_hidden:bool -> unit_name:'a -> 'b option) -> 587 587 + allow_hidden:bool -> 588 588 + unit_name:'a -> 589 589 + 'b option = 590 590 + fun ~s ~to_string ~old_loader ~allow_hidden ~unit_name -> 591 591 + let filename = filename_of_module (to_string unit_name) in 592 592 + #else 576 593 let new_load ~s ~old_loader ~allow_hidden ~unit_name = 577 577 - (* Logs.info (fun m -> m "%s Loading: %s" s unit_name); *) 578 594 let filename = filename_of_module unit_name in 595 595 + #endif 579 596 580 597 let fs_name = Filename.(concat path filename) in 581 598 (* Check if it's already been downloaded. This will be the ··· 612 629 else 613 630 let open Persistent_env.Persistent_signature in 614 631 let old_loader = !load in 632 632 + #if defined OXCAML 633 633 + load := new_load ~s:"comp" ~to_string:Compilation_unit.Name.to_string ~old_loader; 634 634 + #else 615 635 load := new_load ~s:"comp" ~old_loader; 636 636 + #endif 616 637 638 638 + #if defined OXCAML 639 639 + let open Persistent_env.Persistent_signature in 640 640 + let old_loader = !load in 641 641 + load := new_load ~s:"merl" ~to_string:Compilation_unit.Name.to_string ~old_loader 642 642 + #else 617 643 let open Ocaml_typing.Persistent_env.Persistent_signature in 618 644 let old_loader = !load in 619 645 load := new_load ~s:"merl" ~old_loader 646 646 + #endif 620 647 in 621 648 Lwt.return () 622 649 ··· 644 671 | [ dcs ] -> add_dynamic_cmis dcs 645 672 | _ -> Lwt.return () 646 673 in 674 674 + #if defined OXCAML 675 675 + Language_extension.(set_universe_and_enable_all Universe.Beta); 676 676 + #endif 647 677 Clflags.no_check_prims := true; 648 678 649 679 requires := init_libs.findlib_requires; ··· 689 719 Persistent_env.report_error Format.err_formatter e; 690 720 let err = Format.asprintf "%a" Persistent_env.report_error e in 691 721 failwith ("Error: " ^ err) 722 722 + #if defined OXCAML 723 723 + | Env.Error e -> 724 724 + Env.report_error ~level:0 Format.err_formatter e; 725 725 + let err = Format.asprintf "%a" (Env.report_error ~level:0) e in 726 726 + failwith ("Error: " ^ err)) 727 727 + #else 692 728 | Env.Error _ as exn -> 693 729 Location.report_exception Format.err_formatter exn; 694 730 let err = Format.asprintf "%a" Location.report_exception exn in 695 731 failwith ("Error: " ^ err)) 732 732 + #endif 696 733 in 697 734 698 735 let* dcs = ··· 986 1023 Printf.fprintf oc "%s" source; 987 1024 close_out oc; 988 1025 (try Sys.remove (prefix ^ ".cmi") with Sys_error _ -> ()); 1026 1026 + #if defined OXCAML 1027 1027 + let unit_info = Unit_info.make ~source_file:filename Impl prefix 1028 1028 + ~for_pack_prefix:Compilation_unit.Prefix.empty in 1029 1029 + #else 989 1030 let unit_info = Unit_info.make ~source_file:filename Impl prefix in 1031 1031 + #endif 990 1032 try 991 1033 let store = Local_store.fresh () in 992 1034 Local_store.with_store store (fun () -> ··· 998 1040 let lexbuf = Lexing.from_string source in 999 1041 let ast = Parse.implementation lexbuf in 1000 1042 Logs.info (fun m -> m "About to type_implementation"); 1043 1043 + #if defined OXCAML 1044 1044 + let _ = Typemod.type_implementation unit_info 1045 1045 + (Compilation_unit.of_string (modname_of_id id)) env ast in 1046 1046 + #else 1001 1047 let _ = Typemod.type_implementation unit_info env ast in 1048 1048 + #endif 1002 1049 let b = Sys.file_exists (prefix ^ ".cmi") in 1003 1050 Environment.remove_failed_cell execution_env id; 1004 1051 Logs.info (fun m -> m "file_exists: %s = %b" (prefix ^ ".cmi") b)); 1005 1052 Ocaml_typing.Cmi_cache.clear () 1006 1053 with 1054 1054 + #if defined OXCAML 1055 1055 + | Env.Error e -> 1056 1056 + Logs.err (fun m -> m "Env.Error: %a" (Env.report_error ~level:0) e); 1057 1057 + Environment.add_failed_cell execution_env id; 1058 1058 + () 1059 1059 + #else 1007 1060 | Env.Error _ as exn -> 1008 1061 Logs.err (fun m -> m "Env.Error: %a" Location.report_exception exn); 1009 1062 Environment.add_failed_cell execution_env id; 1010 1063 () 1064 1064 + #endif 1011 1065 | exn -> 1012 1066 let s = Printexc.to_string exn in 1013 1067 Logs.err (fun m -> m "Error in add_cmi: %s" s);

+12 -2

odoc-scrollycode-extension/src/scrollycode_extension.ml

··· 431 431 setTimeout(function() { 432 432 // Rebuild DOM 433 433 codeBody.innerHTML = ''; 434 434 + var firstNew = null; 434 435 newLines.forEach(function(l, i) { 435 436 var div = document.createElement('div'); 436 436 - div.className = 'sc-line' + (l.focused ? ' sc-focused' : '') + (!oldById[l.id] ? ' sc-entering' : ''); 437 437 + var isNew = !oldById[l.id]; 438 438 + div.className = 'sc-line' + (l.focused ? ' sc-focused' : '') + (isNew ? ' sc-entering' : ''); 437 439 div.dataset.id = l.id; 438 440 div.innerHTML = '<span class="sc-line-number">' + (i + 1) + '</span>' + l.html; 439 439 - if (!oldById[l.id]) { 441 441 + if (isNew) { 440 442 div.style.animationDelay = (i * 25) + 'ms'; 443 443 + if (!firstNew) firstNew = div; 441 444 } 442 445 codeBody.appendChild(div); 443 446 }); 447 447 + 448 448 + // Scroll to first new line, with some context above 449 449 + if (firstNew) { 450 450 + var lineH = firstNew.offsetHeight || 24; 451 451 + var scrollTarget = firstNew.offsetTop - lineH * 2; 452 452 + codeBody.scrollTo({ top: Math.max(0, scrollTarget), behavior: 'smooth' }); 453 453 + } 444 454 445 455 // Update badge and pips 446 456 if (stepBadge) stepBadge.textContent = (index + 1) + ' / ' + steps.length;

+101 -101

odoc-scrollycode-extension/test/warm_parser.mld

··· 10 10 We encode this directly as an OCaml variant. 11 11 12 12 {[ 13 13 - type json = 14 14 - | Null 15 15 - | Bool of bool 16 16 - | Number of float 17 17 - | String of string 18 18 - | Array of json list 19 19 - | Object of (string * json) list 13 13 + (* >type json = 14 14 + (* > | Null 15 15 + (* > | Bool of bool 16 16 + (* > | Number of float 17 17 + (* > | String of string 18 18 + (* > | Array of json list 19 19 + (* > | Object of (string * json) list 20 20 ]} 21 21 } 22 22 {li ··· 35 35 | Array of json list 36 36 | Object of (string * json) list 37 37 38 38 - type scanner = { 39 39 - input : string; 40 40 - mutable pos : int; 41 41 - } 42 42 - 43 43 - let peek s = 44 44 - while s.pos < String.length s.input 45 45 - && s.input.[s.pos] = ' ' do 46 46 - s.pos <- s.pos + 1 47 47 - done; 48 48 - if s.pos < String.length s.input 49 49 - then Some s.input.[s.pos] 50 50 - else None 51 51 - 52 52 - let advance s = s.pos <- s.pos + 1 38 38 + (* >type scanner = { 39 39 + (* > input : string; 40 40 + (* > mutable pos : int; 41 41 + (* >} 42 42 + (* > 43 43 + (* >let peek s = 44 44 + (* > while s.pos < String.length s.input 45 45 + (* > && s.input.[s.pos] = ' ' do 46 46 + (* > s.pos <- s.pos + 1 47 47 + (* > done; 48 48 + (* > if s.pos < String.length s.input 49 49 + (* > then Some s.input.[s.pos] 50 50 + (* > else None 51 51 + (* > 52 52 + (* >let advance s = s.pos <- s.pos + 1 53 53 ]} 54 54 } 55 55 {li ··· 84 84 85 85 let advance s = s.pos <- s.pos + 1 86 86 87 87 - let parse_string s = 88 88 - advance s; 89 89 - let buf = Buffer.create 64 in 90 90 - while s.pos < String.length s.input 91 91 - && s.input.[s.pos] <> '"' do 92 92 - Buffer.add_char buf s.input.[s.pos]; 93 93 - advance s 94 94 - done; 95 95 - advance s; 96 96 - Buffer.contents buf 87 87 + (* >let parse_string s = 88 88 + (* > advance s; 89 89 + (* > let buf = Buffer.create 64 in 90 90 + (* > while s.pos < String.length s.input 91 91 + (* > && s.input.[s.pos] <> '"' do 92 92 + (* > Buffer.add_char buf s.input.[s.pos]; 93 93 + (* > advance s 94 94 + (* > done; 95 95 + (* > advance s; 96 96 + (* > Buffer.contents buf 97 97 ]} 98 98 } 99 99 {li ··· 139 139 advance s; 140 140 Buffer.contents buf 141 141 142 142 - let is_digit c = c >= '0' && c <= '9' 143 143 - 144 144 - let parse_number s = 145 145 - let start = s.pos in 146 146 - while s.pos < String.length s.input 147 147 - && (is_digit s.input.[s.pos] 148 148 - || s.input.[s.pos] = '.' 149 149 - || s.input.[s.pos] = '-') do 150 150 - advance s 151 151 - done; 152 152 - float_of_string 153 153 - (String.sub s.input start (s.pos - start)) 142 142 + (* >let is_digit c = c >= '0' && c <= '9' 143 143 + (* > 144 144 + (* >let parse_number s = 145 145 + (* > let start = s.pos in 146 146 + (* > while s.pos < String.length s.input 147 147 + (* > && (is_digit s.input.[s.pos] 148 148 + (* > || s.input.[s.pos] = '.' 149 149 + (* > || s.input.[s.pos] = '-') do 150 150 + (* > advance s 151 151 + (* > done; 152 152 + (* > float_of_string 153 153 + (* > (String.sub s.input start (s.pos - start)) 154 154 ]} 155 155 } 156 156 {li ··· 210 210 float_of_string 211 211 (String.sub s.input start (s.pos - start)) 212 212 213 213 - let expect s c = 214 214 - match peek s with 215 215 - | Some c' when c' = c -> advance s 216 216 - | _ -> failwith "unexpected character" 217 217 - 218 218 - let rec parse_value s = 219 219 - match peek s with 220 220 - | Some '"' -> String (parse_string s) 221 221 - | Some c when is_digit c || c = '-' -> 222 222 - Number (parse_number s) 223 223 - | Some 't' -> 224 224 - s.pos <- s.pos + 4; Bool true 225 225 - | Some 'f' -> 226 226 - s.pos <- s.pos + 5; Bool false 227 227 - | Some 'n' -> 228 228 - s.pos <- s.pos + 4; Null 229 229 - | Some '[' -> parse_array s 230 230 - | Some '{' -> parse_object s 231 231 - | _ -> failwith "unexpected token" 232 232 - 233 233 - and parse_array s = 234 234 - advance s; 235 235 - let items = ref [] in 236 236 - (match peek s with 237 237 - | Some ']' -> advance s 238 238 - | _ -> 239 239 - items := [parse_value s]; 240 240 - while peek s = Some ',' do 241 241 - advance s; 242 242 - items := parse_value s :: !items 243 243 - done; 244 244 - expect s ']'); 245 245 - Array (List.rev !items) 246 246 - 247 247 - and parse_object s = 248 248 - advance s; 249 249 - let pairs = ref [] in 250 250 - (match peek s with 251 251 - | Some '}' -> advance s 252 252 - | _ -> 253 253 - let key = parse_string s in 254 254 - expect s ':'; 255 255 - let value = parse_value s in 256 256 - pairs := [(key, value)]; 257 257 - while peek s = Some ',' do 258 258 - advance s; 259 259 - let k = parse_string s in 260 260 - expect s ':'; 261 261 - let v = parse_value s in 262 262 - pairs := (k, v) :: !pairs 263 263 - done; 264 264 - expect s '}'); 265 265 - Object (List.rev !pairs) 213 213 + (* >let expect s c = 214 214 + (* > match peek s with 215 215 + (* > | Some c' when c' = c -> advance s 216 216 + (* > | _ -> failwith "unexpected character" 217 217 + (* > 218 218 + (* >let rec parse_value s = 219 219 + (* > match peek s with 220 220 + (* > | Some '"' -> String (parse_string s) 221 221 + (* > | Some c when is_digit c || c = '-' -> 222 222 + (* > Number (parse_number s) 223 223 + (* > | Some 't' -> 224 224 + (* > s.pos <- s.pos + 4; Bool true 225 225 + (* > | Some 'f' -> 226 226 + (* > s.pos <- s.pos + 5; Bool false 227 227 + (* > | Some 'n' -> 228 228 + (* > s.pos <- s.pos + 4; Null 229 229 + (* > | Some '[' -> parse_array s 230 230 + (* > | Some '{' -> parse_object s 231 231 + (* > | _ -> failwith "unexpected token" 232 232 + (* > 233 233 + (* >and parse_array s = 234 234 + (* > advance s; 235 235 + (* > let items = ref [] in 236 236 + (* > (match peek s with 237 237 + (* > | Some ']' -> advance s 238 238 + (* > | _ -> 239 239 + (* > items := [parse_value s]; 240 240 + (* > while peek s = Some ',' do 241 241 + (* > advance s; 242 242 + (* > items := parse_value s :: !items 243 243 + (* > done; 244 244 + (* > expect s ']'); 245 245 + (* > Array (List.rev !items) 246 246 + (* > 247 247 + (* >and parse_object s = 248 248 + (* > advance s; 249 249 + (* > let pairs = ref [] in 250 250 + (* > (match peek s with 251 251 + (* > | Some '}' -> advance s 252 252 + (* > | _ -> 253 253 + (* > let key = parse_string s in 254 254 + (* > expect s ':'; 255 255 + (* > let value = parse_value s in 256 256 + (* > pairs := [(key, value)]; 257 257 + (* > while peek s = Some ',' do 258 258 + (* > advance s; 259 259 + (* > let k = parse_string s in 260 260 + (* > expect s ':'; 261 261 + (* > let v = parse_value s in 262 262 + (* > pairs := (k, v) :: !pairs 263 263 + (* > done; 264 264 + (* > expect s '}'); 265 265 + (* > Object (List.rev !pairs) 266 266 ]} 267 267 } 268 268 {li ··· 375 375 expect s '}'); 376 376 Object (List.rev !pairs) 377 377 378 378 - let parse input = 379 379 - let s = { input; pos = 0 } in 380 380 - let v = parse_value s in 381 381 - v 378 378 + (* >let parse input = 379 379 + (* > let s = { input; pos = 0 } in 380 380 + (* > let v = parse_value s in 381 381 + (* > v 382 382 ]} 383 383 } 384 384 }

+1 -1

odoc/dune-project

··· 1 1 - (lang dune 3.18) 1 1 + (lang dune 3.21) 2 2 3 3 (using dune_site 0.1) 4 4

+4 -3

odoc/sherlodoc/index/load_doc.ml

··· 116 116 let typ = searchable_type_of_constructor args res in 117 117 let typ = Db_writer.type_of_odoc ~db typ in 118 118 Entry.Kind.Exception typ 119 119 - | Field { mutable_ = _; parent_type; type_ } -> 119 119 + | Field { mutable_ = _; parent_type; type_ } 120 120 + | UnboxedField { mutable_ = _; parent_type; type_ } -> 120 121 let typ = searchable_type_of_record parent_type type_ in 121 122 let typ = Db_writer.type_of_odoc ~db typ in 122 123 Entry.Kind.Field typ ··· 149 150 | `Parameter _ -> `ignore (* redundant with indexed signature *) 150 151 | ( `InstanceVariable _ | `Method _ | `Field _ | `Result _ | `Label _ | `Type _ 151 152 | `Exception _ | `Class _ | `ClassType _ | `Value _ | `Constructor _ | `Extension _ 152 152 - | `ExtensionDecl _ | `Module _ ) as x -> 153 153 + | `ExtensionDecl _ | `Module _ | `UnboxedField _ ) as x -> 153 154 let parent = Identifier.label_parent { id with iv = x } in 154 155 categorize (parent :> Identifier.Any.t) 155 156 | `AssetFile _ | `SourceLocationMod _ | `SourceLocation _ | `SourcePage _ ··· 173 174 ~favoured_prefixes 174 175 ~pkg 175 176 ~cat 176 176 - (Odoc_index.Entry.{ id; doc; kind } as entry) 177 177 + (Odoc_index.Entry.{ id; doc; kind; source_loc = _ } as entry) 177 178 = 178 179 let module Sherlodoc_entry = Entry in 179 180 let open Odoc_search in

odoc/sherlodoc/test/cram/empty.t/dune odoc/sherlodoc/test/cram/empty_project.t/dune

odoc/sherlodoc/test/cram/empty.t/dune-project odoc/sherlodoc/test/cram/empty_project.t/dune-project

odoc/sherlodoc/test/cram/empty.t/foo.ml odoc/sherlodoc/test/cram/empty_project.t/foo.ml

odoc/sherlodoc/test/cram/empty.t/run.t odoc/sherlodoc/test/cram/empty_project.t/run.t

odoc/sherlodoc/test/cram_ancient/empty.t odoc/sherlodoc/test/cram_ancient/empty_project.t

+2

odoc/src/document/ML.mli

··· 30 30 val type_expr : ?needs_parentheses:bool -> Lang.TypeExpr.t -> Codefmt.t 31 31 32 32 val record : Lang.TypeDecl.Field.t list -> Types.DocumentedSrc.one list 33 33 + 34 34 + val unboxed_record : Lang.TypeDecl.UnboxedField.t list -> Types.DocumentedSrc.one list

+2

odoc/src/document/comment.ml

··· 80 80 | `PolyConstructor (r, s) -> 81 81 render_resolved (r :> t) ^ ".`" ^ ConstructorName.to_string s 82 82 | `Field (r, s) -> render_resolved (r :> t) ^ "." ^ FieldName.to_string s 83 83 + | `UnboxedField (r, s) -> render_resolved (r :> t) ^ "." ^ UnboxedFieldName.to_string s 83 84 | `Extension (r, s) -> 84 85 render_resolved (r :> t) ^ "." ^ ExtensionName.to_string s 85 86 | `ExtensionDecl (r, _, s) -> ··· 124 125 | `Constructor (p, f) -> 125 126 render_unresolved (p :> t) ^ "." ^ ConstructorName.to_string f 126 127 | `Field (p, f) -> render_unresolved (p :> t) ^ "." ^ FieldName.to_string f 128 128 + | `UnboxedField (p, f) -> render_unresolved (p :> t) ^ "." ^ UnboxedFieldName.to_string f 127 129 | `Extension (p, f) -> 128 130 render_unresolved (p :> t) ^ "." ^ ExtensionName.to_string f 129 131 | `ExtensionDecl (p, f) ->

+88 -21

odoc/src/document/generator.ml

··· 298 298 299 299 let source id syntax_info infos source_code = 300 300 let url = path id in 301 301 - let mapper (info, loc) = 302 302 - match info_of_info info with Some x -> Some (x, loc) | None -> None 301 301 + let mapper (info, (loc : Lang.Source_info.location_in_file)) = 302 302 + match info_of_info info with Some x -> Some (x, (loc.loc_start.pos_cnum, loc.loc_end.pos_cnum)) | None -> None 303 303 in 304 304 let infos = Odoc_utils.List.filter_map mapper infos in 305 305 let syntax_info = ··· 419 419 in 420 420 Syntax.Type.handle_constructor_params path (O.box_hv params) 421 421 422 422 + and tuple ?(needs_parentheses = false) ~boxed lst = 423 423 + let opt_label = function 424 424 + None -> O.noop 425 425 + | Some lbl -> O.txt lbl ++ O.txt ":" ++ O.cut 426 426 + in 427 427 + let res = 428 428 + O.box_hv_no_indent 429 429 + (O.list lst ~sep:Syntax.Type.Tuple.element_separator 430 430 + ~f:(fun (lbl, typ) -> 431 431 + opt_label lbl ++ type_expr ~needs_parentheses:true typ)) 432 432 + in 433 433 + let lparen = if boxed then "(" else "#(" in 434 434 + if Syntax.Type.Tuple.always_parenthesize || needs_parentheses || not boxed then 435 435 + enclose ~l:lparen res ~r:")" 436 436 + else res 437 437 + 422 438 and type_expr ?(needs_parentheses = false) (t : Odoc_model.Lang.TypeExpr.t) 423 439 = 424 440 let enclose_parens_if_needed res = ··· 460 476 ++ O.sp ++ type_expr dst 461 477 in 462 478 if not needs_parentheses then res else enclose ~l:"(" res ~r:")" 463 463 - | Tuple lst -> 464 464 - let res = 465 465 - O.box_hv_no_indent 466 466 - (O.list lst ~sep:Syntax.Type.Tuple.element_separator 467 467 - ~f:(fun (lbl, ty) -> 468 468 - match lbl with 469 469 - | None -> type_expr ~needs_parentheses:true ty 470 470 - | Some lbl -> 471 471 - tag "label" (O.txt lbl) 472 472 - ++ O.txt ":" ++ O.cut 473 473 - ++ type_expr ~needs_parentheses:true ty)) 474 474 - in 475 475 - if Syntax.Type.Tuple.always_parenthesize || needs_parentheses then 476 476 - enclose ~l:"(" res ~r:")" 477 477 - else res 479 479 + | Tuple lst -> tuple ~needs_parentheses ~boxed:true lst 480 480 + | Unboxed_tuple lst -> tuple ~needs_parentheses ~boxed:false lst 478 481 | Constr (path, args) -> 479 482 let link = Link.from_path (path :> Paths.Path.t) in 480 483 format_type_path ~delim:`parens args link ··· 485 488 (Link.from_path (path :> Paths.Path.t)) 486 489 | Poly (polyvars, t) -> 487 490 O.txt ("'" ^ String.concat ~sep:" '" polyvars ^ ". ") ++ type_expr t 491 491 + | Quote t -> 492 492 + O.span (O.txt "<[ " ++ O.box_hv (type_expr t) ++ O.txt " ]>") 493 493 + | Splice t -> 494 494 + O.span (O.txt "$" ++ type_expr ~needs_parentheses:true t) 488 495 | Package pkg -> 489 496 enclose ~l:"(" ~r:")" 490 497 (O.keyword "module" ++ O.txt " " ··· 524 531 525 532 val record : Lang.TypeDecl.Field.t list -> DocumentedSrc.one list 526 533 534 534 + val unboxed_record : Lang.TypeDecl.UnboxedField.t list -> DocumentedSrc.one list 535 535 + 527 536 val exn : Lang.Exception.t -> Item.t 528 537 529 538 val format_params : ··· 575 584 in 576 585 content 577 586 587 587 + let unboxed_record fields = 588 588 + let field mutable_ id typ = 589 589 + let url = Url.from_identifier ~stop_before:true id in 590 590 + let name = Paths.Identifier.name id in 591 591 + let attrs = 592 592 + [ "def"; "record"; Url.Anchor.string_of_kind url.kind ] 593 593 + in 594 594 + let cell = 595 595 + (* O.td ~a:[ O.a_class ["def"; kind ] ] 596 596 + * [O.a ~a:[O.a_href ("#" ^ anchor); O.a_class ["anchor"]] [] 597 597 + * ; *) 598 598 + O.code 599 599 + ((if mutable_ then O.keyword "mutable" ++ O.txt " " else O.noop) 600 600 + ++ O.txt name 601 601 + ++ O.txt Syntax.Type.annotation_separator 602 602 + ++ type_expr typ 603 603 + ++ O.txt Syntax.Type.Record.field_separator) 604 604 + (* ] *) 605 605 + in 606 606 + (url, attrs, cell) 607 607 + in 608 608 + let rows = 609 609 + fields 610 610 + |> List.map (fun fld -> 611 611 + let open Odoc_model.Lang.TypeDecl.UnboxedField in 612 612 + let url, attrs, code = 613 613 + field fld.mutable_ (fld.id :> Paths.Identifier.t) fld.type_ 614 614 + in 615 615 + let anchor = Some url in 616 616 + let doc = fld.doc.elements in 617 617 + let rhs = Comment.to_ir doc in 618 618 + let doc = if not (Comment.has_doc doc) then [] else rhs in 619 619 + let markers = Syntax.Comment.markers in 620 620 + DocumentedSrc.Documented { anchor; attrs; code; doc; markers }) 621 621 + in 622 622 + let content = 623 623 + O.documentedSrc (O.txt "#{") @ rows @ O.documentedSrc (O.txt "}") 624 624 + in 625 625 + content 626 626 + 578 627 let constructor : 579 628 Paths.Identifier.t -> 580 629 Odoc_model.Lang.TypeDecl.Constructor.argument -> ··· 895 944 | Extensible -> O.documentedSrc (O.txt "..") 896 945 | Variant cstrs -> variant cstrs 897 946 | Record fields -> record fields 947 947 + | Record_unboxed_product fields -> unboxed_record fields 898 948 in 899 949 if List.length content > 0 then 900 950 O.documentedSrc ··· 1426 1476 match t with 1427 1477 | Path { p_expansion = None; _ } 1428 1478 | TypeOf { t_expansion = None; _ } 1429 1429 - | With { w_expansion = None; _ } -> 1479 1479 + | With { w_expansion = None; _ } 1480 1480 + | Strengthen { s_expansion = None; _ } -> 1430 1481 None 1431 1482 | Path { p_expansion = Some e; _ } 1432 1483 | TypeOf { t_expansion = Some e; _ } 1433 1433 - | With { w_expansion = Some e; _ } -> 1484 1484 + | With { w_expansion = Some e; _ } 1485 1485 + | Strengthen { s_expansion = Some e; _ } -> 1434 1486 Some e 1435 1487 | Signature sg -> Some (Signature sg) 1436 1488 | Functor (f_parameter, e) -> ( ··· 1569 1621 | TypeOf (ModPath m, _) | TypeOf (StructInclude m, _) -> 1570 1622 Paths.Path.(is_hidden (m :> t)) 1571 1623 | Signature _ -> false 1624 1624 + | Strengthen (expr, p, _) -> 1625 1625 + umty_hidden expr || Paths.Path.(is_hidden (p :> t)) 1572 1626 1573 1627 and mty_hidden : Odoc_model.Lang.ModuleType.expr -> bool = function 1574 1628 | Path { p_path = mty_path; _ } -> Paths.Path.(is_hidden (mty_path :> t)) ··· 1584 1638 ~sep:(O.cut ++ O.txt " " ++ O.keyword "and" ++ O.txt " ") 1585 1639 ~f:(fun x -> O.span (substitution x)) 1586 1640 subs 1641 1641 + 1642 1642 + and mty_strengthen expr path = 1643 1643 + umty expr ++ O.sp ++ O.keyword "with" ++ O.txt " " 1644 1644 + ++ Link.from_path (path :> Paths.Path.t) 1587 1645 1588 1646 and mty_typeof t_desc = 1589 1647 match t_desc with ··· 1604 1662 | Signature _ -> true 1605 1663 | With (_, expr) -> is_elidable_with_u expr 1606 1664 | TypeOf _ -> false 1665 1665 + | Strengthen (expr,_,_) -> is_elidable_with_u expr 1607 1666 1608 1667 and umty : Odoc_model.Lang.ModuleType.U.expr -> text = 1609 1668 fun m -> ··· 1615 1674 Syntax.Mod.open_tag ++ O.txt " ... " ++ Syntax.Mod.close_tag 1616 1675 | With (subs, expr) -> mty_with subs expr 1617 1676 | TypeOf (t_desc, _) -> mty_typeof t_desc 1677 1677 + | Strengthen (expr, _, _) when is_elidable_with_u expr -> 1678 1678 + Syntax.Mod.open_tag ++ O.txt " ... " ++ Syntax.Mod.close_tag 1679 1679 + | Strengthen (expr, p, _) -> mty_strengthen expr (p :> Paths.Path.t) 1618 1680 1619 1681 and mty : Odoc_model.Lang.ModuleType.expr -> text = 1620 1682 fun m -> ··· 1653 1715 | TypeOf { t_desc; _ } -> mty_typeof t_desc 1654 1716 | Signature _ -> 1655 1717 Syntax.Mod.open_tag ++ O.txt " ... " ++ Syntax.Mod.close_tag 1656 1656 - 1718 1718 + | Strengthen { s_expr; _ } when is_elidable_with_u s_expr -> 1719 1719 + Syntax.Mod.open_tag ++ O.txt " ... " ++ Syntax.Mod.close_tag 1720 1720 + | Strengthen { s_expr; s_path; _ } -> 1721 1721 + O.box_hv @@ mty_strengthen s_expr (s_path :> Paths.Path.t) 1657 1722 and mty_in_decl : 1658 1723 Paths.Identifier.Signature.t -> Odoc_model.Lang.ModuleType.expr -> text 1659 1724 = 1660 1725 fun base -> function 1661 1661 - | (Path _ | Signature _ | With _ | TypeOf _) as m -> 1726 1726 + | (Path _ | Signature _ | With _ | TypeOf _ | Strengthen _) as m -> 1662 1727 O.txt Syntax.Type.annotation_separator ++ O.cut ++ mty m 1663 1728 | Functor _ as m when not Syntax.Mod.functor_contraction -> 1664 1729 O.txt Syntax.Type.annotation_separator ++ O.cut ++ mty m ··· 1852 1917 let type_expr = type_expr 1853 1918 1854 1919 let record = record 1920 1920 + 1921 1921 + let unboxed_record = unboxed_record 1855 1922 end

+2

odoc/src/document/generator_signatures.ml

··· 114 114 val type_expr : ?needs_parentheses:bool -> Lang.TypeExpr.t -> text 115 115 116 116 val record : Lang.TypeDecl.Field.t list -> DocumentedSrc.one list 117 117 + 118 118 + val unboxed_record : Lang.TypeDecl.UnboxedField.t list -> DocumentedSrc.one list 117 119 end

+2 -1

odoc/src/document/targets.ml

··· 49 49 sub @ module_type_expr e 50 50 | Path { p_expansion = e_opt; _ } 51 51 | With { w_expansion = e_opt; _ } 52 52 - | TypeOf { t_expansion = e_opt; _ } -> 52 52 + | TypeOf { t_expansion = e_opt; _ } 53 53 + | Strengthen { s_expansion = e_opt; _ } -> 53 54 opt_expansion e_opt 54 55 55 56 and module_ (t : Odoc_model.Lang.Module.t) =

+7

odoc/src/document/url.ml

··· 231 231 | `Val 232 232 | `Constructor 233 233 | `Field 234 234 + | `UnboxedField 234 235 | `SourceAnchor ] 235 236 236 237 let string_of_kind : kind -> string = function ··· 244 245 | `Val -> "val" 245 246 | `Constructor -> "constructor" 246 247 | `Field -> "field" 248 248 + | `UnboxedField -> "unboxed-field" 247 249 | `SourceAnchor -> "source-anchor" 248 250 249 251 let pp_kind fmt kind = Format.fprintf fmt "%s" (string_of_kind kind) ··· 357 359 let page = from_identifier (parent :> Identifier.t) in 358 360 let kind = `Field in 359 361 let suffix = FieldName.to_string name in 362 362 + add_suffix ~kind page suffix 363 363 + | { iv = `UnboxedField (parent, name); _ } -> 364 364 + let page = from_identifier (parent :> Identifier.t) in 365 365 + let kind = `UnboxedField in 366 366 + let suffix = UnboxedFieldName.to_string name in 360 367 add_suffix ~kind page suffix 361 368 | { iv = `Label (parent, anchor); _ } -> ( 362 369 let str_name = LabelName.to_string anchor in

+1

odoc/src/document/url.mli

··· 68 68 | `Val 69 69 | `Constructor 70 70 | `Field 71 71 + | `UnboxedField 71 72 | `SourceAnchor ] 72 73 73 74 val pp_kind : Format.formatter -> kind -> unit

+4 -2

odoc/src/index/entry.ml

··· 56 56 | ModuleType of module_entry 57 57 | Constructor of constructor_entry 58 58 | Field of field_entry 59 59 + | UnboxedField of field_entry 59 60 | Page of Odoc_model.Frontmatter.t 60 61 | Impl 61 62 | Dir ··· 64 65 id : Odoc_model.Paths.Identifier.Any.t; 65 66 doc : Odoc_model.Comment.elements; 66 67 kind : kind; 68 68 + source_loc : Odoc_model.Lang.Source_loc_jane.t option; 67 69 } 68 70 69 69 - let entry ~id ~doc ~kind = 71 71 + let entry ~id ~doc ~kind ~source_loc = 70 72 let id = (id :> Odoc_model.Paths.Identifier.Any.t) in 71 71 - { id; kind; doc } 73 73 + { id; kind; doc; source_loc }

+3

odoc/src/index/entry.mli

··· 54 54 | ModuleType of module_entry 55 55 | Constructor of constructor_entry 56 56 | Field of field_entry 57 57 + | UnboxedField of field_entry 57 58 | Page of Odoc_model.Frontmatter.t 58 59 | Impl 59 60 | Dir ··· 62 63 id : Odoc_model.Paths.Identifier.Any.t; 63 64 doc : Odoc_model.Comment.elements; 64 65 kind : kind; 66 66 + source_loc : Odoc_model.Lang.Source_loc_jane.t option; 65 67 } 66 68 67 69 val entry : 68 70 id:[< Odoc_model.Paths.Identifier.Any.t_pv ] Odoc_model.Paths.Identifier.id -> 69 71 doc:Odoc_model.Comment.elements -> 70 72 kind:kind -> 73 73 + source_loc:Odoc_model.Lang.Source_loc_jane.t option -> 71 74 t

+45 -17

odoc/src/index/skeleton.ml

··· 14 14 match u.content with Pack _ -> [] | Module m -> m.doc.elements 15 15 in 16 16 Entry.entry ~id:u.id ~doc ~kind:(Module { has_expansion }) 17 17 + ~source_loc:u.source_loc_jane 17 18 18 19 let of_module (m : Module.t) = 19 20 let has_expansion = 20 21 match m.type_ with Alias (_, None) -> false | _ -> true 21 22 in 22 23 Entry.entry ~id:m.id ~doc:m.doc.elements ~kind:(Module { has_expansion }) 24 24 + ~source_loc:m.source_loc_jane 23 25 24 26 let of_module_type (mt : ModuleType.t) = 25 27 let has_expansion = ··· 35 37 | _ -> true 36 38 in 37 39 Entry.entry ~id:mt.id ~doc:mt.doc.elements 38 38 - ~kind:(ModuleType { has_expansion }) 40 40 + ~kind:(ModuleType { has_expansion }) ~source_loc:mt.source_loc_jane 39 41 40 42 let of_type_decl (td : TypeDecl.t) = 41 43 let kind = ··· 47 49 } 48 50 in 49 51 Entry.entry ~id:td.id ~doc:td.doc.elements ~kind 52 52 + ~source_loc:td.source_loc_jane 50 53 51 54 let varify_params = 52 55 List.mapi (fun i param -> ··· 54 57 | Var name -> TypeExpr.Var name 55 58 | Any -> Var (Printf.sprintf "tv_%i" i)) 56 59 57 57 - let of_constructor id_parent params (c : TypeDecl.Constructor.t) = 60 60 + let of_constructor id_parent params source_loc (c : TypeDecl.Constructor.t) = 58 61 let args = c.args in 59 62 let res = 60 63 match c.res with ··· 67 70 params ) 68 71 in 69 72 let kind = Entry.Constructor { args; res } in 70 70 - Entry.entry ~id:c.id ~doc:c.doc.elements ~kind 73 73 + Entry.entry ~id:c.id ~doc:c.doc.elements ~kind ~source_loc 71 74 72 72 - let of_field id_parent params (field : TypeDecl.Field.t) = 75 75 + let of_field id_parent params source_loc (field : TypeDecl.Field.t) = 73 76 let params = varify_params params in 74 77 let parent_type = 75 78 TypeExpr.Constr ··· 81 84 Entry.Field 82 85 { mutable_ = field.mutable_; type_ = field.type_; parent_type } 83 86 in 84 84 - Entry.entry ~id:field.id ~doc:field.doc.elements ~kind 87 87 + Entry.entry ~id:field.id ~doc:field.doc.elements ~kind ~source_loc 88 88 + 89 89 + let of_unboxed_field id_parent params source_loc (field : TypeDecl.UnboxedField.t) = 90 90 + let params = varify_params params in 91 91 + let parent_type = 92 92 + TypeExpr.Constr 93 93 + ( `Identifier 94 94 + ((id_parent :> Odoc_model.Paths.Identifier.Path.Type.t), false), 95 95 + params ) 96 96 + in 97 97 + let kind = 98 98 + Entry.UnboxedField { mutable_ = field.mutable_; type_ = field.type_; parent_type } 99 99 + in 100 100 + Entry.entry ~id:field.id ~doc:field.doc.elements ~kind ~source_loc 85 101 86 102 let of_exception (exc : Exception.t) = 87 103 let res = ··· 94 110 in 95 111 let kind = Entry.Exception { args = exc.args; res } in 96 112 Entry.entry ~id:exc.id ~doc:exc.doc.elements ~kind 113 113 + ~source_loc:exc.source_loc_jane 97 114 98 115 let of_value (v : Value.t) = 99 116 let kind = Entry.Value { value = v.value; type_ = v.type_ } in 100 100 - Entry.entry ~id:v.id ~doc:v.doc.elements ~kind 117 117 + Entry.entry ~id:v.id ~doc:v.doc.elements ~kind ~source_loc:v.source_loc_jane 101 118 102 119 let of_extension_constructor type_path params (v : Extension.Constructor.t) = 103 120 let res = ··· 108 125 TypeExpr.Constr (type_path, params) 109 126 in 110 127 let kind = Entry.ExtensionConstructor { args = v.args; res } in 111 111 - Entry.entry ~id:v.id ~doc:v.doc.elements ~kind 128 128 + Entry.entry ~id:v.id ~doc:v.doc.elements ~kind ~source_loc:None 112 129 113 130 let of_class (cl : Class.t) = 114 131 let kind = Entry.Class { virtual_ = cl.virtual_; params = cl.params } in 115 132 Entry.entry ~id:cl.id ~doc:cl.doc.elements ~kind 133 133 + ~source_loc:cl.source_loc_jane 116 134 117 135 let of_class_type (ct : ClassType.t) = 118 136 let kind = 119 137 Entry.Class_type { virtual_ = ct.virtual_; params = ct.params } 120 138 in 121 139 Entry.entry ~id:ct.id ~doc:ct.doc.elements ~kind 140 140 + ~source_loc:ct.source_loc_jane 122 141 123 142 let of_method (m : Method.t) = 124 143 let kind = 125 144 Entry.Method 126 145 { virtual_ = m.virtual_; private_ = m.private_; type_ = m.type_ } 127 146 in 128 128 - Entry.entry ~id:m.id ~doc:m.doc.elements ~kind 147 147 + Entry.entry ~id:m.id ~doc:m.doc.elements ~kind ~source_loc:None 129 148 130 130 - let of_docs id doc = Entry.entry ~id ~doc:doc.elements ~kind:Doc 149 149 + let of_docs id source_loc doc = 150 150 + Entry.entry ~id ~doc:doc.elements ~kind:Doc ~source_loc 131 151 end 132 152 133 153 let if_non_hidden id f = ··· 215 235 match td.representation with 216 236 | None -> [] 217 237 | Some (Variant cl) -> 218 218 - List.concat_map (constructor td.id td.equation.params) cl 219 219 - | Some (Record fl) -> List.concat_map (field td.id td.equation.params) fl 238 238 + List.concat_map (constructor td.id td.equation.params td.source_loc_jane) cl 239 239 + | Some (Record fl) -> List.concat_map (field td.id td.equation.params td.source_loc_jane) fl 240 240 + | Some (Record_unboxed_product fl) -> 241 241 + List.concat_map (unboxed_field td.id td.equation.params td.source_loc_jane) fl 220 242 | Some Extensible -> [] 221 243 in 222 244 [ { Tree.node = entry; children } ] 223 245 224 224 - and constructor type_id params c = 225 225 - let entry = Entry.of_constructor type_id params c in 246 246 + and constructor type_id params source_loc c = 247 247 + let entry = Entry.of_constructor type_id params source_loc c in 248 248 + [ Tree.leaf entry ] 249 249 + 250 250 + and field type_id params source_loc f = 251 251 + let entry = Entry.of_field type_id params source_loc f in 226 252 [ Tree.leaf entry ] 227 253 228 228 - and field type_id params f = 229 229 - let entry = Entry.of_field type_id params f in 254 254 + and unboxed_field type_id params source_loc f = 255 255 + let entry = Entry.of_unboxed_field type_id params source_loc f in 230 256 [ Tree.leaf entry ] 231 257 232 258 and exception_ exc = ··· 263 289 match d with 264 290 | `Stop -> [] 265 291 | `Docs d -> 266 266 - let entry = Entry.of_docs id d in 292 292 + let entry = Entry.of_docs id None d in 267 293 [ Tree.leaf entry ] 268 294 269 295 and simple_expansion id s_e = ··· 282 308 | With { w_expansion = Some sg; _ } -> simple_expansion id sg 283 309 | TypeOf { t_expansion = Some sg; _ } -> simple_expansion id sg 284 310 | Path { p_expansion = Some sg; _ } -> simple_expansion id sg 311 311 + | Strengthen { s_expansion = Some sg; _ } -> simple_expansion id sg 285 312 | Path { p_expansion = None; _ } -> [] 286 313 | With { w_expansion = None; _ } -> [] 287 314 | TypeOf { t_expansion = None; _ } -> [] 315 315 + | Strengthen { s_expansion = None; _ } -> [] 288 316 289 317 and class_signature id ct_expr = 290 318 let items = filter_class_signature ct_expr.items in ··· 310 338 let from_page (p : Page.t) = 311 339 match p with 312 340 | { name; content; _ } -> 313 313 - let entry = Entry.of_docs name content in 341 341 + let entry = Entry.of_docs name None content in 314 342 Tree.leaf entry

+4 -4

odoc/src/index/skeleton_of.ml

··· 43 43 let kind = Entry.Page page.Lang.Page.frontmatter in 44 44 let doc = page.content.elements in 45 45 let id = page.name in 46 46 - Entry.entry ~kind ~doc ~id 46 46 + Entry.entry ~kind ~doc ~id ~source_loc:None 47 47 in 48 48 let entry_of_impl id = 49 49 let kind = Entry.Impl in 50 50 - Entry.entry ~kind ~doc:[] ~id 50 50 + Entry.entry ~kind ~doc:[] ~id ~source_loc:None 51 51 in 52 52 let children_order, index = 53 53 match In_progress.index dir with ··· 60 60 match In_progress.root_dir dir with 61 61 | Some id -> 62 62 let kind = Entry.Dir in 63 63 - Entry.entry ~kind ~doc:[] ~id 63 63 + Entry.entry ~kind ~doc:[] ~id ~source_loc:None 64 64 | None -> 65 65 let id = 66 66 (* root dir must have an index page *) 67 67 Id.Mk.leaf_page (None, Names.PageName.make_std "index") 68 68 in 69 69 let kind = Entry.Dir in 70 70 - Entry.entry ~kind ~doc:[] ~id 70 70 + Entry.entry ~kind ~doc:[] ~id ~source_loc:None 71 71 in 72 72 (None, entry) 73 73 in

+150 -23

odoc/src/loader/cmi.ml

··· 60 60 let concr_mem = Types.Meths.mem 61 61 let csig_concr x = x.Types.csig_meths 62 62 let eq_type = Types.eq_type 63 63 - #if OCAML_VERSION >= (5,4,0) 63 63 + #if OCAML_VERSION >= (5,4,0) || defined OXCAML 64 64 let invisible_wrap ty = newty2 ~level:Btype.generic_level (Ttuple [None,ty]) 65 65 #else 66 66 let invisible_wrap ty = newty2 ~level:Btype.generic_level (Ttuple [ty]) ··· 86 86 (** Create a new node pointing to [ty] that is printed in the same way as 87 87 [ty]*) 88 88 let invisible_wrap ty = 89 89 - Btype.(newty2 generic_level (Ttuple [ty])) 89 89 + Btype.(newty2 generic_level (Ttuple [None, ty])) 90 90 #endif 91 91 end 92 92 ··· 111 111 else match String.get lbl 0 with 112 112 | '?' -> Some (Optional (String.sub lbl 1 (String.length lbl - 1))) 113 113 | _ -> Some (Label lbl) 114 114 + #elif defined OXCAML 115 115 + match lbl with 116 116 + | Types.Nolabel -> None 117 117 + | Types.Labelled s -> Some (Label s) 118 118 + | Types.Optional s -> Some (Optional s) 119 119 + | Types.Position s -> (* FIXME: do better? *) Some (Label s) 114 120 #else 115 121 match lbl with 116 122 | Asttypes.Nolabel -> None ··· 161 167 with Not_found -> 162 168 let base = 163 169 match ty.desc with 170 170 + #if defined OXCAML 171 171 + | Tvar { name = Some name; _ } | Tunivar { name = Some name; _ } -> name 172 172 + #else 164 173 | Tvar (Some name) | Tunivar (Some name) -> name 174 174 + #endif 165 175 | _ -> next_name () 166 176 in 167 177 let name = fresh_name base in ··· 191 201 if not (List.memq px !aliased) then begin 192 202 aliased := px :: !aliased; 193 203 match px.desc with 194 194 - | Tvar name | Tunivar name -> reserve_name name 204 204 + #if defined OXCAML 205 205 + | Tvar { name; _ } | Tunivar { name; _ } -> 206 206 + #else 207 207 + | Tvar name | Tunivar name -> 208 208 + #endif 209 209 + reserve_name name 195 210 | _ -> () 196 211 end 197 212 ··· 234 249 if List.memq px visited && aliasable ty then add_alias_proxy px else 235 250 let visited = px :: visited in 236 251 match Compat.get_desc ty with 237 237 - | Tvar name -> reserve_name name 252 252 + #if defined OXCAML 253 253 + | Tvar { name; _ } | Tunivar { name; _ } -> 254 254 + #else 255 255 + | Tvar name | Tunivar name -> 256 256 + #endif 257 257 + reserve_name name 238 258 | Tarrow(_, ty1, ty2, _) -> 239 259 loop visited ty1; 240 260 loop visited ty2 241 241 - #if OCAML_VERSION >= (5,4,0) 261 261 + #if OCAML_VERSION >= (5,4,0) || defined OXCAML 242 262 | Ttuple tyl -> List.iter (fun (_lbl,x) -> loop visited x) tyl 243 263 #else 244 264 | Ttuple tyl -> List.iter (loop visited) tyl 265 265 + #endif 266 266 + #if defined OXCAML 267 267 + | Tunboxed_tuple tyl -> List.iter (fun (_, ty) -> loop visited ty) tyl 245 268 #endif 246 269 | Tconstr(_, tyl, _) -> 247 270 List.iter (loop visited) tyl ··· 279 302 | Tpoly (ty, tyl) -> 280 303 List.iter (fun t -> add_alias t) tyl; 281 304 loop visited ty 282 282 - | Tunivar name -> reserve_name name 283 305 #if OCAML_VERSION>=(5,4,0) 284 306 | Tpackage p -> 285 307 List.iter (fun (_,x) -> loop visited x) p.pack_cstrs ··· 294 316 | Tsubst ty -> loop visited ty 295 317 #else 296 318 | Tsubst (ty,_) -> loop visited ty 319 319 + #endif 320 320 + #if defined OXCAML 321 321 + | Tquote typ -> loop visited typ 322 322 + | Tsplice typ -> loop visited typ 323 323 + | Tof_kind _ -> () 297 324 #endif 298 325 | Tlink _ -> assert false 299 326 in ··· 322 349 let tvar_none ty = ty.desc <- Tvar None 323 350 #elif OCAML_VERSION < (4,14,0) 324 351 let tvar_none ty = Types.Private_type_expr.set_desc ty (Tvar None) 352 352 + #elif defined OXCAML 353 353 + let tvar_none ty jkind = 354 354 + Types.Transient_expr.(set_desc (coerce ty) (Tvar { name = None; jkind })) 325 355 #else 326 356 let tvar_none ty = Types.Transient_expr.(set_desc (coerce ty) (Tvar None)) 327 357 #endif ··· 346 376 let vars = Ctype.free_variables ty in 347 377 List.iter 348 378 (fun ty -> match Compat.get_desc ty with 349 349 - | Tvar (Some "_") -> if List.memq ty vars then tvar_none ty 379 379 + #if defined OXCAML 380 380 + | Tvar { name = Some "_"; jkind } -> 381 381 + if List.memq ty vars then tvar_none ty jkind 382 382 + #else 383 383 + | Tvar (Some "_") -> 384 384 + if List.memq ty vars then tvar_none ty 385 385 + #endif 350 386 | _ -> ()) 351 387 params 352 388 | None -> () ··· 359 395 List.iter mark_type 360 396 #else 361 397 function 398 398 + #if defined OXCAML 399 399 + | Cstr_tuple args -> List.iter (fun carg -> mark_type carg.ca_type) args 400 400 + #else 362 401 | Cstr_tuple args -> List.iter mark_type args 402 402 + #endif 363 403 | Cstr_record lds -> List.iter (fun ld -> mark_type ld.ld_type) lds 364 404 #endif 365 405 ··· 369 409 #else 370 410 | Type_abstract -> () 371 411 #endif 372 372 - #if OCAML_VERSION >= (4,13,0) 412 412 + #if defined OXCAML 413 413 + | Type_variant (cds,_,_) -> 414 414 + #elif OCAML_VERSION >= (4,13,0) 373 415 | Type_variant (cds,_) -> 374 416 #else 375 417 | Type_variant cds -> ··· 379 421 mark_constructor_args cd.cd_args; 380 422 opt_iter mark_type cd.cd_res) 381 423 cds 424 424 + #if defined OXCAML 425 425 + | Type_record_unboxed_product(lds, _, _) -> 426 426 + List.iter (fun ld -> mark_type ld.ld_type) lds 427 427 + | Type_record(lds, _, _) -> 428 428 + #else 382 429 | Type_record(lds, _) -> 430 430 + #endif 383 431 List.iter (fun ld -> mark_type ld.ld_type) lds 384 432 | Type_open -> () 385 433 ··· 462 510 let name = name_of_type typ in 463 511 if name = "_" then Any 464 512 else Var name 513 513 + #if defined OXCAML 514 514 + | Tarrow((lbl,_,_), arg, res, _) -> 515 515 + #else 465 516 | Tarrow(lbl, arg, res, _) -> 517 517 + #endif 466 518 let lbl = read_label lbl in 467 519 let lbl,arg = 468 520 match lbl with 469 521 | Some (Optional s) -> ( 522 522 + let read_as_wrapped () = 523 523 + (Some (RawOptional s), read_type_expr env arg) 524 524 + in 470 525 match Compat.get_desc arg with 471 471 - | Tconstr(_option, [arg], _) -> 472 472 - lbl, read_type_expr env arg (* Unwrap option if possible *) 526 526 + | Tpoly(arg, []) -> begin 527 527 + match Compat.get_desc arg with 528 528 + | Tconstr(_option, [arg], _) -> 529 529 + lbl, read_type_expr env arg (* Unwrap option if possible *) 530 530 + | _ -> read_as_wrapped () 531 531 + end 473 532 | _ -> 474 474 - (Some (RawOptional s), read_type_expr env arg)) (* If not, mark is as wrapped *) 533 533 + read_as_wrapped ()) (* If not, mark is as wrapped *) 475 534 | _ -> 476 535 lbl, read_type_expr env arg 477 536 in 478 537 let res = read_type_expr env res in 479 538 Arrow(lbl, arg, res) 480 539 | Ttuple typs -> 481 481 - #if OCAML_VERSION >= (5,4,0) 540 540 + #if OCAML_VERSION >= (5,4,0) || defined OXCAML 482 541 let typs = List.map (fun (lbl,x) -> lbl, read_type_expr env x) typs in 483 542 #else 484 543 let typs = List.map (fun x -> None, read_type_expr env x) typs in 485 544 #endif 486 545 Tuple typs 546 546 + #if defined OXCAML 547 547 + | Tunboxed_tuple typs -> 548 548 + let typs = List.map (fun (l,t) -> l, read_type_expr env t) typs in 549 549 + Unboxed_tuple typs 550 550 + #endif 487 551 | Tconstr(p, params, _) -> 488 552 let p = Env.Path.read_type env.ident_env p in 489 553 let params = List.map (read_type_expr env) params in ··· 524 588 | Tsubst typ -> read_type_expr env typ 525 589 #else 526 590 | Tsubst (typ,_) -> read_type_expr env typ 591 591 + #endif 592 592 + #if defined OXCAML 593 593 + | Tquote typ -> Quote (read_type_expr env typ) 594 594 + | Tsplice typ -> Splice (read_type_expr env typ) 595 595 + | Tof_kind _ -> assert false 527 596 #endif 528 597 | Tlink _ -> assert false 529 598 in ··· 649 718 let type_ = read_type_expr env vd.val_type in 650 719 let value = 651 720 match vd.val_kind with 721 721 + #if defined OXCAML 722 722 + | Val_reg _ -> Value.Abstract 723 723 + #else 652 724 | Val_reg -> Value.Abstract 725 725 + #endif 653 726 | Val_prim desc -> 654 727 let primitives = 655 728 let open Primitive in ··· 659 732 External primitives 660 733 | _ -> assert false 661 734 in 662 662 - Value { Value.id; source_loc; doc; type_; value } 735 735 + (* Source location is not trustworthy since it's a cmi so left as None *) 736 736 + let source_loc_jane = None in 737 737 + Value { Value.id; source_loc; doc; type_; value ; source_loc_jane } 738 738 + 739 739 + #if defined OXCAML 740 740 + let is_mutable = Types.is_mutable 741 741 + #else 742 742 + let is_mutable ld = ld = Mutable 743 743 + #endif 663 744 664 745 let read_label_declaration env parent ld = 665 746 let open TypeDecl.Field in ··· 669 750 Doc_attr.attached_no_tag ~warnings_tag:env.warnings_tag 670 751 (parent :> Identifier.LabelParent.t) ld.ld_attributes 671 752 in 672 672 - let mutable_ = (ld.ld_mutable = Mutable) in 753 753 + let mutable_ = is_mutable ld.ld_mutable in 673 754 let type_ = read_type_expr env ld.ld_type in 674 755 {id; doc; mutable_; type_} 675 756 ··· 682 763 #else 683 764 let open TypeDecl.Constructor in 684 765 match arg with 766 766 + #if defined OXCAML 767 767 + | Cstr_tuple args -> Tuple (List.map (fun arg -> read_type_expr env arg.ca_type) args) 768 768 + #else 685 769 | Cstr_tuple args -> Tuple (List.map (read_type_expr env) args) 770 770 + #endif 686 771 | Cstr_record lds -> 687 772 Record (List.map (read_label_declaration env parent) lds) 688 773 #endif ··· 707 792 | Type_abstract -> 708 793 #endif 709 794 None 710 710 - #if OCAML_VERSION >= (4,13,0) 795 795 + #if defined OXCAML 796 796 + | Type_variant (cstrs,_,_) -> 797 797 + #elif OCAML_VERSION >= (4,13,0) 711 798 | Type_variant (cstrs,_) -> 712 799 #else 713 800 | Type_variant cstrs -> ··· 716 803 List.map (read_constructor_declaration env parent) cstrs 717 804 in 718 805 Some (Variant cstrs) 806 806 + #if defined OXCAML 807 807 + | Type_record_unboxed_product(lbls, _, _) -> 808 808 + let lbls = 809 809 + List.map 810 810 + (read_label_declaration env (parent :> Identifier.FieldParent.t)) 811 811 + lbls 812 812 + in 813 813 + Some (Record lbls) 814 814 + | Type_record(lbls, _, _) -> 815 815 + #else 719 816 | Type_record(lbls, _) -> 817 817 + #endif 720 818 let lbls = 721 819 List.map 722 820 (read_label_declaration env (parent :> Identifier.FieldParent.t)) ··· 791 889 decl.type_manifest = None || decl.type_private = Private 792 890 | Type_record _ -> 793 891 decl.type_private = Private 794 794 - #if OCAML_VERSION >= (4,13,0) 892 892 + #if defined OXCAML 893 893 + | Type_record_unboxed_product _ -> 894 894 + decl.type_private = Private 895 895 + #endif 896 896 + #if defined OXCAML 897 897 + | Type_variant (tll,_,_) -> 898 898 + #elif OCAML_VERSION >= (4,13,0) 795 899 | Type_variant (tll,_) -> 796 900 #else 797 901 | Type_variant tll -> ··· 806 910 in 807 911 let private_ = (decl.type_private = Private) in 808 912 let equation = Equation.{params; manifest; constraints; private_} in 809 809 - {id; source_loc; doc; canonical; equation; representation} 913 913 + (* Source location is not trustworthy since it's a cmi so left as None *) 914 914 + let source_loc_jane = None in 915 915 + {id; source_loc; doc; canonical; equation; representation; source_loc_jane } 810 916 811 917 let read_extension_constructor env parent id ext = 812 918 let open Extension.Constructor in ··· 853 959 (parent : Identifier.Signature.t :> Identifier.FieldParent.t) ext.ext_args 854 960 in 855 961 let res = opt_map (read_type_expr env) ext.ext_ret_type in 856 856 - {id; source_loc; doc; args; res} 962 962 + (* Source location is not trustworthy since it's a cmi so left as None *) 963 963 + let source_loc_jane = None in 964 964 + {id; source_loc; doc; args; res; source_loc_jane} 857 965 858 966 let read_method env parent concrete (name, kind, typ) = 859 967 let open Method in ··· 868 976 let open InstanceVariable in 869 977 let id = Identifier.Mk.instance_variable(parent, Odoc_model.Names.InstanceVariableName.make_std name) in 870 978 let doc = Doc_attr.empty env.warnings_tag in 871 871 - let mutable_ = (mutable_ = Mutable) in 979 979 + let mutable_ = (mutable_ = Asttypes.Mutable) in 872 980 let virtual_ = (virtual_ = Virtual) in 873 981 let type_ = read_type_expr env typ in 874 982 ClassSignature.InstanceVariable {id; doc; mutable_; virtual_; type_} ··· 951 1059 read_class_signature env (id :> Identifier.ClassSignature.t) cltd.clty_params cltd.clty_type 952 1060 in 953 1061 let virtual_ = read_virtual cltd.clty_type in 954 954 - { id; source_loc; doc; virtual_; params; expr; expansion = None } 1062 1062 + (* Source location is not trustworthy since it's a cmi so left as None *) 1063 1063 + let source_loc_jane = None in 1064 1064 + { id; source_loc; doc; virtual_; params; expr; expansion = None ; source_loc_jane} 955 1065 956 1066 let rec read_class_type env parent params = 957 1067 let open Class in function ··· 989 1099 read_class_type env (id :> Identifier.ClassSignature.t) cld.cty_params cld.cty_type 990 1100 in 991 1101 let virtual_ = cld.cty_new = None in 992 992 - { id; source_loc; doc; virtual_; params; type_; expansion = None } 1102 1102 + (* Source location is not trustworthy since it's a cmi so left as None *) 1103 1103 + let source_loc_jane = None in 1104 1104 + { id; source_loc; doc; virtual_; params; type_; expansion = None ; source_loc_jane} 993 1105 994 1106 let rec read_module_type env parent (mty : Odoc_model.Compat.module_type) = 995 1107 let open ModuleType in ··· 1015 1127 let t_original_path = Env.Path.read_module env.ident_env p in 1016 1128 let t_desc = ModPath t_original_path in 1017 1129 TypeOf { t_desc; t_expansion = None; t_original_path } 1130 1130 + | Mty_strengthen (mty, p, a) -> 1131 1131 + let mty = read_module_type env parent mty in 1132 1132 + let s_path = Env.Path.read_module env.ident_env p in 1133 1133 + let s_aliasable = match a with 1134 1134 + | Aliasable -> true 1135 1135 + | Not_aliasable -> false 1136 1136 + in 1137 1137 + match Odoc_model.Lang.umty_of_mty mty with 1138 1138 + | Some s_expr -> 1139 1139 + Strengthen {s_expr; s_path; s_aliasable; s_expansion = None} 1140 1140 + | None -> failwith "invalid Mty_strengthen" 1018 1141 1019 1142 and read_module_type_declaration env parent id (mtd : Odoc_model.Compat.modtype_declaration) = 1020 1143 let open ModuleType in ··· 1024 1147 let doc, canonical = Doc_attr.attached ~warnings_tag:env.warnings_tag Odoc_model.Semantics.Expect_canonical container mtd.mtd_attributes in 1025 1148 let canonical = match canonical with | None -> None | Some s -> Doc_attr.conv_canonical_module_type s in 1026 1149 let expr = opt_map (read_module_type env (id :> Identifier.Signature.t)) mtd.mtd_type in 1027 1027 - {id; source_loc; doc; canonical; expr } 1150 1150 + (* Source location is not trustworthy since it's a cmi so left as None *) 1151 1151 + let source_loc_jane = None in 1152 1152 + {id; source_loc; doc; canonical; expr ; source_loc_jane} 1028 1153 1029 1154 and read_module_declaration env parent ident (md : Odoc_model.Compat.module_declaration) = 1030 1155 let open Module in ··· 1043 1168 | Some _ -> false 1044 1169 | None -> Odoc_model.Names.contains_double_underscore (Ident.name ident) 1045 1170 in 1046 1046 - {id; source_loc; doc; type_; canonical; hidden } 1171 1171 + (* Source location is not trustworthy since it's a cmi so left as None *) 1172 1172 + let source_loc_jane = None in 1173 1173 + {id; source_loc; doc; type_; canonical; hidden ; source_loc_jane} 1047 1174 1048 1175 and read_type_rec_status rec_status = 1049 1176 let open Signature in

+2 -1

odoc/src/loader/cmi.mli

··· 33 33 34 34 #if OCAML_VERSION < (4,3,0) 35 35 val read_label : Asttypes.label -> Odoc_model.Lang.TypeExpr.label option 36 36 + #elif defined OXCAML 37 37 + val read_label : Types.arg_label -> Odoc_model.Lang.TypeExpr.label option 36 38 #else 37 39 val read_label : Asttypes.arg_label -> Odoc_model.Lang.TypeExpr.label option 38 40 #endif ··· 94 96 val read_exception : env -> 95 97 Paths.Identifier.Signature.t -> Ident.t -> 96 98 Types.extension_constructor -> Odoc_model.Lang.Exception.t 97 97 -

+36 -7

odoc/src/loader/cmt.ml

··· 31 31 } 32 32 33 33 34 34 + let cmt_builddir : string ref = ref "" 35 35 + 34 36 let read_core_type env ctyp = 35 37 Cmi.read_type_expr env ctyp.ctyp_type 36 38 ··· 41 43 | Tpat_any -> [] 42 44 #if OCAML_VERSION < (5,2,0) 43 45 | Tpat_var(id, _) -> 46 46 + #elif defined OXCAML 47 47 + | Tpat_var(id, _, _uid, _, _) -> 44 48 #else 45 45 - | Tpat_var(id,_,_uid) -> 49 49 + | Tpat_var(id, _, _uid) -> 46 50 #endif 47 51 let open Value in 48 52 let id = Env.find_value_identifier env.ident_env id in 49 53 Cmi.mark_type_expr pat.pat_type; 50 54 let type_ = Cmi.read_type_expr env pat.pat_type in 51 55 let value = Abstract in 52 52 - [Value {id; source_loc; doc; type_; value}] 56 56 + let source_loc_jane = Some (Odoc_model.Lang.Source_loc_jane.of_location !cmt_builddir pat.pat_loc) in 57 57 + [Value {id; source_loc; doc; type_; value ; source_loc_jane }] 53 58 #if OCAML_VERSION < (5,2, 0) 54 59 | Tpat_alias(pat, id, _) -> 60 60 + #elif defined OXCAML 61 61 + | Tpat_alias(pat, id, _, _, _, _, _) -> 55 62 #elif OCAML_VERSION < (5,4,0) 56 63 | Tpat_alias(pat, id, _,_) -> 57 64 #else ··· 62 69 Cmi.mark_type_expr pat.pat_type; 63 70 let type_ = Cmi.read_type_expr env pat.pat_type in 64 71 let value = Abstract in 65 65 - Value {id; source_loc; doc; type_; value} :: read_pattern env parent doc pat 72 72 + let source_loc_jane = Some (Odoc_model.Lang.Source_loc_jane.of_location !cmt_builddir pat.pat_loc) in 73 73 + Value {id; source_loc; doc; type_; value ; source_loc_jane } :: read_pattern env parent doc pat 66 74 | Tpat_constant _ -> [] 67 75 | Tpat_tuple pats -> 68 68 - #if OCAML_VERSION >= (5, 4, 0) 76 76 + #if OCAML_VERSION >= (5, 4, 0) || defined OXCAML 69 77 let pats = List.map snd pats (* remove labels *) in 70 78 #endif 71 79 List.concat (List.map (read_pattern env parent doc) pats) 80 80 + #if defined OXCAML 81 81 + | Tpat_unboxed_tuple pats -> 82 82 + List.concat (List.map (fun (_, p, _) -> read_pattern env parent doc p) pats) 83 83 + #endif 72 84 #if OCAML_VERSION < (4, 13, 0) 73 85 | Tpat_construct(_, _, pats) -> 74 86 #else ··· 83 95 (List.map 84 96 (fun (_, _, pat) -> read_pattern env parent doc pat) 85 97 pats) 86 86 - #if OCAML_VERSION < (5, 4, 0) 98 98 + #if defined OXCAML 99 99 + | Tpat_record_unboxed_product(pats, _) -> 100 100 + List.concat 101 101 + (List.map 102 102 + (fun (_, _, pat) -> read_pattern env parent doc pat) 103 103 + pats) 104 104 + | Tpat_array (_, _, pats) -> 105 105 + #elif OCAML_VERSION < (5, 4, 0) 87 106 | Tpat_array pats -> 88 107 #else 89 108 | Tpat_array (_, pats) -> ··· 361 380 clparams 362 381 in 363 382 let type_ = read_class_expr env (id :> Identifier.ClassSignature.t) clparams cld.ci_expr in 364 364 - { id; source_loc; doc; virtual_; params; type_; expansion = None } 383 383 + let source_loc_jane = Some (Odoc_model.Lang.Source_loc_jane.of_location !cmt_builddir cld.ci_loc) in 384 384 + { id; source_loc; doc; virtual_; params; type_; expansion = None ; source_loc_jane} 365 385 366 386 let read_class_declarations env parent clds = 367 387 let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in ··· 481 501 | Some _, _ -> false 482 502 #endif 483 503 in 484 484 - Some {id; source_loc; doc; type_; canonical; hidden; } 504 504 + let source_loc_jane = Some (Odoc_model.Lang.Source_loc_jane.of_location !cmt_builddir mb.mb_loc) in 505 505 + Some {id; source_loc; doc; type_; canonical; hidden; source_loc_jane} 485 506 486 507 and read_module_bindings env parent mbs = 487 508 let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) ··· 569 590 let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in 570 591 let doc, status = Doc_attr.attached ~warnings_tag:env.warnings_tag Odoc_model.Semantics.Expect_status container incl.incl_attributes in 571 592 let decl_modty = 593 593 + #if defined OXCAML 594 594 + match unwrap_module_expr_desc incl.incl_mod.mod_desc, incl.incl_kind with 595 595 + | _, (Tincl_functor _ | Tincl_gen_functor _) -> 596 596 + (* TODO: Handle [include functor] *) 597 597 + None 598 598 + | Tmod_ident(p, _), Tincl_structure -> 599 599 + #else 572 600 match unwrap_module_expr_desc incl.incl_mod.mod_desc with 573 601 | Tmod_ident(p, _) -> 602 602 + #endif 574 603 let p = Env.Path.read_module env.ident_env p in 575 604 Some (ModuleType.U.TypeOf (ModuleType.StructInclude p, p)) 576 605 | _ ->

+2

odoc/src/loader/cmt.mli

··· 14 14 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 15 *) 16 16 17 17 + val cmt_builddir : string ref 18 18 + 17 19 val read_implementation : 18 20 Odoc_model.Paths.Identifier.ContainerPage.t option -> 19 21 string ->

+118 -15

odoc/src/loader/cmti.ml

··· 31 31 warnings_tag : string option; 32 32 } 33 33 34 34 + let cmti_builddir : string ref = ref "" 34 35 let read_module_expr : (env -> Identifier.Signature.t -> Identifier.LabelParent.t -> Typedtree.module_expr -> ModuleType.expr) ref = ref (fun _ _ _ _ -> failwith "unset") 35 36 36 37 let opt_map f = function ··· 42 43 let rec read_core_type env container ctyp = 43 44 let open TypeExpr in 44 45 match ctyp.ctyp_desc with 46 46 + #if defined OXCAML 47 47 + (* TODO: presumably we want the layout in these first two cases, 48 48 + eventually *) 49 49 + | Ttyp_var (None, _layout) -> Any 50 50 + | Ttyp_var (Some s, _layout) -> Var s 51 51 + #else 45 52 | Ttyp_any -> Any 46 53 | Ttyp_var s -> Var s 54 54 + #endif 47 55 | Ttyp_arrow(lbl, arg, res) -> 48 56 let lbl = read_label lbl in 49 57 #if OCAML_VERSION < (4,3,0) ··· 64 72 let res = read_core_type env container res in 65 73 Arrow(lbl, arg, res) 66 74 | Ttyp_tuple typs -> 67 67 - #if OCAML_VERSION >= (5,4,0) 75 75 + #if OCAML_VERSION >= (5,4,0) || defined OXCAML 68 76 let typs = List.map (fun (lbl,x) -> lbl, read_core_type env container x) typs in 69 77 #else 70 78 let typs = List.map (fun x -> None, read_core_type env container x) typs in 71 79 #endif 72 80 Tuple typs 81 81 + #if defined OXCAML 82 82 + | Ttyp_unboxed_tuple typs -> 83 83 + let typs = List.map (fun (l, t) -> l, read_core_type env container t) typs in 84 84 + Unboxed_tuple typs 85 85 + #endif 73 86 | Ttyp_constr(p, _, params) -> 74 87 let p = Env.Path.read_type env.ident_env p in 75 88 let params = List.map (read_core_type env container) params in ··· 105 118 let p = Env.Path.read_class_type env.ident_env p in 106 119 let params = List.map (read_core_type env container) params in 107 120 Class(p, params) 108 108 - | Ttyp_alias(typ, var) -> 121 121 + #if defined OXCAML 122 122 + | Ttyp_alias(typ, var, _layout) -> ( 123 123 + (* TODO: presumably we want the layout, eventually *) 124 124 + #else 125 125 + | Ttyp_alias(typ, var) -> ( 126 126 + #endif 109 127 let typ = read_core_type env container typ in 128 128 + #if defined OXCAML 129 129 + match var with 130 130 + | None -> typ 131 131 + | Some var -> 132 132 + #endif 110 133 #if OCAML_VERSION >= (5,2,0) 111 111 - Alias(typ, var.txt) 134 134 + Alias(typ, var.txt) 112 135 #else 113 113 - Alias(typ, var) 136 136 + Alias(typ, var) 114 137 #endif 138 138 + ) 115 139 | Ttyp_variant(fields, closed, present) -> 116 140 let open TypeExpr.Polymorphic_variant in 117 141 let elements = ··· 142 166 in 143 167 Polymorphic_variant {kind; elements} 144 168 | Ttyp_poly([], typ) -> read_core_type env container typ 169 169 + #if defined OXCAML 170 170 + | Ttyp_poly(vars, typ) -> 171 171 + (* TODO: presumably want the layouts, eventually *) 172 172 + Poly(List.map fst vars, read_core_type env container typ) 173 173 + #else 145 174 | Ttyp_poly(vars, typ) -> Poly(vars, read_core_type env container typ) 175 175 + #endif 146 176 #if OCAML_VERSION >= (5,4,0) 147 177 | Ttyp_package {tpt_path = pack_path; tpt_cstrs=pack_fields; _} -> 148 178 #else ··· 164 194 (* TODO: adjust model *) 165 195 read_core_type env container t 166 196 #endif 197 197 + #if defined OXCAML 198 198 + | Ttyp_quote typ -> Quote (read_core_type env container typ) 199 199 + | Ttyp_splice typ -> Splice (read_core_type env container typ) 200 200 + | Ttyp_call_pos -> Constr(Env.Path.read_type env.ident_env Predef.path_lexing_position, []) 201 201 + | Ttyp_of_kind _ -> assert false 202 202 + #endif 167 203 168 204 let read_value_description env parent vd = 169 205 let open Signature in ··· 179 215 | [] -> Value.Abstract 180 216 | primitives -> External primitives 181 217 in 182 182 - Value { Value.id; source_loc; doc; type_; value } 218 218 + let source_loc_jane = Some (Odoc_model.Lang.Source_loc_jane.of_location !cmti_builddir vd.val_loc) in 219 219 + Value { Value.id; source_loc; doc; type_; value ; source_loc_jane } 183 220 184 221 let read_type_parameter (ctyp, var_and_injectivity) = 185 222 let open TypeDecl in 186 223 let desc = 187 224 match ctyp.ctyp_desc with 225 225 + #if defined OXCAML 226 226 + (* TODO: presumably we want the layouts below, eventually *) 227 227 + | Ttyp_var (None, _layout) -> Any 228 228 + | Ttyp_var (Some s, _layout) -> Var s 229 229 + #else 188 230 | Ttyp_any -> Any 189 231 | Ttyp_var s -> Var s 232 232 + #endif 190 233 | _ -> assert false 191 234 in 192 235 let variance, injectivity = ··· 214 257 in 215 258 {desc; variance; injectivity} 216 259 260 260 + #if defined OXCAML 261 261 + let is_mutable = Types.is_mutable 262 262 + #else 263 263 + let is_mutable ld = ld = Mutable 264 264 + #endif 265 265 + 217 266 let read_label_declaration env parent label_parent ld = 218 267 let open TypeDecl.Field in 219 268 let open Odoc_model.Names in 220 269 let name = Ident.name ld.ld_id in 221 270 let id = Identifier.Mk.field(parent, FieldName.make_std name) in 222 271 let doc = Doc_attr.attached_no_tag ~warnings_tag:env.warnings_tag label_parent ld.ld_attributes in 223 223 - let mutable_ = (ld.ld_mutable = Mutable) in 272 272 + let mutable_ = is_mutable ld.ld_mutable in 273 273 + let type_ = read_core_type env label_parent ld.ld_type in 274 274 + {id; doc; mutable_; type_} 275 275 + 276 276 + let read_unboxed_label_declaration env parent label_parent ld = 277 277 + let open TypeDecl.UnboxedField in 278 278 + let open Odoc_model.Names in 279 279 + let name = Ident.name ld.ld_id in 280 280 + let id = Identifier.Mk.unboxed_field(parent, UnboxedFieldName.make_std name) in 281 281 + let doc = Doc_attr.attached_no_tag ~warnings_tag:env.warnings_tag label_parent ld.ld_attributes in 282 282 + let mutable_ = is_mutable ld.ld_mutable in 224 283 let type_ = read_core_type env label_parent ld.ld_type in 225 284 {id; doc; mutable_; type_} 226 285 ··· 231 290 Tuple (List.map (read_core_type env label_parent) arg) 232 291 #else 233 292 match arg with 234 234 - | Cstr_tuple args -> Tuple (List.map (read_core_type env label_parent) args) 293 293 + | Cstr_tuple args -> 294 294 + #if defined OXCAML 295 295 + Tuple (List.map (fun arg -> read_core_type env label_parent arg.ca_type) args) 296 296 + #else 297 297 + Tuple (List.map (fun arg -> read_core_type env label_parent arg) args) 298 298 + #endif 235 299 | Cstr_record lds -> 236 300 Record (List.map (read_label_declaration env parent label_parent) lds) 237 301 #endif ··· 261 325 let lbls = 262 326 List.map (read_label_declaration env parent label_parent) lbls in 263 327 Some (Record lbls) 328 328 + #if defined OXCAML 329 329 + | Ttype_record_unboxed_product lbls -> 330 330 + let parent = (parent :> Identifier.UnboxedFieldParent.t) in 331 331 + let label_parent = (parent :> Identifier.LabelParent.t) in 332 332 + let lbls = 333 333 + List.map (read_unboxed_label_declaration env parent label_parent) lbls in 334 334 + Some (Record_unboxed_product lbls) 335 335 + #endif 264 336 | Ttype_open -> Some Extensible 265 337 266 338 let read_type_equation env container decl = ··· 286 358 let canonical = match canonical with | None -> None | Some s -> Doc_attr.conv_canonical_type s in 287 359 let equation = read_type_equation env container decl in 288 360 let representation = read_type_kind env id decl.typ_kind in 289 289 - {id; source_loc; doc; canonical; equation; representation} 361 361 + let source_loc_jane = Some (Odoc_model.Lang.Source_loc_jane.of_location !cmti_builddir decl.typ_loc) in 362 362 + {id; source_loc; doc; canonical; equation; representation; source_loc_jane} 290 363 291 364 let read_type_declarations env parent rec_flag decls = 292 365 let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in ··· 365 438 env container label_container args 366 439 in 367 440 let res = opt_map (read_core_type env label_container) res in 368 368 - {id; source_loc; doc; args; res} 441 441 + let source_loc_jane = Some (Odoc_model.Lang.Source_loc_jane.of_location !cmti_builddir ext.ext_loc) in 442 442 + {id; source_loc; doc; args; res; source_loc_jane} 369 443 370 444 let rec read_class_type_field env parent ctf = 371 445 let open ClassSignature in ··· 400 474 | Some doc -> Some (Comment doc) 401 475 402 476 and read_self_type env container typ = 403 403 - if typ.ctyp_desc = Ttyp_any then None 404 404 - else Some (read_core_type env container typ) 477 477 + match typ.ctyp_desc with 478 478 + #if defined OXCAML 479 479 + | Ttyp_var (None, _) -> None 480 480 + #else 481 481 + | Ttyp_any -> None 482 482 + #endif 483 483 + | _ -> Some (read_core_type env container typ) 405 484 406 485 and read_class_signature env parent label_parent cltyp = 407 486 let open ClassType in ··· 445 524 let virtual_ = (cltd.ci_virt = Virtual) in 446 525 let params = List.map read_type_parameter cltd.ci_params in 447 526 let expr = read_class_signature env (id :> Identifier.ClassSignature.t) container cltd.ci_expr in 448 448 - { id; source_loc; doc; virtual_; params; expr; expansion = None } 527 527 + let source_loc_jane = Some (Odoc_model.Lang.Source_loc_jane.of_location !cmti_builddir cltd.ci_loc) in 528 528 + { id; source_loc; doc; virtual_; params; expr; expansion = None ; source_loc_jane } 449 529 450 530 let read_class_type_declarations env parent cltds = 451 531 let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in ··· 484 564 let virtual_ = (cld.ci_virt = Virtual) in 485 565 let params = List.map read_type_parameter cld.ci_params in 486 566 let type_ = read_class_type env (id :> Identifier.ClassSignature.t) container cld.ci_expr in 487 487 - { id; source_loc; doc; virtual_; params; type_; expansion = None } 567 567 + let source_loc_jane = Some (Odoc_model.Lang.Source_loc_jane.of_location !cmti_builddir cld.ci_loc) in 568 568 + { id; source_loc; doc; virtual_; params; type_; expansion = None ; source_loc_jane} 488 569 489 570 let read_class_descriptions env parent clds = 490 571 let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in ··· 597 678 in 598 679 decl 599 680 | Tmty_alias _ -> assert false 681 681 + #if defined OXCAML 682 682 + | Tmty_strengthen (mty, path, _) -> 683 683 + let mty = read_module_type env parent label_parent mty in 684 684 + let s_path = Env.Path.read_module env.ident_env path in 685 685 + match Odoc_model.Lang.umty_of_mty mty with 686 686 + | Some s_expr -> 687 687 + (* We always strengthen with aliases *) 688 688 + Strengthen {s_expr; s_path; s_aliasable = true; s_expansion = None} 689 689 + | None -> failwith "invalid Tmty_strengthen" 690 690 + #endif 600 691 601 692 (** Like [read_module_type] but handle the canonical tag in the top-comment. If 602 693 [canonical] is [Some _], no tag is expected in the top-comment. *) ··· 627 718 | None -> (None, canonical) 628 719 in 629 720 let canonical = match canonical with | None -> None | Some s -> Doc_attr.conv_canonical_module_type s in 630 630 - { id; source_loc; doc; canonical; expr } 721 721 + let source_loc_jane = Some (Odoc_model.Lang.Source_loc_jane.of_location !cmti_builddir mtd.mtd_loc) in 722 722 + { id; source_loc; doc; canonical; expr ; source_loc_jane} 631 723 632 724 and read_module_declaration env parent md = 633 725 let open Module in ··· 666 758 | _ -> false 667 759 #endif 668 760 in 669 669 - Some {id; source_loc; doc; type_; canonical; hidden} 761 761 + let source_loc_jane = Some (Odoc_model.Lang.Source_loc_jane.of_location !cmti_builddir md.md_loc) in 762 762 + Some {id; source_loc; doc; type_; canonical; hidden; source_loc_jane} 670 763 671 764 and read_module_declarations env parent mds = 672 765 let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in ··· 724 817 [ 725 818 Open (read_open env parent o) 726 819 ] 820 820 + #if defined OXCAML 821 821 + | Tsig_include (incl, _) -> 822 822 + #else 727 823 | Tsig_include incl -> 824 824 + #endif 728 825 read_include env parent incl 729 826 | Tsig_class cls -> 730 827 read_class_descriptions env parent cls ··· 780 877 let expr = read_module_type env parent container incl.incl_mod in 781 878 let umty = Odoc_model.Lang.umty_of_mty expr in 782 879 let expansion = { content; shadowed; } in 880 880 + #if defined OXCAML 881 881 + match umty, incl.incl_kind with 882 882 + | Some uexpr, Tincl_structure -> 883 883 + #else 783 884 match umty with 784 885 | Some uexpr -> 886 886 + #endif 785 887 let decl = Include.ModuleType uexpr in 786 888 [Include {parent; doc; decl; expansion; status; strengthened=None; loc }] 787 889 | _ -> 890 890 + (* TODO: Handle [include functor] *) 788 891 content.items 789 892 790 893 and read_open env parent o =

+1

odoc/src/loader/cmti.mli

··· 16 16 17 17 module Paths = Odoc_model.Paths 18 18 19 19 + val cmti_builddir : string ref 19 20 val read_module_expr : 20 21 (Cmi.env -> 21 22 Paths.Identifier.Signature.t ->

+17 -18

odoc/src/loader/dune

··· 1 1 - (rule 2 2 - (targets ident_env.ml) 3 3 - (deps 4 4 - (:x ident_env.cppo.ml)) 5 5 - (action 6 6 - (chdir 7 7 - %{workspace_root} 8 8 - (run %{bin:cppo} -V OCAML:%{ocaml_version} %{x} -o %{targets})))) 9 9 - 10 10 - (rule 11 11 - (targets ident_env.mli) 12 12 - (deps 13 13 - (:x ident_env.cppo.mli)) 14 14 - (action 15 15 - (chdir 16 16 - %{workspace_root} 17 17 - (run %{bin:cppo} -V OCAML:%{ocaml_version} %{x} -o %{targets})))) 1 1 + (library 2 2 + (name odoc_loader) 3 3 + (public_name odoc.loader) 4 4 + (enabled_if 5 5 + (not %{ocaml-config:ox})) 6 6 + (preprocess 7 7 + (action 8 8 + (run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file}))) 9 9 + (libraries 10 10 + odoc_model 11 11 + odoc-parser 12 12 + syntax_highlighter 13 13 + odoc_document 14 14 + odoc_utils 15 15 + compiler-libs.optcomp)) 18 16 19 17 (library 20 18 (name odoc_loader) 21 19 (public_name odoc.loader) 20 20 + (enabled_if %{ocaml-config:ox}) 22 21 (preprocess 23 22 (action 24 24 - (run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file}))) 23 23 + (run %{bin:cppo} -V OCAML:%{ocaml_version} -D "OXCAML" %{input-file}))) 25 24 (libraries 26 25 odoc_model 27 26 odoc-parser

+44 -5

odoc/src/loader/ident_env.cppo.ml odoc/src/loader/ident_env.ml

··· 118 118 #else 119 119 | Types.Type_abstract _ -> [] 120 120 #endif 121 121 + #if defined OXCAML 122 122 + | Type_record (_, _, _) -> [] 123 123 + | Type_record_unboxed_product (_, _, _) -> [] 124 124 + #else 121 125 | Type_record (_, _) -> [] 126 126 + #endif 122 127 #if OCAML_VERSION < (4,13,0) 123 128 | Type_variant cstrs -> 129 129 + #elif defined OXCAML 130 130 + | Type_variant (cstrs, _, _) -> 124 131 #else 125 132 | Type_variant (cstrs, _) -> 126 133 #endif ··· 210 217 Ttype_abstract -> [] 211 218 | Ttype_variant constrs -> List.map (fun c -> `Constructor (c.cd_id, decl.typ_id, Some c.cd_loc)) constrs 212 219 | Ttype_record _ -> [] 220 220 + #if defined OXCAML 221 221 + | Ttype_record_unboxed_product _ -> [] 222 222 + #endif 213 223 | Ttype_open -> [] 214 224 ) 215 225 decls @ extract_signature_tree_items hide_item rest ··· 249 259 [`Value (val_id, hide_item, Some sig_loc)] @ extract_signature_tree_items hide_item rest 250 260 | { sig_desc = Tsig_modtype mtd; sig_loc; _} :: rest -> 251 261 [`ModuleType (mtd.mtd_id, hide_item, Some sig_loc)] @ extract_signature_tree_items hide_item rest 262 262 + #if defined OXCAML 263 263 + | {sig_desc = Tsig_include (incl, _); _ } :: rest -> 264 264 + #else 252 265 | {sig_desc = Tsig_include incl; _ } :: rest -> 266 266 + #endif 253 267 [`Include (extract_signature_type_items Exported (Compat.signature incl.incl_type))] @ extract_signature_tree_items hide_item rest 254 268 | {sig_desc = Tsig_attribute attr; _ } :: rest -> 255 269 let hide_item = if Doc_attr.is_stop_comment attr then not hide_item else hide_item in ··· 302 316 match pat.pat_desc with 303 317 #if OCAML_VERSION < (5,2,0) 304 318 | Tpat_var(id, loc) -> 319 319 + #elif defined OXCAML 320 320 + | Tpat_var(id, loc, _, _, _) -> 305 321 #else 306 322 | Tpat_var(id, loc, _) -> 307 323 #endif 308 324 [`Value(id, hide_item, Some loc.loc)] 309 325 #if OCAML_VERSION < (5,2,0) 310 326 | Tpat_alias(pat, id, loc) -> 327 327 + #elif defined OXCAML 328 328 + | Tpat_alias(pat, id, loc, _, _, _, _) -> 311 329 #elif OCAML_VERSION < (5,4,0) 312 330 | Tpat_alias(pat, id, loc, _) -> 313 331 #else ··· 316 334 `Value(id, hide_item, Some loc.loc) :: read_pattern hide_item pat 317 335 | Tpat_record(pats, _) -> 318 336 List.concat (List.map (fun (_, _, pat) -> read_pattern hide_item pat) pats) 337 337 + #if defined OXCAML 338 338 + | Tpat_record_unboxed_product(pats, _) -> 339 339 + List.concat (List.map (fun (_, _, pat) -> read_pattern hide_item pat) pats) 340 340 + #endif 319 341 #if OCAML_VERSION < (4,13,0) 320 342 | Tpat_construct(_, _, pats) 321 343 #else 322 344 | Tpat_construct(_, _, pats, _) 323 345 #endif 324 324 - #if OCAML_VERSION < (5,4,0) 346 346 + #if defined OXCAML 347 347 + | Tpat_array (_, _, pats) -> 348 348 + List.concat (List.map (fun pat -> read_pattern hide_item pat) pats) 349 349 + #elif OCAML_VERSION < (5,4,0) 325 350 | Tpat_array pats -> 326 351 List.concat (List.map (fun pat -> read_pattern hide_item pat) pats) 327 352 #else ··· 329 354 List.concat (List.map (fun pat -> read_pattern hide_item pat) pats) 330 355 #endif 331 356 | Tpat_tuple pats -> 332 332 - #if OCAML_VERSION < (5,4,0) 333 333 - List.concat (List.map (fun pat -> read_pattern hide_item pat) pats) 334 334 - #else 357 357 + #if OCAML_VERSION >= (5,4,0) || defined OXCAML 335 358 List.concat (List.map (fun (_lbl,pat) -> read_pattern hide_item pat) pats) 359 359 + #else 360 360 + List.concat (List.map (fun pat -> read_pattern hide_item pat) pats) 361 361 + #endif 362 362 + #if defined OXCAML 363 363 + | Tpat_unboxed_tuple pats -> 364 364 + List.concat (List.map (fun (_, pat, _) -> read_pattern hide_item pat) pats) 336 365 #endif 337 366 | Tpat_or(pat, _, _) 338 367 | Tpat_variant(_, Some pat, _) ··· 356 385 Ttype_abstract -> [] 357 386 | Ttype_variant constrs -> List.map (fun c -> `Constructor (c.cd_id, decl.typ_id, Some c.cd_loc)) constrs 358 387 | Ttype_record _ -> [] 388 388 + #if defined OXCAML 389 389 + | Ttype_record_unboxed_product _ -> [] 390 390 + #endif 359 391 | Ttype_open -> [] 360 392 )) 361 393 decls @ extract_structure_tree_items hide_item rest ··· 677 709 let find_class_type_identifier env id = 678 710 Ident.find_same id env.class_types 679 711 712 712 + let ident_is_global_or_predef id = 713 713 + #if defined OXCAML 714 714 + Ident.is_global_or_predef id 715 715 + #else 716 716 + Ident.persistent id 717 717 + #endif 718 718 + 680 719 let is_shadowed 681 720 env id = 682 721 List.mem id env.shadowed 683 722 module Path = struct 684 723 685 724 let read_module_ident env id = 686 686 - if Ident.persistent id then `Root (ModuleName.of_ident id) 725 725 + if ident_is_global_or_predef id then `Root (ModuleName.of_ident id) 687 726 else 688 727 try find_module env id 689 728 with Not_found -> assert false

+2

odoc/src/loader/ident_env.cppo.mli odoc/src/loader/ident_env.mli

··· 67 67 68 68 val find_class_identifier : t -> Ident.t -> Paths.Identifier.Class.t 69 69 70 70 + val ident_is_global_or_predef : Ident.t -> bool 71 71 + 70 72 val is_shadowed : t -> Ident.t -> bool 71 73 72 74 val find_class_type_identifier : t -> Ident.t -> Paths.Identifier.ClassType.t

+17 -2

odoc/src/loader/implementation.ml

··· 1 1 #if OCAML_VERSION >= (4, 14, 0) 2 2 3 3 let rec is_persistent : Path.t -> bool = function 4 4 - | Path.Pident id -> Ident.persistent id 4 4 + | Path.Pident id -> Ident_env.ident_is_global_or_predef id 5 5 | Path.Pdot(p, _) -> is_persistent p 6 6 | Path.Papply(p, _) -> is_persistent p 7 7 #if OCAML_VERSION >= (5,1,0) 8 8 | Path.Pextra_ty (p, _) -> is_persistent p 9 9 #endif 10 10 11 11 - let pos_of_loc loc = (loc.Location.loc_start.pos_cnum, loc.loc_end.pos_cnum) 11 11 + let pos_of_loc (loc : Warnings.loc) = { 12 12 + Odoc_model.Lang.Source_info.loc_start = { 13 13 + pos_cnum = loc.loc_start.pos_cnum ; 14 14 + pos_lnum = loc.loc_start.pos_lnum 15 15 + } ; 16 16 + loc_end = { 17 17 + pos_cnum = loc.loc_start.pos_cnum ; 18 18 + pos_lnum = loc.loc_start.pos_lnum 19 19 + } 20 20 + } 12 21 13 22 let counter = 14 23 let c = ref 0 in ··· 70 79 | Tmty_signature sg -> signature env (parent : Identifier.Signature.t) sg 71 80 | Tmty_with (mty, _) -> module_type env parent mty 72 81 | Tmty_functor (_, t) -> module_type env parent t 82 82 + #if defined OXCAML 83 83 + | Tmty_strengthen (t, _, _) -> module_type env parent t 84 84 + #endif 73 85 | Tmty_ident _ | Tmty_alias _ | Tmty_typeof _ -> () 74 86 75 87 and module_bindings env parent mbs = List.iter (module_binding env parent) mbs ··· 207 219 | `AssetFile _ -> assert false 208 220 | `Field (parent, name) -> 209 221 let anchor = anchor `Field (FieldName.to_string name) in 222 222 + continue anchor parent 223 223 + | `UnboxedField (parent, name) -> 224 224 + let anchor = anchor `UnboxedField (UnboxedFieldName.to_string name) in 210 225 continue anchor parent 211 226 | `SourceLocationMod _ -> assert false 212 227 | `Result parent -> anchor_of_identifier acc (parent :> Identifier.t)

+83 -5

odoc/src/loader/odoc_loader.ml

··· 80 80 Some { Source.file; digest; build_dir } 81 81 | _ -> None 82 82 in 83 83 + let source_loc_jane = 84 84 + match sourcefile with 85 85 + | Some (Some file, _, build_dir) -> 86 86 + Some {Odoc_model.Lang.Source_loc_jane.filename = build_dir ^ "/" ^ file ; line_number = 1} 87 87 + | _ -> None 88 88 + in 83 89 { 84 90 id; 85 91 root; ··· 93 99 linked = false; 94 100 canonical; 95 101 source_loc = None; 102 102 + source_loc_jane 96 103 } 97 104 98 105 let compilation_unit_of_sig ~make_root ~imports ~interface ?sourcefile ~name ~id ··· 101 108 make_compilation_unit ~make_root ~imports ~interface ?sourcefile ~name ~id 102 109 ?canonical content 103 110 111 111 + #if defined OXCAML 112 112 + let unit_name_as_string = Compilation_unit.name_as_string 113 113 + let name_to_string = Compilation_unit.Name.to_string 114 114 + #else 115 115 + let unit_name_as_string x = x 116 116 + let name_to_string x = x 117 117 + #endif 118 118 + 104 119 let read_cmti ~make_root ~parent ~filename ~warnings_tag () = 105 120 let cmt_info = Cmt_format.read_cmt filename in 106 121 match cmt_info.cmt_annots with ··· 112 127 try Odoc_model.Names.set_unique_ident (Digest.to_hex digest) 113 128 with _ -> () 114 129 in 115 115 - let name = cmt_info.cmt_modname in 130 130 + let name = cmt_info.cmt_modname |> unit_name_as_string in 116 131 let sourcefile = 117 132 ( cmt_info.cmt_sourcefile, 118 133 cmt_info.cmt_source_digest, 119 134 cmt_info.cmt_builddir ) 120 135 in 136 136 + Cmti.cmti_builddir := cmt_info.cmt_builddir; 121 137 let id, sg, canonical = 122 138 Cmti.read_interface parent name ~warnings_tag intf 123 139 in 124 124 - compilation_unit_of_sig ~make_root ~imports:cmt_info.cmt_imports 140 140 + #if defined OXCAML 141 141 + let imports = 142 142 + cmt_info.cmt_imports 143 143 + |> Array.map (fun import -> 144 144 + Import_info.name import |> Compilation_unit.Name.to_string, 145 145 + Import_info.crc import) 146 146 + |> Array.to_list 147 147 + in 148 148 + #else 149 149 + let imports = cmt_info.cmt_imports in 150 150 + #endif 151 151 + compilation_unit_of_sig ~make_root ~imports 125 152 ~interface ~sourcefile ~name ~id ?canonical sg) 126 153 | _ -> raise Not_an_interface 127 154 ··· 130 157 | exception Cmi_format.Error (Not_an_interface _) -> 131 158 raise Not_an_implementation 132 159 | cmt_info -> ( 133 133 - let name = cmt_info.cmt_modname in 160 160 + let name = cmt_info.cmt_modname |> unit_name_as_string in 134 161 let sourcefile = 135 162 ( cmt_info.cmt_sourcefile, 136 163 cmt_info.cmt_source_digest, ··· 147 174 | Some digest -> ( 148 175 try Odoc_model.Names.set_unique_ident (Digest.to_hex digest) 149 176 with _ -> ())); 177 177 + #if defined OXCAML 178 178 + let imports = 179 179 + cmt_info.cmt_imports 180 180 + |> Array.map (fun import -> 181 181 + Import_info.name import |> Compilation_unit.Name.to_string, 182 182 + Import_info.crc import) 183 183 + |> Array.to_list 184 184 + in 185 185 + #else 150 186 let imports = cmt_info.cmt_imports in 187 187 + #endif 151 188 match cmt_info.cmt_annots with 152 189 | Packed (_, files) -> 153 190 let id = ··· 177 214 make_compilation_unit ~make_root ~imports ~interface ~sourcefile ~name 178 215 ~id content 179 216 | Implementation impl -> 217 217 + Cmt.cmt_builddir := cmt_info.cmt_builddir; 218 218 + Cmti.cmti_builddir := cmt_info.cmt_builddir; 180 219 let id, sg, canonical = 181 220 Cmt.read_implementation parent name ~warnings_tag impl 182 221 in ··· 184 223 ~name ~id ?canonical sg 185 224 | _ -> raise Not_an_implementation) 186 225 226 226 + #if defined OXCAML 227 227 + let compilation_unit_of_import_info (info : Import_info.Intf.Nonalias.t option) = 228 228 + match info with 229 229 + | None -> None 230 230 + | Some (Parameter, _) -> None 231 231 + | Some (Normal cu, _) -> Some (cu |> Compilation_unit.full_path_as_string) 232 232 + #else 233 233 + let compilation_unit_of_import_info info = 234 234 + Option.map snd info 235 235 + #endif 236 236 + 237 237 + #if defined OXCAML 238 238 + let cmi_crcs cmi_info = 239 239 + List.map (fun import -> Import_info.name import, Import_info.Intf.info import) 240 240 + (Array.to_list cmi_info.Cmi_format.cmi_crcs) 241 241 + #else 242 242 + let cmi_crcs cmi_info = cmi_info.Cmi_format.cmi_crcs 243 243 + #endif 244 244 + 187 245 let read_cmi ~make_root ~parent ~filename ~warnings_tag () = 188 246 let cmi_info = Cmi_format.read_cmi filename in 189 189 - match cmi_info.cmi_crcs with 247 247 + let cmi_crcs = cmi_crcs cmi_info in 248 248 + match cmi_crcs with 190 249 | (name, (Some _ as interface)) :: imports when name = cmi_info.cmi_name -> 250 250 + let name = name |> name_to_string in 191 251 let id, sg = 192 252 Cmi.read_interface parent name ~warnings_tag 193 253 (Odoc_model.Compat.signature cmi_info.cmi_sign) 194 254 in 255 255 + #if defined OXCAML 256 256 + let imports = 257 257 + imports 258 258 + |> List.map (fun (name, info_opt) -> 259 259 + name |> Compilation_unit.Name.to_string, 260 260 + compilation_unit_of_import_info info_opt) 261 261 + in 262 262 + let interface = interface |> Option.map snd in 263 263 + #endif 195 264 compilation_unit_of_sig ~make_root ~imports ~interface ~name ~id sg 196 265 | _ -> raise Corrupted 197 266 ··· 200 269 | exception Cmi_format.Error (Not_an_interface _) -> 201 270 raise Not_an_implementation 202 271 | cmt_info -> ( 203 203 - let name = cmt_info.cmt_modname in 272 272 + let name = cmt_info.cmt_modname |> unit_name_as_string in 204 273 let _sourcefile = 205 274 ( cmt_info.cmt_sourcefile, 206 275 cmt_info.cmt_source_digest, ··· 208 277 in 209 278 let interface = cmt_info.cmt_interface_digest in 210 279 let imports = cmt_info.cmt_imports in 280 280 + #if defined OXCAML 281 281 + let imports = 282 282 + imports 283 283 + |> Array.map (fun import -> 284 284 + Import_info.name import |> Compilation_unit.Name.to_string, 285 285 + Import_info.crc import) 286 286 + |> Array.to_list 287 287 + in 288 288 + #endif 211 289 match cmt_info.cmt_annots with 212 290 | Implementation _impl -> 213 291 let digest =

+12 -3

odoc/src/loader/typedtree_traverse.ml

··· 13 13 if exp_loc.loc_ghost then () 14 14 else 15 15 match expr.exp_desc with 16 16 - | Texp_ident (p, _, _) -> poses := (Value p, exp_loc) :: !poses 16 16 + #if defined OXCAML 17 17 + | Texp_ident (p, _, _, _, _) -> 18 18 + #else 19 19 + | Texp_ident (p, _, _) -> 20 20 + #endif 21 21 + poses := (Value p, exp_loc) :: !poses 17 22 | _ -> () 18 23 19 24 let pat env (type a) poses : a Typedtree.general_pattern -> unit = function ··· 25 30 in 26 31 let () = 27 32 match pat_desc with 28 28 - #if OCAML_VERSION >= (5, 2, 0) 33 33 + #if defined OXCAML 34 34 + | Tpat_var (id, loc, _uid, _, _) -> ( 35 35 + #elif OCAML_VERSION >= (5, 2, 0) 29 36 | Tpat_var (id, loc, _uid) -> ( 30 37 #else 31 38 | Tpat_var (id, loc) -> ( ··· 35 42 | None -> ()) 36 43 #if OCAML_VERSION >= (5, 4, 0) 37 44 | Tpat_alias (_, id, loc, _uid, _ty) -> ( 45 45 + #elif OCAML_VERSION = (5, 2, 0) 46 46 + | Tpat_alias (_, id, loc, _uid, _, _, _) -> ( 38 47 #elif OCAML_VERSION >= (5, 2, 0) 39 48 | Tpat_alias (_, id, loc, _uid) -> ( 40 49 #else 41 41 - | Tpat_alias (_, id, loc) -> ( 50 50 + | Tpat_alias (_, id, loc, _, _) -> ( 42 51 #endif 43 52 match maybe_localvalue id loc.loc with 44 53 | Some x -> poses := x :: !poses

+23 -3

odoc/src/model/compat.cppo.ml

··· 28 28 | Exported 29 29 | Hidden 30 30 31 31 + module Aliasability = struct 32 32 + type t = Not_aliasable | Aliasable 33 33 + end 34 34 + 31 35 type module_type = 32 36 Mty_ident of Path.t 33 37 | Mty_signature of signature 34 38 | Mty_functor of functor_parameter * module_type 35 39 | Mty_alias of Path.t 40 40 + | Mty_strengthen of module_type * Path.t * Aliasability.t 36 41 37 42 and functor_parameter = 38 43 | Unit ··· 93 98 | Types.Mty_signature s -> Mty_signature (signature s) 94 99 | Types.Mty_functor (a, b) -> Mty_functor(functor_parameter a, module_type b) 95 100 | Types.Mty_alias p -> Mty_alias p 101 101 + #if defined OXCAML 102 102 + | Types.Mty_strengthen (mty,p,a) -> 103 103 + Mty_strengthen (module_type mty, p, aliasability a) 104 104 + 105 105 + and aliasability : Types.Aliasability.t -> Aliasability.t = function 106 106 + | Types.Aliasability.Not_aliasable -> Aliasability.Not_aliasable 107 107 + | Types.Aliasability.Aliasable -> Aliasability.Aliasable 108 108 + #endif 96 109 97 110 and functor_parameter : Types.functor_parameter -> functor_parameter = function 98 111 | Types.Unit -> Unit ··· 273 286 274 287 #endif 275 288 276 276 - #if OCAML_VERSION >= (5,2,0) 289 289 + #if defined OXCAML 290 290 + 291 291 + let compunit_name : Compilation_unit.t -> string = Compilation_unit.name_as_string 292 292 + 293 293 + let required_compunit_names x = List.map compunit_name x.Cmo_format.cu_required_compunits 294 294 + 295 295 + #elif OCAML_VERSION >= (5,2,0) 296 296 + 277 297 let compunit_name : Cmo_format.compunit -> string = function | Compunit x -> x 278 298 279 299 let required_compunit_names x = List.map compunit_name x.Cmo_format.cu_required_compunits 280 300 281 301 #elif OCAML_VERSION >= (4,04,0) 282 302 283 283 - let compunit_name x = x 303 303 + let compunit_name x = Compilation_unit.name_as_string x 284 304 285 285 - let required_compunit_names x = List.map Ident.name x.Cmo_format.cu_required_globals 305 305 + let required_compunit_names x = List.map compunit_name x.Cmo_format.cu_required_globals 286 306 287 307 #else 288 308

+12

odoc/src/model/dune

··· 2 2 (targets compat.ml) 3 3 (deps 4 4 (:x compat.cppo.ml)) 5 5 + (enabled_if 6 6 + (not %{ocaml-config:ox})) 5 7 (action 6 8 (chdir 7 9 %{workspace_root} 8 10 (run %{bin:cppo} -V OCAML:%{ocaml_version} %{x} -o %{targets})))) 11 11 + 12 12 + (rule 13 13 + (targets compat.ml) 14 14 + (deps 15 15 + (:x compat.cppo.ml)) 16 16 + (enabled_if %{ocaml-config:ox}) 17 17 + (action 18 18 + (chdir 19 19 + %{workspace_root} 20 20 + (run %{bin:cppo} -V OCAML:%{ocaml_version} -D "OXCAML" %{x} -o %{targets})))) 9 21 10 22 (library 11 23 (name odoc_model)

+50 -2

odoc/src/model/lang.ml

··· 16 16 17 17 open Paths 18 18 19 19 + module Source_loc_jane = struct 20 20 + type t = { filename: string ; line_number: int } 21 21 + 22 22 + let of_location (build_dir : string) (loc: Location.t) = 23 23 + let { Location.loc_start ; _ } = loc in 24 24 + let { Lexing.pos_fname ; pos_lnum ; _ } = loc_start in 25 25 + { filename = build_dir ^ "/" ^ pos_fname ; line_number = pos_lnum } 26 26 + end 27 27 + 19 28 (** {3 Modules} *) 20 29 21 30 module rec Module : sig ··· 28 37 source_loc : Identifier.SourceLocation.t option; 29 38 (** Identifier.SourceLocation might not be set when the module is 30 39 artificially constructed from a functor argument. *) 40 40 + source_loc_jane : Source_loc_jane.t option; 31 41 doc : Comment.docs; 32 42 type_ : decl; 33 43 canonical : Path.Module.t option; ··· 83 93 | Signature of Signature.t 84 94 | With of substitution list * expr 85 95 | TypeOf of type_of_desc * Path.Module.t 96 96 + | Strengthen of expr * Path.Module.t * bool 86 97 end 87 98 88 99 type path_t = { ··· 96 107 w_expr : U.expr; 97 108 } 98 109 110 110 + type strengthen_t = { 111 111 + s_expansion : simple_expansion option; 112 112 + s_expr : U.expr; 113 113 + s_path : Path.Module.t; 114 114 + s_aliasable : bool 115 115 + } 116 116 + 99 117 type expr = 100 118 | Path of path_t 101 119 | Signature of Signature.t 102 120 | Functor of FunctorParameter.t * expr 103 121 | With of with_t 104 122 | TypeOf of typeof_t 123 123 + | Strengthen of strengthen_t 105 124 106 125 type t = { 107 126 id : Identifier.ModuleType.t; 108 127 source_loc : Identifier.SourceLocation.t option; 109 128 (** Can be [None] for module types created by a type substitution. *) 129 129 + source_loc_jane : Source_loc_jane.t option; 110 130 doc : Comment.docs; 111 131 canonical : Path.ModuleType.t option; 112 132 expr : expr option; ··· 213 233 } 214 234 end 215 235 236 236 + module UnboxedField : sig 237 237 + type t = { 238 238 + id : Identifier.UnboxedField.t; 239 239 + doc : Comment.docs; 240 240 + mutable_ : bool; 241 241 + type_ : TypeExpr.t; 242 242 + } 243 243 + end 244 244 + 216 245 module Constructor : sig 217 246 type argument = Tuple of TypeExpr.t list | Record of Field.t list 218 247 ··· 228 257 type t = 229 258 | Variant of Constructor.t list 230 259 | Record of Field.t list 260 260 + | Record_unboxed_product of UnboxedField.t list 231 261 | Extensible 232 262 end 233 263 ··· 253 283 type t = { 254 284 id : Identifier.Type.t; 255 285 source_loc : Identifier.SourceLocation.t option; 286 286 + source_loc_jane : Source_loc_jane.t option; 256 287 doc : Comment.docs; 257 288 canonical : Path.Type.t option; 258 289 equation : Equation.t; ··· 290 321 type t = { 291 322 id : Identifier.Exception.t; 292 323 source_loc : Identifier.SourceLocation.t option; 324 324 + source_loc_jane : Source_loc_jane.t option; 293 325 doc : Comment.docs; 294 326 args : TypeDecl.Constructor.argument; 295 327 res : TypeExpr.t option; ··· 305 337 type t = { 306 338 id : Identifier.Value.t; 307 339 source_loc : Identifier.SourceLocation.t option; 340 340 + source_loc_jane : Source_loc_jane.t option; 308 341 value : value; 309 342 doc : Comment.docs; 310 343 type_ : TypeExpr.t; ··· 322 355 type t = { 323 356 id : Identifier.Class.t; 324 357 source_loc : Identifier.SourceLocation.t option; 358 358 + source_loc_jane : Source_loc_jane.t option; 325 359 doc : Comment.docs; 326 360 virtual_ : bool; 327 361 params : TypeDecl.param list; ··· 341 375 type t = { 342 376 id : Identifier.ClassType.t; 343 377 source_loc : Identifier.SourceLocation.t option; 378 378 + source_loc_jane : Source_loc_jane.t option; 344 379 doc : Comment.docs; 345 380 virtual_ : bool; 346 381 params : TypeDecl.param list; ··· 440 475 | Alias of t * string 441 476 | Arrow of label option * t * t 442 477 | Tuple of (string option * t) list 478 478 + | Unboxed_tuple of (string option * t) list 443 479 | Constr of Path.Type.t * t list 444 480 | Polymorphic_variant of TypeExpr.Polymorphic_variant.t 445 481 | Object of TypeExpr.Object.t 446 482 | Class of Path.ClassType.t * t list 447 483 | Poly of string list * t 484 484 + | Quote of t 485 485 + | Splice of t 448 486 | Package of TypeExpr.Package.t 449 487 end = 450 488 TypeExpr ··· 482 520 expansion : Signature.t option; 483 521 linked : bool; (** Whether this unit has been linked. *) 484 522 source_loc : Identifier.SourceLocation.t option; 523 523 + source_loc_jane : Source_loc_jane.t option; 485 524 canonical : Path.Module.t option; 486 525 } 487 526 end = 488 527 Compilation_unit 489 528 490 529 module rec Source_info : sig 530 530 + type point_in_file = { 531 531 + pos_lnum : int; 532 532 + pos_cnum : int; 533 533 + } 534 534 + type location_in_file = {loc_start : point_in_file ; loc_end: point_in_file} 535 535 + 491 536 type 'a jump_to_impl = 492 537 | Unresolved of 'a 493 538 | Resolved of Identifier.SourceLocation.t ··· 504 549 | ModuleType of Path.ModuleType.t jump_to 505 550 | Type of Path.Type.t jump_to 506 551 507 507 - type 'a with_pos = 'a * (int * int) 552 552 + type 'a with_pos = 'a * location_in_file 508 553 509 554 type t = annotation with_pos list 510 555 end = ··· 552 597 | TypeOf { t_desc; t_original_path; _ } -> 553 598 Some (TypeOf (t_desc, t_original_path)) 554 599 | With { w_substitutions; w_expr; _ } -> Some (With (w_substitutions, w_expr)) 600 600 + | Strengthen { s_expr; s_path; s_aliasable; _ } -> 601 601 + Some (Strengthen (s_expr, s_path, s_aliasable)) 555 602 556 603 (** Query the top-comment of a signature. This is [s.doc] most of the time with 557 604 an exception for signature starting with an inline includes. *) ··· 560 607 | ModuleType.U.Path p -> Path.is_hidden (p :> Path.t) 561 608 | Signature _ -> 562 609 true (* Hidden in some sense, we certainly want its top comment *) 563 563 - | With (_, e) -> uexpr_considered_hidden e 610 610 + | With (_, e) 611 611 + | Strengthen (e, _, _) -> uexpr_considered_hidden e 564 612 | TypeOf (ModPath p, _) | TypeOf (StructInclude p, _) -> 565 613 Path.is_hidden (p :> Path.t) 566 614 in

+1

odoc/src/model/names.ml

··· 164 164 module TypeName = Name 165 165 module ConstructorName = SimpleName 166 166 module FieldName = SimpleName 167 167 + module UnboxedFieldName = SimpleName 167 168 module ExtensionName = SimpleName 168 169 module ExceptionName = SimpleName 169 170 module ValueName = Name

+2

odoc/src/model/names.mli

··· 83 83 84 84 module FieldName : SimpleName 85 85 86 86 + module UnboxedFieldName : SimpleName 87 87 + 86 88 module ExtensionName : SimpleName 87 89 88 90 module ExceptionName : SimpleName

+41

odoc/src/model/paths.ml

··· 41 41 | `Type (_, name) -> TypeName.to_string name 42 42 | `Constructor (_, name) -> ConstructorName.to_string name 43 43 | `Field (_, name) -> FieldName.to_string name 44 44 + | `UnboxedField (_, name) -> UnboxedFieldName.to_string name 44 45 | `Extension (_, name) -> ExtensionName.to_string name 45 46 | `ExtensionDecl (_, _, name) -> ExtensionName.to_string name 46 47 | `Exception (_, name) -> ExceptionName.to_string name ··· 71 72 | `Type (_, name) -> TypeName.is_hidden name 72 73 | `Constructor (parent, _) -> is_hidden (parent :> t) 73 74 | `Field (parent, _) -> is_hidden (parent :> t) 75 75 + | `UnboxedField (parent, _) -> is_hidden (parent :> t) 74 76 | `Extension (parent, _) -> is_hidden (parent :> t) 75 77 | `ExtensionDecl (parent, _, _) -> is_hidden (parent :> t) 76 78 | `Exception (parent, _) -> is_hidden (parent :> t) ··· 109 111 ConstructorName.to_string name :: full_name_aux (parent :> t) 110 112 | `Field (parent, name) -> 111 113 FieldName.to_string name :: full_name_aux (parent :> t) 114 114 + | `UnboxedField (parent, name) -> 115 115 + UnboxedFieldName.to_string name :: full_name_aux (parent :> t) 112 116 | `Extension (parent, name) -> 113 117 ExtensionName.to_string name :: full_name_aux (parent :> t) 114 118 | `ExtensionDecl (parent, _, name) -> ··· 165 169 (p : class_signature :> label_parent) 166 170 | { iv = `Constructor (p, _); _ } -> (p : datatype :> label_parent) 167 171 | { iv = `Field (p, _); _ } -> (p : field_parent :> label_parent) 172 172 + | { iv = `UnboxedField (p, _); _ } -> (p : unboxed_field_parent :> label_parent) 168 173 169 174 let label_parent n = label_parent_aux (n :> Id.non_src) 170 175 ··· 220 225 type t_pv = Paths_types.Identifier.field_parent_pv 221 226 end 222 227 228 228 + module UnboxedFieldParent = struct 229 229 + type t = Paths_types.Identifier.unboxed_field_parent 230 230 + type t_pv = Paths_types.Identifier.unboxed_field_parent_pv 231 231 + end 232 232 + 223 233 module LabelParent = struct 224 234 type t = Id.label_parent 225 235 type t_pv = Id.label_parent_pv ··· 290 300 type t_pv = Id.field_pv 291 301 end 292 302 303 303 + module UnboxedField = struct 304 304 + type t = Id.unboxed_field 305 305 + type t_pv = Id.unboxed_field_pv 306 306 + end 307 307 + 293 308 module Extension = struct 294 309 type t = Id.extension 295 310 type t_pv = Id.extension_pv ··· 561 576 FieldParent.t * FieldName.t -> 562 577 [> `Field of FieldParent.t * FieldName.t ] id = 563 578 mk_parent FieldName.to_string "fld" (fun (p, n) -> `Field (p, n)) 579 579 + 580 580 + let unboxed_field : 581 581 + UnboxedFieldParent.t * UnboxedFieldName.t -> 582 582 + [> `UnboxedField of UnboxedFieldParent.t * UnboxedFieldName.t ] id = 583 583 + mk_parent UnboxedFieldName.to_string "unboxedfld" (fun (p, n) -> `UnboxedField (p, n)) 564 584 565 585 let extension : 566 586 Signature.t * ExtensionName.t -> ··· 1012 1032 | `Type _ as t -> 1013 1033 (parent_type_identifier t :> Identifier.FieldParent.t option) 1014 1034 1035 1035 + and unboxed_field_parent_identifier : unboxed_field_parent -> Identifier.UnboxedFieldParent.t option = 1036 1036 + function 1037 1037 + | `Identifier id -> Some id 1038 1038 + | `Type _ as t -> (parent_type_identifier t :> Identifier.UnboxedFieldParent.t option) 1039 1039 + 1015 1040 and label_parent_identifier : 1016 1041 label_parent -> Identifier.LabelParent.t option = function 1017 1042 | `Identifier id -> Some id ··· 1024 1049 1025 1050 and identifier : t -> Identifier.t option = function 1026 1051 | `Identifier id -> Some id 1052 1052 + | `UnboxedField (p, n) -> ( 1053 1053 + match unboxed_field_parent_identifier p with 1054 1054 + | None -> None 1055 1055 + | Some p -> Some (Identifier.Mk.unboxed_field (p, n))) 1027 1056 | ( `Alias _ | `AliasModuleType _ | `Module _ | `Hidden _ | `Type _ 1028 1057 | `Class _ | `ClassType _ | `ModuleType _ ) as r -> 1029 1058 (label_parent_identifier r :> Identifier.t option) ··· 1086 1115 type t = Paths_types.Resolved_reference.field_parent 1087 1116 end 1088 1117 1118 1118 + module UnboxedFieldParent = struct 1119 1119 + type t = Paths_types.Resolved_reference.unboxed_field_parent 1120 1120 + end 1121 1121 + 1089 1122 module LabelParent = struct 1090 1123 type t = Paths_types.Resolved_reference.label_parent 1091 1124 end ··· 1108 1141 1109 1142 module Field = struct 1110 1143 type t = Paths_types.Resolved_reference.field 1144 1144 + end 1145 1145 + 1146 1146 + module UnboxedField = struct 1147 1147 + type t = Paths_types.Resolved_reference.unboxed_field 1111 1148 end 1112 1149 1113 1150 module Extension = struct ··· 1200 1237 1201 1238 module Field = struct 1202 1239 type t = Paths_types.Reference.field 1240 1240 + end 1241 1241 + 1242 1242 + module UnboxedField = struct 1243 1243 + type t = Paths_types.Reference.unboxed_field 1203 1244 end 1204 1245 1205 1246 module Extension = struct

+25

odoc/src/model/paths.mli

··· 80 80 type t = Id.field_parent 81 81 type t_pv = Id.field_parent_pv 82 82 end 83 83 + module UnboxedFieldParent : sig 84 84 + type t = Id.unboxed_field_parent 85 85 + type t_pv = Id.unboxed_field_parent_pv 86 86 + end 83 87 84 88 module FunctorResult : sig 85 89 type t = Id.functor_result ··· 94 98 module Field : sig 95 99 type t = Id.field 96 100 type t_pv = Id.field_pv 101 101 + end 102 102 + 103 103 + module UnboxedField : sig 104 104 + type t = Id.unboxed_field 105 105 + type t_pv = Id.unboxed_field_pv 97 106 end 98 107 99 108 module Extension : sig ··· 301 310 val field : 302 311 FieldParent.t * FieldName.t -> 303 312 [> `Field of FieldParent.t * FieldName.t ] id 313 313 + 314 314 + val unboxed_field : 315 315 + UnboxedFieldParent.t * UnboxedFieldName.t -> 316 316 + [> `UnboxedField of UnboxedFieldParent.t * UnboxedFieldName.t ] id 304 317 305 318 val extension : 306 319 Signature.t * ExtensionName.t -> ··· 495 508 type t = Paths_types.Resolved_reference.field_parent 496 509 end 497 510 511 511 + module UnboxedFieldParent : sig 512 512 + type t = Paths_types.Resolved_reference.unboxed_field_parent 513 513 + end 514 514 + 498 515 module LabelParent : sig 499 516 type t = Paths_types.Resolved_reference.label_parent 500 517 end ··· 517 534 518 535 module Field : sig 519 536 type t = Paths_types.Resolved_reference.field 537 537 + end 538 538 + 539 539 + module UnboxedField : sig 540 540 + type t = Paths_types.Resolved_reference.unboxed_field 520 541 end 521 542 522 543 module Extension : sig ··· 608 629 609 630 module Field : sig 610 631 type t = Paths_types.Reference.field 632 632 + end 633 633 + 634 634 + module UnboxedField : sig 635 635 + type t = Paths_types.Reference.unboxed_field 611 636 end 612 637 613 638 module Extension : sig

+38

odoc/src/model/paths_types.ml

··· 92 92 and field_parent = field_parent_pv id 93 93 (** @canonical Odoc_model.Paths.Identifier.FieldParent.t *) 94 94 95 95 + type unboxed_field_parent_pv = datatype_pv 96 96 + (** @canonical Odoc_model.Paths.Identifier.UnboxedFieldParent.t_pv *) 97 97 + 98 98 + and unboxed_field_parent = unboxed_field_parent_pv id 99 99 + (** @canonical Odoc_model.Paths.Identifier.UnboxedFieldParent.t *) 100 100 + 95 101 type label_parent_pv = [ field_parent_pv | page_pv | class_signature_pv ] 96 102 (** @canonical Odoc_model.Paths.Identifier.LabelParent.t_pv *) 97 103 ··· 149 155 and field = field_pv id 150 156 (** @canonical Odoc_model.Paths.Identifier.Field.t *) 151 157 158 158 + type unboxed_field_pv = [ `UnboxedField of unboxed_field_parent * UnboxedFieldName.t ] 159 159 + (** @canonical Odoc_model.Paths.Identifier.UnboxedField.t_pv *) 160 160 + 161 161 + and unboxed_field = unboxed_field_pv id 162 162 + (** @canonical Odoc_model.Paths.Identifier.UnboxedField.t *) 163 163 + 152 164 type extension_pv = [ `Extension of signature * ExtensionName.t ] 153 165 (** @canonical Odoc_model.Paths.Identifier.Extension.t_pv *) 154 166 ··· 210 222 | class_signature_pv 211 223 | datatype_pv 212 224 | field_parent_pv 225 225 + | unboxed_field_parent_pv 213 226 | label_parent_pv 214 227 | module_pv 215 228 | functor_parameter_pv ··· 218 231 | type_pv 219 232 | constructor_pv 220 233 | field_pv 234 234 + | unboxed_field_pv 221 235 | extension_pv 222 236 | extension_decl_pv 223 237 | exception_pv ··· 286 300 [ constructor_pv | extension_pv | exception_pv ] id 287 301 288 302 type reference_field = field 303 303 + 304 304 + type reference_unboxed_field = unboxed_field 289 305 290 306 type reference_extension = [ extension_pv | exception_pv ] id 291 307 ··· 526 542 527 543 type tag_only_field = [ `TField ] 528 544 545 545 + type tag_only_unboxed_field = [ `TUnboxedField ] 546 546 + 529 547 type tag_only_extension = [ `TExtension ] 530 548 531 549 type tag_only_exception = [ `TException ] ··· 562 580 | `TType 563 581 | `TConstructor 564 582 | `TField 583 583 + | `TUnboxedField 565 584 | `TExtension 566 585 | `TExtensionDecl 567 586 | `TException ··· 692 711 | `Field of fragment_type_parent * FieldName.t ] 693 712 (** @canonical Odoc_model.Paths.Reference.Field.t *) 694 713 714 714 + type unboxed_field = 715 715 + [ `Resolved of Resolved_reference.unboxed_field 716 716 + | `Root of string * [ `TField | `TUnknown ] 717 717 + | `Dot of label_parent * string 718 718 + | `UnboxedField of fragment_type_parent * UnboxedFieldName.t ] 719 719 + (** @canonical Odoc_model.Paths.Reference.UnboxedField.t *) 720 720 + 695 721 type extension = 696 722 [ `Resolved of Resolved_reference.extension 697 723 | `Root of string * [ `TExtension | `TException | `TUnknown ] ··· 776 802 | `Type of signature * TypeName.t 777 803 | `Constructor of fragment_type_parent * ConstructorName.t 778 804 | `Field of fragment_type_parent * FieldName.t 805 805 + | `UnboxedField of fragment_type_parent * UnboxedFieldName.t 779 806 | `Extension of signature * ExtensionName.t 780 807 | `ExtensionDecl of signature * ExtensionName.t 781 808 | `Exception of signature * ExceptionName.t ··· 836 863 | `Type of signature * TypeName.t ] 837 864 (** @canonical Odoc_model.Paths.Reference.Resolved.FragmentTypeParent.t *) 838 865 866 866 + and unboxed_field_parent = 867 867 + [ `Identifier of Identifier.unboxed_field_parent 868 868 + | `Type of signature * TypeName.t ] 869 869 + (** @canonical Odoc_model.Paths.Reference.Resolved.FragmentTypeParent.t *) 870 870 + 839 871 (* The only difference between parent and label_parent 840 872 is that the Identifier allows more types *) 841 873 and label_parent = ··· 874 906 [ `Identifier of Identifier.reference_field 875 907 | `Field of field_parent * FieldName.t ] 876 908 (** @canonical Odoc_model.Paths.Reference.Resolved.Field.t *) 909 909 + 910 910 + type unboxed_field = 911 911 + [ `Identifier of Identifier.reference_unboxed_field 912 912 + | `UnboxedField of unboxed_field_parent * UnboxedFieldName.t ] 913 913 + (** @canonical Odoc_model.Paths.Reference.Resolved.UnboxedField.t *) 877 914 878 915 type extension = 879 916 [ `Identifier of Identifier.reference_extension ··· 944 981 | `Constructor of datatype * ConstructorName.t 945 982 | `PolyConstructor of datatype * ConstructorName.t 946 983 | `Field of field_parent * FieldName.t 984 984 + | `UnboxedField of unboxed_field_parent * UnboxedFieldName.t 947 985 | `Extension of signature * ExtensionName.t 948 986 | `ExtensionDecl of signature * ExtensionName.t * ExtensionName.t 949 987 | `Exception of signature * ExceptionName.t

+2

odoc/src/model/reference.ml

··· 479 479 (parent next_token tokens, ConstructorName.make_std identifier) 480 480 | `TField -> 481 481 `Field (parent next_token tokens, FieldName.make_std identifier) 482 482 + | `TUnboxedField -> 483 483 + `UnboxedField (parent next_token tokens, UnboxedFieldName.make_std identifier) 482 484 | `TExtension -> 483 485 `Extension 484 486 (signature next_token tokens, ExtensionName.make_std identifier)

+87 -2

odoc/src/model_desc/lang_desc.ml

··· 145 145 F ("t_expansion", (fun t -> t.t_expansion), Option simple_expansion); 146 146 ] 147 147 148 148 + and moduletype_strengthen_t : Lang.ModuleType.strengthen_t t = 149 149 + let open Lang.ModuleType in 150 150 + Record 151 151 + [ 152 152 + F ("s_expansion", (fun t -> t.s_expansion), Option simple_expansion); 153 153 + F ("s_expr", (fun t -> t.s_expr), moduletype_u_expr); 154 154 + F ("s_path", (fun t -> (t.s_path :> Paths.Path.t)), path); 155 155 + F ("s_aliasable", (fun t -> t.s_aliasable), bool); 156 156 + ] 157 157 + 148 158 and moduletype_expr = 149 159 let open Lang.ModuleType in 150 160 Variant ··· 154 164 | Functor (x1, x2) -> 155 165 C ("Functor", (x1, x2), Pair (functorparameter_t, moduletype_expr)) 156 166 | With t -> C ("With", t, moduletype_with_t) 157 157 - | TypeOf x -> C ("TypeOf", x, moduletype_typeof_t)) 167 167 + | TypeOf x -> C ("TypeOf", x, moduletype_typeof_t) 168 168 + | Strengthen x -> C ("Strengthen", x, moduletype_strengthen_t)) 158 169 159 170 and moduletype_u_expr = 160 171 let open Lang.ModuleType.U in ··· 171 182 C 172 183 ( "TypeOf", 173 184 (t, (o :> Paths.Path.t)), 174 174 - Pair (moduletype_type_of_desc, path) )) 185 185 + Pair (moduletype_type_of_desc, path) ) 186 186 + | Strengthen (e, x, a) -> 187 187 + C 188 188 + ( "Strengthen", 189 189 + (e, (x :> Paths.Path.t), a), 190 190 + Triple (moduletype_u_expr, path, bool) )) 175 191 176 192 and moduletype_t = 177 193 let open Lang.ModuleType in ··· 309 325 F ("type_", (fun t -> t.type_), typeexpr_t); 310 326 ] 311 327 328 328 + and typedecl_unboxed_field = 329 329 + let open Lang.TypeDecl.UnboxedField in 330 330 + Unboxed_record 331 331 + [ 332 332 + UF ("id", (fun t -> t.id), identifier); 333 333 + UF ("doc", (fun t -> t.doc), docs); 334 334 + UF ("mutable_", (fun t -> t.mutable_), bool); 335 335 + UF ("type_", (fun t -> t.type_), typeexpr_t); 336 336 + ] 337 337 + 312 338 and typedecl_constructor_argument = 313 339 let open Lang.TypeDecl.Constructor in 314 340 T.Variant ··· 332 358 (function 333 359 | Variant x -> C ("Variant", x, List typedecl_constructor) 334 360 | Record x -> C ("Record", x, List typedecl_field) 361 361 + | Record_unboxed_product x -> C ("Record_unboxed_product", x, List typedecl_unboxed_field) 335 362 | Extensible -> C0 "Extensible") 336 363 337 364 and typedecl_variance = ··· 630 657 (x1, x2, x3), 631 658 Triple (Option typeexpr_label, typeexpr_t, typeexpr_t) ) 632 659 | Tuple x -> C ("Tuple", x, List (Pair (Option string, typeexpr_t))) 660 660 + | Unboxed_tuple x -> C ("Unboxed_tuple", x, List (Pair (Option string, typeexpr_t))) 633 661 | Constr (x1, x2) -> 634 662 C ("Constr", ((x1 :> Paths.Path.t), x2), Pair (path, List typeexpr_t)) 635 663 | Polymorphic_variant x -> ··· 638 666 | Class (x1, x2) -> 639 667 C ("Class", ((x1 :> Paths.Path.t), x2), Pair (path, List typeexpr_t)) 640 668 | Poly (x1, x2) -> C ("Poly", (x1, x2), Pair (List string, typeexpr_t)) 669 669 + | Quote x -> C ("Quote", x, typeexpr_t) 670 670 + | Splice x -> C ("Splice", x, typeexpr_t) 641 671 | Package x -> C ("Package", x, typeexpr_package)) 642 672 643 673 (** {3 Compilation_unit} *) ··· 741 771 | { Location_.value = Dir s; _ } -> C ("Dir", s, string) 742 772 | { Location_.value = Module s; _ } -> C ("Module", s, string)) 743 773 774 774 + (** {3 Source_info} *) 775 775 + 776 776 + and source_location_t : Paths.Identifier.SourceLocation.t t = 777 777 + Indirect ((fun sl -> (sl :> Paths.Identifier.t)), identifier) 778 778 + 779 779 + and jump_to_impl_t = 780 780 + let open Lang.Source_info in 781 781 + Variant 782 782 + (function 783 783 + | Unresolved x -> C ("Unresolved", x, path) 784 784 + | Resolved i -> C ("Resolved", i, source_location_t)) 785 785 + 786 786 + and jump_to_t = 787 787 + let open Lang.Source_info in 788 788 + Record 789 789 + [ 790 790 + F ("documentation", (fun t -> t.documentation), Option path); 791 791 + F ("implementation", (fun t -> t.implementation), Option jump_to_impl_t); 792 792 + ] 793 793 + 794 794 + and source_info_annotation_t = 795 795 + let open Lang.Source_info in 796 796 + Variant 797 797 + (function 798 798 + | Definition i -> C ("Definition", i, source_location_t) 799 799 + | Value j -> C ("Value", (j :> Paths.Path.t jump_to), jump_to_t) 800 800 + | Module j -> C ("Module", (j :> Paths.Path.t jump_to), jump_to_t) 801 801 + | ModuleType j -> C ("ModuleType", (j :> Paths.Path.t jump_to), jump_to_t) 802 802 + | Type j -> C ("Type", (j :> Paths.Path.t jump_to), jump_to_t)) 803 803 + 804 804 + and source_info_point_in_file_t : Lang.Source_info.point_in_file t = 805 805 + let open Lang.Source_info in 806 806 + Record 807 807 + [ 808 808 + F ("pos_lnum", (fun t -> t.pos_lnum), int); 809 809 + F ("pos_cnum", (fun t -> t.pos_cnum), int); 810 810 + ] 811 811 + 812 812 + and source_info_location_in_file_t : Lang.Source_info.location_in_file t = 813 813 + let open Lang.Source_info in 814 814 + Record 815 815 + [ 816 816 + F ("loc_start", (fun t -> t.loc_start), source_info_point_in_file_t); 817 817 + F ("loc_end", (fun t -> t.loc_end), source_info_point_in_file_t); 818 818 + ] 819 819 + 820 820 + and source_info_annotation_with_pos_t : Lang.Source_info.annotation Lang.Source_info.with_pos t = 821 821 + Pair (source_info_annotation_t, source_info_location_in_file_t) 822 822 + 823 823 + and source_info_t : Lang.Source_info.t t = 824 824 + List source_info_annotation_with_pos_t 825 825 + 826 826 + (** {3 Implementation} *) 827 827 + 744 828 and implementation_t = 745 829 let open Lang.Implementation in 746 830 Record ··· 748 832 F ("id", (fun t -> t.id), Option identifier); 749 833 F ("digest", (fun t -> t.digest), Digest.t); 750 834 F ("root", (fun t -> t.root), root); 835 835 + F ("source_info", (fun t -> t.source_info), source_info_t); 751 836 ] 752 837 753 838 and asset_t =

+15

odoc/src/model_desc/paths_desc.ml

··· 22 22 23 23 let fieldname = To_string FieldName.to_string 24 24 25 25 + let unboxedfieldname = To_string UnboxedFieldName.to_string 26 26 + 25 27 let exceptionname = To_string ExceptionName.to_string 26 28 27 29 let extensionname = To_string ExtensionName.to_string ··· 129 131 ( "`Field", 130 132 ((parent :> id_t), name), 131 133 Pair (identifier, Names.fieldname) ) 134 134 + | `UnboxedField (parent, name) -> 135 135 + C 136 136 + ( "`UnboxedField", 137 137 + ((parent :> id_t), name), 138 138 + Pair (identifier, Names.unboxedfieldname) ) 132 139 | `Extension (parent, name) -> 133 140 C 134 141 ( "`Extension", ··· 192 199 | `TExtension -> C0 "`TExtension" 193 200 | `TExtensionDecl -> C0 "`TExtensionDecl" 194 201 | `TField -> C0 "`TField" 202 202 + | `TUnboxedField -> C0 "`TUnboxedField" 195 203 | `TInstanceVariable -> C0 "`TInstanceVariable" 196 204 | `TLabel -> C0 "`TLabel" 197 205 | `TMethod -> C0 "`TMethod" ··· 329 337 Pair (reference, Names.constructorname) ) 330 338 | `Field (x1, x2) -> 331 339 C ("`Field", ((x1 :> r), x2), Pair (reference, Names.fieldname)) 340 340 + | `UnboxedField (x1, x2) -> 341 341 + C ("`UnboxedField", ((x1 :> r), x2), Pair (reference, Names.unboxedfieldname)) 332 342 | `Extension (x1, x2) -> 333 343 C 334 344 ( "`Extension", ··· 408 418 ( "`Field", 409 419 ((x1 :> rr), x2), 410 420 Pair (resolved_reference, Names.fieldname) ) 421 421 + | `UnboxedField (x1, x2) -> 422 422 + C 423 423 + ( "`UnboxedField", 424 424 + ((x1 :> rr), x2), 425 425 + Pair (resolved_reference, Names.unboxedfieldname) ) 411 426 | `Hidden x -> C ("`Hidden", (x :> rr), resolved_reference) 412 427 | `Identifier x -> C ("`Identifier", (x :> id_t), identifier) 413 428 | `InstanceVariable (x1, x2) ->

+3

odoc/src/model_desc/type_desc.ml

··· 3 3 deserialize. *) 4 4 type 'a t = 5 5 | Record : 'a field list -> 'a t 6 6 + | Unboxed_record : 'a unboxed_field list -> 'a t 6 7 | Variant : ('a -> case) -> 'a t 7 8 | Pair : 'a t * 'b t -> ('a * 'b) t 8 9 | Triple : 'a t * 'b t * 'c t -> ('a * 'b * 'c) t ··· 12 13 | Indirect : ('a -> 'b) * 'b t -> 'a t 13 14 14 15 and 'a field = F : string * ('a -> 'b) * 'b t -> 'a field 16 16 + 17 17 + and 'a unboxed_field = UF : string * ('a -> 'b) * 'b t -> 'a unboxed_field 15 18 16 19 and case = C : string * 'b * 'b t -> case | C0 : string -> case 17 20

+10

odoc/src/occurrences/table.ml

··· 38 38 | `ModuleType (parent, _) -> do_ parent 39 39 | `Method (parent, _) -> do_ parent 40 40 | `Field (parent, _) -> do_ parent 41 41 + | `UnboxedField (parent, _) -> do_ parent 41 42 | `Extension (parent, _) -> do_ parent 42 43 | `Type (parent, _) -> do_ parent 43 44 | `Constructor (parent, _) -> do_ parent ··· 68 69 | `ModuleType (parent, _) -> do_ parent 69 70 | `Method (parent, _) -> do_ parent 70 71 | `Field (parent, _) -> do_ parent 72 72 + | `UnboxedField (parent, _) -> do_ parent 71 73 | `Extension (parent, _) -> do_ parent 72 74 | `ExtensionDecl (parent, _, _) -> do_ parent 73 75 | `Type (parent, _) -> do_ parent ··· 121 123 | { iv = #DataType.t_pv; _ } as v -> 122 124 (strip_datatype_path v :> FieldParent.t) 123 125 126 126 + and strip_unboxed_field_parent_path : UnboxedFieldParent.t -> UnboxedFieldParent.t = 127 127 + fun x -> 128 128 + match x with 129 129 + | { iv = #DataType.t_pv; _ } as v -> 130 130 + (strip_datatype_path v :> UnboxedFieldParent.t) 131 131 + 124 132 and strip_label_parent_path : LabelParent.t -> LabelParent.t = 125 133 fun x -> 126 134 match x with ··· 141 149 Mk.instance_variable (strip_class_sig_path p, name) 142 150 | { iv = `Method (p, name); _ } -> Mk.method_ (strip_class_sig_path p, name) 143 151 | { iv = `Field (p, name); _ } -> Mk.field (strip_field_parent_path p, name) 152 152 + | { iv = `UnboxedField (p, name); _ } -> 153 153 + Mk.unboxed_field (strip_unboxed_field_parent_path p, name) 144 154 | { iv = `Label (p, name); _ } -> Mk.label (strip_label_parent_path p, name) 145 155 | { iv = `Exception (p, name); _ } -> Mk.exception_ (strip_sig_path p, name) 146 156 | { iv = `Extension (p, name); _ } -> Mk.extension (strip_sig_path p, name)

+69 -11

odoc/src/odoc/classify.cppo.ml

··· 15 15 let log fmt = 16 16 if !debug then Format.printf fmt else Format.ifprintf Format.std_formatter fmt 17 17 18 18 + #if defined OXCAML 19 19 + let name_of_import import = Import_info.name import |> Compilation_unit.Name.to_string 20 20 + let intf_info import = Option.map snd (Import_info.Intf.info import) 21 21 + let cmt_imports cmt_infos = Array.to_list cmt_infos.Cmt_format.cmt_imports 22 22 + let cmi_crcs cmi_infos = Array.to_list cmi_infos.Cmi_format.cmi_crcs 23 23 + #else 24 24 + let name_of_import (cu, _) = cu 25 25 + let intf_info (_, info) = info 26 26 + let cmt_imports cmt_infos = cmt_infos.Cmt_format.cmt_imports 27 27 + let cmi_crcs cmi_infos = cmi_infos.Cmi_format.cmi_crcs 28 28 + #endif 29 29 + 18 30 module Archive = struct 19 31 type name = string 20 32 ··· 39 51 impl_deps = StringSet.diff s.impl_deps s.modules; 40 52 } 41 53 54 54 + #if defined OXCAML 55 55 + let cu_imports cu = Array.to_list cu.cu_imports 56 56 + #else 57 57 + let cu_imports cu = cu.cu_imports 58 58 + #endif 59 59 + 42 60 let add_cu lib cu = 43 61 normalise 44 62 { ··· 47 65 StringSet.add (Odoc_model.Compat.compunit_name cu.cu_name) lib.modules; 48 66 intf_deps = 49 67 List.fold_left 50 50 - (fun deps (cu, _) -> StringSet.add cu deps) 51 51 - lib.intf_deps cu.cu_imports; 68 68 + (fun deps import -> StringSet.add (name_of_import import) deps) 69 69 + lib.intf_deps (cu_imports cu); 52 70 impl_deps = 53 71 List.fold_left 54 72 (fun deps id -> StringSet.add id deps) ··· 56 74 (Odoc_model.Compat.required_compunit_names cu); 57 75 } 58 76 59 59 - let add_unit_info lib (unit_info : Cmx_format.unit_infos) = 77 77 + let add_unit_info lib (unit, cmis, cmxs) = 78 78 + let name = 79 79 + unit 80 80 + #if defined OXCAML 81 81 + |> Compilation_unit.name_as_string 82 82 + #endif 83 83 + in 60 84 normalise 61 85 { 62 86 lib with 63 63 - modules = StringSet.add unit_info.ui_name lib.modules; 87 87 + modules = StringSet.add name lib.modules; 64 88 intf_deps = 65 89 List.fold_left 66 66 - (fun deps (unit_info, _) -> StringSet.add unit_info deps) 67 67 - lib.intf_deps unit_info.ui_imports_cmi; 90 90 + (fun deps import -> StringSet.add (name_of_import import) deps) 91 91 + lib.intf_deps cmis; 68 92 impl_deps = 69 93 List.fold_left 70 70 - (fun deps (name, _) -> StringSet.add name deps) 71 71 - lib.impl_deps unit_info.ui_imports_cmx; 94 94 + (fun deps import -> StringSet.add (name_of_import import) deps) 95 95 + lib.impl_deps cmxs; 72 96 } 73 97 74 98 let add_module_by_name lib name = ··· 96 120 let get_deps filename = 97 121 let cmi, _cmt = Cmt_format.read filename in 98 122 match cmi with 99 99 - | Some cmi -> List.map fst cmi.Cmi_format.cmi_crcs |> StringSet.of_list 123 123 + | Some cmi -> 124 124 + let cmi_crcs = cmi_crcs cmi in 125 125 + List.map name_of_import cmi_crcs |> StringSet.of_list 100 126 | None -> StringSet.empty 101 127 end 102 128 ··· 166 192 let read_cmxa ic init = 167 193 let li = (input_value ic : Cmx_format.library_infos) in 168 194 close_in ic; 169 169 - Ok (List.fold_left Archive.add_unit_info init (List.map fst li.lib_units)) 195 195 + #if defined OXCAML 196 196 + (* FIXME: This OxCaml-specific code is awful and can be gotten rid of 197 197 + once this PR (which was inspired by having to write this very code) is merged: 198 198 + https://github.com/oxcaml/oxcaml/pull/2673 *) 199 199 + let get_masked array i ~mask = 200 200 + if Misc.Bitmap.get mask i then Some (Array.get array i) else None 201 201 + in 202 202 + let bitmap_to_list b ~array = 203 203 + List.init (Array.length array) (fun i -> i) 204 204 + |> List.filter_map (fun i -> get_masked array i ~mask:b) 205 205 + in 206 206 + let units = 207 207 + List.map 208 208 + (fun (unit : Cmx_format.lib_unit_info) -> 209 209 + let cmis = bitmap_to_list unit.li_imports_cmi ~array:li.lib_imports_cmi in 210 210 + let cmxs = bitmap_to_list unit.li_imports_cmx ~array:li.lib_imports_cmx in 211 211 + unit.li_name, cmis, cmxs) 212 212 + li.lib_units 213 213 + in 214 214 + #else 215 215 + let units = 216 216 + List.map 217 217 + (fun (u, _) -> u.Cmx_format.ui_name, u.ui_imports_cmi, u.ui_imports_cmx) 218 218 + li.lib_units 219 219 + in 220 220 + #endif 221 221 + Ok (List.fold_left Archive.add_unit_info init units) 222 222 + 170 223 171 224 #if OCAML_VERSION >= (4, 12, 0) 172 225 open Misc ··· 175 228 let open Magic_number in 176 229 match read_current_info ~expected_kind:None ic with 177 230 | Ok { kind = Cma; version = _ } -> read_cma ic init 178 178 - | Ok { kind = Cmxa _; version = _ } -> read_cmxa ic init 231 231 + #if defined OXCAML 232 232 + | Ok { kind = Cmxa; version = _ } -> 233 233 + #else 234 234 + | Ok { kind = Cmxa _; version = _ } -> 235 235 + #endif 236 236 + read_cmxa ic init 179 237 | Ok { kind = _; version = _ } -> Error (`Msg "Not a valid library") 180 238 | Error _ -> Error (`Msg "Not a valid file") 181 239 #else

+7 -4

odoc/src/odoc/depends.ml

··· 35 35 36 36 module Compile_set = Set.Make (Compile) 37 37 38 38 - let add_dep acc = function 39 39 - | _, None -> acc (* drop module aliases *) 38 38 + let add_dep acc import = 39 39 + let unit_name = Classify.name_of_import import in 40 40 + let crc_with_unit = Classify.intf_info import in 41 41 + match (unit_name, crc_with_unit) with 42 42 + | _, None -> acc 40 43 | unit_name, Some digest -> Compile_set.add { Compile.unit_name; digest } acc 41 44 42 45 let for_compile_step_cmt acc file = 43 46 let cmt_infos = Cmt_format.read_cmt (Fs.File.to_string file) in 44 44 - List.fold_left ~f:add_dep ~init:acc cmt_infos.Cmt_format.cmt_imports 47 47 + List.fold_left ~f:add_dep ~init:acc (Classify.cmt_imports cmt_infos) 45 48 46 49 let for_compile_step_cmi_or_cmti acc file = 47 50 let cmi_infos = Cmi_format.read_cmi (Fs.File.to_string file) in 48 48 - List.fold_left ~f:add_dep ~init:acc cmi_infos.Cmi_format.cmi_crcs 51 51 + List.fold_left ~f:add_dep ~init:acc (Classify.cmi_crcs cmi_infos) 49 52 50 53 let for_compile_step files = 51 54 let set =

+24

odoc/src/odoc/dune

··· 26 26 (targets classify.ml) 27 27 (deps 28 28 (:x classify.cppo.ml)) 29 29 + (enabled_if 30 30 + (not %{ocaml-config:ox})) 29 31 (action 30 32 (chdir 31 33 %{workspace_root} 32 34 (run %{bin:cppo} -V OCAML:%{ocaml_version} %{x} -o %{targets})))) 35 35 + 36 36 + (rule 37 37 + (targets classify.ml) 38 38 + (deps 39 39 + (:x classify.cppo.ml)) 40 40 + (enabled_if %{ocaml-config:ox}) 41 41 + (action 42 42 + (chdir 43 43 + %{workspace_root} 44 44 + (run %{bin:cppo} -V OCAML:%{ocaml_version} -D OXCAML %{x} -o %{targets})))) 33 45 34 46 (rule 35 47 (targets extract_code.ml) 36 48 (deps 37 49 (:x extract_code.cppo.ml)) 50 50 + (enabled_if 51 51 + (not %{ocaml-config:ox})) 38 52 (action 39 53 (chdir 40 54 %{workspace_root} 41 55 (run %{bin:cppo} -V OCAML:%{ocaml_version} %{x} -o %{targets})))) 56 56 + 57 57 + (rule 58 58 + (targets extract_code.ml) 59 59 + (deps 60 60 + (:x extract_code.cppo.ml)) 61 61 + (enabled_if %{ocaml-config:ox}) 62 62 + (action 63 63 + (chdir 64 64 + %{workspace_root} 65 65 + (run %{bin:cppo} -V OCAML:%{ocaml_version} -D OXCAML %{x} -o %{targets})))) 42 66 43 67 (documentation 44 68 (package odoc))

+6 -1

odoc/src/odoc/extract_code.cppo.ml

··· 89 89 let signature_item sub sig_ = 90 90 match sig_.Typedtree.sig_desc with 91 91 | Tsig_attribute attr -> attribute sub attr 92 92 - | Tsig_include incl -> attributes sub incl.incl_attributes 92 92 + #if defined OXCAML 93 93 + | Tsig_include (incl, _) -> 94 94 + #else 95 95 + | Tsig_include incl -> 96 96 + #endif 97 97 + attributes sub incl.incl_attributes 93 98 | Tsig_open o -> attributes sub o.open_attributes 94 99 | _ -> default_iterator.signature_item sub sig_ 95 100 in

+9 -4

odoc/src/search/html.ml

··· 4 4 open Lang 5 5 open Odoc_index 6 6 7 7 - let url { Entry.id; kind; doc = _ } = 7 7 + let url { Entry.id; kind; doc = _ ; source_loc = _} = 8 8 let open Entry in 9 9 let stop_before = 10 10 (* Some module/module types/... might not have an expansion, so we need to ··· 34 34 let open Odoc_model.Lang in 35 35 match args with 36 36 | TypeDecl.Constructor.Tuple args -> 37 37 + let no_label arg = None, arg in 37 38 (match args with 38 38 - | _ :: _ :: _ -> 39 39 - Some TypeExpr.(Tuple (List.map (fun x -> (None, x)) args)) 39 39 + | _ :: _ :: _ -> Some TypeExpr.(Tuple (List.map no_label args)) 40 40 | [ arg ] -> Some arg 41 41 | _ -> None) 42 42 |> map_option Text.of_type ··· 104 104 constructor ~id ~args ~res) 105 105 |> String.concat " | " 106 106 | Record record -> Text.of_record record 107 107 + | Record_unboxed_product record -> Text.of_unboxed_record record 107 108 108 109 let typedecl_rhs ({ equation; representation; _ } : Entry.type_decl_entry) = 109 110 let ({ private_; manifest; constraints; _ } : TypeDecl.Equation.t) = ··· 155 156 156 157 let kind_field = "field" 157 158 159 159 + let kind_unboxed_field = "unboxed field" 160 160 + 158 161 let kind_value = "val" 159 162 160 163 let kind_extension = "ext" ··· 164 167 function 165 168 | Constructor _ -> kind_constructor 166 169 | Field _ -> kind_field 170 170 + | UnboxedField _ -> kind_unboxed_field 167 171 | ExtensionConstructor _ -> kind_extension_constructor 168 172 | TypeDecl _ -> kind_typedecl 169 173 | Module _ -> kind_module ··· 194 198 | Constructor t | ExtensionConstructor t | Exception t -> 195 199 Some (constructor_rhs t) 196 200 | Field f -> Some (field_rhs f) 201 201 + | UnboxedField f -> Some (field_rhs f) 197 202 | Module _ | Class_type _ | Method _ | Class _ | TypeExtension _ 198 203 | ModuleType _ | Doc | Page _ | Impl | Dir -> 199 204 None ··· 222 227 doc |> of_doc |> Format.asprintf "%a" (Tyxml.Html.pp_elt ()) 223 228 224 229 let of_entry (entry : Entry.t) = 225 225 - let ({ id; doc; kind } : Entry.t) = entry in 230 230 + let ({ id; doc; kind ; source_loc=_} : Entry.t) = entry in 226 231 let rhs = rhs_of_kind kind in 227 232 let prefix_name, name = names_of_id id in 228 233 let prefix_name = Some prefix_name and name = Some name in

+12 -1

odoc/src/search/json_index/json_search.ml

··· 55 55 ret "Constructor" (ConstructorName.to_string name) :: of_id (parent :> t) 56 56 | `Field (parent, name) -> 57 57 ret "Field" (FieldName.to_string name) :: of_id (parent :> t) 58 58 + | `UnboxedField (parent, name) -> 59 59 + ret "UnboxedField" (UnboxedFieldName.to_string name) :: of_id (parent :> t) 58 60 | `Extension (parent, name) -> 59 61 ret "Extension" (ExtensionName.to_string name) :: of_id (parent :> t) 60 62 | `ExtensionDecl (parent, _, name) -> ··· 107 109 (prefix_of_parent parent, ConstructorName.to_string name, "constructor") 108 110 | `Field (parent, name) -> 109 111 (prefix_of_parent parent, FieldName.to_string name, "field") 112 112 + | `UnboxedField (parent, name) -> 113 113 + (prefix_of_parent parent, UnboxedFieldName.to_string name, "unboxed_field") 110 114 | `Extension (parent, name) -> 111 115 (prefix_of_parent parent, ExtensionName.to_string name, "extension") 112 116 | `ExtensionDecl (parent, _, name) -> ··· 135 139 let txt = Text.of_doc doc in 136 140 `String txt 137 141 138 138 - let of_entry ({ Entry.id; doc; kind } as entry) html occurrences = 142 142 + let of_entry ({ Entry.id; doc; kind ; source_loc = _} as entry) html occurrences = 139 143 let j_id = of_id id in 140 144 let doc = of_doc doc in 141 145 let kind = ··· 206 210 return "Constructor" [ ("args", args); ("res", res) ] 207 211 | Field { mutable_; type_; parent_type } -> 208 212 return "Field" 213 213 + [ 214 214 + ("mutable", `Bool mutable_); 215 215 + ("type", `String (Text.of_type type_)); 216 216 + ("parent_type", `String (Text.of_type parent_type)); 217 217 + ] 218 218 + | UnboxedField { mutable_; type_; parent_type } -> 219 219 + return "UnboxedField" 209 220 [ 210 221 ("mutable", `Bool mutable_); 211 222 ("type", `String (Text.of_type type_));

+4

odoc/src/search/text.ml

··· 97 97 let of_record fields = 98 98 let te_text = Odoc_document.ML.record fields in 99 99 Of_document.documented_src te_text 100 100 + 101 101 + let of_unboxed_record fields = 102 102 + let te_text = Odoc_document.ML.unboxed_record fields in 103 103 + Of_document.documented_src te_text

+2

odoc/src/search/text.mli

··· 7 7 val of_doc : Odoc_model.Comment.elements -> string 8 8 9 9 val of_record : Odoc_model.Lang.TypeDecl.Field.t list -> string 10 10 + 11 11 + val of_unboxed_record : Odoc_model.Lang.TypeDecl.UnboxedField.t list -> string

+11

odoc/src/syntax_highlighter/dune

··· 1 1 (library 2 2 (name syntax_highlighter) 3 3 (public_name odoc.syntax_highlighter) 4 4 + (enabled_if 5 5 + (not %{ocaml-config:ox})) 4 6 (preprocess 5 7 (action 6 8 (run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file}))) 7 9 (libraries compiler-libs.common)) 10 10 + 11 11 + (library 12 12 + (name syntax_highlighter) 13 13 + (public_name odoc.syntax_highlighter) 14 14 + (enabled_if %{ocaml-config:ox}) 15 15 + (preprocess 16 16 + (action 17 17 + (run %{bin:cppo} -V OCAML:%{ocaml_version} -D OXCAML %{input-file}))) 18 18 + (libraries compiler-libs.common))

+27

odoc/src/syntax_highlighter/syntax_highlighter.ml

··· 145 145 | ANDOP _ -> "ANDOP" 146 146 | LETOP _ -> "LETOP" 147 147 #endif 148 148 + #if defined OXCAML 149 149 + | AT -> "AT" 150 150 + | ATAT -> "ATAT" 151 151 + | COLONRBRACKET -> "COLONRBRACKET" 152 152 + | DOLLAR -> "DOLLAR" 153 153 + | DOTHASH -> "DOTHASH" 154 154 + | EXCLAVE -> "EXCLAVE" 155 155 + | GLOBAL -> "GLOBAL" 156 156 + | HASHLBRACE -> "HASHLBRACE" 157 157 + | HASHLPAREN -> "HASHLPAREN" 158 158 + | HASH_CHAR _ -> "HASH_CHAR" 159 159 + | HASH_FLOAT _ -> "HASH_FLOAT" 160 160 + | HASH_INT _ -> "HASH_INT" 161 161 + | HASH_SUFFIX -> "HASH_SUFFIX" 162 162 + | KIND_ABBREV -> "KIND_ABBREV" 163 163 + | KIND_OF -> "KIND_OF" 164 164 + | LBRACKETCOLON -> "LBRACKETCOLON" 165 165 + | LESSLBRACKET -> "LESSLBRACKET" 166 166 + | LOCAL -> "LOCAL" 167 167 + | MOD -> "MOD" 168 168 + | ONCE -> "ONCE" 169 169 + | OVERWRITE -> "OVERWRITE" 170 170 + | RBRACKETGREATER -> "RBRACKETGREATER" 171 171 + | STACK -> "STACK" 172 172 + | UNIQUE -> "UNIQUE" 173 173 + #endif 148 174 #if OCAML_VERSION >= (5,3,0) 149 175 | METAOCAML_ESCAPE -> "METAOCAML_ESCAPE" 150 176 | METAOCAML_BRACKET_OPEN -> "METAOCAML_BRACKET_OPEN" 151 177 | METAOCAML_BRACKET_CLOSE -> "METAOCAML_BRACKET_CLOSE" 152 178 | EFFECT -> "EFFECT" 153 179 #endif 180 180 + 154 181 155 182 let syntax_highlighting_locs src = 156 183 try

+18

odoc/src/xref2/compile.ml

··· 629 629 -> 630 630 Some (`Module p) 631 631 | TypeOf _ -> None 632 632 + | Strengthen (e, _, _) -> find_parent e 632 633 in 633 634 match find_parent cexpr with 634 635 | None -> None ··· 673 674 | StructInclude p -> StructInclude (module_path env p) 674 675 in 675 676 TypeOf (t_desc, t_original_path) 677 677 + | Strengthen (expr, path, aliasable) -> 678 678 + Strengthen (inner expr, module_path env path, aliasable) 676 679 in 677 680 inner expr 678 681 ··· 739 742 | StructInclude p -> StructInclude (module_path env p) 740 743 in 741 744 TypeOf { t_desc; t_original_path; t_expansion } 745 745 + | Strengthen { s_expr; s_path; s_aliasable; s_expansion } as e -> 746 746 + let s_expansion = get_expansion s_expansion e in 747 747 + let s_expr = u_module_type_expr env id s_expr in 748 748 + let s_path = module_path env s_path in 749 749 + Strengthen { s_expr; s_path; s_aliasable; s_expansion } 742 750 743 751 and type_decl : Env.t -> TypeDecl.t -> TypeDecl.t = 744 752 fun env t -> ··· 775 783 match r with 776 784 | Variant cs -> Variant (List.map (type_decl_constructor env parent) cs) 777 785 | Record fs -> Record (List.map (type_decl_field env parent) fs) 786 786 + | Record_unboxed_product fs -> 787 787 + Record_unboxed_product (List.map (type_decl_unboxed_field env parent) fs) 778 788 | Extensible -> Extensible 779 789 780 790 and type_decl_field env parent f = 781 791 let open TypeDecl.Field in 792 792 + { f with type_ = type_expression env parent f.type_ } 793 793 + 794 794 + and type_decl_unboxed_field env parent f = 795 795 + let open TypeDecl.UnboxedField in 782 796 { f with type_ = type_expression env parent f.type_ } 783 797 784 798 and type_decl_constructor_argument env parent c = ··· 906 920 | Tuple ts -> 907 921 Tuple 908 922 (List.map (fun (lbl, ty) -> (lbl, type_expression env parent ty)) ts) 923 923 + | Unboxed_tuple ts -> 924 924 + Unboxed_tuple (List.map (fun (l, t) -> l, type_expression env parent t) ts) 909 925 | Constr (path, ts') -> ( 910 926 let cp = Component.Of_Lang.(type_path (empty ()) path) in 911 927 let ts = List.map (type_expression env parent) ts' in ··· 931 947 Class (`Resolved p, ts') 932 948 | _ -> Class (path, ts')) 933 949 | Poly (strs, t) -> Poly (strs, type_expression env parent t) 950 950 + | Quote t -> Quote (type_expression env parent t) 951 951 + | Splice t -> Splice (type_expression env parent t) 934 952 | Package p -> Package (type_expression_package env parent p) 935 953 936 954 let compile ~filename env compilation_unit =

+103 -1

odoc/src/xref2/component.ml

··· 65 65 66 66 type t = { 67 67 source_loc : Odoc_model.Paths.Identifier.SourceLocation.t option; 68 68 + source_loc_jane : Odoc_model.Lang.Source_loc_jane.t option; 68 69 doc : CComment.docs; 69 70 type_ : decl; 70 71 canonical : Odoc_model.Paths.Path.Module.t option; ··· 123 124 | Alias of t * string 124 125 | Arrow of label option * t * t 125 126 | Tuple of (string option * t) list 127 127 + | Unboxed_tuple of (string option * t) list 126 128 | Constr of Cpath.type_ * t list 127 129 | Polymorphic_variant of TypeExpr.Polymorphic_variant.t 128 130 | Object of TypeExpr.Object.t 129 131 | Class of Cpath.class_type * t list 130 132 | Poly of string list * t 133 133 + | Quote of t 134 134 + | Splice of t 131 135 | Package of TypeExpr.Package.t 132 136 end = 133 137 TypeExpr ··· 156 160 and Exception : sig 157 161 type t = { 158 162 source_loc : Odoc_model.Paths.Identifier.SourceLocation.t option; 163 163 + source_loc_jane : Odoc_model.Lang.Source_loc_jane.t option; 159 164 doc : CComment.docs; 160 165 args : TypeDecl.Constructor.argument; 161 166 res : TypeExpr.t option; ··· 199 204 | Signature of Signature.t 200 205 | With of substitution list * expr 201 206 | TypeOf of type_of_desc * Cpath.module_ 207 207 + | Strengthen of expr * Cpath.module_ * bool 202 208 end 203 209 204 210 type path_t = { ··· 210 216 w_substitutions : substitution list; 211 217 w_expansion : simple_expansion option; 212 218 w_expr : U.expr; 219 219 + } 220 220 + 221 221 + type strengthen_t = { 222 222 + s_expansion : simple_expansion option; 223 223 + s_expr : U.expr; 224 224 + s_path : Cpath.module_; 225 225 + s_aliasable : bool 213 226 } 214 227 215 228 type expr = ··· 218 231 | With of with_t 219 232 | Functor of FunctorParameter.t * expr 220 233 | TypeOf of typeof_t 234 234 + | Strengthen of strengthen_t 221 235 222 236 type t = { 223 237 source_loc : Odoc_model.Paths.Identifier.SourceLocation.t option; 238 238 + source_loc_jane : Odoc_model.Lang.Source_loc_jane.t option; 224 239 doc : CComment.docs; 225 240 canonical : Odoc_model.Paths.Path.ModuleType.t option; 226 241 expr : expr option; ··· 238 253 } 239 254 end 240 255 256 256 + module UnboxedField : sig 257 257 + type t = { 258 258 + name : string; 259 259 + doc : CComment.docs; 260 260 + mutable_ : bool; 261 261 + type_ : TypeExpr.t; 262 262 + } 263 263 + end 264 264 + 241 265 module Constructor : sig 242 266 type argument = Tuple of TypeExpr.t list | Record of Field.t list 243 267 ··· 253 277 type t = 254 278 | Variant of Constructor.t list 255 279 | Record of Field.t list 280 280 + | Record_unboxed_product of UnboxedField.t list 256 281 | Extensible 257 282 end 258 283 ··· 269 294 270 295 type t = { 271 296 source_loc : Odoc_model.Paths.Identifier.SourceLocation.t option; 297 297 + source_loc_jane : Odoc_model.Lang.Source_loc_jane.t option; 272 298 doc : CComment.docs; 273 299 canonical : Odoc_model.Paths.Path.Type.t option; 274 300 equation : Equation.t; ··· 282 308 283 309 type t = { 284 310 source_loc : Odoc_model.Paths.Identifier.SourceLocation.t option; 311 311 + source_loc_jane : Odoc_model.Lang.Source_loc_jane.t option; 285 312 doc : CComment.docs; 286 313 type_ : TypeExpr.t; 287 314 value : value; ··· 353 380 354 381 type t = { 355 382 source_loc : Odoc_model.Paths.Identifier.SourceLocation.t option; 383 383 + source_loc_jane : Odoc_model.Lang.Source_loc_jane.t option; 356 384 doc : CComment.docs; 357 385 virtual_ : bool; 358 386 params : TypeDecl.param list; ··· 369 397 370 398 type t = { 371 399 source_loc : Odoc_model.Paths.Identifier.SourceLocation.t option; 400 400 + source_loc_jane : Odoc_model.Lang.Source_loc_jane.t option; 372 401 doc : CComment.docs; 373 402 virtual_ : bool; 374 403 params : TypeDecl.param list; ··· 510 539 511 540 type field = [ `Field of Identifier.Field.t * TypeDecl.Field.t ] 512 541 542 542 + type unboxed_field = 543 543 + [ `UnboxedField of Identifier.UnboxedField.t * TypeDecl.UnboxedField.t ] 544 544 + 513 545 (* No component for pages yet *) 514 546 type page = [ `Page of Identifier.Page.t * Odoc_model.Lang.Page.t ] 515 547 ··· 529 561 | extension 530 562 | extension_decl 531 563 | field 564 564 + | unboxed_field 532 565 | page ] 533 566 534 567 let identifier : [< any ] -> Odoc_model.Paths.Identifier.t = ··· 544 577 | `Constructor (id, _) -> (id :> t) 545 578 | `Exception (id, _) -> (id :> t) 546 579 | `Field (id, _) -> (id :> t) 580 580 + | `UnboxedField (id, _) -> (id :> t) 547 581 | `Extension (id, _, _) -> (id :> t) 548 582 | `ExtensionDecl (id, _) -> (id :> t) 549 583 | `Page (id, _) -> (id :> t) ··· 697 731 Format.fprintf ppf "%a.%s" (model_identifier c) 698 732 (ty :> id) 699 733 (FieldName.to_string name) 734 734 + | `UnboxedField (ty, name) -> 735 735 + Format.fprintf ppf "%a.%s" (model_identifier c) 736 736 + (ty :> id) 737 737 + (UnboxedFieldName.to_string name) 700 738 | `Exception (p, name) -> 701 739 Format.fprintf ppf "%a.%s" (model_identifier c) 702 740 (p :> id) ··· 943 981 Format.fprintf ppf "%a with [%a]" (u_module_type_expr c) e 944 982 (substitution_list c) subs 945 983 | TypeOf (t_desc, _) -> module_type_type_of_desc c ppf t_desc 984 984 + | Strengthen (e, p, _) -> 985 985 + Format.fprintf ppf "%a with %a" (u_module_type_expr c) e (module_path c) p 946 986 947 987 and module_type_expr c ppf mt = 948 988 let open ModuleType in ··· 961 1001 | TypeOf { t_desc = StructInclude p; _ } -> 962 1002 Format.fprintf ppf "module type of struct include %a end" 963 1003 (module_path c) p 1004 1004 + | Strengthen { s_expr; s_path; _ } -> 1005 1005 + Format.fprintf ppf "%a with %a" (u_module_type_expr c) s_expr 1006 1006 + (module_path c) s_path 964 1007 965 1008 and module_type_expansion c ppf mt = 966 1009 let open ModuleType in ··· 996 1039 function 997 1040 | Variant cs -> fpp_list " | " "%a" (type_decl_constructor c) ppf cs 998 1041 | Record fs -> type_decl_fields c ppf fs 1042 1042 + | Record_unboxed_product fs -> type_decl_unboxed_fields c ppf fs 999 1043 | Extensible -> Format.fprintf ppf ".." 1000 1044 1001 1045 and type_decl_constructor c ppf t = ··· 1018 1062 let mutable_ = if t.mutable_ then "mutable " else "" in 1019 1063 fpf ppf "%s%s : %a" mutable_ t.name (type_expr c) t.type_ 1020 1064 1065 1065 + and type_decl_unboxed_field c ppf t = 1066 1066 + let open TypeDecl.UnboxedField in 1067 1067 + let mutable_ = if t.mutable_ then "mutable " else "" in 1068 1068 + fpf ppf "%s%s : %a" mutable_ t.name (type_expr c) t.type_ 1069 1069 + 1021 1070 and type_decl_fields c ppf fs = 1022 1022 - fpp_list "; " "{ %a }" (type_decl_field c) ppf fs 1071 1071 + fpf ppf "{ %a }" (fpp_list "; " "%a" (type_decl_field c)) fs 1072 1072 + 1073 1073 + and type_decl_unboxed_fields c ppf fs = 1074 1074 + fpf ppf "#{ %a }" (fpp_list "; " "%a" (type_decl_unboxed_field c)) fs 1023 1075 1024 1076 and type_constructor_params c ppf ts = 1025 1077 fpp_list " * " "%a" (type_expr c) ppf ts ··· 1139 1191 Format.fprintf ppf "%a(%a) -> %a" type_expr_label l (type_expr c) t1 1140 1192 (type_expr c) t2 1141 1193 | Tuple ts -> Format.fprintf ppf "(%a)" (type_labeled_tuple c) ts 1194 1194 + | Unboxed_tuple ts -> Format.fprintf ppf "#(%a)" (type_labeled_tuple c) ts 1142 1195 | Constr (p, args) -> ( 1143 1196 match args with 1144 1197 | [] -> Format.fprintf ppf "%a" (type_path c) p ··· 1152 1205 | Object x -> type_object c ppf x 1153 1206 | Class (x, y) -> type_class c ppf (x, y) 1154 1207 | Poly (_ss, _t) -> Format.fprintf ppf "(poly)" 1208 1208 + | Quote t -> Format.fprintf ppf "(quote %a)" (type_expr c) t 1209 1209 + | Splice t -> Format.fprintf ppf "(splice %a)" (type_expr c) t 1155 1210 | Package x -> type_package c ppf x 1156 1211 1157 1212 and resolved_module_path : ··· 1618 1673 (model_resolved_reference c) 1619 1674 (parent :> t) 1620 1675 (FieldName.to_string name) 1676 1676 + | `UnboxedField (parent, name) -> 1677 1677 + Format.fprintf ppf "%a.#%s" 1678 1678 + (model_resolved_reference c) 1679 1679 + (parent :> t) 1680 1680 + (UnboxedFieldName.to_string name) 1621 1681 | `Extension (parent, name) -> 1622 1682 Format.fprintf ppf "%a.%s" 1623 1683 (model_resolved_reference c) ··· 1714 1774 Format.fprintf ppf "%a.%s" (model_reference c) 1715 1775 (parent :> t) 1716 1776 (FieldName.to_string name) 1777 1777 + | `UnboxedField (parent, name) -> 1778 1778 + Format.fprintf ppf "%a.%s" (model_reference c) 1779 1779 + (parent :> t) 1780 1780 + (UnboxedFieldName.to_string name) 1717 1781 | `Extension (parent, name) -> 1718 1782 Format.fprintf ppf "%a.%s" (model_reference c) 1719 1783 (parent :> t) ··· 2149 2213 let open Odoc_model.Lang.TypeDecl in 2150 2214 { 2151 2215 TypeDecl.source_loc = ty.source_loc; 2216 2216 + source_loc_jane = ty.source_loc_jane; 2152 2217 doc = docs ident_map ty.doc; 2153 2218 canonical = ty.canonical; 2154 2219 equation = type_equation ident_map ty.equation; ··· 2163 2228 TypeDecl.Representation.Variant 2164 2229 (List.map (type_decl_constructor ident_map) cs) 2165 2230 | Record fs -> Record (List.map (type_decl_field ident_map) fs) 2231 2231 + | Record_unboxed_product fs -> 2232 2232 + Record_unboxed_product (List.map (type_decl_unboxed_field ident_map) fs) 2166 2233 | Extensible -> Extensible 2167 2234 2168 2235 and type_decl_constructor ident_map t = ··· 2188 2255 let type_ = type_expression ident_map f.type_ in 2189 2256 { 2190 2257 TypeDecl.Field.name = Paths.Identifier.name f.id; 2258 2258 + doc = docs ident_map f.doc; 2259 2259 + mutable_ = f.mutable_; 2260 2260 + type_; 2261 2261 + } 2262 2262 + 2263 2263 + and type_decl_unboxed_field ident_map f = 2264 2264 + let type_ = type_expression ident_map f.type_ in 2265 2265 + { 2266 2266 + TypeDecl.UnboxedField.name = Paths.Identifier.name f.id; 2191 2267 doc = docs ident_map f.doc; 2192 2268 mutable_ = f.mutable_; 2193 2269 type_; ··· 2264 2340 | Tuple ts -> 2265 2341 Tuple 2266 2342 (List.map (fun (lbl, ty) -> (lbl, type_expression ident_map ty)) ts) 2343 2343 + | Unboxed_tuple ts -> 2344 2344 + Unboxed_tuple (List.map (fun (l, t) -> l, type_expression ident_map t) ts) 2267 2345 | Polymorphic_variant v -> 2268 2346 Polymorphic_variant (type_expr_polyvar ident_map v) 2269 2347 | Poly (s, ts) -> Poly (s, type_expression ident_map ts) ··· 2272 2350 Class 2273 2351 (class_type_path ident_map p, List.map (type_expression ident_map) ts) 2274 2352 | Object o -> Object (type_object ident_map o) 2353 2353 + | Quote t -> Quote (type_expression ident_map t) 2354 2354 + | Splice t -> Splice (type_expression ident_map t) 2275 2355 | Package p -> Package (type_package ident_map p) 2276 2356 2277 2357 and module_decl ident_map m = ··· 2317 2397 let canonical = m.Odoc_model.Lang.Module.canonical in 2318 2398 { 2319 2399 Module.source_loc = m.source_loc; 2400 2400 + source_loc_jane = m.source_loc_jane; 2320 2401 doc = docs ident_map m.doc; 2321 2402 type_; 2322 2403 canonical; ··· 2383 2464 let res = Opt.map (type_expression ident_map) e.res in 2384 2465 { 2385 2466 Exception.source_loc = e.source_loc; 2467 2467 + source_loc_jane = e.source_loc_jane; 2386 2468 doc = docs ident_map e.doc; 2387 2469 args; 2388 2470 res; ··· 2409 2491 (* see comment in module_type_expr below *) 2410 2492 let t_original_path = module_path (empty ()) t_original_path in 2411 2493 TypeOf (t_desc, t_original_path) 2494 2494 + | Strengthen (e, p, a) -> 2495 2495 + let e = u_module_type_expr ident_map e in 2496 2496 + let p = module_path ident_map p in 2497 2497 + Strengthen (e, p, a) 2412 2498 2413 2499 and module_type_expr ident_map m = 2414 2500 let open Odoc_model in ··· 2469 2555 _create_ a `TypeOf` expression as part of fragmap *) 2470 2556 let t_original_path = module_path (empty ()) t_original_path in 2471 2557 ModuleType.(TypeOf { t_desc; t_original_path; t_expansion }) 2558 2558 + | Lang.ModuleType.Strengthen s -> 2559 2559 + let s' = 2560 2560 + ModuleType. 2561 2561 + { s_expr = u_module_type_expr ident_map s.s_expr; 2562 2562 + s_path = module_path ident_map s.s_path; 2563 2563 + s_aliasable = s.s_aliasable; 2564 2564 + s_expansion = option simple_expansion ident_map s.s_expansion 2565 2565 + } 2566 2566 + in 2567 2567 + ModuleType.Strengthen s' 2472 2568 2473 2569 and module_type ident_map m = 2474 2570 let expr = ··· 2476 2572 in 2477 2573 { 2478 2574 ModuleType.source_loc = m.source_loc; 2575 2575 + source_loc_jane = m.source_loc_jane; 2479 2576 doc = docs ident_map m.doc; 2480 2577 canonical = m.canonical; 2481 2578 expr; ··· 2488 2585 doc = docs ident_map v.doc; 2489 2586 value = v.value; 2490 2587 source_loc = v.source_loc; 2588 2588 + source_loc_jane = v.source_loc_jane 2491 2589 } 2492 2590 2493 2591 and include_ ident_map i = ··· 2509 2607 let expansion = Opt.map (class_signature ident_map) c.expansion in 2510 2608 { 2511 2609 Class.source_loc = c.source_loc; 2610 2610 + source_loc_jane = c.source_loc_jane; 2512 2611 doc = docs ident_map c.doc; 2513 2612 virtual_ = c.virtual_; 2514 2613 params = c.params; ··· 2536 2635 let expansion = Opt.map (class_signature ident_map) t.expansion in 2537 2636 { 2538 2637 ClassType.source_loc = t.source_loc; 2638 2638 + source_loc_jane = t.source_loc_jane; 2539 2639 doc = docs ident_map t.doc; 2540 2640 virtual_ = t.virtual_; 2541 2641 params = t.params; ··· 2615 2715 let manifest = module_path ident_map t.manifest in 2616 2716 { 2617 2717 Module.source_loc = None; 2718 2718 + source_loc_jane = None; 2618 2719 doc = docs ident_map t.doc; 2619 2720 type_ = Alias (manifest, None); 2620 2721 canonical = None; ··· 2736 2837 let module_of_functor_argument (arg : FunctorParameter.parameter) = 2737 2838 { 2738 2839 Module.source_loc = None; 2840 2840 + source_loc_jane = None; 2739 2841 doc = { elements = []; warnings_tag = None }; 2740 2842 type_ = ModuleType arg.expr; 2741 2843 canonical = None;

+33

odoc/src/xref2/component.mli

··· 63 63 64 64 type t = { 65 65 source_loc : Odoc_model.Paths.Identifier.SourceLocation.t option; 66 66 + source_loc_jane : Odoc_model.Lang.Source_loc_jane.t option; 66 67 doc : CComment.docs; 67 68 type_ : decl; 68 69 canonical : Odoc_model.Paths.Path.Module.t option; ··· 118 119 | Alias of t * string 119 120 | Arrow of label option * t * t 120 121 | Tuple of (string option * t) list 122 122 + | Unboxed_tuple of (string option * t) list 121 123 | Constr of Cpath.type_ * t list 122 124 | Polymorphic_variant of TypeExpr.Polymorphic_variant.t 123 125 | Object of TypeExpr.Object.t 124 126 | Class of Cpath.class_type * t list 125 127 | Poly of string list * t 128 128 + | Quote of t 129 129 + | Splice of t 126 130 | Package of TypeExpr.Package.t 127 131 end 128 132 ··· 149 153 and Exception : sig 150 154 type t = { 151 155 source_loc : Odoc_model.Paths.Identifier.SourceLocation.t option; 156 156 + source_loc_jane : Odoc_model.Lang.Source_loc_jane.t option; 152 157 doc : CComment.docs; 153 158 args : TypeDecl.Constructor.argument; 154 159 res : TypeExpr.t option; ··· 190 195 | Signature of Signature.t 191 196 | With of substitution list * expr 192 197 | TypeOf of type_of_desc * Cpath.module_ 198 198 + | Strengthen of expr * Cpath.module_ * bool 193 199 end 194 200 195 201 type path_t = { ··· 203 209 w_expr : U.expr; 204 210 } 205 211 212 212 + type strengthen_t = { 213 213 + s_expansion : simple_expansion option; 214 214 + s_expr : U.expr; 215 215 + s_path : Cpath.module_; 216 216 + s_aliasable : bool 217 217 + } 218 218 + 206 219 type expr = 207 220 | Path of path_t 208 221 | Signature of Signature.t 209 222 | With of with_t 210 223 | Functor of FunctorParameter.t * expr 211 224 | TypeOf of typeof_t 225 225 + | Strengthen of strengthen_t 212 226 213 227 type t = { 214 228 source_loc : Odoc_model.Paths.Identifier.SourceLocation.t option; 229 229 + source_loc_jane : Odoc_model.Lang.Source_loc_jane.t option; 215 230 doc : CComment.docs; 216 231 canonical : Odoc_model.Paths.Path.ModuleType.t option; 217 232 expr : expr option; ··· 228 243 } 229 244 end 230 245 246 246 + module UnboxedField : sig 247 247 + type t = { 248 248 + name : string; 249 249 + doc : CComment.docs; 250 250 + mutable_ : bool; 251 251 + type_ : TypeExpr.t; 252 252 + } 253 253 + end 254 254 + 231 255 module Constructor : sig 232 256 type argument = Tuple of TypeExpr.t list | Record of Field.t list 233 257 ··· 243 267 type t = 244 268 | Variant of Constructor.t list 245 269 | Record of Field.t list 270 270 + | Record_unboxed_product of UnboxedField.t list 246 271 | Extensible 247 272 end 248 273 ··· 259 284 260 285 type t = { 261 286 source_loc : Odoc_model.Paths.Identifier.SourceLocation.t option; 287 287 + source_loc_jane : Odoc_model.Lang.Source_loc_jane.t option; 262 288 doc : CComment.docs; 263 289 canonical : Odoc_model.Paths.Path.Type.t option; 264 290 equation : Equation.t; ··· 324 350 325 351 type t = { 326 352 source_loc : Odoc_model.Paths.Identifier.SourceLocation.t option; 353 353 + source_loc_jane : Odoc_model.Lang.Source_loc_jane.t option; 327 354 doc : CComment.docs; 328 355 type_ : TypeExpr.t; 329 356 value : value; ··· 337 364 338 365 type t = { 339 366 source_loc : Odoc_model.Paths.Identifier.SourceLocation.t option; 367 367 + source_loc_jane : Odoc_model.Lang.Source_loc_jane.t option; 340 368 doc : CComment.docs; 341 369 virtual_ : bool; 342 370 params : TypeDecl.param list; ··· 352 380 353 381 type t = { 354 382 source_loc : Odoc_model.Paths.Identifier.SourceLocation.t option; 383 383 + source_loc_jane : Odoc_model.Lang.Source_loc_jane.t option; 355 384 doc : CComment.docs; 356 385 virtual_ : bool; 357 386 params : TypeDecl.param list; ··· 486 515 487 516 type field = [ `Field of Identifier.Field.t * TypeDecl.Field.t ] 488 517 518 518 + type unboxed_field = 519 519 + [ `UnboxedField of Identifier.UnboxedField.t * TypeDecl.UnboxedField.t ] 520 520 + 489 521 (* No component for pages yet *) 490 522 type page = [ `Page of Identifier.Page.t * Odoc_model.Lang.Page.t ] 491 523 ··· 505 537 | extension 506 538 | extension_decl 507 539 | field 540 540 + | unboxed_field 508 541 | page ] 509 542 510 543 val identifier : [< any ] -> Identifier.t

+19 -3

odoc/src/xref2/dune

··· 8 8 (libraries odoc_model odoc_utils)) 9 9 10 10 (rule 11 11 - (with-stdout-to 12 12 - shape_tools.ml 13 13 - (run %{bin:cppo} -V OCAML:%{ocaml_version} %{dep:shape_tools.cppo.ml}))) 11 11 + (enabled_if 12 12 + (not %{ocaml-config:ox})) 13 13 + (action 14 14 + (with-stdout-to 15 15 + shape_tools.ml 16 16 + (run %{bin:cppo} -V OCAML:%{ocaml_version} %{dep:shape_tools.cppo.ml})))) 17 17 + 18 18 + (rule 19 19 + (enabled_if %{ocaml-config:ox}) 20 20 + (action 21 21 + (with-stdout-to 22 22 + shape_tools.ml 23 23 + (run 24 24 + %{bin:cppo} 25 25 + -V 26 26 + OCAML:%{ocaml_version} 27 27 + -D 28 28 + OXCAML 29 29 + %{dep:shape_tools.cppo.ml})))) 14 30 15 31 (rule 16 32 (with-stdout-to

+31 -3

odoc/src/xref2/env.ml

··· 91 91 | Kind_Exception 92 92 | Kind_Extension 93 93 | Kind_Field 94 94 + | Kind_UnboxedField 94 95 95 96 module ElementsByName : sig 96 97 type t ··· 167 168 ids : ElementsById.t; 168 169 (** Elements mapped by their identifier. Queried with {!find_by_id}. *) 169 170 ambiguous_labels : Component.Element.label amb_err Identifier.Maps.Label.t; 171 171 + ambiguous_unboxed_labels : 172 172 + Component.Element.label amb_err Identifier.Maps.Label.t; 173 173 + [@warning "-unused-field"] 170 174 resolver : resolver option; 171 175 recorder : recorder option; 172 176 warnings_tags : string list; ··· 212 216 resolver = None; 213 217 recorder = None; 214 218 ambiguous_labels = Identifier.Maps.Label.empty; 219 219 + ambiguous_unboxed_labels = Identifier.Maps.Label.empty; 215 220 warnings_tags = []; 216 221 fragmentroot = None; 217 222 } ··· 242 247 ids = ElementsById.add identifier component env.ids; 243 248 } 244 249 245 245 - let add_label identifier heading env = 250 250 + let add_label identifier heading env ~unboxed = 246 251 assert env.linking; 252 252 + (* TODO: implement proper behavior for unboxed labels *) 253 253 + assert (not unboxed); 247 254 let comp = `Label (identifier, heading) in 248 255 let name = Identifier.name identifier in 249 256 let ambiguous_labels = ··· 279 286 (fun env -> function 280 287 | { Location_.value = `Heading (attrs, id, text); location } -> 281 288 let label = Ident.Of_Identifier.label id in 282 282 - add_label id { Component.Label.attrs; label; text; location } env 289 289 + add_label id 290 290 + { Component.Label.attrs; label; text; location } 291 291 + env ~unboxed:false 283 292 | _ -> env) 284 293 env docs.elements 285 294 ··· 295 304 let label = 296 305 Paths.Identifier.Mk.label (Paths.Identifier.label_parent p, name) 297 306 in 298 298 - add_label label h env 307 307 + add_label label h env ~unboxed:false 299 308 | _ -> env) 300 309 env docs.elements 301 310 ··· 320 329 FieldName.make_std field.name ) 321 330 in 322 331 add_to_elts Kind_Field ident (`Field (ident, field)) env 332 332 + and add_unboxed_field env (field : TypeDecl.UnboxedField.t) = 333 333 + let ident = 334 334 + Paths.Identifier.Mk.unboxed_field 335 335 + ( (identifier :> Paths.Identifier.UnboxedFieldParent.t), 336 336 + UnboxedFieldName.make_std field.name ) 337 337 + in 338 338 + add_to_elts Kind_UnboxedField ident (`UnboxedField (ident, field)) env 323 339 in 324 340 let open TypeDecl in 325 341 match t.representation with ··· 329 345 | Some (Record fields) -> 330 346 ( List.fold_left add_field cs fields, 331 347 List.map (fun t -> t.Field.doc) fields ) 348 348 + | Some (Record_unboxed_product fields) -> 349 349 + ( List.fold_left add_unboxed_field cs fields, 350 350 + List.map (fun t -> t.UnboxedField.doc) fields ) 332 351 | Some Extensible | None -> (cs, []) 333 352 in 334 353 let env, docs = if env.linking then open_typedecl env else (env, []) in ··· 381 400 { 382 401 id; 383 402 source_loc = None; 403 403 + source_loc_jane = unit.source_loc_jane; 384 404 doc = { elements = []; warnings_tag = None }; 385 405 type_ = ModuleType (Signature s); 386 406 canonical = unit.canonical; ··· 395 415 { 396 416 id; 397 417 source_loc = None; 418 418 + source_loc_jane = unit.source_loc_jane; 398 419 doc = { elements = []; warnings_tag = None }; 399 420 type_ = 400 421 ModuleType ··· 625 646 let s_field : Component.Element.field scope = 626 647 make_scope (function #Component.Element.field as r -> Some r | _ -> None) 627 648 649 649 + let s_unboxed_field : Component.Element.unboxed_field scope = 650 650 + make_scope (function 651 651 + | #Component.Element.unboxed_field as r -> Some r 652 652 + | _ -> None) 653 653 + 628 654 let s_label_parent : Component.Element.label_parent scope = 629 655 make_scope ~root:lookup_page_or_root_module_fallback (function 630 656 | #Component.Element.label_parent as r -> Some r ··· 656 682 Component.Module. 657 683 { 658 684 source_loc = None; 685 685 + source_loc_jane = None; 659 686 doc = { elements = []; warnings_tag = None }; 660 687 type_; 661 688 canonical = None; ··· 830 857 { 831 858 id = t.id; 832 859 source_loc = None; 860 860 + source_loc_jane = None; 833 861 doc = t.doc; 834 862 expr = Some t.manifest; 835 863 canonical = None;

+3 -1

odoc/src/xref2/env.mli

··· 64 64 65 65 val add_value : Identifier.Value.t -> Component.Value.t -> t -> t 66 66 67 67 - val add_label : Identifier.Label.t -> Component.Label.t -> t -> t 67 67 + val add_label : Identifier.Label.t -> Component.Label.t -> t -> unboxed:bool -> t 68 68 69 69 val add_class : Identifier.Class.t -> Component.Class.t -> t -> t 70 70 ··· 153 153 val s_extension : Component.Element.extension scope 154 154 155 155 val s_field : Component.Element.field scope 156 156 + 157 157 + val s_unboxed_field : Component.Element.unboxed_field scope 156 158 157 159 val s_label_parent : Component.Element.label_parent scope 158 160

+2

odoc/src/xref2/errors.ml

··· 16 16 | `Page 17 17 | `Cons 18 18 | `Field 19 19 + | `UnboxedField 19 20 | `Label 20 21 | `Page_path 21 22 | `Module_path ··· 129 130 | `Page -> "page" 130 131 | `Cons -> "constructor" 131 132 | `Field -> "field" 133 133 + | `UnboxedField -> "unboxed field" 132 134 | `Label -> "label" 133 135 | `Page_path -> "path to a page" 134 136 | `Module_path -> "path to a module"

+3

odoc/src/xref2/expand_tools.ml

··· 58 58 if List.mem_assoc s map then raise Clash else Alias (type_expr map t, s) 59 59 | Arrow (l, t1, t2) -> Arrow (l, type_expr map t1, type_expr map t2) 60 60 | Tuple ts -> Tuple (List.map (fun (l, ty) -> (l, type_expr map ty)) ts) 61 61 + | Unboxed_tuple ts -> Unboxed_tuple (List.map (fun (l, t) -> l, type_expr map t) ts) 61 62 | Constr (p, ts) -> Constr (p, List.map (type_expr map) ts) 62 63 | Polymorphic_variant pv -> Polymorphic_variant (polymorphic_variant map pv) 63 64 | Object o -> Object (object_ map o) 64 65 | Class (path, ts) -> Class (path, List.map (type_expr map) ts) 65 66 | Poly (s, t) -> Poly (s, type_expr map t) 66 67 | Package p -> Package (package map p) 68 68 + | Quote t -> Quote (type_expr map t) 69 69 + | Splice t -> Splice (type_expr map t) 67 70 68 71 and polymorphic_variant map pv = 69 72 let open Lang.TypeExpr.Polymorphic_variant in

+10 -1

odoc/src/xref2/find.ml

··· 38 38 39 39 type field = [ `FField of TypeDecl.Field.t ] 40 40 41 41 - type any_in_type = [ constructor | field | polymorphic_constructor ] 41 41 + type unboxed_field = [ `FUnboxedField of TypeDecl.UnboxedField.t ] 42 42 + 43 43 + type any_in_type = [ constructor | field | unboxed_field | polymorphic_constructor ] 42 44 43 45 type any_in_type_in_sig = 44 46 [ `In_type of Odoc_model.Names.TypeName.t * TypeDecl.t * any_in_type ] ··· 206 208 | _ :: tl -> find_field tl 207 209 | [] -> None 208 210 in 211 211 + let rec find_unboxed_field = function 212 212 + | ({ TypeDecl.UnboxedField.name = name'; _ } as field) :: _ when name' = name -> 213 213 + Some (`FUnboxedField field) 214 214 + | _ :: tl -> find_unboxed_field tl 215 215 + | [] -> None 216 216 + in 209 217 let rec find_poly = function 210 218 | TypeExpr.Polymorphic_variant.Constructor 211 219 ({ TypeExpr.Polymorphic_variant.Constructor.name = name'; _ } as cons) ··· 218 226 match typ.representation with 219 227 | Some (Variant cons) -> find_cons cons 220 228 | Some (Record fields) -> find_field fields 229 229 + | Some (Record_unboxed_product fields) -> find_unboxed_field fields 221 230 | Some Extensible -> None 222 231 | None -> ( 223 232 match typ.equation.manifest with

+3 -1

odoc/src/xref2/find.mli

··· 37 37 38 38 type field = [ `FField of TypeDecl.Field.t ] 39 39 40 40 - type any_in_type = [ constructor | field | polymorphic_constructor ] 40 40 + type unboxed_field = [ `FUnboxedField of TypeDecl.UnboxedField.t ] 41 41 + 42 42 + type any_in_type = [ constructor | field | unboxed_field | polymorphic_constructor ] 41 43 42 44 type any_in_type_in_sig = [ `In_type of TypeName.t * TypeDecl.t * any_in_type ] 43 45

+5

odoc/src/xref2/ident.ml

··· 14 14 15 15 type field = [ `LField of FieldName.t * int ] 16 16 17 17 + type unboxed_field = [ `LUnboxedField of UnboxedFieldName.t * int ] 18 18 + 17 19 type extension = [ `LExtension of ExtensionName.t * int ] 18 20 19 21 type exception_ = [ `LException of ExceptionName.t * int ] ··· 34 36 | type_ 35 37 | constructor 36 38 | field 39 39 + | unboxed_field 37 40 | extension 38 41 | exception_ 39 42 | value ··· 56 59 | `LValue (_, i) 57 60 | `LInstanceVariable (_, i) 58 61 | `LField (_, i) 62 62 + | `LUnboxedField (_, i) 59 63 | `LLabel (_, i) 60 64 | `LModuleType (_, i) 61 65 | `LPage (_, i) ··· 193 197 | `LType (n, i) -> (TypeName.to_string n, i) 194 198 | `LConstructor (n, i) -> (ConstructorName.to_string n, i) 195 199 | `LField (n, i) -> (FieldName.to_string n, i) 200 200 + | `LUnboxedField (n, i) -> (UnboxedFieldName.to_string n, i) 196 201 | `LExtension (n, i) -> (ExtensionName.to_string n, i) 197 202 | `LException (n, i) -> (ExceptionName.to_string n, i) 198 203 | `LValue (n, i) -> (ValueName.to_string n, i)

+43

odoc/src/xref2/lang_of.ml

··· 489 489 { 490 490 id = identifier; 491 491 source_loc = c.source_loc; 492 492 + source_loc_jane = c.source_loc_jane; 492 493 doc = docs (parent :> Identifier.LabelParent.t) c.doc; 493 494 virtual_ = c.virtual_; 494 495 params = c.params; ··· 527 528 { 528 529 Odoc_model.Lang.ClassType.id = identifier; 529 530 source_loc = c.source_loc; 531 531 + source_loc_jane = c.source_loc_jane; 530 532 doc = docs (parent :> Identifier.LabelParent.t) c.doc; 531 533 virtual_ = c.virtual_; 532 534 params = c.params; ··· 687 689 { 688 690 id = identifier; 689 691 source_loc = v.source_loc; 692 692 + source_loc_jane = v.source_loc_jane; 690 693 doc = docs (parent :> Identifier.LabelParent.t) v.doc; 691 694 type_ = type_expr map (parent :> Identifier.LabelParent.t) v.type_; 692 695 value = v.value; ··· 730 733 { 731 734 Odoc_model.Lang.Module.id; 732 735 source_loc = m.source_loc; 736 736 + source_loc_jane = m.source_loc_jane; 733 737 doc = docs (parent :> Identifier.LabelParent.t) m.doc; 734 738 type_ = module_decl map identifier m.type_; 735 739 canonical = m.canonical; ··· 799 803 TypeOf (ModPath (Path.module_ map p), Path.module_ map original_path) 800 804 | TypeOf (StructInclude p, original_path) -> 801 805 TypeOf (StructInclude (Path.module_ map p), Path.module_ map original_path) 806 806 + | Strengthen (expr, path, aliasable) -> 807 807 + let expr = u_module_type_expr map identifier expr in 808 808 + let path = Path.module_ map path in 809 809 + Strengthen (expr, path, aliasable) 802 810 803 811 and module_type_expr map identifier = function 804 812 | Component.ModuleType.Path { p_path; p_expansion } -> ··· 849 857 t_original_path = Path.module_ map t_original_path; 850 858 t_expansion = Opt.map (simple_expansion map identifier) t_expansion; 851 859 } 860 860 + | Strengthen { s_expr; s_path; s_aliasable; s_expansion } -> 861 861 + Strengthen 862 862 + { 863 863 + s_expr = u_module_type_expr map identifier s_expr; 864 864 + s_path = Path.module_ map s_path; 865 865 + s_aliasable; 866 866 + s_expansion = Opt.map (simple_expansion map identifier) s_expansion 867 867 + } 852 868 853 869 and module_type : 854 870 maps -> ··· 864 880 { 865 881 Odoc_model.Lang.ModuleType.id = identifier; 866 882 source_loc = mty.source_loc; 883 883 + source_loc_jane = mty.source_loc_jane; 867 884 doc = docs (parent :> Identifier.LabelParent.t) mty.doc; 868 885 canonical = mty.canonical; 869 886 expr = Opt.map (module_type_expr map sig_id) mty.expr; ··· 912 929 type_ = type_expr map (parent :> Identifier.LabelParent.t) f.type_; 913 930 } 914 931 932 932 + and type_decl_unboxed_field : 933 933 + maps -> 934 934 + Identifier.UnboxedFieldParent.t -> 935 935 + Component.TypeDecl.UnboxedField.t -> 936 936 + Odoc_model.Lang.TypeDecl.UnboxedField.t = 937 937 + fun map parent f -> 938 938 + let identifier = Identifier.Mk.unboxed_field (parent, UnboxedFieldName.make_std f.name) in 939 939 + { 940 940 + id = identifier; 941 941 + doc = docs (parent :> Identifier.LabelParent.t) f.doc; 942 942 + mutable_ = f.mutable_; 943 943 + type_ = type_expr map (parent :> Identifier.LabelParent.t) f.type_; 944 944 + } 945 945 + 915 946 and type_decl_equation map (parent : Identifier.FieldParent.t) 916 947 (eqn : Component.TypeDecl.Equation.t) : Odoc_model.Lang.TypeDecl.Equation.t 917 948 = ··· 932 963 { 933 964 id = identifier; 934 965 source_loc = t.source_loc; 966 966 + source_loc_jane = t.source_loc_jane; 935 967 equation = 936 968 type_decl_equation map (parent :> Identifier.FieldParent.t) t.equation; 937 969 doc = docs (parent :> Identifier.LabelParent.t) t.doc; ··· 951 983 (type_decl_field map 952 984 (id :> Odoc_model.Paths.Identifier.FieldParent.t)) 953 985 fs) 986 986 + | Record_unboxed_product fs -> 987 987 + Record_unboxed_product 988 988 + (List.map 989 989 + (type_decl_unboxed_field map 990 990 + (id :> Odoc_model.Paths.Identifier.UnboxedFieldParent.t)) 991 991 + fs) 954 992 955 993 and type_decl_constructor : 956 994 maps -> ··· 992 1030 Arrow (lbl, type_expr map parent t1, type_expr map parent t2) 993 1031 | Tuple ts -> 994 1032 Tuple (List.map (fun (lbl, ty) -> (lbl, type_expr map parent ty)) ts) 1033 1033 + | Unboxed_tuple ts -> 1034 1034 + Unboxed_tuple (List.map (fun (l, t) -> l, type_expr map parent t) ts) 995 1035 | Constr (path, ts) -> 996 1036 Constr 997 1037 ( (Path.type_ map path :> Paths.Path.Type.t), ··· 1002 1042 | Class (p, ts) -> 1003 1043 Class (Path.class_type map p, List.map (type_expr map parent) ts) 1004 1044 | Poly (strs, t) -> Poly (strs, type_expr map parent t) 1045 1045 + | Quote t -> Quote (type_expr map parent t) 1046 1046 + | Splice t -> Splice (type_expr map parent t) 1005 1047 | Package p -> Package (type_expr_package map parent p) 1006 1048 with e -> 1007 1049 let bt = Printexc.get_backtrace () in ··· 1061 1103 { 1062 1104 id = identifier; 1063 1105 source_loc = e.source_loc; 1106 1106 + source_loc_jane = e.source_loc_jane; 1064 1107 doc = docs (parent :> Identifier.LabelParent.t) e.doc; 1065 1108 args = 1066 1109 type_decl_constructor_argument map

+32

odoc/src/xref2/link.ml

··· 466 466 internal_typ_exp t.type_ 467 467 in 468 468 469 469 + let internal_unboxed_field t = 470 470 + let open Lang.TypeDecl.UnboxedField in 471 471 + internal_typ_exp t.type_ 472 472 + in 473 473 + 469 474 let fmt_cfg = Component.Fmt.{ default with short_paths = true } in 470 475 match r with 471 476 | Variant constructors -> ··· 486 491 "@[<2>Hidden fields in type '%a': %s@]" 487 492 Component.Fmt.(model_identifier fmt_cfg) 488 493 (id :> Id.any) (String.concat ", " field_names)) 494 494 + | Record_unboxed_product fields -> 495 495 + if List.exists internal_unboxed_field fields then 496 496 + Lookup_failures.report_warning "@[<2>Hidden unboxed fields in type '%a'@]" 497 497 + Component.Fmt.(model_identifier fmt_cfg) 498 498 + (id :> Id.any) 489 499 | Extensible -> () 490 500 491 501 let rec unit env t = ··· 905 915 TypeOf (StructInclude (module_path env p), original_path) 906 916 | TypeOf (ModPath p, original_path) -> 907 917 TypeOf (ModPath (module_path env p), original_path) 918 918 + | Strengthen (expr, path, aliasable) -> 919 919 + let expr = u_module_type_expr env id expr in 920 920 + Strengthen (expr, module_path env path, aliasable) 908 921 909 922 and module_type_expr : 910 923 Env.t -> Id.Signature.t -> ModuleType.expr -> ModuleType.expr = ··· 968 981 t_desc = ModPath (module_path env p); 969 982 t_expansion = do_expn t_expansion None; 970 983 t_original_path; 984 984 + } 985 985 + | Strengthen { s_expr; s_path; s_aliasable; s_expansion } -> 986 986 + Strengthen 987 987 + { 988 988 + s_expr = u_module_type_expr env id s_expr; 989 989 + s_path = module_path env s_path; 990 990 + s_aliasable; 991 991 + s_expansion = do_expn s_expansion None; 971 992 } 972 993 973 994 and type_decl_representation : ··· 980 1001 match r with 981 1002 | Variant cs -> Variant (List.map (type_decl_constructor env parent) cs) 982 1003 | Record fs -> Record (List.map (type_decl_field env parent) fs) 1004 1004 + | Record_unboxed_product fs -> 1005 1005 + Record_unboxed_product (List.map (type_decl_unboxed_field env parent) fs) 983 1006 | Extensible -> Extensible 984 1007 985 1008 and type_decl : Env.t -> Id.Signature.t -> TypeDecl.t -> TypeDecl.t = ··· 1042 1065 let doc = comment_docs env parent f.doc in 1043 1066 { f with type_ = type_expression env parent [] f.type_; doc } 1044 1067 1068 1068 + and type_decl_unboxed_field env parent f = 1069 1069 + let open TypeDecl.UnboxedField in 1070 1070 + let doc = comment_docs env parent f.doc in 1071 1071 + { f with type_ = type_expression env parent [] f.type_; doc } 1072 1072 + 1045 1073 and type_decl_constructor_argument env parent c = 1046 1074 let open TypeDecl.Constructor in 1047 1075 match c with ··· 1121 1149 (List.map 1122 1150 (fun (lbl, ty) -> (lbl, type_expression env parent visited ty)) 1123 1151 ts) 1152 1152 + | Unboxed_tuple ts -> 1153 1153 + Unboxed_tuple (List.map (fun (l, t) -> l, type_expression env parent visited t) ts) 1124 1154 | Constr (path', ts') -> ( 1125 1155 let path = type_path env path' in 1126 1156 let ts = List.map (type_expression env parent visited) ts' in ··· 1184 1214 Class (`Resolved p, ts) 1185 1215 | _ -> Class (path', ts)) 1186 1216 | Poly (strs, t) -> Poly (strs, type_expression env parent visited t) 1217 1217 + | Quote t -> Quote (type_expression env parent visited t) 1218 1218 + | Splice t -> Splice (type_expression env parent visited t) 1187 1219 | Package p -> Package (type_expression_package env parent visited p) 1188 1220 1189 1221 let link ~filename x y =

+71 -12

odoc/src/xref2/ref_tools.ml

··· 78 78 | `Extension _ -> "extension" 79 79 | `ExtensionDecl _ -> "extension-decl" 80 80 | `Field _ -> "field" 81 81 + | `UnboxedField _ -> "unboxed-field" 81 82 | `Page _ -> "page" 82 83 83 84 let ref_kind_of_find = function ··· 94 95 | `FExt _ -> "extension" 95 96 | `FExtDecl _ -> "extension-decl" 96 97 | `FField _ | `In_type (_, _, `FField _) -> "field" 98 98 + | `FUnboxedField _ | `In_type (_, _, `FUnboxedField _) -> "unboxed-field" 97 99 | `FMethod _ -> "method" 98 100 | `FInstance_variable _ -> "instance-variable" 99 101 ··· 519 521 env_lookup_by_name Env.s_constructor name env 520 522 >>= fun (`Constructor (id, _)) -> Ok (`Identifier id :> t) 521 523 522 522 - let got_a_field name = 523 523 - (* Let's pretend we didn't see the field and say we didn't find anything. *) 524 524 + let not_a_constructor name = 525 525 + (* Let's pretend we didn't see the field/unboxed field and say we didn't find anything. *) 524 526 Error (`Find_by_name (`Cons, name)) 525 527 526 528 let in_parent _env (parent : fragment_type_parent_lookup_result) name = ··· 528 530 match parent with 529 531 | `S (parent', parent_cp, sg) -> ( 530 532 let sg = Tools.prefix_signature (parent_cp, sg) in 531 531 - find_ambiguous Find.any_in_type_in_sig sg name_s >>= function 532 532 - | `In_type (_, _, `FField _) -> got_a_field name_s 533 533 + let find_ambiguous = 534 534 + (find_ambiguous : ?kind:([> `Any ] as 'a) -> 535 535 + (Component.Signature.t -> string -> Find.any_in_type_in_sig list) 536 536 + -> 537 537 + Component.Signature.t -> string -> (Find.any_in_type_in_sig, [> `Find_by_name of 'a * string ]) result) 538 538 + in 539 539 + find_ambiguous Find.any_in_type_in_sig sg name_s >>= function 540 540 + | `In_type (_, _, `FField _) -> not_a_constructor name_s 541 541 + | `In_type (_, _, `FUnboxedField _) -> not_a_constructor name_s 533 542 | `In_type (typ_name, _, `FPoly cs) -> 534 543 Ok 535 544 (`PolyConstructor ··· 538 547 Ok (`Constructor (`Type (parent', typ_name), name))) 539 548 | `T (parent', t) -> ( 540 549 find Find.any_in_type t (fun x -> x) name_s >>= function 541 541 - | `FField _ -> got_a_field name_s 550 550 + | `FField _ -> not_a_constructor name_s 551 551 + | `FUnboxedField _ -> not_a_constructor name_s 542 552 | `FPoly cs -> 543 553 Ok 544 554 (`PolyConstructor ··· 567 577 env_lookup_by_name Env.s_field name env >>= fun (`Field (id, _)) -> 568 578 Ok (`Identifier id :> t) 569 579 570 570 - let got_a_constructor name = 571 571 - (* Let's pretend we didn't see the constructor and say we didn't find anything. *) 580 580 + let not_a_field name = 581 581 + (* Let's pretend we didn't see the constructor/unboxed field and say we didn't find anything. *) 572 582 Error (`Find_by_name (`Field, name)) 573 583 574 584 let in_parent _env (parent : fragment_type_parent_lookup_result) name = ··· 577 587 | `S (parent', parent_cp, sg) -> ( 578 588 let sg = Tools.prefix_signature (parent_cp, sg) in 579 589 find_ambiguous Find.any_in_type_in_sig sg name_s >>= function 580 580 - | `In_type (_, _, `FConstructor _) -> got_a_constructor name_s 581 581 - | `In_type (_, _, `FPoly _) -> got_a_constructor name_s 590 590 + | `In_type (_, _, `FConstructor _) -> not_a_field name_s 591 591 + | `In_type (_, _, `FPoly _) -> not_a_field name_s 592 592 + | `In_type (_, _, `FUnboxedField _) -> not_a_field name_s 582 593 | `In_type (typ_name, _, `FField _) -> 583 594 Ok 584 595 (`Field 585 596 ((`Type (parent', typ_name) :> Resolved.FieldParent.t), name))) 586 597 | `T (parent', t) -> ( 587 598 find Find.any_in_type t (fun x -> x) name_s >>= function 588 588 - | `FConstructor _ -> got_a_constructor name_s 589 589 - | `FPoly _ -> got_a_constructor name_s 599 599 + | `FConstructor _ -> not_a_field name_s 600 600 + | `FPoly _ -> not_a_field name_s 601 601 + | `FUnboxedField _ -> not_a_field name_s 590 602 | `FField _ -> Ok (`Field ((parent' :> Resolved.FieldParent.t), name))) 591 603 592 604 let of_component _env parent name = ··· 596 608 FieldName.make_std name )) 597 609 end 598 610 611 611 + module UF = struct 612 612 + (** Unboxed field *) 613 613 + 614 614 + type t = Resolved.UnboxedField.t 615 615 + 616 616 + let in_env env name = 617 617 + env_lookup_by_name Env.s_unboxed_field name env >>= fun (`UnboxedField (id, _)) -> 618 618 + Ok (`Identifier id :> t) 619 619 + 620 620 + let not_an_unboxed_field name = 621 621 + (* Let's pretend we didn't see the constructor/field and say we didn't find anything. *) 622 622 + Error (`Find_by_name (`UnboxedField, name)) 623 623 + 624 624 + let in_parent _env (parent : fragment_type_parent_lookup_result) name = 625 625 + let name_s = UnboxedFieldName.to_string name in 626 626 + match parent with 627 627 + | `S (parent', parent_cp, sg) -> ( 628 628 + let sg = Tools.prefix_signature (parent_cp, sg) in 629 629 + find_ambiguous Find.any_in_type_in_sig sg name_s >>= function 630 630 + | `In_type (_, _, `FConstructor _) -> not_an_unboxed_field name_s 631 631 + | `In_type (_, _, `FPoly _) -> not_an_unboxed_field name_s 632 632 + | `In_type (_, _, `FField _) -> not_an_unboxed_field name_s 633 633 + | `In_type (typ_name, _, `FUnboxedField _) -> 634 634 + Ok 635 635 + (`UnboxedField 636 636 + ((`Type (parent', typ_name) :> Resolved.UnboxedFieldParent.t), name))) 637 637 + | `T (parent', t) -> ( 638 638 + find Find.any_in_type t (fun x -> x) name_s >>= function 639 639 + | `FConstructor _ -> not_an_unboxed_field name_s 640 640 + | `FPoly _ -> not_an_unboxed_field name_s 641 641 + | `FField _ -> not_an_unboxed_field name_s 642 642 + | `FUnboxedField _ -> Ok (`UnboxedField ((parent' :> Resolved.UnboxedFieldParent.t), name))) 643 643 + 644 644 + let of_component _env parent name = 645 645 + Ok 646 646 + (`UnboxedField 647 647 + ( (parent : Resolved.DataType.t :> Resolved.UnboxedFieldParent.t), 648 648 + UnboxedFieldName.make_std name )) 649 649 + end 650 650 + 599 651 module MM = struct 600 652 (** Method *) 601 653 ··· 872 924 match r with 873 925 | `FConstructor _ -> CS.of_component env parent name >>= resolved1 874 926 | `FPoly p -> CS.poly_of_component env parent p.name >>= resolved1 875 875 - | `FField _ -> F.of_component env parent name >>= resolved1) 927 927 + | `FField _ -> F.of_component env parent name >>= resolved1 928 928 + | `FUnboxedField _ -> UF.of_component env parent name >>= resolved1) 876 929 | `FModule_subst _ | `FType_subst _ | `FModuleType_subst _ -> 877 930 Error (`Find_by_name (`Any, name)) 878 931 ··· 884 937 | `FConstructor _ -> CS.of_component env parent_ref name >>= resolved1 885 938 | `FPoly p -> CS.poly_of_component env parent_ref p.name >>= resolved1 886 939 | `FField _ -> F.of_component env parent_ref name >>= resolved1 940 940 + | `FUnboxedField _ -> UF.of_component env parent_ref name >>= resolved1 887 941 888 942 let resolve_reference_dot_class env p name = 889 943 type_lookup_to_class_signature_lookup env p >>= fun (parent_ref, cs) -> ··· 931 985 | `Extension (id, _, _) -> identifier id 932 986 | `ExtensionDecl (id, _) -> identifier id 933 987 | `Field (id, _) -> identifier id 988 988 + | `UnboxedField (id, _) -> identifier id 934 989 | `Page (id, _) -> identifier id) 935 990 | `Resolved r -> Ok (r, None) 936 991 | `Root (name, (`TModule | `TChildModule)) -> M.in_env env name >>= resolved ··· 985 1040 | `Field (parent, name) -> 986 1041 resolve_fragment_type_parent_reference env parent >>= fun p -> 987 1042 F.in_parent env p name >>= resolved1 1043 1043 + | `Root (name, `TUnboxedField) -> UF.in_env env name >>= resolved1 1044 1044 + | `UnboxedField (parent, name) -> 1045 1045 + resolve_fragment_type_parent_reference env parent >>= fun p -> 1046 1046 + UF.in_parent env p name >>= resolved1 988 1047 | `Root (name, `TMethod) -> MM.in_env env name >>= resolved1 989 1048 | `Method (parent, name) -> 990 1049 resolve_class_signature_reference env parent >>= fun p ->

+12 -1

odoc/src/xref2/shape_tools.cppo.ml

··· 49 49 | `ClassType (parent, name) -> 50 50 proj parent Kind.Class_type (TypeName.to_string_unsafe name) 51 51 | `Page _ | `LeafPage _ | `Label _ 52 52 - | `Constructor _ | `Field _ | `Method _ | `InstanceVariable _ | `Parameter _ 52 52 + | `Constructor _ | `Field _ | `UnboxedField _ | `Method _ | `InstanceVariable _ | `Parameter _ 53 53 -> 54 54 (* Not represented in shapes. *) 55 55 None ··· 118 118 | Item { comp_unit; _ } -> Some comp_unit 119 119 | Predef _ -> None 120 120 | Internal -> None 121 121 + #if defined OXCAML 122 122 + | Unboxed_version _ -> None 123 123 + #endif 121 124 122 125 #if OCAML_VERSION >= (5,2,0) 123 126 let rec traverse_aliases = function ··· 155 158 | Some (shape, _) -> Some shape 156 159 | None -> None) 157 160 | _ -> None 161 161 + #if defined OXCAML 162 162 + let fuel () = Misc.Maybe_bounded.of_int fuel 163 163 + let projection_rules_for_merlin_enabled = false 164 164 + let fuel_for_compilation_units = fuel 165 165 + let max_shape_reduce_steps_per_variable = fuel 166 166 + let max_compilation_unit_depth = fuel 167 167 + let read_unit_shape ~diagnostics:_ ~unit_name = read_unit_shape ~unit_name 168 168 + #endif 158 169 end) in 159 170 let result = try Some (Reduce.reduce_for_uid Ocaml_env.empty query) with Not_found -> None in 160 171 result >>= traverse_aliases >>= fun uid ->

+28 -2

odoc/src/xref2/subst.ml

··· 125 125 Arrow (lbl, substitute_vars vars t1, substitute_vars vars t2) 126 126 | Tuple ts -> 127 127 Tuple (List.map (fun (lbl, ty) -> (lbl, substitute_vars vars ty)) ts) 128 128 + | Unboxed_tuple ts -> 129 129 + Unboxed_tuple (List.map (fun (l, t) -> l, substitute_vars vars t) ts) 128 130 | Constr (p, ts) -> Constr (p, List.map (substitute_vars vars) ts) 129 131 | Polymorphic_variant v -> 130 132 Polymorphic_variant (substitute_vars_poly_variant vars v) 131 133 | Object o -> Object (substitute_vars_type_object vars o) 132 134 | Class (p, ts) -> Class (p, List.map (substitute_vars vars) ts) 133 135 | Poly (strs, ts) -> Poly (strs, substitute_vars vars ts) 136 136 + | Quote t -> Quote (substitute_vars vars t) 137 137 + | Splice t -> Splice (substitute_vars vars t) 134 138 | Package p -> Package (substitute_vars_package vars p) 135 139 136 140 and substitute_vars_package vars p = ··· 489 493 match t with 490 494 | Variant cs -> Variant (List.map (type_decl_constructor s) cs) 491 495 | Record fs -> Record (List.map (type_decl_field s) fs) 496 496 + | Record_unboxed_product fs -> 497 497 + Record_unboxed_product (List.map (type_decl_unboxed_field s) fs) 492 498 | Extensible -> t 493 499 494 500 and type_decl_constructor s t = ··· 548 554 | Alias (t, str) -> Alias (type_expr s t, str) 549 555 | Arrow (lbl, t1, t2) -> Arrow (lbl, type_expr s t1, type_expr s t2) 550 556 | Tuple ts -> Tuple (List.map (fun (lbl, ty) -> (lbl, type_expr s ty)) ts) 557 557 + | Unboxed_tuple ts -> Unboxed_tuple (List.map (fun (l, t) -> l, type_expr s t) ts) 551 558 | Constr (p, ts) -> ( 552 559 match type_path s p with 553 560 | Replaced (t, eq) -> ··· 563 570 | Object o -> Object (type_object s o) 564 571 | Class (p, ts) -> Class (class_type_path s p, List.map (type_expr s) ts) 565 572 | Poly (strs, ts) -> Poly (strs, type_expr s ts) 573 573 + | Quote t -> Quote (type_expr s t) 574 574 + | Splice t -> Splice (type_expr s t) 566 575 | Package p -> Package (type_package s p) 567 576 568 577 and simple_expansion : ··· 580 589 let expr = 581 590 match t.expr with Some m -> Some (module_type_expr s m) | None -> None 582 591 in 583 583 - { expr; source_loc = t.source_loc; doc = t.doc; canonical = t.canonical } 592 592 + { expr; source_loc = t.source_loc; source_loc_jane = t.source_loc_jane ; doc = t.doc; canonical = t.canonical } 584 593 585 594 and module_type_substitution s t = 586 595 let open Component.ModuleTypeSubstitution in ··· 613 622 | With w -> With (w.w_substitutions, w.w_expr) 614 623 | Functor _ -> 615 624 (* non functor cannot be substituted away to a functor *) 616 616 - assert false)) 625 625 + assert false 626 626 + | Strengthen s -> Strengthen (s.s_expr, s.s_path, s.s_aliasable))) 617 627 | Signature sg -> Signature (signature s sg) 618 628 | With (subs, e) -> 619 629 With 620 630 (List.map (with_module_type_substitution s) subs, u_module_type_expr s e) 621 631 | TypeOf (t_desc, t_original_path) -> 622 632 TypeOf (module_type_type_of_desc s t_desc, t_original_path) 633 633 + | Strengthen (expr, path, aliasable) -> 634 634 + let expr = u_module_type_expr s expr in 635 635 + let path = module_path s path in 636 636 + Strengthen (expr, path, aliasable) 623 637 624 638 and module_type_expr s t = 625 639 let open Component.ModuleType in ··· 647 661 t_desc = module_type_type_of_desc s t.t_desc; 648 662 t_expansion = option_ simple_expansion s t.t_expansion; 649 663 } 664 664 + | Strengthen { s_expr; s_path; s_aliasable; s_expansion } -> 665 665 + Strengthen 666 666 + { 667 667 + s_expr = u_module_type_expr s s_expr; 668 668 + s_path = module_path s s_path; 669 669 + s_aliasable; 670 670 + s_expansion = option_ simple_expansion s s_expansion 671 671 + } 650 672 651 673 and with_module_type_substitution s sub = 652 674 let open Component.ModuleType in ··· 683 705 684 706 and type_decl_field s f = 685 707 let open Component.TypeDecl.Field in 708 708 + { f with type_ = type_expr s f.type_ } 709 709 + 710 710 + and type_decl_unboxed_field s f = 711 711 + let open Component.TypeDecl.UnboxedField in 686 712 { f with type_ = type_expr s f.type_ } 687 713 688 714 and type_decl_constructor_arg s a =

+9

odoc/src/xref2/tools.ml

··· 1631 1631 handle_signature_with_subs env sg subs 1632 1632 | TypeOf (desc, original_path) -> 1633 1633 signature_of_module_type_of env desc ~original_path >>= assert_not_functor 1634 1634 + | Strengthen (expr, path, _aliasable) -> 1635 1635 + signature_of_u_module_type_expr env expr >>= fun sg -> 1636 1636 + Ok (Strengthen.signature path sg) 1634 1637 1635 1638 and expansion_of_simple_expansion : 1636 1639 Component.ModuleType.simple_expansion -> expansion = ··· 1673 1676 | StructInclude p -> (p, true) 1674 1677 in 1675 1678 expansion_of_module_path env ~strengthen p 1679 1679 + | Component.ModuleType.Strengthen { s_expr; s_path; _ } -> 1680 1680 + signature_of_u_module_type_expr env s_expr >>= fun sg -> 1681 1681 + let sg = Strengthen.signature s_path sg in 1682 1682 + Ok (Signature sg) 1676 1683 1677 1684 and expansion_of_module_type : 1678 1685 Env.t -> ··· 1759 1766 | TypeOf { t_desc; t_original_path; _ } -> TypeOf (t_desc, t_original_path) 1760 1767 | With { w_substitutions; w_expr; _ } -> With (w_substitutions, w_expr) 1761 1768 | Functor _ -> assert false 1769 1769 + | Strengthen { s_expr; s_path; s_aliasable; _ } -> 1770 1770 + Strengthen (s_expr, s_path, s_aliasable) 1762 1771 1763 1772 and fragmap : 1764 1773 Env.t ->

+6 -1

root.opam

··· 19 19 "cppo" 20 20 "crunch" 21 21 "decompress" 22 22 - "dune" {>= "3.20"} 22 22 + "dockerfile" 23 23 + "dream" 24 24 + "dune" {>= "3.21"} 23 25 "dune-site" 24 26 "eio" 25 27 "eio_main" ··· 37 39 "mime_printer" 38 40 "ocaml" 39 41 "ocamlfind" 42 42 + "ocamlformat-lib" 40 43 "odig" 44 44 + "opam-0install" 41 45 "opam-format" 42 46 "ppx_blob" 43 47 "ppx_deriving" 44 48 "ppx_deriving_rpc" 49 49 + "ppx_deriving_yojson" 45 50 "ppx_expect" 46 51 "ppx_sexp_conv" 47 52 "ppxlib"

+1 -1

x-ocaml/dune-project

··· 1 1 - (lang dune 3.10) 1 1 + (lang dune 3.21) 2 2 3 3 (generate_opam_files true) 4 4