From 239b3a4e992f85bfaf76018faa1d4715ca895e48 Mon Sep 17 00:00:00 2001 From: Martin Jambon Date: Tue, 19 May 2026 00:11:11 +0000 Subject: [PATCH 1/7] Add Speedscope export format MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Adds `format=speedscope` to `OCAML_LANDMARKS`, which writes a sampled flame-graph profile openable at https://www.speedscope.app. Implementation: - `src/speedscope_fmt.atd` — ATD schema for the Speedscope file format (source of truth; regenerate with `atdml speedscope_fmt.atd`) - `src/speedscope_fmt.ml[i]` — generated types + Yojson serialisers, tracked in git so the build has no atdml dependency - `src/graph.ml` — `Graph.Speedscope` submodule: DFS over the call graph producing one sampled stack per node with positive self-time; uses `sys_time` (seconds) when collected, CPU cycles (`unit: none`) otherwise - `src/landmark.ml[i]` — new `Speedscope` variant of `profile_format`, env-var parsing, at-exit hook wiring - `src/dune` / `dune-project` — add `yojson` dependency - `tests/speedscope/` — hand-instrumented example with pre-generated `profile.json` checked in for read-without-running convenience Co-Authored-By: Claude Sonnet 4.6 --- README.md | 8 +-- dune-project | 1 + landmarks.opam | 1 + src/dune | 1 + src/graph.ml | 98 +++++++++++++++++++++++++++++++++++ src/graph.mli | 10 ++++ src/landmark.ml | 7 ++- src/landmark.mli | 1 + src/speedscope_fmt.atd | 51 ++++++++++++++++++ src/speedscope_fmt.ml | 82 +++++++++++++++++++++++++++++ src/speedscope_fmt.mli | 46 ++++++++++++++++ tests/speedscope/README.md | 47 +++++++++++++++++ tests/speedscope/dune | 3 ++ tests/speedscope/example.ml | 34 ++++++++++++ tests/speedscope/profile.json | 31 +++++++++++ 15 files changed, 417 insertions(+), 4 deletions(-) create mode 100644 src/speedscope_fmt.atd create mode 100644 src/speedscope_fmt.ml create mode 100644 src/speedscope_fmt.mli create mode 100644 tests/speedscope/README.md create mode 100644 tests/speedscope/dune create mode 100644 tests/speedscope/example.ml create mode 100644 tests/speedscope/profile.json diff --git a/README.md b/README.md index cc03ff4..51cdd60 100755 --- a/README.md +++ b/README.md @@ -251,9 +251,11 @@ This variable is parsed as a comma-separated list of items of the form * When loading an instrumented program (at runtime): - * `format` with possible arguments: `textual` (default) or `json`. It controls - the output format of the profiling which is either a console friendly - representation or json encoding of the callgraph. + * `format` with possible arguments: `textual` (default), `json`, or `speedscope`. + It controls the output format of the profiling: a console-friendly + representation, a JSON encoding of the callgraph, or a + [Speedscope](https://www.speedscope.app) sampled profile (combine with + `time` for second-precision weights, otherwise weights are in CPU cycles). * `threshold` with a number between 0.0 and 100.0 as argument (default: 1.0). If the threshold is not zero the textual output will hide nodes in the callgraph below this threshold (in percent of time of their parent). This option is meaningless for other formats. diff --git a/dune-project b/dune-project index 31727ff..c3795e1 100755 --- a/dune-project +++ b/dune-project @@ -22,6 +22,7 @@ ) (depends (ocaml (>= 4.08)) + (yojson (>= 1.6)) (js_of_ocaml (and :with-test (> 5))) ) (conflicts ocaml-option-bytecode-only) diff --git a/landmarks.opam b/landmarks.opam index 1c66374..81c8150 100644 --- a/landmarks.opam +++ b/landmarks.opam @@ -16,6 +16,7 @@ bug-reports: "https://github.com/LexiFi/landmarks/issues" depends: [ "dune" {>= "3.16"} "ocaml" {>= "4.08"} + "yojson" {>= "1.6"} "js_of_ocaml" {with-test & > "5"} "odoc" {with-doc} ] diff --git a/src/dune b/src/dune index d138a06..462bb3f 100755 --- a/src/dune +++ b/src/dune @@ -8,5 +8,6 @@ (language c) (names utils)) (js_of_ocaml (javascript_files utils.js)) + (libraries yojson) (instrumentation.backend (ppx landmarks-ppx))) diff --git a/src/graph.ml b/src/graph.ml index a6999f0..439b615 100644 --- a/src/graph.ml +++ b/src/graph.ml @@ -461,3 +461,101 @@ let json_of_graphs {nodes; label; root} = "root", Int root] let output_json oc graph = JSON.output oc (json_of_graphs graph) + +module Speedscope = struct + + let schema_url = "https://www.speedscope.app/file-format-schema.json" + let exporter_name = "landmarks" + + let parse_location loc = + match String.rindex_opt loc ':' with + | None -> loc, None + | Some i -> + let file = String.sub loc 0 i in + let rest = String.sub loc (i + 1) (String.length loc - i - 1) in + (match int_of_string_opt rest with + | Some n -> file, Some n + | None -> loc, None) + + (* One frame per unique landmark (by landmark_id), skipping Root nodes. *) + let make_frames (graph : graph) = + let tbl = Hashtbl.create 16 in + let frames = ref [] in + let next_idx = ref 0 in + Array.iter (fun (node : node) -> + if node.kind <> Root && not (Hashtbl.mem tbl node.landmark_id) then begin + let file, line = parse_location node.location in + let frame : Speedscope_fmt.frame = + { name = node.name; file = Some file; line; col = None } + in + Hashtbl.add tbl node.landmark_id !next_idx; + frames := frame :: !frames; + incr next_idx + end + ) graph.nodes; + List.rev !frames, tbl + + (* DFS producing one sample per call-graph node that has positive self-time. + Each sample is a stack of frame indices from outermost to innermost + caller (Speedscope's "bottom to top" convention). + Counter and Sampler nodes are skipped. *) + let collect_samples ~use_sys_time (graph : graph) frame_idx = + let samples = ref [] in + let weights = ref [] in + let visited = Hashtbl.create 16 in + let node_time n = if use_sys_time then n.sys_time else n.time in + let rec aux stack (node : node) = + if not (Hashtbl.mem visited node.id) then begin + Hashtbl.add visited node.id (); + match node.kind with + | Root -> + List.iter (aux stack) (children graph node) + | Counter | Sampler -> () + | Normal -> + let fidx = Hashtbl.find frame_idx node.landmark_id in + let stack' = fidx :: stack in (* maintained reversed; reversed on emit *) + let child_list = children graph node in + let child_time = + List.fold_left (fun acc c -> acc +. node_time c) 0.0 child_list + in + let self_time = node_time node -. child_time in + if self_time > 0.0 then begin + samples := List.rev stack' :: !samples; + weights := self_time :: !weights + end; + List.iter (aux stack') child_list + end + in + aux [] (root graph); + List.rev !samples, List.rev !weights + + let export_to_channel oc (graph : graph) = + let frames, frame_idx = make_frames graph in + let use_sys_time = + Array.exists (fun (n : node) -> n.sys_time > 0.0) graph.nodes + in + let samples, weights = collect_samples ~use_sys_time graph frame_idx in + let end_value = List.fold_left ( +. ) 0.0 weights in + let unit_ = if use_sys_time then Speedscope_fmt.Seconds else Speedscope_fmt.None_ in + let profile : Speedscope_fmt.sampled_profile = { + type_ = "sampled"; + name = graph.label; + unit_; + start_value = 0.0; + end_value; + samples; + weights; + } in + let file : Speedscope_fmt.file_format = { + dollar_schema = schema_url; + name = (if graph.label = "" then None else Some graph.label); + exporter = Some exporter_name; + active_profile_index = None; + profiles = [profile]; + shared = { frames }; + } in + Yojson.Safe.pretty_to_channel ~std:true oc + (Speedscope_fmt.yojson_of_file_format file); + output_char oc '\n' + +end diff --git a/src/graph.mli b/src/graph.mli index 80521eb..9d8e8cc 100644 --- a/src/graph.mli +++ b/src/graph.mli @@ -106,3 +106,13 @@ val output: ?threshold:float -> out_channel -> graph -> unit val output_json: out_channel -> graph -> unit (** Output a JSON representation of a call graph on an out_channel. *) + +module Speedscope : sig + val export_to_channel : out_channel -> graph -> unit + (** Write a Speedscope-format sampled profile to [out_channel]. + + If [sys_time] was collected during profiling the weights are in seconds; + otherwise raw CPU-cycle counts are used with unit "none". + + The resulting JSON can be opened directly at {{: https://www.speedscope.app } speedscope.app}. *) +end diff --git a/src/landmark.ml b/src/landmark.ml index 5996026..bd19bc8 100644 --- a/src/landmark.ml +++ b/src/landmark.ml @@ -256,6 +256,7 @@ type textual_option = {threshold : float} type profile_format = | JSON | Textual of textual_option + | Speedscope let profiling_ref = ref false let profile_with_debug = ref false @@ -783,6 +784,8 @@ let exit_hook () = Graph.output ~threshold out cg | Channel out, JSON -> Graph.output_json out cg + | Channel out, Speedscope -> + Graph.Speedscope.export_to_channel out cg | Temporary temp_dir, format -> let tmp_file, oc = Filename.open_temp_file ?temp_dir "profile_at_exit" ".tmp" @@ -792,7 +795,8 @@ let exit_hook () = flush stdout; (match format with | Textual {threshold} -> Graph.output ~threshold oc cg - | JSON -> Graph.output_json oc cg); + | JSON -> Graph.output_json oc cg + | Speedscope -> Graph.Speedscope.export_to_channel oc cg); close_out oc end @@ -843,6 +847,7 @@ let parse_env_options s = | _ -> format := Textual {threshold = 1.0}; end | [ "format"; "json" ] -> format := JSON; + | [ "format"; "speedscope" ] -> format := Speedscope | [ "format"; unknown ] -> invalid_for "format" unknown | [ "output"; "stderr" ] -> output := Channel stderr | [ "output"; "stdout" ] -> output := Channel stdout diff --git a/src/landmark.mli b/src/landmark.mli index 7588fde..63de270 100644 --- a/src/landmark.mli +++ b/src/landmark.mli @@ -92,6 +92,7 @@ type textual_option = {threshold : float} type profile_format = | JSON (** Easily parsable export format. *) | Textual of textual_option (** Console friendly output; nodes below the threshold (0.0 <= threshold <= 100.0) are not displayed in the callgraph. *) + | Speedscope (** Sampled profile in the Speedscope file format, openable at {{: https://www.speedscope.app } speedscope.app}. Enable [sys_time] in {! profiling_options} for second-precision weights; otherwise weights are in raw CPU cycles. *) (** The profiling options control the behavior of the landmark infrastructure. *) type profiling_options = { diff --git a/src/speedscope_fmt.atd b/src/speedscope_fmt.atd new file mode 100644 index 0000000..cd09d6d --- /dev/null +++ b/src/speedscope_fmt.atd @@ -0,0 +1,51 @@ +(* Speedscope file-format types. + Schema: https://www.speedscope.app/file-format-schema.json + Docs: https://github.com/jlfwong/speedscope/wiki/Importing-from-custom-sources + + To regenerate speedscope_fmt.ml and speedscope_fmt.mli from this file: + atdml speedscope_fmt.atd +*) + +type value_unit = [ + | Bytes + | Microseconds + | Milliseconds + | Nanoseconds + | None_ + | Seconds +] + +type frame = { + name : string; + ?file : string option; + ?line : int option; + ?col : int option; +} + +(* We only export sampled profiles; the Speedscope format also supports + evented profiles. The "type" field is the discriminator used by + Speedscope for the profile union and must always be "sampled". *) +type sampled_profile = { + type_ : string; + name : string; + unit_ : value_unit; + start_value : float; + end_value : float; + samples : int list list; + weights : float list; +} + +type shared = { + frames : frame list; +} + +(* "$schema" uses a JSON name annotation because "$" is not a valid + OCaml identifier character. *) +type file_format = { + dollar_schema : string; + ?name : string option; + ?exporter : string option; + ?active_profile_index : int option; + profiles : sampled_profile list; + shared : shared; +} diff --git a/src/speedscope_fmt.ml b/src/speedscope_fmt.ml new file mode 100644 index 0000000..9852e1d --- /dev/null +++ b/src/speedscope_fmt.ml @@ -0,0 +1,82 @@ +(* Generated from speedscope_fmt.atd — do not edit by hand. + To regenerate: atdml speedscope_fmt.atd *) + +type value_unit = + | Bytes + | Microseconds + | Milliseconds + | Nanoseconds + | None_ + | Seconds + +type frame = { + name : string; + file : string option; + line : int option; + col : int option; +} + +type sampled_profile = { + type_ : string; + name : string; + unit_ : value_unit; + start_value : float; + end_value : float; + samples : int list list; + weights : float list; +} + +type shared = { + frames : frame list; +} + +type file_format = { + dollar_schema : string; + name : string option; + exporter : string option; + active_profile_index : int option; + profiles : sampled_profile list; + shared : shared; +} + +let yojson_of_value_unit = function + | Bytes -> `String "bytes" + | Microseconds -> `String "microseconds" + | Milliseconds -> `String "milliseconds" + | Nanoseconds -> `String "nanoseconds" + | None_ -> `String "none" + | Seconds -> `String "seconds" + +let yojson_of_frame {name; file; line; col} = + let fields = ref [("name", `String name)] in + (match file with Some v -> fields := ("file", `String v) :: !fields | None -> ()); + (match line with Some v -> fields := ("line", `Int v) :: !fields | None -> ()); + (match col with Some v -> fields := ("col", `Int v) :: !fields | None -> ()); + `Assoc (List.rev !fields) + +let yojson_of_sampled_profile + {type_; name; unit_; start_value; end_value; samples; weights} = + `Assoc [ + "type", `String type_; + "name", `String name; + "unit", yojson_of_value_unit unit_; + "startValue", `Float start_value; + "endValue", `Float end_value; + "samples", `List (List.map (fun s -> `List (List.map (fun i -> `Int i) s)) samples); + "weights", `List (List.map (fun w -> `Float w) weights); + ] + +let yojson_of_shared {frames} = + `Assoc ["frames", `List (List.map yojson_of_frame frames)] + +let yojson_of_file_format + {dollar_schema; name; exporter; active_profile_index; profiles; shared} = + let opt k f = function Some v -> [k, f v] | None -> [] in + `Assoc ( + ["$schema", `String dollar_schema] + @ opt "name" (fun s -> `String s) name + @ opt "exporter" (fun s -> `String s) exporter + @ opt "activeProfileIndex" (fun i -> `Int i) active_profile_index + @ ["profiles", `List (List.map yojson_of_sampled_profile profiles); + "shared", yojson_of_shared shared] + ) diff --git a/src/speedscope_fmt.mli b/src/speedscope_fmt.mli new file mode 100644 index 0000000..46335c0 --- /dev/null +++ b/src/speedscope_fmt.mli @@ -0,0 +1,46 @@ +(* Generated from speedscope_fmt.atd — do not edit by hand. + To regenerate: atdml speedscope_fmt.atd *) + +type value_unit = + | Bytes + | Microseconds + | Milliseconds + | Nanoseconds + | None_ + | Seconds + +type frame = { + name : string; + file : string option; + line : int option; + col : int option; +} + +type sampled_profile = { + type_ : string; + name : string; + unit_ : value_unit; + start_value : float; + end_value : float; + samples : int list list; + weights : float list; +} + +type shared = { + frames : frame list; +} + +type file_format = { + dollar_schema : string; + name : string option; + exporter : string option; + active_profile_index : int option; + profiles : sampled_profile list; + shared : shared; +} + +val yojson_of_value_unit : value_unit -> Yojson.Safe.t +val yojson_of_frame : frame -> Yojson.Safe.t +val yojson_of_sampled_profile : sampled_profile -> Yojson.Safe.t +val yojson_of_shared : shared -> Yojson.Safe.t +val yojson_of_file_format : file_format -> Yojson.Safe.t diff --git a/tests/speedscope/README.md b/tests/speedscope/README.md new file mode 100644 index 0000000..449c2ac --- /dev/null +++ b/tests/speedscope/README.md @@ -0,0 +1,47 @@ +# Speedscope export example + +This directory contains a minimal hand-instrumented OCaml program that +demonstrates exporting a landmarks profile to the +[Speedscope](https://www.speedscope.app) flame-graph viewer. + +## What the example does + +`example.ml` instruments four functions: + +``` +main +├── sort (sort 500 000 integers) +└── compute + └── fib (compute fib(33) recursively) +``` + +## Build + +From the repository root: + +``` +dune build +``` + +## Run and export + +``` +OCAML_LANDMARKS="format=speedscope,output=profile.json,time" \ + ./_build/default/tests/speedscope/example.exe +``` + +| `OCAML_LANDMARKS` option | Effect | +|---|---| +| `format=speedscope` | Write Speedscope JSON instead of the default text report | +| `output=profile.json` | Write the profile to this file instead of stderr | +| `time` | Collect wall-clock (`Sys.time`) seconds; without this, weights are in raw CPU cycles | + +## Visualise + +Open [speedscope.app](https://www.speedscope.app) and drag-and-drop the +generated `profile.json`, or load the pre-generated +[profile.json](profile.json) from this directory. + +The "Time Order" view shows functions in the order they were called; the +"Left Heavy" view groups identical stacks, which is most useful for recursive +functions. diff --git a/tests/speedscope/dune b/tests/speedscope/dune new file mode 100644 index 0000000..e0349ab --- /dev/null +++ b/tests/speedscope/dune @@ -0,0 +1,3 @@ +(executable + (name example) + (libraries landmark)) diff --git a/tests/speedscope/example.ml b/tests/speedscope/example.ml new file mode 100644 index 0000000..0a4657d --- /dev/null +++ b/tests/speedscope/example.ml @@ -0,0 +1,34 @@ +(* Example: hand-instrumented profiling with Speedscope export. + + Build: + dune build + + Run and write a Speedscope profile: + OCAML_LANDMARKS="format=speedscope,output=profile.json,time" \ + ./_build/default/tests/speedscope/example.exe + + Open profile.json at https://www.speedscope.app to visualise the flame + graph. The file tests/speedscope/profile.json is a pre-generated example + of what the output looks like. *) + +let fib_lm = Landmark.register "fib" +let sort_lm = Landmark.register "sort" +let compute_lm = Landmark.register "compute" +let main_lm = Landmark.register "main" + +let rec fib n = + Landmark.wrap fib_lm + (fun n -> if n <= 1 then 1 else fib (n - 1) + fib (n - 2)) + n + +let compute () = + Landmark.wrap compute_lm (fun () -> ignore (fib 33)) () + +let sort_descending lst = + Landmark.wrap sort_lm (List.sort (fun a b -> compare b a)) lst + +let () = + Landmark.enter main_lm; + ignore (sort_descending (List.init 500_000 (fun i -> i))); + compute (); + Landmark.exit main_lm diff --git a/tests/speedscope/profile.json b/tests/speedscope/profile.json new file mode 100644 index 0000000..69201f1 --- /dev/null +++ b/tests/speedscope/profile.json @@ -0,0 +1,31 @@ +{ + "$schema": "https://www.speedscope.app/file-format-schema.json", + "name": "./_build/default/tests/speedscope/example.exe", + "exporter": "landmarks", + "profiles": [ + { + "type": "sampled", + "name": "./_build/default/tests/speedscope/example.exe", + "unit": "seconds", + "startValue": 0.0, + "endValue": 0.25488900000000003, + "samples": [ [ 0 ], [ 0, 1 ], [ 0, 2 ], [ 0, 2, 3 ] ], + "weights": [ + 0.014163000000000064, 0.138753, 3.0000000000030003e-06, + 0.10196999999999998 + ] + } + ], + "shared": { + "frames": [ + { "name": "main", "file": "tests/speedscope/example.ml", "line": 17 }, + { "name": "sort", "file": "tests/speedscope/example.ml", "line": 15 }, + { + "name": "compute", + "file": "tests/speedscope/example.ml", + "line": 16 + }, + { "name": "fib", "file": "tests/speedscope/example.ml", "line": 14 } + ] + } +} From 53f3869a5e67b4d1b238a4fcb7aed17b0e3be1b0 Mon Sep 17 00:00:00 2001 From: Martin Jambon Date: Tue, 19 May 2026 01:02:23 +0000 Subject: [PATCH 2/7] Address PR review comments MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - Move Speedscope export to a standalone Speedscope module (src/speedscope.ml[i]) instead of a submodule of Graph; expose it as Landmark.Speedscope - Regenerate speedscope_fmt.ml[i] using atdml (fixed ATD syntax: annotations need '=', 'shared' is a reserved ATD keyword, 'None' shadows Stdlib.None) - Rename ATD fields per review: unit_ → unit, dollar_schema → schema, shared → profile_shared; use None_ for the "none" value_unit variant - Add link to the TypeScript spec in the ATD file header - Wrap Speedscope doc comment in landmark.mli to ≤80 columns - Rewrite example using PPX [@landmark] decorators with a 3-level call tree (main → prepare/run/summarise, run → phase_a/phase_b) - Add deterministic test (test.ml builds a fixed Graph and exports it; test.out.expected is checked in and verified by dune runtest) Co-Authored-By: Claude Sonnet 4.6 --- src/graph.ml | 98 ------ src/graph.mli | 10 - src/landmark.ml | 5 +- src/landmark.mli | 7 +- src/speedscope.ml | 95 ++++++ src/speedscope.mli | 8 + src/speedscope_fmt.atd | 42 +-- src/speedscope_fmt.ml | 464 +++++++++++++++++++++++++---- src/speedscope_fmt.mli | 123 ++++++-- tests/speedscope/dune | 16 + tests/speedscope/example.ml | 58 ++-- tests/speedscope/profile.json | 60 +++- tests/speedscope/test.ml | 22 ++ tests/speedscope/test.out.expected | 22 ++ 14 files changed, 778 insertions(+), 252 deletions(-) create mode 100644 src/speedscope.ml create mode 100644 src/speedscope.mli create mode 100644 tests/speedscope/test.ml create mode 100644 tests/speedscope/test.out.expected diff --git a/src/graph.ml b/src/graph.ml index 439b615..a6999f0 100644 --- a/src/graph.ml +++ b/src/graph.ml @@ -461,101 +461,3 @@ let json_of_graphs {nodes; label; root} = "root", Int root] let output_json oc graph = JSON.output oc (json_of_graphs graph) - -module Speedscope = struct - - let schema_url = "https://www.speedscope.app/file-format-schema.json" - let exporter_name = "landmarks" - - let parse_location loc = - match String.rindex_opt loc ':' with - | None -> loc, None - | Some i -> - let file = String.sub loc 0 i in - let rest = String.sub loc (i + 1) (String.length loc - i - 1) in - (match int_of_string_opt rest with - | Some n -> file, Some n - | None -> loc, None) - - (* One frame per unique landmark (by landmark_id), skipping Root nodes. *) - let make_frames (graph : graph) = - let tbl = Hashtbl.create 16 in - let frames = ref [] in - let next_idx = ref 0 in - Array.iter (fun (node : node) -> - if node.kind <> Root && not (Hashtbl.mem tbl node.landmark_id) then begin - let file, line = parse_location node.location in - let frame : Speedscope_fmt.frame = - { name = node.name; file = Some file; line; col = None } - in - Hashtbl.add tbl node.landmark_id !next_idx; - frames := frame :: !frames; - incr next_idx - end - ) graph.nodes; - List.rev !frames, tbl - - (* DFS producing one sample per call-graph node that has positive self-time. - Each sample is a stack of frame indices from outermost to innermost - caller (Speedscope's "bottom to top" convention). - Counter and Sampler nodes are skipped. *) - let collect_samples ~use_sys_time (graph : graph) frame_idx = - let samples = ref [] in - let weights = ref [] in - let visited = Hashtbl.create 16 in - let node_time n = if use_sys_time then n.sys_time else n.time in - let rec aux stack (node : node) = - if not (Hashtbl.mem visited node.id) then begin - Hashtbl.add visited node.id (); - match node.kind with - | Root -> - List.iter (aux stack) (children graph node) - | Counter | Sampler -> () - | Normal -> - let fidx = Hashtbl.find frame_idx node.landmark_id in - let stack' = fidx :: stack in (* maintained reversed; reversed on emit *) - let child_list = children graph node in - let child_time = - List.fold_left (fun acc c -> acc +. node_time c) 0.0 child_list - in - let self_time = node_time node -. child_time in - if self_time > 0.0 then begin - samples := List.rev stack' :: !samples; - weights := self_time :: !weights - end; - List.iter (aux stack') child_list - end - in - aux [] (root graph); - List.rev !samples, List.rev !weights - - let export_to_channel oc (graph : graph) = - let frames, frame_idx = make_frames graph in - let use_sys_time = - Array.exists (fun (n : node) -> n.sys_time > 0.0) graph.nodes - in - let samples, weights = collect_samples ~use_sys_time graph frame_idx in - let end_value = List.fold_left ( +. ) 0.0 weights in - let unit_ = if use_sys_time then Speedscope_fmt.Seconds else Speedscope_fmt.None_ in - let profile : Speedscope_fmt.sampled_profile = { - type_ = "sampled"; - name = graph.label; - unit_; - start_value = 0.0; - end_value; - samples; - weights; - } in - let file : Speedscope_fmt.file_format = { - dollar_schema = schema_url; - name = (if graph.label = "" then None else Some graph.label); - exporter = Some exporter_name; - active_profile_index = None; - profiles = [profile]; - shared = { frames }; - } in - Yojson.Safe.pretty_to_channel ~std:true oc - (Speedscope_fmt.yojson_of_file_format file); - output_char oc '\n' - -end diff --git a/src/graph.mli b/src/graph.mli index 9d8e8cc..80521eb 100644 --- a/src/graph.mli +++ b/src/graph.mli @@ -106,13 +106,3 @@ val output: ?threshold:float -> out_channel -> graph -> unit val output_json: out_channel -> graph -> unit (** Output a JSON representation of a call graph on an out_channel. *) - -module Speedscope : sig - val export_to_channel : out_channel -> graph -> unit - (** Write a Speedscope-format sampled profile to [out_channel]. - - If [sys_time] was collected during profiling the weights are in seconds; - otherwise raw CPU-cycle counts are used with unit "none". - - The resulting JSON can be opened directly at {{: https://www.speedscope.app } speedscope.app}. *) -end diff --git a/src/landmark.ml b/src/landmark.ml index bd19bc8..d49e3fe 100644 --- a/src/landmark.ml +++ b/src/landmark.ml @@ -17,6 +17,7 @@ let allocated_bytes_major () = Int64.to_int (allocated_bytes_major ()) exception LandmarkFailure of string module Graph = Graph +module Speedscope = Speedscope module SparseArray = struct type 'a t = { @@ -785,7 +786,7 @@ let exit_hook () = | Channel out, JSON -> Graph.output_json out cg | Channel out, Speedscope -> - Graph.Speedscope.export_to_channel out cg + Speedscope.export_to_channel out cg | Temporary temp_dir, format -> let tmp_file, oc = Filename.open_temp_file ?temp_dir "profile_at_exit" ".tmp" @@ -796,7 +797,7 @@ let exit_hook () = (match format with | Textual {threshold} -> Graph.output ~threshold oc cg | JSON -> Graph.output_json oc cg - | Speedscope -> Graph.Speedscope.export_to_channel oc cg); + | Speedscope -> Speedscope.export_to_channel oc cg); close_out oc end diff --git a/src/landmark.mli b/src/landmark.mli index 63de270..0ee6802 100644 --- a/src/landmark.mli +++ b/src/landmark.mli @@ -3,6 +3,7 @@ (* Copyright (C) 2000-2025 LexiFi *) module Graph = Graph +module Speedscope = Speedscope (** The main module *) @@ -92,7 +93,11 @@ type textual_option = {threshold : float} type profile_format = | JSON (** Easily parsable export format. *) | Textual of textual_option (** Console friendly output; nodes below the threshold (0.0 <= threshold <= 100.0) are not displayed in the callgraph. *) - | Speedscope (** Sampled profile in the Speedscope file format, openable at {{: https://www.speedscope.app } speedscope.app}. Enable [sys_time] in {! profiling_options} for second-precision weights; otherwise weights are in raw CPU cycles. *) + | Speedscope + (** Sampled profile in the Speedscope file format, openable at + {{: https://www.speedscope.app } speedscope.app}. + Enable [sys_time] in {!profiling_options} for second-precision + weights; otherwise weights are in raw CPU cycles. *) (** The profiling options control the behavior of the landmark infrastructure. *) type profiling_options = { diff --git a/src/speedscope.ml b/src/speedscope.ml new file mode 100644 index 0000000..6f50f22 --- /dev/null +++ b/src/speedscope.ml @@ -0,0 +1,95 @@ +let schema_url = "https://www.speedscope.app/file-format-schema.json" +let exporter_name = "landmarks" + +let parse_location loc = + match String.rindex_opt loc ':' with + | None -> loc, None + | Some i -> + let file = String.sub loc 0 i in + let rest = String.sub loc (i + 1) (String.length loc - i - 1) in + (match int_of_string_opt rest with + | Some n -> file, Some n + | None -> loc, None) + +(* One Speedscope frame per unique landmark (by landmark_id), skipping Root. *) +let make_frames (graph : Graph.graph) = + let tbl = Hashtbl.create 16 in + let frames = ref [] in + let next_idx = ref 0 in + Array.iter (fun (node : Graph.node) -> + if node.kind <> Graph.Root && not (Hashtbl.mem tbl node.landmark_id) then begin + let file, line = parse_location node.location in + let frame = Speedscope_fmt.create_frame ~name:node.name ~file ?line () in + Hashtbl.add tbl node.landmark_id !next_idx; + frames := frame :: !frames; + incr next_idx + end + ) graph.nodes; + List.rev !frames, tbl + +(* DFS producing one sample per call-graph node with positive self-time. + Each sample is a stack of frame indices from outermost to innermost + caller (Speedscope's "bottom to top" convention). + Counter and Sampler nodes are skipped. *) +let collect_samples ~use_sys_time (graph : Graph.graph) frame_idx = + let samples = ref [] in + let weights = ref [] in + let visited = Hashtbl.create 16 in + let node_time (n : Graph.node) = if use_sys_time then n.sys_time else n.time in + let rec aux stack (node : Graph.node) = + if not (Hashtbl.mem visited node.id) then begin + Hashtbl.add visited node.id (); + match node.kind with + | Graph.Root -> + List.iter (aux stack) (Graph.children graph node) + | Graph.Counter | Graph.Sampler -> () + | Graph.Normal -> + let fidx = Hashtbl.find frame_idx node.landmark_id in + let stack' = fidx :: stack in (* maintained reversed; reversed on emit *) + let child_list = Graph.children graph node in + let child_time = + List.fold_left (fun acc c -> acc +. node_time c) 0.0 child_list + in + let self_time = node_time node -. child_time in + if self_time > 0.0 then begin + samples := List.rev stack' :: !samples; + weights := self_time :: !weights + end; + List.iter (aux stack') child_list + end + in + aux [] (Graph.root graph); + List.rev !samples, List.rev !weights + +let export_to_channel oc (graph : Graph.graph) = + let frames, frame_idx = make_frames graph in + let use_sys_time = + Array.exists (fun (n : Graph.node) -> n.sys_time > 0.0) graph.nodes + in + let samples, weights = collect_samples ~use_sys_time graph frame_idx in + let end_value = List.fold_left ( +. ) 0.0 weights in + let weight_unit = + if use_sys_time then Speedscope_fmt.Seconds else Speedscope_fmt.None_ + in + let profile = Speedscope_fmt.create_sampled_profile + ~type_:"sampled" + ~name:graph.label + ~unit:weight_unit + ~start_value:0.0 + ~end_value + ~samples + ~weights + () + in + let shared = Speedscope_fmt.create_profile_shared ~frames () in + let file = Speedscope_fmt.create_file_format + ~schema:schema_url + ?name:(if graph.label = "" then None else Some graph.label) + ~exporter:exporter_name + ~profiles:[profile] + ~shared + () + in + Yojson.Safe.pretty_to_channel ~std:true oc + (Speedscope_fmt.yojson_of_file_format file); + output_char oc '\n' diff --git a/src/speedscope.mli b/src/speedscope.mli new file mode 100644 index 0000000..9d85702 --- /dev/null +++ b/src/speedscope.mli @@ -0,0 +1,8 @@ +val export_to_channel : out_channel -> Graph.graph -> unit +(** Write a Speedscope sampled profile to [out_channel]. + + If [sys_time] was collected during profiling, weights are in seconds; + otherwise raw CPU-cycle counts are used with unit "none". + + The resulting JSON can be opened at + {{: https://www.speedscope.app } speedscope.app}. *) diff --git a/src/speedscope_fmt.atd b/src/speedscope_fmt.atd index cd09d6d..1045b85 100644 --- a/src/speedscope_fmt.atd +++ b/src/speedscope_fmt.atd @@ -1,18 +1,19 @@ (* Speedscope file-format types. - Schema: https://www.speedscope.app/file-format-schema.json - Docs: https://github.com/jlfwong/speedscope/wiki/Importing-from-custom-sources + Schema: https://www.speedscope.app/file-format-schema.json + Spec (TS): https://github.com/jlfwong/speedscope/blob/main/src/lib/file-format-spec.ts + Import docs: https://github.com/jlfwong/speedscope/wiki/Importing-from-custom-sources To regenerate speedscope_fmt.ml and speedscope_fmt.mli from this file: atdml speedscope_fmt.atd *) type value_unit = [ - | Bytes - | Microseconds - | Milliseconds - | Nanoseconds - | None_ - | Seconds + | Bytes + | Microseconds + | Milliseconds + | Nanoseconds + | None_ + | Seconds ] type frame = { @@ -26,26 +27,29 @@ type frame = { evented profiles. The "type" field is the discriminator used by Speedscope for the profile union and must always be "sampled". *) type sampled_profile = { - type_ : string; + type_ : string; name : string; - unit_ : value_unit; - start_value : float; - end_value : float; + unit : value_unit; + start_value : float; + end_value : float; samples : int list list; weights : float list; } -type shared = { +(* The "shared" section of a Speedscope file. + "shared" is a reserved word in ATD, hence the name profile_shared here; + the JSON key is "shared" via the annotation on the file_format field below. *) +type profile_shared = { frames : frame list; } (* "$schema" uses a JSON name annotation because "$" is not a valid OCaml identifier character. *) type file_format = { - dollar_schema : string; - ?name : string option; - ?exporter : string option; - ?active_profile_index : int option; - profiles : sampled_profile list; - shared : shared; + schema : string; + ?name : string option; + ?exporter : string option; + ?active_profile_index : int option; + profiles : sampled_profile list; + shared : profile_shared; } diff --git a/src/speedscope_fmt.ml b/src/speedscope_fmt.ml index 9852e1d..b2a5cc4 100644 --- a/src/speedscope_fmt.ml +++ b/src/speedscope_fmt.ml @@ -1,5 +1,89 @@ -(* Generated from speedscope_fmt.atd — do not edit by hand. - To regenerate: atdml speedscope_fmt.atd *) +(* Auto-generated from "speedscope_fmt.atd" by atdml. *) +[@@@ocaml.warning "-27-32-33-35-39"] + +(* Inlined runtime — no external dependency needed. *) +module Atdml_runtime = struct + (* Returns true iff the list has strictly more than [n] elements, + without traversing past element n+1. *) + let rec list_length_gt n = function + | _ :: rest -> if n = 0 then true else list_length_gt (n - 1) rest + | [] -> false + + module Yojson = struct + let bad_type expected_type x = + Printf.ksprintf failwith "expected %s, got: %s" + expected_type (Yojson.Safe.to_string x) + + let bad_sum type_name x = + Printf.ksprintf failwith "invalid variant for type '%s': %s" + type_name (Yojson.Safe.to_string x) + + let missing_field type_name field_name = + Printf.ksprintf failwith "missing field '%s' in object of type '%s'" + field_name type_name + + let bool_of_yojson = function + | `Bool b -> b + | x -> bad_type "bool" x + + let yojson_of_bool b = `Bool b + + let int_of_yojson = function + | `Int n -> n + | x -> bad_type "int" x + + let yojson_of_int n = `Int n + + let float_of_yojson = function + | `Float f -> f + | `Int n -> Float.of_int n + | x -> bad_type "float" x + + let yojson_of_float f = `Float f + + let string_of_yojson = function + | `String s -> s + | x -> bad_type "string" x + + let yojson_of_string s = `String s + + let unit_of_yojson = function + | `Null -> () + | x -> bad_type "null" x + + let yojson_of_unit () = `Null + + let list_of_yojson f = function + | `List xs -> List.map f xs + | x -> bad_type "array" x + + let yojson_of_list f xs = `List (List.map f xs) + + let option_of_yojson f = function + | `String "None" -> None + | `List [`String "Some"; x] -> Some (f x) + | x -> bad_type "option" x + + let yojson_of_option f = function + | None -> `String "None" + | Some x -> `List [`String "Some"; f x] + + let nullable_of_yojson f = function + | `Null -> None + | x -> Some (f x) + + let yojson_of_nullable f = function + | None -> `Null + | Some x -> f x + + let assoc_of_yojson f = function + | `Assoc pairs -> List.map (fun (k, v) -> (k, f v)) pairs + | x -> bad_type "object" x + + let yojson_of_assoc f xs = + `Assoc (List.map (fun (k, v) -> (k, f v)) xs) + end +end type value_unit = | Bytes @@ -9,74 +93,326 @@ type value_unit = | None_ | Seconds -type frame = { - name : string; - file : string option; - line : int option; - col : int option; -} +let value_unit_of_yojson (x : Yojson.Safe.t) : value_unit = + match x with + | `String "bytes" -> Bytes + | `String "microseconds" -> Microseconds + | `String "milliseconds" -> Milliseconds + | `String "nanoseconds" -> Nanoseconds + | `String "none" -> None_ + | `String "seconds" -> Seconds + | _ -> Atdml_runtime.Yojson.bad_sum "value_unit" x + +let yojson_of_value_unit (x : value_unit) : Yojson.Safe.t = + match x with + | Bytes -> `String "bytes" + | Microseconds -> `String "microseconds" + | Milliseconds -> `String "milliseconds" + | Nanoseconds -> `String "nanoseconds" + | None_ -> `String "none" + | Seconds -> `String "seconds" + +let value_unit_of_json s = + value_unit_of_yojson (Yojson.Safe.from_string s) + +let json_of_value_unit x = + Yojson.Safe.to_string (yojson_of_value_unit x) + +module Value_unit = struct + type nonrec t = value_unit + let of_yojson = value_unit_of_yojson + let to_yojson = yojson_of_value_unit + let of_json = value_unit_of_json + let to_json = json_of_value_unit +end type sampled_profile = { - type_ : string; - name : string; - unit_ : value_unit; - start_value : float; - end_value : float; - samples : int list list; - weights : float list; + type_: string; + name: string; + unit: value_unit; + start_value: float; + end_value: float; + samples: int list list; + weights: float list; } -type shared = { - frames : frame list; +let create_sampled_profile ~type_ ~name ~unit ~start_value ~end_value ~samples ~weights () : sampled_profile = + { type_; name; unit; start_value; end_value; samples; weights } + +let sampled_profile_of_yojson (x : Yojson.Safe.t) : sampled_profile = + match x with + | `Assoc fields -> + (* Duplicate JSON keys: behavior is unspecified (RFC 8259 §4 says keys SHOULD + be unique). Below the threshold, List.assoc_opt returns the first binding; + above it, the hashtable returns the last. *) + let assoc_ = + if Atdml_runtime.list_length_gt 5 fields then + let tbl = Hashtbl.create 16 in + List.iter (fun (k, v) -> Hashtbl.add tbl k v) fields; + (fun key -> Hashtbl.find_opt tbl key) + else (fun key -> List.assoc_opt key fields) + in + let type_ = + match assoc_ "type" with + | Some v -> Atdml_runtime.Yojson.string_of_yojson v + | None -> Atdml_runtime.Yojson.missing_field "sampled_profile" "type" + in + let name = + match assoc_ "name" with + | Some v -> Atdml_runtime.Yojson.string_of_yojson v + | None -> Atdml_runtime.Yojson.missing_field "sampled_profile" "name" + in + let unit = + match assoc_ "unit" with + | Some v -> value_unit_of_yojson v + | None -> Atdml_runtime.Yojson.missing_field "sampled_profile" "unit" + in + let start_value = + match assoc_ "startValue" with + | Some v -> Atdml_runtime.Yojson.float_of_yojson v + | None -> Atdml_runtime.Yojson.missing_field "sampled_profile" "startValue" + in + let end_value = + match assoc_ "endValue" with + | Some v -> Atdml_runtime.Yojson.float_of_yojson v + | None -> Atdml_runtime.Yojson.missing_field "sampled_profile" "endValue" + in + let samples = + match assoc_ "samples" with + | Some v -> (Atdml_runtime.Yojson.list_of_yojson (Atdml_runtime.Yojson.list_of_yojson Atdml_runtime.Yojson.int_of_yojson)) v + | None -> Atdml_runtime.Yojson.missing_field "sampled_profile" "samples" + in + let weights = + match assoc_ "weights" with + | Some v -> (Atdml_runtime.Yojson.list_of_yojson Atdml_runtime.Yojson.float_of_yojson) v + | None -> Atdml_runtime.Yojson.missing_field "sampled_profile" "weights" + in + { type_; name; unit; start_value; end_value; samples; weights } + | _ -> Atdml_runtime.Yojson.bad_type "sampled_profile" x + +let yojson_of_sampled_profile (x : sampled_profile) : Yojson.Safe.t = + `Assoc (List.concat [ + [("type", Atdml_runtime.Yojson.yojson_of_string x.type_)]; + [("name", Atdml_runtime.Yojson.yojson_of_string x.name)]; + [("unit", yojson_of_value_unit x.unit)]; + [("startValue", Atdml_runtime.Yojson.yojson_of_float x.start_value)]; + [("endValue", Atdml_runtime.Yojson.yojson_of_float x.end_value)]; + [("samples", (Atdml_runtime.Yojson.yojson_of_list (Atdml_runtime.Yojson.yojson_of_list Atdml_runtime.Yojson.yojson_of_int)) x.samples)]; + [("weights", (Atdml_runtime.Yojson.yojson_of_list Atdml_runtime.Yojson.yojson_of_float) x.weights)]; + ]) + +let sampled_profile_of_json s = + sampled_profile_of_yojson (Yojson.Safe.from_string s) + +let json_of_sampled_profile x = + Yojson.Safe.to_string (yojson_of_sampled_profile x) + +module Sampled_profile = struct + type nonrec t = sampled_profile + let create = create_sampled_profile + let of_yojson = sampled_profile_of_yojson + let to_yojson = yojson_of_sampled_profile + let of_json = sampled_profile_of_json + let to_json = json_of_sampled_profile +end + +type frame = { + name: string; + file: string option; + line: int option; + col: int option; +} + +let create_frame ~name ?file ?line ?col () : frame = + { name; file; line; col } + +let frame_of_yojson (x : Yojson.Safe.t) : frame = + match x with + | `Assoc fields -> + (* Duplicate JSON keys: behavior is unspecified (RFC 8259 §4 says keys SHOULD + be unique). Below the threshold, List.assoc_opt returns the first binding; + above it, the hashtable returns the last. *) + let assoc_ = + if Atdml_runtime.list_length_gt 5 fields then + let tbl = Hashtbl.create 16 in + List.iter (fun (k, v) -> Hashtbl.add tbl k v) fields; + (fun key -> Hashtbl.find_opt tbl key) + else (fun key -> List.assoc_opt key fields) + in + let name = + match assoc_ "name" with + | Some v -> Atdml_runtime.Yojson.string_of_yojson v + | None -> Atdml_runtime.Yojson.missing_field "frame" "name" + in + let file = + match assoc_ "file" with + | None | Some `Null -> None + | Some v -> Some (Atdml_runtime.Yojson.string_of_yojson v) + in + let line = + match assoc_ "line" with + | None | Some `Null -> None + | Some v -> Some (Atdml_runtime.Yojson.int_of_yojson v) + in + let col = + match assoc_ "col" with + | None | Some `Null -> None + | Some v -> Some (Atdml_runtime.Yojson.int_of_yojson v) + in + { name; file; line; col } + | _ -> Atdml_runtime.Yojson.bad_type "frame" x + +let yojson_of_frame (x : frame) : Yojson.Safe.t = + `Assoc (List.concat [ + [("name", Atdml_runtime.Yojson.yojson_of_string x.name)]; + (match x.file with None -> [] | Some v -> [("file", Atdml_runtime.Yojson.yojson_of_string v)]); + (match x.line with None -> [] | Some v -> [("line", Atdml_runtime.Yojson.yojson_of_int v)]); + (match x.col with None -> [] | Some v -> [("col", Atdml_runtime.Yojson.yojson_of_int v)]); + ]) + +let frame_of_json s = + frame_of_yojson (Yojson.Safe.from_string s) + +let json_of_frame x = + Yojson.Safe.to_string (yojson_of_frame x) + +module Frame = struct + type nonrec t = frame + let create = create_frame + let of_yojson = frame_of_yojson + let to_yojson = yojson_of_frame + let of_json = frame_of_json + let to_json = json_of_frame +end + +type profile_shared = { + frames: frame list; } +let create_profile_shared ~frames () : profile_shared = + { frames } + +let profile_shared_of_yojson (x : Yojson.Safe.t) : profile_shared = + match x with + | `Assoc fields -> + (* Duplicate JSON keys: behavior is unspecified (RFC 8259 §4 says keys SHOULD + be unique). Below the threshold, List.assoc_opt returns the first binding; + above it, the hashtable returns the last. *) + let assoc_ = + if Atdml_runtime.list_length_gt 5 fields then + let tbl = Hashtbl.create 16 in + List.iter (fun (k, v) -> Hashtbl.add tbl k v) fields; + (fun key -> Hashtbl.find_opt tbl key) + else (fun key -> List.assoc_opt key fields) + in + let frames = + match assoc_ "frames" with + | Some v -> (Atdml_runtime.Yojson.list_of_yojson frame_of_yojson) v + | None -> Atdml_runtime.Yojson.missing_field "profile_shared" "frames" + in + { frames } + | _ -> Atdml_runtime.Yojson.bad_type "profile_shared" x + +let yojson_of_profile_shared (x : profile_shared) : Yojson.Safe.t = + `Assoc (List.concat [ + [("frames", (Atdml_runtime.Yojson.yojson_of_list yojson_of_frame) x.frames)]; + ]) + +let profile_shared_of_json s = + profile_shared_of_yojson (Yojson.Safe.from_string s) + +let json_of_profile_shared x = + Yojson.Safe.to_string (yojson_of_profile_shared x) + +module Profile_shared = struct + type nonrec t = profile_shared + let create = create_profile_shared + let of_yojson = profile_shared_of_yojson + let to_yojson = yojson_of_profile_shared + let of_json = profile_shared_of_json + let to_json = json_of_profile_shared +end + type file_format = { - dollar_schema : string; - name : string option; - exporter : string option; - active_profile_index : int option; - profiles : sampled_profile list; - shared : shared; + schema: string; + name: string option; + exporter: string option; + active_profile_index: int option; + profiles: sampled_profile list; + shared: profile_shared; } -let yojson_of_value_unit = function - | Bytes -> `String "bytes" - | Microseconds -> `String "microseconds" - | Milliseconds -> `String "milliseconds" - | Nanoseconds -> `String "nanoseconds" - | None_ -> `String "none" - | Seconds -> `String "seconds" - -let yojson_of_frame {name; file; line; col} = - let fields = ref [("name", `String name)] in - (match file with Some v -> fields := ("file", `String v) :: !fields | None -> ()); - (match line with Some v -> fields := ("line", `Int v) :: !fields | None -> ()); - (match col with Some v -> fields := ("col", `Int v) :: !fields | None -> ()); - `Assoc (List.rev !fields) - -let yojson_of_sampled_profile - {type_; name; unit_; start_value; end_value; samples; weights} = - `Assoc [ - "type", `String type_; - "name", `String name; - "unit", yojson_of_value_unit unit_; - "startValue", `Float start_value; - "endValue", `Float end_value; - "samples", `List (List.map (fun s -> `List (List.map (fun i -> `Int i) s)) samples); - "weights", `List (List.map (fun w -> `Float w) weights); - ] - -let yojson_of_shared {frames} = - `Assoc ["frames", `List (List.map yojson_of_frame frames)] - -let yojson_of_file_format - {dollar_schema; name; exporter; active_profile_index; profiles; shared} = - let opt k f = function Some v -> [k, f v] | None -> [] in - `Assoc ( - ["$schema", `String dollar_schema] - @ opt "name" (fun s -> `String s) name - @ opt "exporter" (fun s -> `String s) exporter - @ opt "activeProfileIndex" (fun i -> `Int i) active_profile_index - @ ["profiles", `List (List.map yojson_of_sampled_profile profiles); - "shared", yojson_of_shared shared] - ) +let create_file_format ~schema ?name ?exporter ?active_profile_index ~profiles ~shared () : file_format = + { schema; name; exporter; active_profile_index; profiles; shared } + +let file_format_of_yojson (x : Yojson.Safe.t) : file_format = + match x with + | `Assoc fields -> + (* Duplicate JSON keys: behavior is unspecified (RFC 8259 §4 says keys SHOULD + be unique). Below the threshold, List.assoc_opt returns the first binding; + above it, the hashtable returns the last. *) + let assoc_ = + if Atdml_runtime.list_length_gt 5 fields then + let tbl = Hashtbl.create 16 in + List.iter (fun (k, v) -> Hashtbl.add tbl k v) fields; + (fun key -> Hashtbl.find_opt tbl key) + else (fun key -> List.assoc_opt key fields) + in + let schema = + match assoc_ "$schema" with + | Some v -> Atdml_runtime.Yojson.string_of_yojson v + | None -> Atdml_runtime.Yojson.missing_field "file_format" "$schema" + in + let name = + match assoc_ "name" with + | None | Some `Null -> None + | Some v -> Some (Atdml_runtime.Yojson.string_of_yojson v) + in + let exporter = + match assoc_ "exporter" with + | None | Some `Null -> None + | Some v -> Some (Atdml_runtime.Yojson.string_of_yojson v) + in + let active_profile_index = + match assoc_ "activeProfileIndex" with + | None | Some `Null -> None + | Some v -> Some (Atdml_runtime.Yojson.int_of_yojson v) + in + let profiles = + match assoc_ "profiles" with + | Some v -> (Atdml_runtime.Yojson.list_of_yojson sampled_profile_of_yojson) v + | None -> Atdml_runtime.Yojson.missing_field "file_format" "profiles" + in + let shared = + match assoc_ "shared" with + | Some v -> profile_shared_of_yojson v + | None -> Atdml_runtime.Yojson.missing_field "file_format" "shared" + in + { schema; name; exporter; active_profile_index; profiles; shared } + | _ -> Atdml_runtime.Yojson.bad_type "file_format" x + +let yojson_of_file_format (x : file_format) : Yojson.Safe.t = + `Assoc (List.concat [ + [("$schema", Atdml_runtime.Yojson.yojson_of_string x.schema)]; + (match x.name with None -> [] | Some v -> [("name", Atdml_runtime.Yojson.yojson_of_string v)]); + (match x.exporter with None -> [] | Some v -> [("exporter", Atdml_runtime.Yojson.yojson_of_string v)]); + (match x.active_profile_index with None -> [] | Some v -> [("activeProfileIndex", Atdml_runtime.Yojson.yojson_of_int v)]); + [("profiles", (Atdml_runtime.Yojson.yojson_of_list yojson_of_sampled_profile) x.profiles)]; + [("shared", yojson_of_profile_shared x.shared)]; + ]) + +let file_format_of_json s = + file_format_of_yojson (Yojson.Safe.from_string s) + +let json_of_file_format x = + Yojson.Safe.to_string (yojson_of_file_format x) + +module File_format = struct + type nonrec t = file_format + let create = create_file_format + let of_yojson = file_format_of_yojson + let to_yojson = yojson_of_file_format + let of_json = file_format_of_json + let to_json = json_of_file_format +end + diff --git a/src/speedscope_fmt.mli b/src/speedscope_fmt.mli index 46335c0..97c5b4f 100644 --- a/src/speedscope_fmt.mli +++ b/src/speedscope_fmt.mli @@ -1,5 +1,4 @@ -(* Generated from speedscope_fmt.atd — do not edit by hand. - To regenerate: atdml speedscope_fmt.atd *) +(* Auto-generated from "speedscope_fmt.atd" by atdml. *) type value_unit = | Bytes @@ -9,38 +8,106 @@ type value_unit = | None_ | Seconds -type frame = { - name : string; - file : string option; - line : int option; - col : int option; -} +val value_unit_of_yojson : Yojson.Safe.t -> value_unit +val yojson_of_value_unit : value_unit -> Yojson.Safe.t +val value_unit_of_json : string -> value_unit +val json_of_value_unit : value_unit -> string + +module Value_unit : sig + type nonrec t = value_unit + val of_yojson : Yojson.Safe.t -> t + val to_yojson : t -> Yojson.Safe.t + val of_json : string -> t + val to_json : t -> string +end type sampled_profile = { - type_ : string; - name : string; - unit_ : value_unit; - start_value : float; - end_value : float; - samples : int list list; - weights : float list; + type_: string; + name: string; + unit: value_unit; + start_value: float; + end_value: float; + samples: int list list; + weights: float list; +} + +val create_sampled_profile : type_:string -> name:string -> unit:value_unit -> start_value:float -> end_value:float -> samples:int list list -> weights:float list -> unit -> sampled_profile +val sampled_profile_of_yojson : Yojson.Safe.t -> sampled_profile +val yojson_of_sampled_profile : sampled_profile -> Yojson.Safe.t +val sampled_profile_of_json : string -> sampled_profile +val json_of_sampled_profile : sampled_profile -> string + +module Sampled_profile : sig + type nonrec t = sampled_profile + val create : type_:string -> name:string -> unit:value_unit -> start_value:float -> end_value:float -> samples:int list list -> weights:float list -> unit -> t + val of_yojson : Yojson.Safe.t -> t + val to_yojson : t -> Yojson.Safe.t + val of_json : string -> t + val to_json : t -> string +end + +type frame = { + name: string; + file: string option; + line: int option; + col: int option; } -type shared = { - frames : frame list; +val create_frame : name:string -> ?file:string -> ?line:int -> ?col:int -> unit -> frame +val frame_of_yojson : Yojson.Safe.t -> frame +val yojson_of_frame : frame -> Yojson.Safe.t +val frame_of_json : string -> frame +val json_of_frame : frame -> string + +module Frame : sig + type nonrec t = frame + val create : name:string -> ?file:string -> ?line:int -> ?col:int -> unit -> t + val of_yojson : Yojson.Safe.t -> t + val to_yojson : t -> Yojson.Safe.t + val of_json : string -> t + val to_json : t -> string +end + +type profile_shared = { + frames: frame list; } +val create_profile_shared : frames:frame list -> unit -> profile_shared +val profile_shared_of_yojson : Yojson.Safe.t -> profile_shared +val yojson_of_profile_shared : profile_shared -> Yojson.Safe.t +val profile_shared_of_json : string -> profile_shared +val json_of_profile_shared : profile_shared -> string + +module Profile_shared : sig + type nonrec t = profile_shared + val create : frames:frame list -> unit -> t + val of_yojson : Yojson.Safe.t -> t + val to_yojson : t -> Yojson.Safe.t + val of_json : string -> t + val to_json : t -> string +end + type file_format = { - dollar_schema : string; - name : string option; - exporter : string option; - active_profile_index : int option; - profiles : sampled_profile list; - shared : shared; + schema: string; + name: string option; + exporter: string option; + active_profile_index: int option; + profiles: sampled_profile list; + shared: profile_shared; } -val yojson_of_value_unit : value_unit -> Yojson.Safe.t -val yojson_of_frame : frame -> Yojson.Safe.t -val yojson_of_sampled_profile : sampled_profile -> Yojson.Safe.t -val yojson_of_shared : shared -> Yojson.Safe.t -val yojson_of_file_format : file_format -> Yojson.Safe.t +val create_file_format : schema:string -> ?name:string -> ?exporter:string -> ?active_profile_index:int -> profiles:sampled_profile list -> shared:profile_shared -> unit -> file_format +val file_format_of_yojson : Yojson.Safe.t -> file_format +val yojson_of_file_format : file_format -> Yojson.Safe.t +val file_format_of_json : string -> file_format +val json_of_file_format : file_format -> string + +module File_format : sig + type nonrec t = file_format + val create : schema:string -> ?name:string -> ?exporter:string -> ?active_profile_index:int -> profiles:sampled_profile list -> shared:profile_shared -> unit -> t + val of_yojson : Yojson.Safe.t -> t + val to_yojson : t -> Yojson.Safe.t + val of_json : string -> t + val to_json : t -> string +end + diff --git a/tests/speedscope/dune b/tests/speedscope/dune index e0349ab..070948f 100644 --- a/tests/speedscope/dune +++ b/tests/speedscope/dune @@ -1,3 +1,19 @@ (executable (name example) + (libraries landmark) + (preprocess + (pps ppx_landmarks))) + +(executable + (name test) (libraries landmark)) + +(rule + (with-stdout-to test.out + (run ./test.exe))) + +(rule + (alias runtest) + (package landmarks) + (action + (diff test.out.expected test.out))) diff --git a/tests/speedscope/example.ml b/tests/speedscope/example.ml index 0a4657d..1ee4a83 100644 --- a/tests/speedscope/example.ml +++ b/tests/speedscope/example.ml @@ -1,4 +1,4 @@ -(* Example: hand-instrumented profiling with Speedscope export. +(* Example: profiling with Speedscope export using PPX instrumentation. Build: dune build @@ -7,28 +7,44 @@ OCAML_LANDMARKS="format=speedscope,output=profile.json,time" \ ./_build/default/tests/speedscope/example.exe - Open profile.json at https://www.speedscope.app to visualise the flame - graph. The file tests/speedscope/profile.json is a pre-generated example - of what the output looks like. *) + Open profile.json at https://www.speedscope.app to visualise the + flame graph. A pre-generated example is in tests/speedscope/profile.json. -let fib_lm = Landmark.register "fib" -let sort_lm = Landmark.register "sort" -let compute_lm = Landmark.register "compute" -let main_lm = Landmark.register "main" + The call tree below grows and shrinks to form a visible flame shape: -let rec fib n = - Landmark.wrap fib_lm - (fun n -> if n <= 1 then 1 else fib (n - 1) + fib (n - 2)) - n + main + ├── prepare (sort a list) + │ └── make_input (build the list) + ├── run + │ ├── phase_a (fib — deep recursion) + │ └── phase_b (fold over a list) + └── summarise (cheap post-processing) +*) -let compute () = - Landmark.wrap compute_lm (fun () -> ignore (fib 33)) () +let[@landmark] rec fib n = + if n <= 1 then 1 else fib (n - 1) + fib (n - 2) -let sort_descending lst = - Landmark.wrap sort_lm (List.sort (fun a b -> compare b a)) lst +let[@landmark] make_input n = + List.init n (fun i -> n - i) -let () = - Landmark.enter main_lm; - ignore (sort_descending (List.init 500_000 (fun i -> i))); - compute (); - Landmark.exit main_lm +let[@landmark] prepare n = + List.sort compare (make_input n) + +let[@landmark] phase_a () = ignore (fib 33) + +let[@landmark] phase_b lst = + List.fold_left (fun acc x -> acc + x) 0 lst + +let[@landmark] run lst = + phase_a (); + ignore (phase_b lst) + +let[@landmark] summarise lst = + List.length lst + +let[@landmark] main () = + let lst = prepare 300_000 in + run lst; + ignore (summarise lst) + +let () = main () diff --git a/tests/speedscope/profile.json b/tests/speedscope/profile.json index 69201f1..9f4d795 100644 --- a/tests/speedscope/profile.json +++ b/tests/speedscope/profile.json @@ -8,24 +8,66 @@ "name": "./_build/default/tests/speedscope/example.exe", "unit": "seconds", "startValue": 0.0, - "endValue": 0.25488900000000003, - "samples": [ [ 0 ], [ 0, 1 ], [ 0, 2 ], [ 0, 2, 3 ] ], + "endValue": 0.07972899999999999, + "samples": [ + [ 0 ], + [ 0, 1 ], + [ 0, 1, 2 ], + [ 0, 3 ], + [ 0, 3, 4 ], + [ 0, 3, 4, 5 ], + [ 0, 3, 6 ], + [ 0, 7 ] + ], "weights": [ - 0.014163000000000064, 0.138753, 3.0000000000030003e-06, - 0.10196999999999998 + 8.000000000008001e-06, 0.057884999999999985, 0.007527, + 3.0000000000030003e-06, 3.0000000000030003e-06, 0.013155, + 0.0008259999999999934, 0.00032200000000000284 ] } ], "shared": { "frames": [ - { "name": "main", "file": "tests/speedscope/example.ml", "line": 17 }, - { "name": "sort", "file": "tests/speedscope/example.ml", "line": 15 }, { - "name": "compute", + "name": "Example.main", "file": "tests/speedscope/example.ml", - "line": 16 + "line": 45 }, - { "name": "fib", "file": "tests/speedscope/example.ml", "line": 14 } + { + "name": "Example.prepare", + "file": "tests/speedscope/example.ml", + "line": 30 + }, + { + "name": "Example.make_input", + "file": "tests/speedscope/example.ml", + "line": 27 + }, + { + "name": "Example.run", + "file": "tests/speedscope/example.ml", + "line": 38 + }, + { + "name": "Example.phase_a", + "file": "tests/speedscope/example.ml", + "line": 33 + }, + { + "name": "Example.fib", + "file": "tests/speedscope/example.ml", + "line": 24 + }, + { + "name": "Example.phase_b", + "file": "tests/speedscope/example.ml", + "line": 35 + }, + { + "name": "Example.summarise", + "file": "tests/speedscope/example.ml", + "line": 42 + } ] } } diff --git a/tests/speedscope/test.ml b/tests/speedscope/test.ml new file mode 100644 index 0000000..2b51ede --- /dev/null +++ b/tests/speedscope/test.ml @@ -0,0 +1,22 @@ +open Landmark.Graph + +(* Build a fixed graph with known values so the Speedscope output is + deterministic and can be compared against test.out.expected. *) + +let make_node id kind name location calls time children = + { id; kind; name; landmark_id = name; location; calls; time; + children; sys_time = 0.0; allocated_bytes = 0; + allocated_bytes_major = 0; distrib = Float.Array.create 0 } + +let () = + (* Graph: + root (Root) + ├── foo time=0.50 + └── bar time=0.25 + unit = "none" (no sys_time) + *) + let root = make_node 0 Root "ROOT" "" 1 0.75 [1; 2] in + let foo = make_node 1 Normal "foo" "test.ml:10" 5 0.50 [] in + let bar = make_node 2 Normal "bar" "test.ml:20" 3 0.25 [] in + let graph = graph_of_nodes ~label:"test" [root; foo; bar] in + Landmark.Speedscope.export_to_channel stdout graph diff --git a/tests/speedscope/test.out.expected b/tests/speedscope/test.out.expected new file mode 100644 index 0000000..ad29681 --- /dev/null +++ b/tests/speedscope/test.out.expected @@ -0,0 +1,22 @@ +{ + "$schema": "https://www.speedscope.app/file-format-schema.json", + "name": "test", + "exporter": "landmarks", + "profiles": [ + { + "type": "sampled", + "name": "test", + "unit": "none", + "startValue": 0.0, + "endValue": 0.75, + "samples": [ [ 0 ], [ 1 ] ], + "weights": [ 0.5, 0.25 ] + } + ], + "shared": { + "frames": [ + { "name": "foo", "file": "test.ml", "line": 10 }, + { "name": "bar", "file": "test.ml", "line": 20 } + ] + } +} From 3340d0bf13fed70f981cb67c2595931722f483bd Mon Sep 17 00:00:00 2001 From: Martin Jambon Date: Tue, 19 May 2026 01:49:15 +0000 Subject: [PATCH 3/7] Copy TS spec comments into ATD file as annotations All applicable field and type comments from file-format-spec.ts are now expressed as ATD doc annotations and flow through into the generated speedscope_fmt.mli as OCaml doc comments. Co-Authored-By: Claude Sonnet 4.6 --- src/speedscope_fmt.atd | 77 +++++++++++++++++++++++++++++++++--------- src/speedscope_fmt.ml | 45 ++++++++++++++++++++++-- src/speedscope_fmt.mli | 45 ++++++++++++++++++++++-- 3 files changed, 145 insertions(+), 22 deletions(-) diff --git a/src/speedscope_fmt.atd b/src/speedscope_fmt.atd index 1045b85..284f6c4 100644 --- a/src/speedscope_fmt.atd +++ b/src/speedscope_fmt.atd @@ -7,7 +7,7 @@ atdml speedscope_fmt.atd *) -type value_unit = [ +type value_unit = [ | Bytes | Microseconds | Milliseconds @@ -24,32 +24,77 @@ type frame = { } (* We only export sampled profiles; the Speedscope format also supports - evented profiles. The "type" field is the discriminator used by + evented profiles. The 'type' field is the discriminator used by Speedscope for the profile union and must always be "sampled". *) type sampled_profile = { - type_ : string; - name : string; - unit : value_unit; - start_value : float; - end_value : float; - samples : int list list; - weights : float list; + type_ + + + : string; + + name + + : string; + + unit + + + : value_unit; + + start_value + + + : float; + + end_value + + + : float; + + samples + + : int list list; + + weights + + : float list; } (* The "shared" section of a Speedscope file. "shared" is a reserved word in ATD, hence the name profile_shared here; the JSON key is "shared" via the annotation on the file_format field below. *) -type profile_shared = { +type profile_shared + += { frames : frame list; } (* "$schema" uses a JSON name annotation because "$" is not a valid OCaml identifier character. *) type file_format = { - schema : string; - ?name : string option; - ?exporter : string option; - ?active_profile_index : int option; - profiles : sampled_profile list; - shared : profile_shared; + schema + + : string; + + ?name + + : string option; + + ?exporter + + : string option; + + ?active_profile_index + + + : int option; + + profiles + + : sampled_profile list; + + shared + + + : profile_shared; } diff --git a/src/speedscope_fmt.ml b/src/speedscope_fmt.ml index b2a5cc4..a41f61e 100644 --- a/src/speedscope_fmt.ml +++ b/src/speedscope_fmt.ml @@ -85,6 +85,7 @@ module Atdml_runtime = struct end end +(** Unit in which all profile values are expressed. *) type value_unit = | Bytes | Microseconds @@ -128,12 +129,36 @@ end type sampled_profile = { type_: string; + (** + Type of profile. Used as a discriminator in the profile union to + future-proof the file format. For sampled profiles, always 'sampled'. + *) name: string; - unit: value_unit; + (** + Name of the profile. Typically a filename for the source of the + profile. + *) + unit: value_unit; (** Unit in which all values in this profile are expressed. *) start_value: float; + (** + The starting value of the profile. Typically a timestamp. All event + values are displayed relative to startValue. + *) end_value: float; + (** + The final value of the profile. Must be >= startValue. Useful when the + recorded profile extends past the last event. + *) samples: int list list; + (** + List of stacks. Each stack is a list of indices into the shared frames + array. + *) weights: float list; + (** + Weight of the sample at the corresponding index. Must have the same + length as samples. + *) } let create_sampled_profile ~type_ ~name ~unit ~start_value ~end_value ~samples ~weights () : sampled_profile = @@ -285,6 +310,7 @@ module Frame = struct let to_json = json_of_frame end +(** Data shared between profiles. *) type profile_shared = { frames: frame list; } @@ -336,10 +362,23 @@ end type file_format = { schema: string; name: string option; + (** + The name of the contained profile group. If omitted, the viewer uses + the filename. + *) exporter: string option; + (** + The name of the program that exported this profile. Not consumed by + speedscope, but useful for debugging. Recommended format: + name\@version. + *) active_profile_index: int option; - profiles: sampled_profile list; - shared: profile_shared; + (** + Index into the profiles array to display on load. Defaults to the + first profile if omitted. + *) + profiles: sampled_profile list; (** List of profile definitions. *) + shared: profile_shared; (** Data shared between profiles. *) } let create_file_format ~schema ?name ?exporter ?active_profile_index ~profiles ~shared () : file_format = diff --git a/src/speedscope_fmt.mli b/src/speedscope_fmt.mli index 97c5b4f..4464e08 100644 --- a/src/speedscope_fmt.mli +++ b/src/speedscope_fmt.mli @@ -1,5 +1,6 @@ (* Auto-generated from "speedscope_fmt.atd" by atdml. *) +(** Unit in which all profile values are expressed. *) type value_unit = | Bytes | Microseconds @@ -23,12 +24,36 @@ end type sampled_profile = { type_: string; + (** + Type of profile. Used as a discriminator in the profile union to + future-proof the file format. For sampled profiles, always 'sampled'. + *) name: string; - unit: value_unit; + (** + Name of the profile. Typically a filename for the source of the + profile. + *) + unit: value_unit; (** Unit in which all values in this profile are expressed. *) start_value: float; + (** + The starting value of the profile. Typically a timestamp. All event + values are displayed relative to startValue. + *) end_value: float; + (** + The final value of the profile. Must be >= startValue. Useful when the + recorded profile extends past the last event. + *) samples: int list list; + (** + List of stacks. Each stack is a list of indices into the shared frames + array. + *) weights: float list; + (** + Weight of the sample at the corresponding index. Must have the same + length as samples. + *) } val create_sampled_profile : type_:string -> name:string -> unit:value_unit -> start_value:float -> end_value:float -> samples:int list list -> weights:float list -> unit -> sampled_profile @@ -68,6 +93,7 @@ module Frame : sig val to_json : t -> string end +(** Data shared between profiles. *) type profile_shared = { frames: frame list; } @@ -90,10 +116,23 @@ end type file_format = { schema: string; name: string option; + (** + The name of the contained profile group. If omitted, the viewer uses + the filename. + *) exporter: string option; + (** + The name of the program that exported this profile. Not consumed by + speedscope, but useful for debugging. Recommended format: + name\@version. + *) active_profile_index: int option; - profiles: sampled_profile list; - shared: profile_shared; + (** + Index into the profiles array to display on load. Defaults to the + first profile if omitted. + *) + profiles: sampled_profile list; (** List of profile definitions. *) + shared: profile_shared; (** Data shared between profiles. *) } val create_file_format : schema:string -> ?name:string -> ?exporter:string -> ?active_profile_index:int -> profiles:sampled_profile list -> shared:profile_shared -> unit -> file_format From 97a3a3dfbd4de0eceda2f4ad316261c8dc28332c Mon Sep 17 00:00:00 2001 From: Martin Jambon Date: Tue, 19 May 2026 01:53:14 +0000 Subject: [PATCH 4/7] Wrap speedscope_fmt.atd at 80 columns - Move long URLs in the file header onto their own indented lines - Condense strings that exceeded the column limit - Regenerate speedscope_fmt.ml[i] Co-Authored-By: Claude Sonnet 4.6 --- src/speedscope_fmt.atd | 33 ++++++++++++++----------- src/speedscope_fmt.ml | 55 +++++++----------------------------------- src/speedscope_fmt.mli | 55 +++++++----------------------------------- 3 files changed, 37 insertions(+), 106 deletions(-) diff --git a/src/speedscope_fmt.atd b/src/speedscope_fmt.atd index 284f6c4..6ce3c4c 100644 --- a/src/speedscope_fmt.atd +++ b/src/speedscope_fmt.atd @@ -1,13 +1,18 @@ (* Speedscope file-format types. - Schema: https://www.speedscope.app/file-format-schema.json - Spec (TS): https://github.com/jlfwong/speedscope/blob/main/src/lib/file-format-spec.ts - Import docs: https://github.com/jlfwong/speedscope/wiki/Importing-from-custom-sources + Schema: + https://www.speedscope.app/file-format-schema.json + Spec (TS): + https://github.com/jlfwong/speedscope/blob/main/src/lib/file-format-spec.ts + Import docs: + https://github.com/jlfwong/speedscope/wiki/Importing-from-custom-sources To regenerate speedscope_fmt.ml and speedscope_fmt.mli from this file: atdml speedscope_fmt.atd *) -type value_unit = [ +type value_unit + += [ | Bytes | Microseconds | Milliseconds @@ -29,11 +34,11 @@ type frame = { type sampled_profile = { type_ - + : string; name - + : string; unit @@ -43,26 +48,26 @@ type sampled_profile = { start_value - + : float; end_value - + : float; samples - + : int list list; weights - + : float list; } (* The "shared" section of a Speedscope file. "shared" is a reserved word in ATD, hence the name profile_shared here; - the JSON key is "shared" via the annotation on the file_format field below. *) + the JSON key is "shared" via the field annotation below. *) type profile_shared = { @@ -77,16 +82,16 @@ type file_format = { : string; ?name - + : string option; ?exporter - + : string option; ?active_profile_index - + : int option; profiles diff --git a/src/speedscope_fmt.ml b/src/speedscope_fmt.ml index a41f61e..ff3ab4e 100644 --- a/src/speedscope_fmt.ml +++ b/src/speedscope_fmt.ml @@ -128,37 +128,13 @@ module Value_unit = struct end type sampled_profile = { - type_: string; - (** - Type of profile. Used as a discriminator in the profile union to - future-proof the file format. For sampled profiles, always 'sampled'. - *) - name: string; - (** - Name of the profile. Typically a filename for the source of the - profile. - *) + type_: string; (** Profile type discriminator; always 'sampled'. *) + name: string; (** Name of the profile. Typically a filename. *) unit: value_unit; (** Unit in which all values in this profile are expressed. *) - start_value: float; - (** - The starting value of the profile. Typically a timestamp. All event - values are displayed relative to startValue. - *) - end_value: float; - (** - The final value of the profile. Must be >= startValue. Useful when the - recorded profile extends past the last event. - *) - samples: int list list; - (** - List of stacks. Each stack is a list of indices into the shared frames - array. - *) - weights: float list; - (** - Weight of the sample at the corresponding index. Must have the same - length as samples. - *) + start_value: float; (** The starting value. All values are relative to this. *) + end_value: float; (** The final value. Must be >= startValue. *) + samples: int list list; (** List of stacks; each is a list of frame indices. *) + weights: float list; (** Weight of each sample. Same length as samples. *) } let create_sampled_profile ~type_ ~name ~unit ~start_value ~end_value ~samples ~weights () : sampled_profile = @@ -361,22 +337,9 @@ end type file_format = { schema: string; - name: string option; - (** - The name of the contained profile group. If omitted, the viewer uses - the filename. - *) - exporter: string option; - (** - The name of the program that exported this profile. Not consumed by - speedscope, but useful for debugging. Recommended format: - name\@version. - *) - active_profile_index: int option; - (** - Index into the profiles array to display on load. Defaults to the - first profile if omitted. - *) + name: string option; (** Profile group name. Defaults to the filename if omitted. *) + exporter: string option; (** Exporter name. Not consumed. Format: name\@version. *) + active_profile_index: int option; (** Index into profiles to display on load. Defaults to 0. *) profiles: sampled_profile list; (** List of profile definitions. *) shared: profile_shared; (** Data shared between profiles. *) } diff --git a/src/speedscope_fmt.mli b/src/speedscope_fmt.mli index 4464e08..5d4fa0a 100644 --- a/src/speedscope_fmt.mli +++ b/src/speedscope_fmt.mli @@ -23,37 +23,13 @@ module Value_unit : sig end type sampled_profile = { - type_: string; - (** - Type of profile. Used as a discriminator in the profile union to - future-proof the file format. For sampled profiles, always 'sampled'. - *) - name: string; - (** - Name of the profile. Typically a filename for the source of the - profile. - *) + type_: string; (** Profile type discriminator; always 'sampled'. *) + name: string; (** Name of the profile. Typically a filename. *) unit: value_unit; (** Unit in which all values in this profile are expressed. *) - start_value: float; - (** - The starting value of the profile. Typically a timestamp. All event - values are displayed relative to startValue. - *) - end_value: float; - (** - The final value of the profile. Must be >= startValue. Useful when the - recorded profile extends past the last event. - *) - samples: int list list; - (** - List of stacks. Each stack is a list of indices into the shared frames - array. - *) - weights: float list; - (** - Weight of the sample at the corresponding index. Must have the same - length as samples. - *) + start_value: float; (** The starting value. All values are relative to this. *) + end_value: float; (** The final value. Must be >= startValue. *) + samples: int list list; (** List of stacks; each is a list of frame indices. *) + weights: float list; (** Weight of each sample. Same length as samples. *) } val create_sampled_profile : type_:string -> name:string -> unit:value_unit -> start_value:float -> end_value:float -> samples:int list list -> weights:float list -> unit -> sampled_profile @@ -115,22 +91,9 @@ end type file_format = { schema: string; - name: string option; - (** - The name of the contained profile group. If omitted, the viewer uses - the filename. - *) - exporter: string option; - (** - The name of the program that exported this profile. Not consumed by - speedscope, but useful for debugging. Recommended format: - name\@version. - *) - active_profile_index: int option; - (** - Index into the profiles array to display on load. Defaults to the - first profile if omitted. - *) + name: string option; (** Profile group name. Defaults to the filename if omitted. *) + exporter: string option; (** Exporter name. Not consumed. Format: name\@version. *) + active_profile_index: int option; (** Index into profiles to display on load. Defaults to 0. *) profiles: sampled_profile list; (** List of profile definitions. *) shared: profile_shared; (** Data shared between profiles. *) } From 0c149447be88642159b1e7ac6b403a0e087387a4 Mon Sep 17 00:00:00 2001 From: Martin Jambon Date: Tue, 19 May 2026 02:01:04 +0000 Subject: [PATCH 5/7] Fix imported doc comments --- src/speedscope_fmt.atd | 55 +++++++++++++++++++------------- src/speedscope_fmt.ml | 71 ++++++++++++++++++++++++++++++++++++------ src/speedscope_fmt.mli | 71 ++++++++++++++++++++++++++++++++++++------ 3 files changed, 158 insertions(+), 39 deletions(-) diff --git a/src/speedscope_fmt.atd b/src/speedscope_fmt.atd index 6ce3c4c..0d7db68 100644 --- a/src/speedscope_fmt.atd +++ b/src/speedscope_fmt.atd @@ -1,18 +1,18 @@ -(* Speedscope file-format types. - Schema: - https://www.speedscope.app/file-format-schema.json - Spec (TS): - https://github.com/jlfwong/speedscope/blob/main/src/lib/file-format-spec.ts - Import docs: - https://github.com/jlfwong/speedscope/wiki/Importing-from-custom-sources + type value_unit - -= [ + = [ | Bytes | Microseconds | Milliseconds @@ -34,11 +34,14 @@ type frame = { type sampled_profile = { type_ - + : string; name - + : string; unit @@ -48,26 +51,32 @@ type sampled_profile = { start_value - + : float; end_value - + : float; samples - + : int list list; weights - + : float list; } (* The "shared" section of a Speedscope file. "shared" is a reserved word in ATD, hence the name profile_shared here; - the JSON key is "shared" via the field annotation below. *) + the JSON key is "shared" via the annotation on the file_format field below. *) type profile_shared = { @@ -82,16 +91,20 @@ type file_format = { : string; ?name - + : string option; ?exporter - + : string option; ?active_profile_index - + : int option; profiles diff --git a/src/speedscope_fmt.ml b/src/speedscope_fmt.ml index ff3ab4e..f28da15 100644 --- a/src/speedscope_fmt.ml +++ b/src/speedscope_fmt.ml @@ -1,6 +1,22 @@ (* Auto-generated from "speedscope_fmt.atd" by atdml. *) [@@@ocaml.warning "-27-32-33-35-39"] +(** + Speedscope file-format types. + + Schema: https://www.speedscope.app/file-format-schema.json Spec (TS): + https://github.com/jlfwong/speedscope/blob/main/src/lib/file-format-spec.ts + Import docs: + https://github.com/jlfwong/speedscope/wiki/Importing-from-custom-sources + + To regenerate speedscope_fmt.ml and speedscope_fmt.mli from this file: + + {v + atdml speedscope_fmt.atd + + v} +*) + (* Inlined runtime — no external dependency needed. *) module Atdml_runtime = struct (* Returns true iff the list has strictly more than [n] elements, @@ -128,13 +144,37 @@ module Value_unit = struct end type sampled_profile = { - type_: string; (** Profile type discriminator; always 'sampled'. *) - name: string; (** Name of the profile. Typically a filename. *) + type_: string; + (** + Type of profile. Used as a discriminator in the profile union to + future-proof the file format. For sampled profiles, always 'sampled'. + *) + name: string; + (** + Name of the profile. Typically a filename for the source of the + profile. + *) unit: value_unit; (** Unit in which all values in this profile are expressed. *) - start_value: float; (** The starting value. All values are relative to this. *) - end_value: float; (** The final value. Must be >= startValue. *) - samples: int list list; (** List of stacks; each is a list of frame indices. *) - weights: float list; (** Weight of each sample. Same length as samples. *) + start_value: float; + (** + The starting value of the profile. Typically a timestamp. All event + values are displayed relative to startValue. + *) + end_value: float; + (** + The final value of the profile. Must be >= startValue. Useful when the + recorded profile extends past the last event. + *) + samples: int list list; + (** + List of stacks. Each stack is a list of indices into the shared frames + array. + *) + weights: float list; + (** + Weight of the sample at the corresponding index. Must have the same + length as samples. + *) } let create_sampled_profile ~type_ ~name ~unit ~start_value ~end_value ~samples ~weights () : sampled_profile = @@ -337,9 +377,22 @@ end type file_format = { schema: string; - name: string option; (** Profile group name. Defaults to the filename if omitted. *) - exporter: string option; (** Exporter name. Not consumed. Format: name\@version. *) - active_profile_index: int option; (** Index into profiles to display on load. Defaults to 0. *) + name: string option; + (** + The name of the contained profile group. If omitted, the viewer uses + the filename. + *) + exporter: string option; + (** + The name of the program that exported this profile. Not consumed by + speedscope, but useful for debugging. Recommended format: + [name\@version]. + *) + active_profile_index: int option; + (** + Index into the profiles array to display on load. Defaults to the + first profile if omitted. + *) profiles: sampled_profile list; (** List of profile definitions. *) shared: profile_shared; (** Data shared between profiles. *) } diff --git a/src/speedscope_fmt.mli b/src/speedscope_fmt.mli index 5d4fa0a..afbf0d8 100644 --- a/src/speedscope_fmt.mli +++ b/src/speedscope_fmt.mli @@ -1,5 +1,21 @@ (* Auto-generated from "speedscope_fmt.atd" by atdml. *) +(** + Speedscope file-format types. + + Schema: https://www.speedscope.app/file-format-schema.json Spec (TS): + https://github.com/jlfwong/speedscope/blob/main/src/lib/file-format-spec.ts + Import docs: + https://github.com/jlfwong/speedscope/wiki/Importing-from-custom-sources + + To regenerate speedscope_fmt.ml and speedscope_fmt.mli from this file: + + {v + atdml speedscope_fmt.atd + + v} +*) + (** Unit in which all profile values are expressed. *) type value_unit = | Bytes @@ -23,13 +39,37 @@ module Value_unit : sig end type sampled_profile = { - type_: string; (** Profile type discriminator; always 'sampled'. *) - name: string; (** Name of the profile. Typically a filename. *) + type_: string; + (** + Type of profile. Used as a discriminator in the profile union to + future-proof the file format. For sampled profiles, always 'sampled'. + *) + name: string; + (** + Name of the profile. Typically a filename for the source of the + profile. + *) unit: value_unit; (** Unit in which all values in this profile are expressed. *) - start_value: float; (** The starting value. All values are relative to this. *) - end_value: float; (** The final value. Must be >= startValue. *) - samples: int list list; (** List of stacks; each is a list of frame indices. *) - weights: float list; (** Weight of each sample. Same length as samples. *) + start_value: float; + (** + The starting value of the profile. Typically a timestamp. All event + values are displayed relative to startValue. + *) + end_value: float; + (** + The final value of the profile. Must be >= startValue. Useful when the + recorded profile extends past the last event. + *) + samples: int list list; + (** + List of stacks. Each stack is a list of indices into the shared frames + array. + *) + weights: float list; + (** + Weight of the sample at the corresponding index. Must have the same + length as samples. + *) } val create_sampled_profile : type_:string -> name:string -> unit:value_unit -> start_value:float -> end_value:float -> samples:int list list -> weights:float list -> unit -> sampled_profile @@ -91,9 +131,22 @@ end type file_format = { schema: string; - name: string option; (** Profile group name. Defaults to the filename if omitted. *) - exporter: string option; (** Exporter name. Not consumed. Format: name\@version. *) - active_profile_index: int option; (** Index into profiles to display on load. Defaults to 0. *) + name: string option; + (** + The name of the contained profile group. If omitted, the viewer uses + the filename. + *) + exporter: string option; + (** + The name of the program that exported this profile. Not consumed by + speedscope, but useful for debugging. Recommended format: + [name\@version]. + *) + active_profile_index: int option; + (** + Index into the profiles array to display on load. Defaults to the + first profile if omitted. + *) profiles: sampled_profile list; (** List of profile definitions. *) shared: profile_shared; (** Data shared between profiles. *) } From 4274e1c9fc179a1772d270c51b4fc753956f8767 Mon Sep 17 00:00:00 2001 From: Martin Jambon Date: Tue, 19 May 2026 02:16:17 +0000 Subject: [PATCH 6/7] Update changelog; regenerate from revised ATD file Co-Authored-By: Claude Sonnet 4.6 --- CHANGES.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 76b3702..a36af94 100755 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,8 @@ working version --------------- +* add Speedscope export format: set `format=speedscope` in `OCAML_LANDMARKS` + to write a sampled flame-graph profile openable at https://www.speedscope.app + (combine with `time` for second-precision weights) version 1.6, 12 may 2026 ------------------------ From 892f860c9e55f753de9ca6eaa5b2869e8e0ecc87 Mon Sep 17 00:00:00 2001 From: Martin Jambon Date: Tue, 19 May 2026 02:27:15 +0000 Subject: [PATCH 7/7] Add intro comments --- src/speedscope.ml | 4 ++++ src/speedscope.mli | 7 +++++++ 2 files changed, 11 insertions(+) diff --git a/src/speedscope.ml b/src/speedscope.ml index 6f50f22..42d7ad6 100644 --- a/src/speedscope.ml +++ b/src/speedscope.ml @@ -1,3 +1,7 @@ +(* + Export to the Speedscope format +*) + let schema_url = "https://www.speedscope.app/file-format-schema.json" let exporter_name = "landmarks" diff --git a/src/speedscope.mli b/src/speedscope.mli index 9d85702..c75aa17 100644 --- a/src/speedscope.mli +++ b/src/speedscope.mli @@ -1,3 +1,10 @@ +(** Export to the Speedscope format + + See https://www.speedscope.app for using the visualization app + and https://github.com/jlfwong/speedscope/blob/main/src/lib/file-format-spec.ts + for the annotated format specification. +*) + val export_to_channel : out_channel -> Graph.graph -> unit (** Write a Speedscope sampled profile to [out_channel].