diff --git a/.gitignore b/.gitignore index 73b2b4678f..40a1a74e3a 100644 --- a/.gitignore +++ b/.gitignore @@ -37,3 +37,12 @@ TAGS *.ps *.svg tests/purs/make/ + +# Legacy perf-harness scratch space (replaced by experiments/ framework) +.profile-baseline/ +profile-output/ +profile-results.log + +.claude/settings.local.json +.claude/*.lock +thoughts diff --git a/CLAUDE.md b/CLAUDE.md new file mode 100644 index 0000000000..889d32f57f --- /dev/null +++ b/CLAUDE.md @@ -0,0 +1,181 @@ +# Claude guidance for this repo + +This is the PureScript compiler (restaumatic fork). Build with +`stack build`, test with `stack test --fast`. See `INSTALL.md` for +toolchain setup. + +--- + +## Performance work + +All compiler-performance optimisation work is organised as +**experiments** tracked under `experiments/`. Before starting anything +perf-related, read: + +1. `experiments/README.md` — index of all experiments with status, + verdict, and headline delta. +2. `experiments/LESSONS.md` — **required reading.** Distilled + learnings from closed experiments, including dead-end techniques + (e.g., don't cache cheap per-decl typecheck work; don't trust + headline speedups >20% without checking for a semantics bug). +3. `experiments/SCHEMA.md` — layout of each experiment folder and + the lifecycle states. + +### Workload + +Performance is measured against **pr-admin** +(`/workspace/restaumatic/apps/pr-admin`, 1758 modules), built via +`spago build` with a custom `purs` binary on PATH. Baseline numbers on +the `restaumatic` branch, optimised build: + +| Scenario | Time | +| ------------------------------------- | ------- | +| Full build | ~72–73s | +| No-change rebuild | ~1.1s | +| Touch leaf | ~1.2s | +| Comment change to Prelude (1342 deps) | ~2.3s | + +### Four scenarios to always run + +An optimisation is only a win if it doesn't regress any scenario. Many +cache-oriented changes win on `full` and lose on `nochange` or +`prelude` — that's the whole reason we run all four: + +| Scenario | How | What it catches | +| ---------- | --------------------------------------------------- | ------------------------------- | +| `full` | `rm -rf output && spago build` | raw throughput | +| `nochange` | full, then a second `spago build` | overhead on the no-op path | +| `prelude` | full, touch Prelude, `spago build` | cascade cost (1342 deps) | +| `leaf` | full, touch an arbitrary leaf module, `spago build` | single-module rebuild overhead | + +### Noise discipline + +- Discard run 1 as warm-up, report median + (min, max) of the + remaining runs. +- Run ≥4 runs after warm-up (so median-of-4 is meaningful). +- Don't compare a `--profile` build against a non-profile build, or a + `--fast` build against an optimised one — the overhead is real. +- If baseline-vs-baseline varies by more than ~1–2% between + back-to-back invocations, the measurement harness has a bug; fix it + before trusting any numbers. + +### Starting a new experiment + +```sh +# Scaffolds experiments//, creates branch off baseline-sha, +# creates worktree at /workspace/p/ +experiments/scripts/exp new [--from ] +``` + +The scaffold produces: +- `experiments//EXPERIMENT.md` — frontmatter + hypothesis. Fill + this in immediately; it's the entry point for anyone finding the + experiment later. +- `experiments//TASK.md` — detailed plan (what to change, where, + why). +- `experiments//HANDOFF.md` — live work log. Update as you go so + the next agent (or future-you) can pick up where you left off. +- `experiments//results.md` — structured results table, + append-only. + +Then work on the branch in `/workspace/p/`. The main repo at +`/workspace/purescript` stays on the current branch; the worktree has +its own checkout. + +### Measuring + +```sh +# Single scenario, quick iteration +experiments/scripts/exp run --scenarios full --runs 5 + +# All four scenarios, with cost-centre profiling +experiments/scripts/exp run --scenarios all --runs 5 --profile +``` + +Results append to `experiments//results.md` with baseline SHA, +head SHA, median, and notes. If `--profile` is set, `.prof` files land +in `experiments//profiles/` (gitignored) with a tracked +`.meta.md` sidecar recording the top cost centres and the commit. + +### Baselines + +Baselines are keyed by the commit SHA they were built from, stored at +`experiments/baselines//purs` (gitignored). Rebuild on +demand: + +```sh +experiments/scripts/exp build-baseline +``` + +The manifest at `experiments/baselines/manifest.md` tracks what +baselines have been built, on what machine, with what GHC — so any +measurement can be reproduced. + +Every `EXPERIMENT.md` records which `baseline_sha` its results are +against, so you can always figure out what a number is comparing to. + +### Closing an experiment + +```sh +experiments/scripts/exp close --verdict win|partial|no-win|abandoned +``` + +This sets the frontmatter to closed and prompts for a one-paragraph +entry in `experiments/LESSONS.md`. **Add that entry** — especially for +dead ends. The lesson is worth more than the code. + +### Worktrees + +Active experiment worktrees live at `/workspace/p/`. The current +set: + +```sh +git worktree list +# /workspace/purescript [restaumatic] +# /workspace/p/tc-queries [tc-queries] +# /workspace/p/synonym-opt [synonym-opt] +# /workspace/p/rust-interning [rust-interning] +``` + +Each experiment's `EXPERIMENT.md` also records its worktree path in +the frontmatter. + +### Per-declaration profiling + +The compiler emits eventlog markers for every typechecked declaration. +To see which specific declarations are slow (e.g., complex type-level +row-list computations, heavy instance resolution): + +```sh +# Within an experiment: before/after profiles +experiments/scripts/exp profile --phase before # profile baseline +# ... make changes ... +experiments/scripts/exp profile --phase after # profile head + +# Manual workflow (outside experiments) +stack build +purs +RTS -l-agu -N1 -RTS compile $(spago sources) +eventlog2html --json purs.eventlog +node debug/eventlog.js purs.eventlog.json # text report +node debug/eventlog-chrome-trace.js purs.eventlog.json > profile.json +# Open profile.json in chrome://tracing +``` + +See `debug/README.md` for details on RTS flags and tools. + +### Hotspot reference + +From the most recent profile on the `restaumatic` branch (see +`experiments/README.md` for the live table): + +| Cost Centre | Module | % time | Status | +| ---------------------------- | --------------------- | ------ | ------------------------ | +| `compare` (Qualified a) | Names.hs:234 | 20.8% | unattacked | +| `replaceAllTypeSynonyms'.go` | TypeChecker.Synonyms | 16.9% | see `synonym-opt` | +| `compare` (PSString) | PSString.hs:52 | 8.6% | unattacked | +| `compareType` | Types.hs | 4.2% | unattacked | + +When selecting a new experiment, pick an unattacked hotspot, or a +previously-attacked one whose experiment reached `no-win` with a +clear path to a different approach. **Don't re-attempt a dead-end +technique without new evidence** — check `LESSONS.md` first. diff --git a/debug/README.md b/debug/README.md new file mode 100644 index 0000000000..0197e331eb --- /dev/null +++ b/debug/README.md @@ -0,0 +1,105 @@ +# Per-declaration typecheck profiling + +The compiler emits eventlog markers at two levels: + +- **Module-level**: `"ModuleName start"` / `"ModuleName end"` (from `Make.hs`) +- **Declaration-level**: `"tc ModuleName kind:name start"` / `"tc ModuleName kind:name end"` (from `TypeChecker.hs`) + +Declaration kinds: `val`, `bind` (recursive group), `data`, `datagroup`, +`syn`, `kind`, `class`, `instance`, `extern`, `externdata`, `role`. + +## Quick start + +```bash +# 1. Build the compiler (eventlog is enabled by default in GHC >= 9.2) +stack build + +# 2. Run with eventlog enabled, single-threaded for clean nesting +cd /path/to/your/purescript/project +purs +RTS -l-agu -N1 -RTS compile $(spago sources) + +# 3. Convert the binary eventlog to JSON +eventlog2html --json purs.eventlog + +# 4a. Text report (module + declaration breakdown) +node /path/to/purescript/debug/eventlog.js purs.eventlog.json + +# 4b. Flamegraph (Chrome trace format — works in speedscope and chrome://tracing) +node /path/to/purescript/debug/eventlog-chrome-trace.js purs.eventlog.json > profile.json +# Open profile.json at https://www.speedscope.app/ or chrome://tracing +``` + +## RTS flags explained + +| Flag | Purpose | +| ------- | -------------------------------------------------- | +| `-l` | Enable eventlog output to `purs.eventlog` | +| `-agu` | Suppress GC/scheduler/user-tick noise | +| `-N1` | Single-threaded: gives clean per-declaration nesting | +| `-N` | Multi-threaded (default): faster but events interleave | + +Without `-N1`, modules typecheck in parallel and declaration events +from different modules interleave. The speedscope converter handles +this, but the flamegraph is cleaner with `-N1`. + +## Tools + +### `eventlog.js` — text report + +``` +node debug/eventlog.js purs.eventlog.json +``` + +Prints per-module timing (sorted ascending), concurrency stats, and +a per-declaration breakdown showing the top 50 slowest declarations +with module name, declaration kind, wall-clock time, and percentage. + +### `eventlog-chrome-trace.js` — flamegraph + +``` +node debug/eventlog-chrome-trace.js purs.eventlog.json > profile.json +``` + +Outputs Chrome trace format JSON. Open in: +- https://www.speedscope.app/ (drag and drop) +- `chrome://tracing` in Chrome (load file) + +The flamegraph shows module-level and declaration-level spans nested +properly. The text report (top N declarations) is also printed to +stderr. + +Options: +- `--top N` — number of declarations in stderr report (default: 50) +- `--cap CAP` — filter to a specific GHC capability (thread) + +## What the flamegraph shows + +The flamegraph has two levels: + +1. **Module** — total time for the module (includes desugaring, codegen, etc.) +2. **Declaration** — time for typechecking each declaration within the module + +This tells you which declarations are expensive. Common patterns: + +- **Large `instance:` spans** — complex instance resolution, often + involving row-list traversals or `EncodeJson`/`DecodeJson` generics +- **Large `bind:` or `val:` spans** — complex type inference with + many constraints +- **Large `datagroup:` spans** — mutually recursive type definitions + with many constructors + +## Overhead + +The `traceMarker` calls are effectively free when not profiling: +- GHC >= 9.2: eventlog is always linked; `traceMarker` checks a flag and returns +- Per call: ~tens of nanoseconds (buffer write) +- Total for ~10k declarations: ~1ms against a ~72s build + +## Prerequisites + +Install `eventlog2html`: +```bash +cabal install eventlog2html +# or +pip install eventlog2html +``` diff --git a/debug/analyze-hasfield.js b/debug/analyze-hasfield.js new file mode 100644 index 0000000000..8596f77cdf --- /dev/null +++ b/debug/analyze-hasfield.js @@ -0,0 +1,249 @@ +// Analyze HasField entailment performance from eventlog JSON +// +// Usage: +// node debug/analyze-hasfield.js /path/to/purs.eventlog.json +// +// This script digs into the tc-entails events to understand: +// 1. Distribution of HasField resolution times +// 2. What sub-constraints are solved inside HasField +// 3. Time breakdown: instance matching vs sub-constraint solving +// 4. How much time is spent on newtypes vs plain Records +// 5. Whether there are repeated identical constraints + +var fs = require("fs"); + +var inputFile = process.argv[2]; +if (!inputFile) { + console.error("Usage: node debug/analyze-hasfield.js "); + process.exit(1); +} + +var eventlog = JSON.parse(fs.readFileSync(inputFile, "utf-8")); +eventlog.traces.sort(function(a, b) { return a.tx - b.tx; }); + +// Parse all entailment events into a tree structure +var entailsStartRe = /^tc-entails ([\w.]+) (.+) start$/; +var entailsEndRe = /^tc-entails ([\w.]+) end$/; +var instanceRe = /^tc-entails-instance ([\w.]+) (.+)$/; + +// Build a tree of entailment spans +var stack = []; +var rootSpans = []; + +for (var trace of eventlog.traces) { + var m; + if ((m = entailsStartRe.exec(trace.desc))) { + var span = { + className: m[1], + args: m[2].trim(), + startTx: trace.tx, + endTx: null, + duration: null, + instance: null, + children: [], + parent: stack.length > 0 ? stack[stack.length - 1] : null + }; + if (span.parent) { + span.parent.children.push(span); + } + stack.push(span); + } else if ((m = entailsEndRe.exec(trace.desc))) { + if (stack.length > 0 && stack[stack.length - 1].className === m[1]) { + var span = stack.pop(); + span.endTx = trace.tx; + span.duration = trace.tx - span.startTx; + if (!span.parent) { + rootSpans.push(span); + } + } + } else if ((m = instanceRe.exec(trace.desc))) { + if (stack.length > 0) { + stack[stack.length - 1].instance = m[2]; + } + } +} + +// Now analyze HasField specifically +var hasFieldSpans = []; +function collectHasField(span) { + if (span.className === "Data.Record.HasField") { + hasFieldSpans.push(span); + } + // Don't recurse into children — we want top-level HasField invocations +} + +for (var span of rootSpans) { + collectHasField(span); + // Also check direct children of non-HasField roots +} + +// Actually, let's collect ALL HasField spans, noting depth +function collectAll(span, depth) { + if (span.className === "Data.Record.HasField") { + hasFieldSpans.push({ span: span, depth: depth }); + } + for (var child of span.children) { + collectAll(child, depth + 1); + } +} + +hasFieldSpans = []; +for (var span of rootSpans) { + collectAll(span, 0); +} + +console.error("=== HasField Analysis ===\n"); +console.error("Total HasField entailment spans: " + hasFieldSpans.length); + +// 1. Time distribution +var durations = hasFieldSpans.map(function(h) { return h.span.duration * 1000; }); // ms +durations.sort(function(a, b) { return a - b; }); + +var totalMs = durations.reduce(function(s, d) { return s + d; }, 0); +console.error("Total HasField time: " + totalMs.toFixed(0) + "ms (" + (totalMs/1000).toFixed(1) + "s)"); +console.error("Mean: " + (totalMs / durations.length).toFixed(3) + "ms"); +console.error("Median: " + durations[Math.floor(durations.length / 2)].toFixed(3) + "ms"); +console.error("P90: " + durations[Math.floor(durations.length * 0.9)].toFixed(3) + "ms"); +console.error("P99: " + durations[Math.floor(durations.length * 0.99)].toFixed(3) + "ms"); +console.error("Max: " + durations[durations.length - 1].toFixed(3) + "ms"); +console.error("Min: " + durations[0].toFixed(6) + "ms"); + +// Distribution buckets +var buckets = [0.01, 0.05, 0.1, 0.5, 1, 2, 5, 10, 50, 100, Infinity]; +var bucketCounts = buckets.map(function() { return { count: 0, totalMs: 0 }; }); +for (var d of durations) { + for (var i = 0; i < buckets.length; i++) { + if (d < buckets[i]) { + bucketCounts[i].count++; + bucketCounts[i].totalMs += d; + break; + } + } +} +console.error("\nTime distribution:"); +var prevBound = 0; +for (var i = 0; i < buckets.length; i++) { + var label = prevBound + "-" + (buckets[i] === Infinity ? "∞" : buckets[i]) + "ms"; + console.error(" " + label.padEnd(15) + " " + + String(bucketCounts[i].count).padStart(7) + " spans " + + bucketCounts[i].totalMs.toFixed(0).padStart(7) + "ms total " + + (bucketCounts[i].totalMs / totalMs * 100).toFixed(1).padStart(5) + "% of time"); + prevBound = buckets[i]; +} + +// 2. Depth analysis (how many are top-level vs sub-constraints) +var depthCounts = {}; +for (var h of hasFieldSpans) { + depthCounts[h.depth] = (depthCounts[h.depth] || 0) + 1; +} +console.error("\nDepth distribution (0 = top-level entailment call):"); +for (var depth in depthCounts) { + console.error(" depth " + depth + ": " + depthCounts[depth] + " spans"); +} + +// 3. Instance analysis — what instances are resolved? +var instanceCounts = {}; +for (var h of hasFieldSpans) { + var inst = h.span.instance || "(unknown)"; + if (!instanceCounts[inst]) instanceCounts[inst] = { count: 0, totalMs: 0 }; + instanceCounts[inst].count++; + instanceCounts[inst].totalMs += h.span.duration * 1000; +} +var instEntries = Object.entries(instanceCounts).sort(function(a, b) { return b[1].totalMs - a[1].totalMs; }); +console.error("\nInstance resolution (top 20):"); +for (var entry of instEntries.slice(0, 20)) { + console.error(" " + entry[0].padEnd(60) + " " + + String(entry[1].count).padStart(6) + "x " + + entry[1].totalMs.toFixed(0).padStart(7) + "ms " + + (entry[1].totalMs / totalMs * 100).toFixed(1).padStart(5) + "%"); +} + +// 4. Sub-constraint analysis — what's inside each HasField? +var childClassCounts = {}; +for (var h of hasFieldSpans) { + for (var child of h.span.children) { + var key = child.className; + if (!childClassCounts[key]) childClassCounts[key] = { count: 0, totalMs: 0 }; + childClassCounts[key].count++; + childClassCounts[key].totalMs += child.duration * 1000; + } +} +console.error("\nSub-constraints inside HasField (immediate children):"); +var childEntries = Object.entries(childClassCounts).sort(function(a, b) { return b[1].totalMs - a[1].totalMs; }); +for (var entry of childEntries) { + console.error(" " + entry[0].padEnd(50) + " " + + String(entry[1].count).padStart(6) + "x " + + entry[1].totalMs.toFixed(0).padStart(7) + "ms " + + (entry[1].totalMs / totalMs * 100).toFixed(1).padStart(5) + "%"); +} + +// 5. "Self time" — HasField time NOT spent in child constraints +var selfTimes = hasFieldSpans.map(function(h) { + var childTime = h.span.children.reduce(function(s, c) { return s + c.duration; }, 0); + return (h.span.duration - childTime) * 1000; // ms +}); +var totalSelfMs = selfTimes.reduce(function(s, d) { return s + d; }, 0); +console.error("\nSelf time (HasField overhead excluding sub-constraints):"); +console.error(" Total self time: " + totalSelfMs.toFixed(0) + "ms (" + (totalSelfMs / totalMs * 100).toFixed(1) + "% of HasField time)"); +console.error(" Mean self time: " + (totalSelfMs / selfTimes.length).toFixed(3) + "ms"); + +// 6. Args analysis — what types are being accessed? +var argPatterns = {}; +for (var h of hasFieldSpans) { + var args = h.span.args; + if (!argPatterns[args]) argPatterns[args] = { count: 0, totalMs: 0 }; + argPatterns[args].count++; + argPatterns[args].totalMs += h.span.duration * 1000; +} +var argEntries = Object.entries(argPatterns).sort(function(a, b) { return b[1].totalMs - a[1].totalMs; }); +console.error("\nTop 30 HasField argument patterns (by total time):"); +for (var entry of argEntries.slice(0, 30)) { + console.error(" " + entry[0].substring(0, 80).padEnd(80) + " " + + String(entry[1].count).padStart(5) + "x " + + entry[1].totalMs.toFixed(0).padStart(6) + "ms " + + (entry[1].totalMs / totalMs * 100).toFixed(1).padStart(5) + "%"); +} + +// 7. Repeated constraints — how many unique vs repeated? +var uniqueArgs = Object.keys(argPatterns).length; +var totalArgs = hasFieldSpans.length; +var repeatedEntries = argEntries.filter(function(e) { return e[1].count > 1; }); +var repeatedTotal = repeatedEntries.reduce(function(s, e) { return s + e[1].count; }, 0); +var repeatedTimeMs = repeatedEntries.reduce(function(s, e) { return s + e[1].totalMs; }, 0); +console.error("\nRepetition analysis:"); +console.error(" Unique constraint patterns: " + uniqueArgs); +console.error(" Total resolutions: " + totalArgs); +console.error(" Repeated (>1x): " + repeatedEntries.length + " patterns, " + repeatedTotal + " resolutions, " + repeatedTimeMs.toFixed(0) + "ms"); +console.error(" Savings if cached: ~" + (repeatedTimeMs - repeatedEntries.length * (totalSelfMs / totalArgs)).toFixed(0) + "ms"); + +// 8. Number of children per HasField span +var childCountDist = {}; +for (var h of hasFieldSpans) { + var nc = h.span.children.length; + childCountDist[nc] = (childCountDist[nc] || 0) + 1; +} +console.error("\nChildren-per-HasField distribution:"); +for (var nc of Object.keys(childCountDist).sort(function(a, b) { return a - b; })) { + console.error(" " + nc + " children: " + childCountDist[nc] + " spans"); +} + +// 9. Record type analysis — what record types are being accessed? +// The third arg in HasField is the record type +// Pattern: "'fieldName' TypeCtor" or "'fieldName' TypeCtor {..}" +var recordTypes = {}; +for (var h of hasFieldSpans) { + var parts = h.span.args.split(" "); + // First part is the field name (quoted), rest is the type + var recordType = parts.length > 1 ? parts.slice(1).join(" ") : "(unknown)"; + if (!recordTypes[recordType]) recordTypes[recordType] = { count: 0, totalMs: 0 }; + recordTypes[recordType].count++; + recordTypes[recordType].totalMs += h.span.duration * 1000; +} +var recordEntries = Object.entries(recordTypes).sort(function(a, b) { return b[1].totalMs - a[1].totalMs; }); +console.error("\nTop 30 record types being accessed (by total time):"); +for (var entry of recordEntries.slice(0, 30)) { + console.error(" " + entry[0].substring(0, 60).padEnd(60) + " " + + String(entry[1].count).padStart(5) + "x " + + entry[1].totalMs.toFixed(0).padStart(6) + "ms " + + (entry[1].totalMs / totalMs * 100).toFixed(1).padStart(5) + "%"); +} diff --git a/debug/analyze-labels.js b/debug/analyze-labels.js new file mode 100644 index 0000000000..f6622315c9 --- /dev/null +++ b/debug/analyze-labels.js @@ -0,0 +1,151 @@ +#!/usr/bin/env node +// Analyze HasField entailment time by label, type, and module +const fs = require("fs"); +const data = JSON.parse(fs.readFileSync(process.argv[2] || "purs.eventlog.json", "utf8")); +const traces = data.traces; + +let currentModule = null; +let moduleStack = []; +let hasFieldStack = []; + +let byModule = {}; +let byLabel = {}; +let byType = {}; // second arg (the field type) +let byModuleLabel = {}; + +for (const t of traces) { + if (!t.desc) continue; + + // Module markers: "ModuleName start" / "ModuleName end" + let m = /^([\w.]+) (start|end)$/.exec(t.desc); + if (m) { + if (m[2] === "start") { + moduleStack.push(m[1]); + currentModule = m[1]; + } else { + moduleStack.pop(); + currentModule = moduleStack.length > 0 ? moduleStack[moduleStack.length - 1] : null; + } + continue; + } + + // HasField start: "tc-entails Data.Record.HasField start" + m = /^tc-entails Data\.Record\.HasField (.+) start$/.exec(t.desc); + if (m) { + hasFieldStack.push({ module: currentModule, args: m[1], startTx: t.tx }); + continue; + } + + // HasField end + if (t.desc === "tc-entails Data.Record.HasField end") { + if (hasFieldStack.length > 0) { + const entry = hasFieldStack.pop(); + const dur = t.tx - entry.startTx; + const mod = entry.module || "unknown"; + const args = entry.args; + + // Parse: 'labelName' TypeName RowKind + // or: _ _ Record (unknown) + const parts = args.split(/\s+/); + let label = "_"; + let fieldType = "_"; + if (parts[0].startsWith("'")) { + // label is 'xxx' — may contain spaces if it's a multi-word symbol, but usually single + label = parts[0].replace(/'/g, ""); + fieldType = parts.length > 1 ? parts[1] : "_"; + } + + if (!byModule[mod]) byModule[mod] = { time: 0, count: 0 }; + byModule[mod].time += dur; + byModule[mod].count++; + + if (!byLabel[label]) byLabel[label] = { time: 0, count: 0 }; + byLabel[label].time += dur; + byLabel[label].count++; + + if (!byType[fieldType]) byType[fieldType] = { time: 0, count: 0 }; + byType[fieldType].time += dur; + byType[fieldType].count++; + + const key = mod + " | " + label; + if (!byModuleLabel[key]) byModuleLabel[key] = { time: 0, count: 0, module: mod, label }; + byModuleLabel[key].time += dur; + byModuleLabel[key].count++; + } + } +} + +const totalTime = Object.values(byLabel).reduce((s, v) => s + v.time, 0); + +console.log("=== HasField inclusive time by LABEL (top 40) ===\n"); +const sortedLabels = Object.entries(byLabel).sort((a, b) => b[1].time - a[1].time); +for (const [label, val] of sortedLabels.slice(0, 40)) { + const pct = (val.time / totalTime * 100).toFixed(1); + console.log( + ("'" + label + "'").padEnd(45), + (val.time * 1000).toFixed(0).toString().padStart(8) + "ms", + pct.padStart(6) + "%", + val.count.toString().padStart(7) + " calls" + ); +} + +console.log("\n=== HasField inclusive time by FIELD TYPE (top 20) ===\n"); +const sortedTypes = Object.entries(byType).sort((a, b) => b[1].time - a[1].time); +for (const [type, val] of sortedTypes.slice(0, 20)) { + const pct = (val.time / totalTime * 100).toFixed(1); + console.log( + type.padEnd(45), + (val.time * 1000).toFixed(0).toString().padStart(8) + "ms", + pct.padStart(6) + "%", + val.count.toString().padStart(7) + " calls" + ); +} + +console.log("\n=== HasField inclusive time by MODULE (top 20) ===\n"); +const sortedModules = Object.entries(byModule).sort((a, b) => b[1].time - a[1].time); +for (const [mod, val] of sortedModules.slice(0, 20)) { + const pct = (val.time / totalTime * 100).toFixed(1); + console.log( + mod.padEnd(55), + (val.time * 1000).toFixed(0).toString().padStart(8) + "ms", + pct.padStart(6) + "%", + val.count.toString().padStart(7) + " calls" + ); +} + +// TranslationKey analysis +console.log("\n=== TranslationKey analysis ===\n"); +let tkTime = 0, tkCount = 0; +for (const [type, val] of Object.entries(byType)) { + if (/TranslationKey/i.test(type)) { + tkTime += val.time; + tkCount += val.count; + console.log("Type:", type, (val.time * 1000).toFixed(0) + "ms", val.count, "calls"); + } +} +console.log("\nTotal TranslationKey HasField time:", (tkTime * 1000).toFixed(0) + "ms", + "(" + (tkTime / totalTime * 100).toFixed(1) + "% of HasField)"); +console.log("Total TranslationKey HasField calls:", tkCount); + +// Also check labels that look like translation keys +console.log("\n=== Labels matching translation-like patterns ===\n"); +let tlLabelTime = 0, tlLabelCount = 0; +for (const [label, val] of sortedLabels) { + // Translation keys are often camelCase identifiers + // Let's just look for the top labels in TranslationKey-typed calls +} + +// Top module+label combos +console.log("\n=== Top module+label combos (top 30) ===\n"); +const sortedML = Object.entries(byModuleLabel).sort((a, b) => b[1].time - a[1].time); +for (const [key, val] of sortedML.slice(0, 30)) { + console.log( + key.padEnd(75), + (val.time * 1000).toFixed(0).toString().padStart(8) + "ms", + val.count.toString().padStart(7) + " calls" + ); +} + +console.log("\n--- Total ---"); +console.log("Total HasField time (inclusive):", (totalTime * 1000).toFixed(0) + "ms"); +console.log("Total HasField calls:", Object.values(byLabel).reduce((s, v) => s + v.count, 0)); diff --git a/debug/eventlog-chrome-trace.js b/debug/eventlog-chrome-trace.js new file mode 100644 index 0000000000..14a8b140b3 --- /dev/null +++ b/debug/eventlog-chrome-trace.js @@ -0,0 +1,222 @@ +// Convert eventlog2html JSON to Chrome trace format for flamegraph visualization. +// +// Usage: +// purs +RTS -l-agu -N1 -RTS compile $(spago sources) +// eventlog2html --json purs.eventlog +// node debug/eventlog-chrome-trace.js purs.eventlog.json > profile.json +// # Open profile.json in chrome://tracing (or https://www.speedscope.app/) +// +// The output contains two levels of nesting: +// - Module-level spans (from traceMarkerIO in Make.hs): "ModuleName start/end" +// - Declaration-level spans (from traceMarker in TypeChecker.hs): "tc ModuleName kind:name start/end" +// +// Use -N1 when profiling to get clean single-threaded nesting. + +var fs = require("fs"); + +var inputFile = process.argv[2]; +if (!inputFile) { + console.error("Usage: node eventlog-chrome-trace.js [--top N] [--cap CAP]"); + console.error(""); + console.error("Options:"); + console.error(" --top N Also print top N slowest declarations to stderr (default: 50)"); + console.error(" --cap CAP Filter to a specific GHC capability (thread). Default: all."); + process.exit(1); +} + +var topN = 50; +var filterCap = null; +var minMs = 0; // skip entails events shorter than this (ms) +for (var i = 3; i < process.argv.length; i++) { + if (process.argv[i] === "--top" && process.argv[i+1]) { + topN = parseInt(process.argv[i+1], 10); + i++; + } else if (process.argv[i] === "--cap" && process.argv[i+1]) { + filterCap = parseInt(process.argv[i+1], 10); + i++; + } else if (process.argv[i] === "--min-ms" && process.argv[i+1]) { + minMs = parseFloat(process.argv[i+1]); + i++; + } +} + +var eventlog = JSON.parse(fs.readFileSync(inputFile, "utf-8")); + +// Module-level: "ModuleName start" / "ModuleName end" +var moduleRe = /^([\w.]+) (start|end)$/; +// Declaration-level: "tc ModuleName kind:name start" / "tc ModuleName kind:name end" +var declRe = /^tc ([\w.]+) ([\w:+]+) (start|end)$/; +// Phase-level: "tc-phase ModuleName bindName phase start" / "... end" +var phaseRe = /^tc-phase ([\w.]+) ([\w+]+) (infer|solve) (start|end)$/; +// Entailment: "tc-entails ClassName [typeArgs...] start" / "tc-entails ClassName end" +var entailsStartRe = /^tc-entails ([\w.]+) (.+) start$/; +var entailsEndRe = /^tc-entails ([\w.]+) end$/; +// Instance resolution: "tc-entails-instance ClassName instanceName" +var instanceRe = /^tc-entails-instance ([\w.]+) (.+)$/; + +// Sort by timestamp +eventlog.traces.sort(function(a, b) { return a.tx - b.tx; }); + +// Filter by capability if requested +var traces = eventlog.traces; +if (filterCap !== null) { + traces = traces.filter(function(t) { return t.cap === filterCap; }); +} + +// Build Chrome trace events and collect declaration timings +// Chrome trace format: https://docs.google.com/document/d/1CvAClvFfyA5R-PhYUmn5OOQtYMH4h6I0nSsKchNAySU +var chromeEvents = []; +var declTimings = []; +var openSpans = {}; // key -> startTime (seconds) + +for (var trace of traces) { + var m = moduleRe.exec(trace.desc); + var d = declRe.exec(trace.desc); + var p = phaseRe.exec(trace.desc); + var e; + var tid = trace.cap !== undefined ? trace.cap : 0; + + if (d) { + var spanName = d[1] + " " + d[2]; + var ev = d[3]; + if (ev === "start") { + openSpans[spanName] = trace.tx; + chromeEvents.push({ + name: d[2], // e.g. "val:updateExternalMenuView" + cat: "typecheck", + ph: "B", + ts: trace.tx * 1e6, + pid: 1, tid: tid + }); + } else if (ev === "end") { + chromeEvents.push({ + name: d[2], + cat: "typecheck", + ph: "E", + ts: trace.tx * 1e6, + pid: 1, tid: tid + }); + if (openSpans[spanName] !== undefined) { + declTimings.push({ + module: d[1], + label: d[2], + duration: trace.tx - openSpans[spanName] + }); + delete openSpans[spanName]; + } + } + } else if (p) { + // Phase within typesOf: infer / solve + chromeEvents.push({ + name: p[3], // "infer" or "solve" + cat: "phase", + ph: p[4] === "start" ? "B" : "E", + ts: trace.tx * 1e6, + pid: 1, tid: tid + }); + } else if ((e = entailsStartRe.exec(trace.desc))) { + // Per-constraint entailment start — buffer it, emit on end if long enough + var entailArgs = e[2].trim(); + var bev = { name: e[1], cat: "entails", ph: "B", ts: trace.tx * 1e6, pid: 1, tid: tid }; + if (entailArgs) bev.args = { types: entailArgs }; + if (!openSpans._entailStack) openSpans._entailStack = []; + openSpans._entailStack.push({ bev: bev, startTx: trace.tx, childEvents: [] }); + } else if ((e = entailsEndRe.exec(trace.desc))) { + var stack = openSpans._entailStack; + if (stack && stack.length > 0) { + var span = stack.pop(); + var durMs = (trace.tx - span.startTx) * 1000; + var eev = { name: e[1], cat: "entails", ph: "E", ts: trace.tx * 1e6, pid: 1, tid: tid }; + if (durMs >= minMs) { + chromeEvents.push(span.bev); + for (var ce of span.childEvents) chromeEvents.push(ce); + chromeEvents.push(eev); + } + // If parent exists, add our events as child events (if we emitted) + if (stack.length > 0 && durMs >= minMs) { + // Already pushed to chromeEvents, no need to buffer in parent + } + } + } else if ((e = instanceRe.exec(trace.desc))) { + // Instance resolution — attach to current entailment span + var stack = openSpans._entailStack; + if (stack && stack.length > 0 && minMs <= 0) { + stack[stack.length-1].childEvents.push({ + name: e[1] + " => " + e[2], + cat: "instance", + ph: "i", s: "t", + ts: trace.tx * 1e6, + pid: 1, tid: tid, + args: { class: e[1], instance: e[2] } + }); + } else if (minMs <= 0) { + chromeEvents.push({ + name: e[1] + " => " + e[2], + cat: "instance", + ph: "i", s: "t", + ts: trace.tx * 1e6, + pid: 1, tid: tid, + args: { class: e[1], instance: e[2] } + }); + } + } else if (m) { + chromeEvents.push({ + name: m[1], // e.g. "Restaumatic.PR.MenuV2.Import" + cat: "module", + ph: m[2] === "start" ? "B" : "E", + ts: trace.tx * 1e6, + pid: 1, tid: tid + }); + } +} + +if (chromeEvents.length === 0) { + console.error("No matching start/end spans found in " + inputFile); + console.error("Make sure you ran: purs +RTS -l-agu -N1 -RTS compile ..."); + process.exit(1); +} + +// Output Chrome trace JSON to stdout +// Using the object format with metadata +var output = { + traceEvents: chromeEvents, + displayTimeUnit: "ms", + metadata: { + source: "purs eventlog" + } +}; +fs.writeFileSync("/dev/stdout", JSON.stringify(output)); + +// Print declaration timing report to stderr +if (topN > 0 && declTimings.length > 0) { + declTimings.sort(function(a, b) { return b.duration - a.duration; }); + + var totalDeclTime = declTimings.reduce(function(sum, d) { return sum + d.duration; }, 0); + + console.error(""); + console.error("=== Per-declaration typecheck timing (top " + Math.min(topN, declTimings.length) + " of " + declTimings.length + ") ==="); + console.error(""); + + var maxModLen = 0, maxLabelLen = 0; + var shown = declTimings.slice(0, topN); + for (var d of shown) { + if (d.module.length > maxModLen) maxModLen = d.module.length; + if (d.label.length > maxLabelLen) maxLabelLen = d.label.length; + } + + for (var d of shown) { + var ms = (d.duration * 1000).toFixed(1); + var pct = (d.duration / totalDeclTime * 100).toFixed(1); + console.error( + d.module.padEnd(maxModLen) + " " + + d.label.padEnd(maxLabelLen) + " " + + ms.padStart(8) + "ms " + + pct.padStart(5) + "%" + ); + } + + var topTime = shown.reduce(function(sum, d) { return sum + d.duration; }, 0); + console.error(""); + console.error("Total declaration typecheck time: " + (totalDeclTime * 1000).toFixed(0) + "ms across " + declTimings.length + " declarations"); + console.error("Top " + shown.length + " account for " + (topTime / totalDeclTime * 100).toFixed(1) + "% of declaration time"); +} diff --git a/debug/eventlog.js b/debug/eventlog.js index 43aa4f7221..2c74410420 100644 --- a/debug/eventlog.js +++ b/debug/eventlog.js @@ -1,18 +1,17 @@ // Debug compilation times of modules from eventlog profiling // -// Build and run purs with profiling enabled: -// cabal build --enable-profiling -// cabal exec -- purs ...... -// Or with stack: -// stack build --profile -// stack --profile exec -- purs ...... +// Build with stack: +// stack build // Run a command like this to generate purs.eventlog: -// purs +RTS -l-agu -i1.5 -hc -RTS compile -g corefn $(spago sources) -// (If you want accurate stats for individual modules, add -N1.) +// purs +RTS -l-agu -N1 -RTS compile $(spago sources) +// (Use -N1 for accurate per-declaration timings.) // Process it with // eventlog2html --json purs.eventlog // node eventlog.js purs.eventlog.json // +// This shows per-module timing and concurrency stats. +// For per-declaration flamegraphs, see eventlog-speedscope.js. +// // See the GHC docs for descriptions of the RTS flags: // - https://downloads.haskell.org/ghc/latest/docs/users_guide/profiling.html#rts-options-for-heap-profiling // - https://downloads.haskell.org/ghc/latest/docs/users_guide/runtime_control.html#rts-eventlog @@ -184,7 +183,82 @@ for (let [name, time] of timings) { console.log(name.padEnd(name_length, " "), time); } -//require("fs").writeFileSync("concurrencies.json", JSON.stringify(concurrencies, null, 2), "utf-8"); +// Per-declaration breakdown (from "tc Module kind:name start/end" markers) +var declRe = /^tc ([\w.]+) ([\w:+]+) (start|end)$/; +// Phase markers: "tc-phase Module bindName infer|solve start|end" +var phaseRe = /^tc-phase ([\w.]+) ([\w+]+) (infer|solve) (start|end)$/; +var declTraces = {}; +var phaseTraces = {}; +var rawEventlog = JSON.parse(require("fs").readFileSync(mainFile, "utf-8")); +for (let trace of rawEventlog.traces) { + var d = declRe.exec(trace.desc); + if (d) { + var key = d[1] + " " + d[2]; + if (!(key in declTraces)) declTraces[key] = { module: d[1], label: d[2] }; + declTraces[key][d[3]] = trace.tx; + continue; + } + var p = phaseRe.exec(trace.desc); + if (p) { + var pkey = p[1] + " " + p[2] + " " + p[3]; + if (!(pkey in phaseTraces)) phaseTraces[pkey] = { module: p[1], bind: p[2], phase: p[3] }; + phaseTraces[pkey][p[4]] = trace.tx; + } +} + +// Build phase timing lookup: "Module bind" -> { infer: ms, solve: ms } +var phaseLookup = {}; +for (let key in phaseTraces) { + let pt = phaseTraces[key]; + if ("start" in pt && "end" in pt) { + var lkey = pt.module + " " + pt.bind; + if (!(lkey in phaseLookup)) phaseLookup[lkey] = {}; + phaseLookup[lkey][pt.phase] = (pt.end - pt.start) * 1000; + } +} + +var declTimings = []; +for (let key in declTraces) { + let dt = declTraces[key]; + if ("start" in dt && "end" in dt) { + // Try to find matching phase data + var bindName = dt.label.replace(/^(val|bind):/, ""); + var phases = phaseLookup[dt.module + " " + bindName] || {}; + declTimings.push([dt.module, dt.label, dt.end - dt.start, phases]); + } +} + +if (declTimings.length > 0) { + declTimings.sort(([,,t1], [,,t2]) => t2 - t1); + var totalDeclTime = declTimings.reduce((s, [,,t]) => s + t, 0); + var maxModLen = Math.max(...declTimings.slice(0, 50).map(([m]) => m.length)); + var maxLabelLen = Math.max(...declTimings.slice(0, 50).map(([,l]) => l.length)); + + console.log(""); + console.log("=== Per-declaration typecheck timing (top " + Math.min(50, declTimings.length) + " of " + declTimings.length + ") ==="); + console.log(""); + for (let [mod, label, time, phases] of declTimings.slice(0, 50)) { + var ms = (time * 1000).toFixed(1); + var pct = (time / totalDeclTime * 100).toFixed(1); + var phaseStr = ""; + if (phases.infer !== undefined || phases.solve !== undefined) { + var inferMs = (phases.infer || 0).toFixed(0); + var solveMs = (phases.solve || 0).toFixed(0); + phaseStr = " [infer:" + inferMs + " solve:" + solveMs + "]"; + } + console.log( + mod.padEnd(maxModLen) + " " + + label.padEnd(maxLabelLen) + " " + + ms.padStart(8) + "ms " + + pct.padStart(5) + "%" + + phaseStr + ); + } + var topTime = declTimings.slice(0, 50).reduce((s, [,,t]) => s + t, 0); + console.log(""); + console.log("Total declaration time: " + (totalDeclTime * 1000).toFixed(0) + "ms across " + declTimings.length + " declarations"); + console.log("Top 50 account for " + (topTime / totalDeclTime * 100).toFixed(1) + "%"); +} function space(v) { diff --git a/experiments/.gitignore b/experiments/.gitignore new file mode 100644 index 0000000000..2e5ab5c8f7 --- /dev/null +++ b/experiments/.gitignore @@ -0,0 +1,4 @@ +# Profile traces are large (100-150MB) — don't commit them. +# Upload to the PR as attachments instead. +*-profile-before.json +*-profile-after.json diff --git a/experiments/LESSONS.md b/experiments/LESSONS.md new file mode 100644 index 0000000000..e6bdd5099d --- /dev/null +++ b/experiments/LESSONS.md @@ -0,0 +1,143 @@ +# Cross-experiment lessons + +Distilled learnings from performance experiments on the PureScript +compiler. Read this before starting a new experiment — particularly +the "dead-end techniques" section, so you don't re-attempt something +that's already been shown not to work on our workload (pr-admin, 1758 +modules). + +Each entry names the experiment it came from so you can dig into the +details. Append new entries when closing an experiment. + +## Workload baseline + +All numbers on this page are measured against `pr-admin` +(`/workspace/restaumatic/apps/pr-admin`, 1758 modules) unless noted. +Baseline numbers on the `restaumatic` branch, optimised build: + +| Scenario | Time | +| ------------------------------------- | ------- | +| Full build | ~72–73s | +| No-change rebuild | ~1.1s | +| Touch leaf (timestamp only) | ~1.2s | +| Comment change to Prelude (1342 deps) | ~2.3s | + +Headline deltas quoted elsewhere are relative to those numbers. A +"+1% full" penalty is easily inside noise on a busy machine; a real +regression is usually ≥5%. + +## Correctness traps + +### A suspiciously large speedup usually means you broke semantics +**From:** `rust-interning` (see +`/workspace/p/rust-interning/PHASE2-RESULTS.md` and +`/workspace/p/rust-interning/profile-results.log`) + +The Phase 2 Label-interning work measured an 80.7% improvement (57s → +11s) with "all 1340 tests passing." The speedup was real but came from +an `Ord` instance that compared interning ids rather than the +underlying string bytes. That is wrong whenever label iteration order +is observable (row normalisation, error formatting, deterministic +output). Our test corpus didn't exercise those paths. + +Once the `Ord` instance was corrected, the same interning work +measured **+29% slower** than baseline (second-order lookup cost +exceeded the O(1) compare saving). A subsequent "caching" variant +recovered to -3.4%. A later commit regressed to **+148% slower** — +the variance suggests an unstable optimisation. + +**Takeaways:** +1. When a perf experiment shows >20% improvement on a well-trodden + path, assume something is broken and look for it explicitly. 5–10% + is the normal range for a correct single-axis optimisation. +2. Tests passing is not semantic confirmation — we need test cases + that depend on iteration order (error-message snapshot tests, + deterministic-output tests) before trusting any change to `Ord`. +3. The 80.7% headline in `PHASE2-RESULTS.md` should be treated as + refuted; the experiment's actual state is unresolved. + +## Dead-end techniques (do not re-attempt without new evidence) + +### Caching cheap per-decl work across builds +**From:** `tc-queries` (see `p/tc-queries/HANDOFF.md`) + +For cheap declaration kinds (`DataDeclaration`, +`TypeSynonymDeclaration`, `TypeClassDeclaration`, `ExternDeclaration`, +`ExternDataDeclaration`, `RoleDeclaration`, `TypeInstanceDeclaration`) +the typecheck work per decl runs in low tens of microseconds. Adding a +cache — fingerprint + env-delta compute + env-delta apply — costs +*more* than the work it skips. On pr-admin, caching these decl kinds +adds +4–6% to full builds and +13% to incremental edits, even with +100% cache hit rates. The overhead is per-decl, not per-miss. + +**Takeaway:** don't cache work that costs less than a hash+map-diff. +The prize is value-groups, not cheap decls. Any future caching +experiment should bring a measurement that the work-per-item exceeds +the caching overhead before building the cache. + +### Changing PSString internal representation (ShortByteString) +**From:** `rust-interning` / earlier `rows-optimization` attempt +(see `/workspace/p/rust-interning/perf.md`) + +Replacing PSString's internal `[Word16]` with `ShortByteString` for +better cache locality measured **+3.5% slower** on pr-admin. The +conversion overhead at every call site (`toUTF16CodeUnits`, +`fromUTF16CodeUnits`, JSON serialisation round-trips) dwarfed the +comparison-speed gain — because, per the above, PSString comparison +isn't the bottleneck we thought it was. + +**Takeaway:** if you're changing a core representation, count the +conversion sites first. If the existing API shape forces conversions +around the hot path, the representation change has to pay for those +conversions before it can even start winning. + +### Serialising elaborated value declarations to disk +**From:** `tc-queries` (see `p/tc-queries/HANDOFF.md`) + +The elaborated `Declaration` output of `typesOf` embeds fully-typed +expressions (`TypedValue` annotations, dictionary references, source +spans everywhere). CBOR-serialising these to disk produces megabytes +per decl, aggregating to ~2 GB on pr-admin's ~17k value decls. Disk +I/O and in-memory allocation at that scale dwarfs any typecheck saving +(full build goes 73s → 217s). + +**Takeaway:** a within-module cache for value groups is valuable in +principle, but not with the elaborated representation. Any future +attempt needs either (a) a smaller cache shape — e.g., env-delta only, +with codegen refactored to operate on un-elaborated decls plus +separately-cached type info — or (b) aggressive compression. Just +serialising the current types will lose. + +## Confirmed boundaries worth exploiting + +### `withFreshSubstitution` marks natural query boundaries +**From:** `tc-queries` + +Both `typesOf` (`src/Language/PureScript/TypeChecker/Types.hs:93`) and +`kindsOfAll` (`src/Language/PureScript/TypeChecker/Kinds.hs:957`) start +with a clean unification substitution and don't leak it. These are +self-contained computation units — good Rock-query boundaries in +principle. The infrastructure for dispatching through queries is +already wired up on the `tc-queries` branch, but caching was blocked +by the serialisation cost above. + +### Per-module extern hash reuse is mandatory +**From:** `tc-queries` + +If you want to fingerprint anything per-decl-within-module, you have +to reuse per-module extern hashes across all modules that depend on +them. Re-serialising dep externs for every module with any cached +decl was a 10s+ cost on pr-admin. See `externHashRef` on the +`tc-queries` branch. + +## Open territory (no experiment yet) + +- **`compare (Qualified a)` at 20.8% of time** — the single biggest + cost centre. Interning, switching to a smaller key type, or using + `HashMap` instead of `Map` for `Environment` lookups are candidates. +- **`compare (PSString) at 8.6%`** — row labels and type-level string + comparisons. Interning or a precomputed-hash wrapper. +- **`compareType` at 4.2%** — likely related to the above two via + structural comparison of type trees. + +Evaluate these against the "dead-end" lessons above before planning. diff --git a/experiments/README.md b/experiments/README.md new file mode 100644 index 0000000000..7694858042 --- /dev/null +++ b/experiments/README.md @@ -0,0 +1,63 @@ +# Compiler performance experiments + +This directory tracks performance optimization experiments on the +PureScript compiler. Each experiment is a branch + worktree + a folder +here capturing its hypothesis, plan, measurements, and outcome. + +See `SCHEMA.md` for what each experiment folder contains and how the +lifecycle works. See `LESSONS.md` for cross-experiment learnings — +read it before starting a new experiment so you don't re-attempt a +known dead end. + +## How to run an experiment + +``` +# start a new experiment +experiments/scripts/exp new [--from ] + +# profile the baseline (before) +experiments/scripts/exp profile --phase before + +# ...hack in /workspace/p/... + +# profile the result (after) +experiments/scripts/exp profile --phase after + +# measure all scenarios +experiments/scripts/exp run --scenarios all --runs 5 + +# close it out +experiments/scripts/exp close --verdict win|partial|no-win|abandoned +``` + +See `scripts/README.md` for details and `CLAUDE.md` (repo root) for the +agent-facing overview. + +## Active experiments + +| Id | Status | Verdict | Baseline | Headline Δ | Tags | +| ---------------------------------------------- | ------------ | ------- | ---------- | ------------------------------------ | ------------------------------ | +| [tc-queries](tc-queries/EXPERIMENT.md) | blocked | no-win | 2e89bd4f | +0.1% full, +9% prelude-edit | incrementality, rock, caching | +| [synonym-opt](synonym-opt/EXPERIMENT.md) | in-progress | tbd | 3fcac773 | (unmeasured under framework) | typechecker, synonyms, flags | +| [rust-interning](rust-interning/EXPERIMENT.md) | in-progress | tbd | (varies) | conflicting — see EXPERIMENT.md | interning, psstring, label | +| [entailment-memo](entailment-memo/EXPERIMENT.md) | in-progress | tbd | ebb0a6bb | -15.5% full, 0% others | entailment, unification, rows | + +## Closed experiments + +| Id | Status | Verdict | Baseline | Headline Δ | Tags | +| ---------------------------------------------- | ------- | ------- | -------- | ----------------------------------- | --------------- | +| [noise-check](noise-check/EXPERIMENT.md) | shipped | win | 3fcac773 | +0.1% full (within noise — harness OK) | meta, framework | + +## Hotspots being tracked + +Updated after each profile run. Source: `p/tc-queries/PROFILING.md:105–112`. + +| Cost Centre | Module | % time | Status | +| -------------------------------- | ------------------------- | ------ | ---------------------------------------- | +| `compare` (Qualified a) | Names.hs:234 | 20.8% | unattacked | +| `replaceAllTypeSynonyms'.go` | TypeChecker.Synonyms | 16.9% | see `synonym-opt` | +| `compare` (PSString) | PSString.hs:52 | 8.6% | unattacked | +| `compareType` | Types.hs | 4.2% | unattacked | +| `everywhereOnTypes.go` | Types.hs | 3.0% | unattacked | +| `introduceSkolemScope` | TypeChecker.Skolems | 2.4% | unattacked | +| `replaceTypeWildcards` | TypeChecker.Unify | 2.2% | unattacked | diff --git a/experiments/SCHEMA.md b/experiments/SCHEMA.md new file mode 100644 index 0000000000..69410eb167 --- /dev/null +++ b/experiments/SCHEMA.md @@ -0,0 +1,141 @@ +# Experiment folder schema + +Each experiment lives at `experiments//`. `` is a short +kebab-case name (e.g., `tc-queries`, `qualified-compare-intern`) and +matches the branch name and worktree name at `/workspace/p/`. + +## Required files + +### `EXPERIMENT.md` + +Live summary + status. YAML frontmatter is the machine-readable part; +the body is a short human narrative (hypothesis, scope, links). + +```yaml +--- +id: +status: proposed | in-progress | blocked | shipped | abandoned +verdict: tbd | win | partial | no-win | abandoned +branch: +worktree: /workspace/p/ +baseline_sha: # the baseline this is measured against +head_sha: # tip of the experiment branch +hypothesis: > + One or two sentences naming the hypothesis. What expensive thing + are we trying to make cheaper, and what change will (supposedly) + make that happen? +headline_delta: "+/-X% full, +/-Y% prelude-edit" # null while in-progress +tags: [area, technique] # e.g. [typechecker, interning] +started: YYYY-MM-DD +closed: YYYY-MM-DD | null +--- +``` + +Body sections: + +- **Hypothesis** (expanded from the frontmatter line). +- **Scope** — what's in, what's out. +- **Links** — worktree, related commits, pointers to `TASK.md`/`HANDOFF.md`. + +### `TASK.md` + +Detailed implementation plan. Same convention as +`/workspace/p/tc-queries/TASK.md`. Covers goal, background, proposed +approach, key files, things to measure, and known risks. Kept mostly +stable once the experiment starts — updates happen in `HANDOFF.md`. + +### `HANDOFF.md` + +Live work log. What's done, what's blocked, what the current numbers +are. Rewritten as understanding shifts. This is the file a successor +should be able to read and continue from. See +`/workspace/p/tc-queries/HANDOFF.md` for the model. + +### `results.md` + +Structured results table. One row per (scenario × run-set). + +```markdown +| Date | Scenario | Baseline SHA | Head SHA | Base (s) | Head (s) | Δ | Notes | +| ---------- | -------- | ------------ | -------- | -------- | -------- | ------- | ------------------------------ | +| 2026-04-15 | full | 3fcac773 | abc1234 | 73.4 | 70.2 | -4.4% | median of 4, warm-up discarded | +| 2026-04-15 | nochange | 3fcac773 | abc1234 | 1.1 | 1.1 | 0% | | +| 2026-04-15 | prelude | 3fcac773 | abc1234 | 2.3 | 2.2 | -4.3% | | +| 2026-04-15 | leaf | 3fcac773 | abc1234 | 1.2 | 1.2 | 0% | | +``` + +Append-only. Never rewrite historical rows — if a measurement is wrong, +add a new row and note it. + +## Optional files + +### `profiles/` (gitignored binaries, tracked sidecars) + +Raw `.prof`/`.hp` files are too large to commit. When a profile is +saved, drop a sibling `.meta.md` alongside it documenting: + +- Commit SHA the profile was captured against +- Scenario (`full`, `prelude`, etc.) +- RTS flags used (usually `+RTS -p -hc -RTS`) +- Top cost centres (paste the output of `awk` over the `.prof`) +- Any one-line analysis + +The `.meta.md` is committed. The `.prof`/`.hp` is not. + +``` +experiments//profiles/ + .gitignore # *.prof, *.hp + full-20260415.prof # gitignored + full-20260415.meta.md # committed +``` + +### Chrome trace profiles (before/after) + +Generated by `exp profile --phase before|after`. These are +Chrome trace format JSON files from a full `-N1` eventlog build of +pr-admin. Open in `chrome://tracing`. + +``` +experiments// + -profile-before.json # gitignored (100-150MB) + -profile-after.json # gitignored +``` + +These are gitignored due to their size. When creating a PR, upload +both profiles as attachments so the reviewer can compare them in +`chrome://tracing`. + +Workflow: +```bash +# Before starting work (profile the baseline) +exp profile --phase before + +# ... implement the change ... + +# After the change +exp profile --phase after +``` + +## Naming conventions + +- Experiment id: kebab-case, short, descriptive of the technique — + not the hotspot. `qualified-compare-intern`, not `fix-names`. +- Branch name matches the experiment id. +- Worktree at `/workspace/p/`. + +## Lifecycle + +1. **proposed** — `EXPERIMENT.md` exists with a plausible hypothesis, + nothing built yet. +2. **in-progress** — worktree exists, code is changing, measurements + may be incomplete. +3. **blocked** — known problem prevents progress; `HANDOFF.md` names + the blocker. +4. **shipped** — merged to `restaumatic` (or the appropriate target + branch). Verdict `win` or `partial`. +5. **abandoned** — not shipping. Verdict `no-win` or `abandoned`. + +When an experiment leaves the active set (shipped or abandoned), the +author adds a one-paragraph entry to `experiments/LESSONS.md` capturing +the transferable learning — especially for dead ends, so the technique +isn't re-attempted by accident. diff --git a/experiments/archive/.gitkeep b/experiments/archive/.gitkeep new file mode 100644 index 0000000000..e69de29bb2 diff --git a/experiments/archive/README.md b/experiments/archive/README.md new file mode 100644 index 0000000000..ed5097d0ea --- /dev/null +++ b/experiments/archive/README.md @@ -0,0 +1,23 @@ +# Archive + +Historical artefacts from the pre-framework era. Kept for reference +but not actively updated. + +## `profile-results-2025-12-to-2026-04.log` + +Old append-only log from the legacy `run-profile.sh` at the repo root. +Covers runs between 2025-12-26 and 2026-04-11. Format is the legacy +one (TIMESTAMP | VERSION | RUN# | TIME(s) | NOTES), which has several +known issues: + +- Spurious 1-second entries (PATH shim ignored by spago, see + `experiments/scripts/run-profile.sh` KNOWN-BUGS section) +- Subprocess log output occasionally contaminating the TIME field + (multi-line entries around lines 12–14, 18–19, 45–46) +- No commit SHA column, no scenario column +- Integer-second resolution, so anything under ~1 second reads as 0 + +Deltas in this log (e.g. "-80.7%" for the rust-interning phase 2 +variant) should **not** be trusted without cross-referencing against +the per-experiment `EXPERIMENT.md` and `LESSONS.md`, which capture +follow-up measurements that invalidated the initial numbers. diff --git a/experiments/archive/profile-results-2025-12-to-2026-04.log b/experiments/archive/profile-results-2025-12-to-2026-04.log new file mode 100644 index 0000000000..51d8ce7e63 --- /dev/null +++ b/experiments/archive/profile-results-2025-12-to-2026-04.log @@ -0,0 +1,50 @@ +# PureScript Compiler Profile Results +# Format: TIMESTAMP | VERSION | RUN# | TIME(s) | NOTES + +2025-12-26 11:56:33 | baseline (restaumatic) | 1 | 1s | +2025-12-26 11:56:33 | type-interning | 1 | 1s | +2025-12-26 11:56:35 | baseline (restaumatic) | 2 | 175s | +2025-12-26 11:56:35 | type-interning | 2 | 0s | +2025-12-26 11:59:31 | baseline (restaumatic) | 3 | 2s | avg: 59s +2025-12-26 11:59:31 | type-interning | 3 | 1s | avg: 0s, delta: -59s (-100.0%) +2025-12-26 11:59:42 | baseline (restaumatic) | 1 | 1s | +2025-12-26 11:59:42 | type-interning-clean | 1 | 1s | , delta: +0s (+0%) +2025-12-26 12:11:56 | type-interning | 1 | [2025-12-26 12:11:56] Creating purs profiling wrapper... +[2025-12-26 12:11:57] Profile saved to /workspace/purescript/profile-output/current-20251226-121157.prof +1s | +2025-12-26 15:59:20 | lazy-hash-v1 | 1 | 173s | +2025-12-26 16:02:21 | baseline (restaumatic) | 1 | 1s | +2025-12-26 16:02:21 | lazy-hash-v1 | 1 | 176s | , delta: +175s (+17500.0%) +2025-12-26 16:21:45 | lazy-hash-v1 | 1 | [2025-12-26 16:21:46] Profile saved to /workspace/purescript/profile-output/current-20251226-162146.prof +1s | +2025-12-27 09:59:51 | baseline (restaumatic) | 1 | 166s | +2025-12-27 09:59:51 | map-based-rows | 1 | 1s | +2025-12-27 10:02:38 | baseline (restaumatic) | 2 | 1s | +2025-12-27 10:02:38 | map-based-rows | 2 | 1s | +2025-12-27 10:02:40 | baseline (restaumatic) | 3 | 1s | avg: 56s +2025-12-27 10:02:40 | map-based-rows | 3 | 1s | avg: 1s, delta: -55s (-98.2%) +2025-12-27 10:03:21 | baseline (restaumatic) | 1 | 0s | +2025-12-27 10:03:21 | map-based-rows-clean | 1 | 1s | +2026-01-03 16:16:35 | baseline (restaumatic) | 1 | 2s | +2026-01-03 16:16:35 | type-traversal-opts | 1 | 1s | +2026-01-03 16:16:38 | baseline (restaumatic) | 2 | 176s | +2026-01-03 16:16:38 | type-traversal-opts | 2 | 0s | +2026-01-03 16:19:35 | baseline (restaumatic) | 3 | 1s | avg: 59s +2026-01-03 16:19:35 | type-traversal-opts | 3 | 171s | avg: 57s, delta: -2s (-3.3%) +2026-01-03 16:26:25 | baseline (restaumatic) | 1 | 164s | +2026-01-03 16:26:25 | type-traversal-opts-v2 | 1 | 1s | , delta: -163s (-99.3%) +2026-01-03 17:02:32 | baseline (restaumatic) | 1 | 167s | +2026-01-03 17:02:32 | containsUnknowns-only | 1 | 1s | , delta: -166s (-99.4%) +2026-01-03 17:05:32 | baseline (restaumatic) | 1 | 171s | +2026-01-03 17:05:32 | containsUnknowns-only-v2 | 1 | 166s | , delta: -5s (-2.9%) +2026-04-10 12:45:23 | baseline (restaumatic) | 1 | 194s | +2026-04-10 12:45:23 | rock-incremental | 1 | 1s | +2026-04-10 12:48:38 | baseline (restaumatic) | 2 | 192s | +2026-04-10 12:48:38 | rock-incremental | 2 | 1s | +2026-04-10 12:51:51 | baseline (restaumatic) | 3 | 2s | avg: 129s +2026-04-11 07:40:18 | rock | 1 | [2026-04-11 08:06:37] Profile saved to /workspace/purescript/profile-output/current-20260411-080637.prof +1579s | +2026-04-11 08:06:49 | rock | 1 | [2026-04-11 08:06:50] Profile saved to /workspace/purescript/profile-output/current-20260411-080650.prof +1s | +2026-04-11 08:16:27 | rock | 1 | [2026-04-11 08:21:26] Profile saved to /workspace/purescript/profile-output/current-20260411-082126.prof +299s | diff --git a/experiments/baselines/.gitignore b/experiments/baselines/.gitignore new file mode 100644 index 0000000000..92da852d3f --- /dev/null +++ b/experiments/baselines/.gitignore @@ -0,0 +1,3 @@ +* +!.gitignore +!manifest.md diff --git a/experiments/baselines/manifest.md b/experiments/baselines/manifest.md new file mode 100644 index 0000000000..2d9ecd7422 --- /dev/null +++ b/experiments/baselines/manifest.md @@ -0,0 +1,16 @@ +# Baseline binary manifest + +Each row records a pre-built baseline `purs` binary stored at +`experiments/baselines//purs` (not committed — the binary +is ~170 MB, rebuild from the SHA with `exp build-baseline `). + +Experiments reference baselines by `short-sha` in their +`EXPERIMENT.md` frontmatter (`baseline_sha:` field). + +| Short SHA | Branch at build | Built (UTC) | GHC | Stack resolver | Built by | Notes | +| --------- | --------------- | -------------------- | ----- | -------------- | -------- | ---------------------- | +| ebb0a6bb | ebb0a6bb | 2026-04-16 20:27 UTC | The Glorious Glasgow Haskell Compilation System, version 9.6.6 | lts-22.43 | user | new | +| 3fcac773 | restaumatic | 2026-04-15 19:11 UTC | 9.6.6 | lts-22.43 | user | current restaumatic tip | + +_Entries sorted most-recent-first._ + diff --git a/experiments/entailment-memo/EXPERIMENT.md b/experiments/entailment-memo/EXPERIMENT.md new file mode 100644 index 0000000000..410c382b71 --- /dev/null +++ b/experiments/entailment-memo/EXPERIMENT.md @@ -0,0 +1,50 @@ +--- +id: entailment-memo +status: in-progress +verdict: tbd +branch: entailment-memo +worktree: /workspace/p/entailment-memo +baseline_sha: ebb0a6bb +head_sha: 953c9149 +hypothesis: > + Memoizing solved entailment constraints within a module's typecheck + avoids redundant O(n) row-alignment work when the same constraint + (e.g. HasField "views" Translations) is solved repeatedly. + pr-admin has 87% redundancy on wide-row HasField calls — expect + ~15-20s saving on a 170s build. +headline_delta: "-15.5% full, 0% nochange/prelude/leaf" +tags: [entailment, memoization, hasfield, row-types] +started: 2026-04-16 +closed: null +--- + +# entailment-memo + +## Hypothesis + +The entailment solver re-solves identical constraints many times within +a module. For cheap constraints (IsSymbol, Bind, etc.) this is +harmless. But for HasField on wide rows (e.g. the 667-field +Translations type), each solve costs 8-20ms due to O(n) row alignment +in `alignRowsWith`. pr-admin modules repeat the same top-level +Translations HasField lookup up to 87 times per module. + +A within-module memoization of solved constraints — keyed on +(ClassName, ground types) — should eliminate the redundant work. +Unlike the tc-queries caching (which serialized to disk), this is +an in-memory Map lookup costing microseconds vs the 8-20ms it skips. + +## Scope + +**In:** Memo table in CheckState, populated when a constraint is +solved with fully-ground types, consulted before instance search. + +**Out:** Cross-module caching, serialization, any changes to row +representation or HasField instance logic. + +## Links + +- Worktree: /workspace/p/entailment-memo +- Plan: [TASK.md](TASK.md) +- Live state: [HANDOFF.md](HANDOFF.md) +- Results: [results.md](results.md) diff --git a/experiments/entailment-memo/HANDOFF.md b/experiments/entailment-memo/HANDOFF.md new file mode 100644 index 0000000000..881fdde519 --- /dev/null +++ b/experiments/entailment-memo/HANDOFF.md @@ -0,0 +1,38 @@ +# Handoff: entailment-memo + +## TL;DR + +Single two-line change in Entailment.hs gives -15.5% on full builds +(74s → 63s). All 1340 tests pass. Other scenarios (nochange, prelude, +leaf) unchanged. Ready for review and merge. + +## What's done + +- Identified root cause: entailment fundep enforcement at line 327-329 + of Entailment.hs calls `unifyTypes inferredType t2` where both sides + are often structurally identical (the inferred type IS the constraint + type after substitution). For row types like the 667-field + Translations record, this triggers O(n) row alignment via + `alignRowsWith` + `rowToSortedList` for no semantic benefit. + +- Added `unless (eqType inferredType t2)` guard before the + `unifyTypes` call. `eqType` is O(n) but much cheaper than the full + `unifyRows` path (no sorting, no recursive unification of field + types, no cache insertion). + +- Important lesson: modifying Unify.hs (the hot path) caused -30% + regression even with seemingly beneficial changes, because GHC -O2 + recompiled the module with different inlining decisions. The fix was + to make the change in Entailment.hs (the call site) instead. + +## What's blocked + +Nothing. + +## Next steps + +- Run the formal `exp run` with all 4 scenarios and 5 runs each +- Merge to `restaumatic` branch if numbers hold +- The remaining HasField cost (~7s remaining after this fix) could be + further reduced by a within-module entailment memo, but that's more + complex and may not be worth it given the current improvement. diff --git a/experiments/entailment-memo/TASK.md b/experiments/entailment-memo/TASK.md new file mode 100644 index 0000000000..c20719afbd --- /dev/null +++ b/experiments/entailment-memo/TASK.md @@ -0,0 +1,77 @@ +# Task: entailment-memo + +## Goal + +Reduce redundant entailment solving within a module by memoizing +constraints that have been solved with fully-ground types. Primary +target: HasField on wide row types (Translations: 667 fields, 8-20ms +per solve, 87% redundancy across pr-admin modules). + +## Background + +The entailment solver (`Entailment.hs:solve/go`) resolves each +constraint independently. When a module accesses `t.views.foo` 80 +times, `HasField "views" Translations` is solved 80 times — each +doing full instance search, `matches` with `alignRowsWith` (O(n) +row alignment on 667-field row), `withFreshTypes`, `unifyTypes`, and +`solveSubgoals`. + +From eventlog profiling on pr-admin: +- HasField self-time: 16.6s (50.7% of entailment) +- Row.Cons self-time: 6.9s (21.0%) +- Total entailment: 96.3s inclusive, 32.7s exclusive +- 87% of top-level Translations HasField calls are redundant + +LESSONS.md says "don't cache cheap work" — but this work is NOT +cheap (8-20ms per call). The tc-queries experiment failed because it +serialized to disk; this is in-memory only. + +## Approach + +1. Add `checkEntailmentMemo :: Map (Qualified (ProperName 'ClassName), [SourceType]) Expr` + to `CheckState` in `TypeChecker/Monad.hs`. + +2. In `Entailment.hs:go`, after substituting types: + - Compute memo key = (className', kinds'' ++ tys'') + - If key has no TUnknowns (fully ground), check memo + - On cache hit: return cached Expr, skip instance search + - On Solved: store result in memo before returning + +3. Ground-check: only memo when all types in the key are ground + (no TUnknown, no Skolem). If any are present, the constraint + could resolve differently after unification. + +4. Clear memo between modules (it's per-module state). + +## Key files + +- `src/Language/PureScript/TypeChecker/Monad.hs` — add memo field to CheckState +- `src/Language/PureScript/TypeChecker/Entailment.hs` — memo lookup/store in `go` + +## How to measure + +Run all four scenarios against pr-admin: +```bash +experiments/scripts/exp run entailment-memo --scenarios all --runs 5 +``` + +## Tests + +```bash +stack test --fast # all tests must pass +``` + +## Risks / things to watch + +- **Correctness**: memo key must be on fully-substituted, ground types + only. TUnknown in the key means the constraint could resolve + differently after unification fills in the unknown. +- **Memory**: the memo Map grows per-module. For pr-admin's largest + modules (~3000 HasField calls), this is ~3000 Map entries — trivial. +- **Side effects**: `solve` both returns an Expr and performs + unifications via `unifyTypes`. The memo caches the Expr but not the + unification side effects. This is OK because for ground types, the + unifications are deterministic (same types → same unification result). + But we need to verify that replaying the unifications isn't needed. + Actually — if all types are ground, the unifications are no-ops + (ground type unified with itself). So the side effects don't matter. diff --git a/experiments/entailment-memo/profiles/.gitignore b/experiments/entailment-memo/profiles/.gitignore new file mode 100644 index 0000000000..a92f998404 --- /dev/null +++ b/experiments/entailment-memo/profiles/.gitignore @@ -0,0 +1,3 @@ +*.prof +*.hp +!*.meta.md diff --git a/experiments/entailment-memo/results.md b/experiments/entailment-memo/results.md new file mode 100644 index 0000000000..6d6c57a343 --- /dev/null +++ b/experiments/entailment-memo/results.md @@ -0,0 +1,8 @@ +# Results: entailment-memo + +| Date | Scenario | Baseline SHA | Head SHA | Base (s) | Head (s) | Δ | Notes | +| ---------- | -------- | ------------ | -------- | -------- | -------- | ------- | ---------------------------------- | +| 2026-04-16 | full | ebb0a6bb | 953c9149 | 74.1 | 62.6 | -15.5% | median of 3, clean -O2 build | +| 2026-04-16 | nochange | ebb0a6bb | 953c9149 | 1.24 | 1.29 | +4.0% | median of 2, within noise | +| 2026-04-16 | prelude | ebb0a6bb | 953c9149 | 5.25 | 5.44 | +3.6% | median of 3, comment change | +| 2026-04-16 | leaf | ebb0a6bb | 953c9149 | 2.03 | 2.00 | -1.5% | median of 3, comment change | diff --git a/experiments/experiment_queue.md b/experiments/experiment_queue.md new file mode 100644 index 0000000000..1fb6750cdb --- /dev/null +++ b/experiments/experiment_queue.md @@ -0,0 +1,85 @@ +# Experiment queue + +Candidates identified from per-declaration profiling of pr-admin. +`Data.Record.HasField` accounts for **81.7% of entailment time** (35s of 43s, +39,219 constraint resolutions). This is the dominant bottleneck. + +## Queue + +### 1. bypass-hasfield — Remove HasField desugaring for record access + +**Impact:** ~35s elimination (potentially ~50% full-build speedup) +**Risk:** Low — only affects code with custom `HasField` instances on non-Record types +**Effort:** Small + +The restaumatic fork's `Sugar/Accessor.hs` desugars every `record.field` into +`getField (Proxy :: Proxy "field") record`, forcing the typechecker through +`HasField` → `Row.Cons` → entailment solver. But the native typechecker +already handles `Accessor` directly via unification (TypeChecker/Types.hs:456), +which is much cheaper — no type class resolution needed. + +**Change:** Disable `desugarAccessorModule` in the sugar pipeline. The native +`Accessor` path in `infer'`/`check'` handles it directly. + +**What to verify:** +- Full build time (expect ~35-40s, down from ~72s) +- All four scenarios (full, nochange, prelude, leaf) +- Tests pass +- Check if any code relies on custom `HasField` instances + +### 2. fast-path-hasfield — Short-circuit HasField in entailment solver + +**Impact:** ~35s reduction if experiment 1 isn't viable +**Risk:** Low +**Effort:** Medium + +If removing the desugaring entirely isn't possible (e.g., custom `HasField` +instances exist in the codebase), add a fast path in the entailment solver: +when solving `HasField label a (Record r)` where `r` is a known concrete row, +directly look up the field without going through the full `Row.Cons` → unify +cycle. + +**Prerequisite:** Only needed if experiment 1 fails. + +### 3. optimize-row-unify — Efficient row-type representation + +**Impact:** Broad — benefits all row operations (RowCons, RowUnion, RowToList, etc.) +**Risk:** Medium — changes core type representation +**Effort:** Large + +Currently row types are `RCons label type rest` chains — field lookup is O(n). +An internal `Map Label Type` representation would make it O(log n). This would +benefit the 39k HasField calls, the 2k Union calls, and all other row +operations. + +**Prerequisite:** Profile first with experiment 1 applied to see if row +unification is still a bottleneck after removing the HasField overhead. + +## Discovered from profiling + +Source: eventlog run on pr-admin, 2026-04-16, commit on `experiments` branch. + +### Entailment time by class (top 10) + +| Class | Time | Count | % of entailment | +| ---------------------------------- | ------ | ------ | --------------- | +| Data.Record.HasField | 35.0s | 39,219 | 81.7% | +| Restaumatic.Form.Internal.Initialize | 2.0s | 372 | 4.6% | +| Restaumatic.Form.Query.Query | 0.8s | 3,597 | 1.8% | +| Restaumatic.Form.Internal.Merge | 0.5s | 1,523 | 1.1% | +| Restaumatic.Form.Internal.AddContext | 0.3s | 2,439 | 0.8% | +| Foreign.Generic.Class.GenericDecode | 0.3s | 623 | 0.6% | +| Foreign.Generic.Class.GenericEncode | 0.2s | 629 | 0.6% | +| Data.Show.Generic.GenericShow | 0.2s | 812 | 0.5% | +| Data.Variant.Internal.VariantMatchCases | 0.2s | 60 | 0.4% | +| Unscramble.Generic.GenericDecode | 0.2s | 601 | 0.4% | + +### Key finding + +`Data.Record.HasField` is a restaumatic-prelude class +(`/workspace/restaumatic/libs/ps/restaumatic-prelude/src/Data/Record.purs`) +added for overloaded record accessors. Its single instance requires +`Row.Cons label a trash r`, which triggers expensive row-type unification +for every field access. The compiler's native `Accessor` handling +(TypeChecker/Types.hs:456) does the same job via direct unification, +bypassing the entailment solver entirely. diff --git a/experiments/noise-check/EXPERIMENT.md b/experiments/noise-check/EXPERIMENT.md new file mode 100644 index 0000000000..9f88719716 --- /dev/null +++ b/experiments/noise-check/EXPERIMENT.md @@ -0,0 +1,45 @@ +--- +id: noise-check +status: shipped +verdict: win +branch: restaumatic +worktree: /workspace/purescript +baseline_sha: 3fcac773 +head_sha: 3fcac773 +hypothesis: > + Framework self-check: baseline-vs-baseline should measure identical + binaries with delta < 1-2%. If not, the measurement harness has a + bug and should not be trusted for real experiments. +headline_delta: "+0.1% full (within noise — harness OK)" +tags: [meta, framework] +started: 2026-04-15 +closed: 2026-04-15 +--- + +# noise-check — harness self-test + +Compares the same baseline binary against itself. Any delta > 1-2% +indicates a bug in the harness (not in purs). + +## Result (2026-04-15) + +**PASS.** Baseline median 71041 ms vs head median 71093 ms, Δ +0.1%. +Individual runs: + +- Baseline (drop warm-up 71635): 71041 ms, 71902 ms — spread 1.2% +- Head (drop warm-up 70057): 71093 ms, 73826 ms — spread 3.9% + +Head's max of 73826 ms was almost certainly transient machine load +(other processes scheduled); the median filters it out, which is +exactly what warm-up-discard + median-of-N is for. A future noise +check with `--runs 5` or more would tighten this further. + +## What this validates + +- `purs compile $(spago sources)` with `set -f` to skip shell globbing + correctly passes globs through for purs to expand recursively. +- `date +%s%N` gives millisecond-precision timing (no more 1s rounding). +- Logging to stderr means command-substitution captures clean numeric + output. +- The ~71s full-build baseline on pr-admin matches the pre-framework + reference in `/workspace/p/tc-queries/PROFILING.md:98` (~72s). diff --git a/experiments/noise-check/results.md b/experiments/noise-check/results.md new file mode 100644 index 0000000000..d6e5bb4ccd --- /dev/null +++ b/experiments/noise-check/results.md @@ -0,0 +1,7 @@ +# Results for noise-check + +Append-only. See experiments/SCHEMA.md for format. + +| Date | Scenario | Baseline SHA | Head SHA | Base (s) | Head (s) | Δ | Notes | +| ---------- | -------- | ------------ | -------- | -------- | -------- | ------- | ----- | +| 2026-04-15 | full | 3fcac773 | 3fcac773 | 71.0 | 71.1 | +0.1% | median of 2, 71093-73826 ms | diff --git a/experiments/rust-interning/EXPERIMENT.md b/experiments/rust-interning/EXPERIMENT.md new file mode 100644 index 0000000000..bdc2ae9212 --- /dev/null +++ b/experiments/rust-interning/EXPERIMENT.md @@ -0,0 +1,86 @@ +--- +id: rust-interning +status: in-progress +verdict: tbd +branch: rust-interning +worktree: /workspace/p/rust-interning +baseline_sha: restaumatic-at-2026-04-13 +head_sha: e6f85f32 +hypothesis: > + Interning PSString and Label (Rust-compiler-style symbol interning) + converts row-label and type-level-string comparisons from O(n) byte + compares to O(1) integer compares. Row unification and type-class + resolution should get dramatically faster on label-heavy workloads. +headline_delta: "see HANDOFF — conflicting measurements" +tags: [interning, psstring, label, row-unification] +started: 2025-12-23 +closed: null +--- + +# rust-interning — PSString + Label interning + +## Hypothesis + +See frontmatter. The key insight (per Rust compiler's `Symbol`) is that +labels are finite and reused extensively; switching equality/ordering +from byte-compare to int-compare removes an entire class of cost from +row-unification inner loops. + +## Scope + +In scope: intern PSString and Label globally (via `atomicModifyIORef'`); +change `Eq`/`Ord` to compare ids; preserve API compatibility via +`mkLabel` / `runLabel`. + +Out of scope (Phase 3 in the original plan): interning whole `Type` +nodes. + +## Status + +**In progress, results conflicting.** Historical documentation +(`PHASE2-RESULTS.md`) claims 80.7% improvement (57s → 11s). That +measurement turned out to be partly an artefact of an incorrect `Ord` +instance — once `Ord` was made semantically correct +(`phase1+2-corrected-ord`), the variant was 29% *slower* than baseline. +Further tuning recovered to `-3.4%`. Most recent run (2026-04-13) on +the `rust-interning-fixed` variant measured **+148% slower** (64s → 159s), +suggesting further regression after subsequent commits. + +Raw history in `/workspace/p/rust-interning/profile-results.log`. + +## Measured results (from worktree log, to be re-run under framework) + +| Date | Variant | Baseline | Head | Δ | Notes | +| ---------- | ---------------------------------- | -------- | ----- | ------------- | ------------------------------ | +| 2025-12-23 | `phase1-psstring` | 58s | 55s | -5.1% | 3-run avg | +| 2025-12-23 | `phase1+2-psstring+label` | 57s | 11s | -80.7% | **ORD INSTANCE WAS INCORRECT** | +| 2025-12-23 | `phase1+2-corrected-ord` | 58s | 75s | +29.3% | correct Ord, profile build | +| 2025-12-23 | `corrected-ord-no-profile` | 57s | 66s | +15.7% | | +| 2025-12-23 | `optimized-label-cached-psstring` | 58s | 56s | -3.4% | best corrected-Ord variant | +| 2026-04-13 | `rust-interning-fixed` | 64s | 159s | +148% | latest tip — catastrophic regression | + +## Links + +- Plan v2: `/workspace/p/rust-interning/INTERNING-PLAN-V2.md` +- Historical write-up (MISLEADING ON HEADLINE): `/workspace/p/rust-interning/PHASE2-RESULTS.md` +- Analysis: `/workspace/p/rust-interning/phase2-results-analysis.md`, + `/workspace/p/rust-interning/profile-analysis.md` +- Earlier failed attempt (reverted): `/workspace/p/rust-interning/perf.md` + — PSString with `ShortByteString` representation, -3.5% + +## Open problems + +- **The 80.7% headline is not real.** It came from an incorrect `Ord` + instance that compared interning ids instead of the underlying + string bytes, which is wrong whenever label iteration order affects + behaviour (row normalisation, error formatting, deterministic + output). Correct `Ord` needs to hit the string via a second lookup, + which costs more than the int-compare saves. +- **Current tip regresses heavily.** Root cause of the 2026-04-13 + +148% regression unknown; `e6f85f32 Add plan v2` may just have + re-organised without landing a performing variant. +- **What's the right experiment structure?** Phase 1 (PSString) alone + produced a solid -5.1% and is probably worth landing. Phase 2 as + implemented is unviable; a correct-Ord variant that actually wins + would need a different interning scheme (ordered ids? deterministic + hash?). diff --git a/experiments/scripts/README.md b/experiments/scripts/README.md new file mode 100644 index 0000000000..6a4d58602c --- /dev/null +++ b/experiments/scripts/README.md @@ -0,0 +1,45 @@ +# experiments/scripts + +Profiling harness and experiment-driver scripts. + +## `exp` + +Main driver. Wraps `run-profile.sh` and adds worktree/experiment +lifecycle management. + +``` +exp new [--from ] + Create branch , worktree /workspace/p/, and + experiments//{EXPERIMENT.md,TASK.md,HANDOFF.md,results.md} + scaffolds. + +exp build-baseline + Build an optimised purs from the given ref into + experiments/baselines//purs and append to manifest.md. + +exp run [--scenarios all] [--runs 5] [--profile] + Run baseline + current across the chosen scenarios and append to + experiments//results.md. + +exp profile --phase before|after [--skip-build] + Generate a chrome-trace profile (full -N1 eventlog build of + pr-admin). Output: experiments//-profile-{before,after}.json + Open in chrome://tracing. Upload both to the PR for review. + +exp report [] + Print the per-experiment results table, or the global index. + +exp close --verdict win|partial|no-win|abandoned + Set frontmatter to closed, prompt for a LESSONS.md entry. +``` + +## `run-profile.sh` + +Lower-level timing harness. Invoked by `exp run`. Can also be run +standalone for ad-hoc measurements. + +## `purs-profiled.sh` + +PATH shim used when `--profile` is requested. Wraps the profiled +`purs` binary with `+RTS -p -hc -RTS` so spago-invoked builds produce +cost-centre + heap profiles. diff --git a/experiments/scripts/exp b/experiments/scripts/exp new file mode 100755 index 0000000000..e78d0e867b --- /dev/null +++ b/experiments/scripts/exp @@ -0,0 +1,536 @@ +#!/bin/bash +set -euo pipefail + +# exp — experiment lifecycle driver for PureScript compiler perf work. +# +# Sub-commands: +# exp new [--from ] +# exp build-baseline +# exp run [--scenarios all|full,nochange,...] [--runs 5] [--profile] +# [--baseline ] [--notes "..."] +# exp report [] +# exp close --verdict win|partial|no-win|abandoned +# +# The driver looks up binaries and SHAs from +# experiments//EXPERIMENT.md frontmatter, so `exp run ` is +# usually all you need once the experiment is set up. + +SCRIPT_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" +REPO_ROOT="$(cd "$SCRIPT_DIR/../.." && pwd)" +EXPERIMENTS_DIR="$REPO_ROOT/experiments" +BASELINES_DIR="$EXPERIMENTS_DIR/baselines" +WORKTREE_BASE="/workspace/p" +PROFILE_SH="$SCRIPT_DIR/run-profile.sh" + +log() { echo "[exp] $*" >&2; } +error() { echo "[exp ERROR] $*" >&2; exit 1; } + +usage() { + cat >&2 <<'EOF' +exp — experiment lifecycle driver + + exp new [--from ] + Create worktree /workspace/p/ on a new branch and + scaffold experiments//{EXPERIMENT,TASK,HANDOFF,results}.md. + + exp build-baseline + Build an optimised purs from the given ref into + experiments/baselines//purs and update manifest.md. + + exp run [options] + Run scenarios against the experiment's worktree. + --scenarios full|nochange|prelude|leaf|all (default: all) + --runs N (default: 5) + --profile collect .prof files + --baseline override the frontmatter baseline + --skip-build don't stack build first + --notes "..." extra notes column + The purs binary is built automatically from the worktree unless + --skip-build is set. + + exp report [] + Print the results table for , or the top-level index if omitted. + + exp profile --phase before|after [--skip-build] + Generate a chrome-trace profile for the experiment. + --phase before profile the baseline binary + --phase after profile the experiment's worktree binary + --skip-build don't stack build first (after phase only) + Output: experiments//-profile-{before,after}.json + The profile is a full -N1 eventlog build of pr-admin, converted + to Chrome trace format. Open in chrome://tracing. + + exp close --verdict win|partial|no-win|abandoned + Set EXPERIMENT.md frontmatter to closed status and prompt for a + LESSONS.md entry. +EOF + exit 1 +} + +################################################################################ +# Helpers — read YAML-ish frontmatter from EXPERIMENT.md +################################################################################ + +# Usage: fm_get +fm_get() { + awk -v f="$2" ' + /^---$/ { state++; next } + state == 1 { + # strip leading whitespace + sub(/^[[:space:]]+/, "", $0) + if (match($0, "^" f ":[[:space:]]*")) { + val = substr($0, RLENGTH+1) + # strip trailing comments + sub(/[[:space:]]+#.*$/, "", val) + # strip surrounding quotes + gsub(/^"|"$/, "", val) + print val + exit + } + } + ' "$1" +} + +# Usage: fm_set +fm_set() { + local FILE="$1" FIELD="$2" VALUE="$3" + awk -v f="$FIELD" -v v="$VALUE" ' + BEGIN { state = 0; updated = 0 } + /^---$/ { state++; print; next } + state == 1 && $0 ~ "^" f ":" { + printf "%s: %s\n", f, v + updated = 1 + next + } + { print } + ' "$FILE" > "$FILE.tmp" && mv "$FILE.tmp" "$FILE" +} + +################################################################################ +# exp new +################################################################################ + +cmd_new() { + local ID="${1:-}" + [[ -n "$ID" ]] || error "exp new required" + shift + local FROM="restaumatic" + while [[ $# -gt 0 ]]; do + case "$1" in + --from) FROM="$2"; shift 2;; + *) error "unknown option: $1";; + esac + done + + local WORKTREE="$WORKTREE_BASE/$ID" + local EXP_DIR="$EXPERIMENTS_DIR/$ID" + + [[ ! -d "$WORKTREE" ]] || error "worktree already exists: $WORKTREE" + [[ ! -d "$EXP_DIR" ]] || error "experiment folder already exists: $EXP_DIR" + + log "creating branch $ID from $FROM" + log "creating worktree $WORKTREE" + git -C "$REPO_ROOT" worktree add -b "$ID" "$WORKTREE" "$FROM" + + local RESOLVED_SHA + RESOLVED_SHA=$(git -C "$WORKTREE" rev-parse --short HEAD) + + mkdir -p "$EXP_DIR/profiles" + + cat > "$EXP_DIR/EXPERIMENT.md" < + (Fill in: what expensive thing are we making cheaper, and by what + mechanism?) +headline_delta: tbd +tags: [] +started: $(date '+%Y-%m-%d') +closed: null +--- + +# $ID + +## Hypothesis + +_Expand the frontmatter hypothesis here._ + +## Scope + +_What's in. What's out._ + +## Links + +- Worktree: $WORKTREE +- Plan: [TASK.md](TASK.md) +- Live state: [HANDOFF.md](HANDOFF.md) +- Results: [results.md](results.md) +EOF + + cat > "$EXP_DIR/TASK.md" < "$EXP_DIR/HANDOFF.md" < "$EXP_DIR/profiles/.gitignore" < required" + "$PROFILE_SH" build-baseline --sha "$SHA" +} + +################################################################################ +# exp run +################################################################################ + +cmd_run() { + local ID="${1:-}" + [[ -n "$ID" ]] || error "exp run required" + shift + + local EXP_DIR="$EXPERIMENTS_DIR/$ID" + local EXP_FILE="$EXP_DIR/EXPERIMENT.md" + [[ -f "$EXP_FILE" ]] || error "no EXPERIMENT.md at $EXP_FILE" + + local SCENARIOS="all" + local RUNS="5" + local PROFILE_FLAG="" + local BASELINE_OVERRIDE="" + local NOTES="" + local SKIP_BUILD="" + while [[ $# -gt 0 ]]; do + case "$1" in + --scenarios) SCENARIOS="$2"; shift 2;; + --runs) RUNS="$2"; shift 2;; + --profile) PROFILE_FLAG="--profile"; shift;; + --baseline) BASELINE_OVERRIDE="$2"; shift 2;; + --skip-build) SKIP_BUILD="1"; shift;; + --notes) NOTES="$2"; shift 2;; + *) error "unknown option: $1";; + esac + done + + local WORKTREE + WORKTREE=$(fm_get "$EXP_FILE" "worktree") + [[ -d "$WORKTREE" ]] || error "worktree not found at $WORKTREE (from frontmatter)" + + local BASELINE_SHA HEAD_SHA BASELINE_PURS + BASELINE_SHA=$(fm_get "$EXP_FILE" "baseline_sha") + HEAD_SHA=$(git -C "$WORKTREE" rev-parse --short HEAD) + + # Resolve baseline binary + if [[ -n "$BASELINE_OVERRIDE" ]]; then + if [[ -x "$BASELINE_OVERRIDE" ]]; then + BASELINE_PURS="$BASELINE_OVERRIDE" + else + BASELINE_PURS="$BASELINES_DIR/$BASELINE_OVERRIDE/purs" + BASELINE_SHA="$BASELINE_OVERRIDE" + fi + else + BASELINE_PURS="$BASELINES_DIR/$BASELINE_SHA/purs" + fi + [[ -x "$BASELINE_PURS" ]] || error "baseline binary not found or not executable: $BASELINE_PURS + run: exp build-baseline $BASELINE_SHA" + + # Build the current worktree's purs (unless --skip-build) + if [[ -z "$SKIP_BUILD" ]]; then + log "building purs in worktree $WORKTREE" + (cd "$WORKTREE" && stack build --system-ghc) + fi + local HEAD_PURS + HEAD_PURS=$(cd "$WORKTREE" && stack path --local-install-root)/bin/purs + [[ -x "$HEAD_PURS" ]] || error "head binary not found: $HEAD_PURS" + + log "running experiment $ID" + log " baseline: $BASELINE_PURS ($BASELINE_SHA)" + log " head: $HEAD_PURS ($HEAD_SHA)" + + local NOTE_ARG=() + [[ -n "$NOTES" ]] && NOTE_ARG=(--notes "$NOTES") + local PROFILE_ARG=() + [[ -n "$PROFILE_FLAG" ]] && PROFILE_ARG=("$PROFILE_FLAG") + + "$PROFILE_SH" run \ + --experiment "$ID" \ + --variant head \ + --purs "$HEAD_PURS" \ + --baseline-purs "$BASELINE_PURS" \ + --scenarios "$SCENARIOS" \ + --runs "$RUNS" \ + --baseline-sha "$BASELINE_SHA" \ + --head-sha "$HEAD_SHA" \ + "${PROFILE_ARG[@]}" \ + "${NOTE_ARG[@]}" + + # Update head_sha in frontmatter + fm_set "$EXP_FILE" "head_sha" "$HEAD_SHA" + log "updated frontmatter head_sha → $HEAD_SHA" +} + +################################################################################ +# exp report +################################################################################ + +cmd_report() { + local ID="${1:-}" + if [[ -z "$ID" ]]; then + # global index + if [[ -f "$EXPERIMENTS_DIR/README.md" ]]; then + cat "$EXPERIMENTS_DIR/README.md" + else + error "no README.md in $EXPERIMENTS_DIR" + fi + return + fi + local EXP_DIR="$EXPERIMENTS_DIR/$ID" + [[ -d "$EXP_DIR" ]] || error "no experiment: $ID" + + echo "=== $ID ===" + if [[ -f "$EXP_DIR/EXPERIMENT.md" ]]; then + awk '/^---$/{s++; if(s==2)exit; next} s==1' "$EXP_DIR/EXPERIMENT.md" + echo + fi + if [[ -f "$EXP_DIR/results.md" ]]; then + echo "--- results.md ---" + cat "$EXP_DIR/results.md" + else + echo "(no results.md yet)" + fi +} + +################################################################################ +# exp close +################################################################################ + +cmd_close() { + local ID="${1:-}" + [[ -n "$ID" ]] || error "exp close required" + shift + local VERDICT="" + while [[ $# -gt 0 ]]; do + case "$1" in + --verdict) VERDICT="$2"; shift 2;; + *) error "unknown option: $1";; + esac + done + [[ -n "$VERDICT" ]] || error "--verdict win|partial|no-win|abandoned required" + + local EXP_FILE="$EXPERIMENTS_DIR/$ID/EXPERIMENT.md" + [[ -f "$EXP_FILE" ]] || error "no EXPERIMENT.md at $EXP_FILE" + + local STATUS + case "$VERDICT" in + win|partial) STATUS="shipped";; + no-win|abandoned) STATUS="abandoned";; + *) error "unknown verdict: $VERDICT";; + esac + + fm_set "$EXP_FILE" "status" "$STATUS" + fm_set "$EXP_FILE" "verdict" "$VERDICT" + fm_set "$EXP_FILE" "closed" "$(date '+%Y-%m-%d')" + log "$ID set to status=$STATUS verdict=$VERDICT" + + cat >&2 < required" + shift + + local PHASE="" + local SKIP_BUILD="" + while [[ $# -gt 0 ]]; do + case "$1" in + --phase) PHASE="$2"; shift 2;; + --skip-build) SKIP_BUILD="1"; shift;; + *) error "unknown option: $1";; + esac + done + [[ "$PHASE" == "before" || "$PHASE" == "after" ]] || error "--phase before|after required" + + local EXP_DIR="$EXPERIMENTS_DIR/$ID" + local EXP_FILE="$EXP_DIR/EXPERIMENT.md" + [[ -f "$EXP_FILE" ]] || error "no EXPERIMENT.md at $EXP_FILE" + + local WORKTREE BASELINE_SHA PURS_BIN + WORKTREE=$(fm_get "$EXP_FILE" "worktree") + BASELINE_SHA=$(fm_get "$EXP_FILE" "baseline_sha") + + if [[ "$PHASE" == "before" ]]; then + # Use the baseline binary + PURS_BIN="$BASELINES_DIR/$BASELINE_SHA/purs" + [[ -x "$PURS_BIN" ]] || error "baseline binary not found: $PURS_BIN + run: exp build-baseline $BASELINE_SHA" + log "profiling baseline ($BASELINE_SHA)" + else + # Build and use the experiment binary + if [[ -z "$SKIP_BUILD" ]]; then + log "building purs in worktree $WORKTREE" + (cd "$WORKTREE" && stack build --system-ghc) + fi + PURS_BIN=$(cd "$WORKTREE" && stack path --local-install-root)/bin/purs + [[ -x "$PURS_BIN" ]] || error "head binary not found: $PURS_BIN" + log "profiling head ($(git -C "$WORKTREE" rev-parse --short HEAD))" + fi + + local PR_ADMIN="/workspace/restaumatic/apps/pr-admin" + [[ -d "$PR_ADMIN" ]] || error "pr-admin not found at $PR_ADMIN" + + # App-only rebuild with eventlog, single-threaded for clean nesting. + # Remove only Restaumatic.* output to skip rebuilding the dependency + # tree — makes the trace smaller and profiling faster. + if [[ ! -d "$PR_ADMIN/output" ]] || [[ -z "$(ls "$PR_ADMIN/output/" 2>/dev/null)" ]]; then + log "output/ empty — doing a full build first to populate deps..." + ( set -f; cd "$PR_ADMIN" && "$PURS_BIN" compile $SOURCES 1>/dev/null 2>&1 ) \ + || error "initial full build failed" + fi + log "clearing Restaumatic.* modules for app-only rebuild..." + find "$PR_ADMIN/output" -maxdepth 1 -name 'Restaumatic.*' -type d -exec rm -rf {} + 2>/dev/null || true + + local SOURCES + SOURCES=$(cd "$PR_ADMIN" && spago sources 2>/dev/null | grep -v '^\[' || true) + [[ -n "$SOURCES" ]] || error "spago sources returned nothing" + + log "running eventlog build (-N1)..." + # Disable glob expansion so spago's **/*.purs globs pass through to purs + ( set -f + cd "$PR_ADMIN" && "$PURS_BIN" +RTS -l-agu -N1 -RTS compile $SOURCES 1>/dev/null 2>&1 + ) || error "purs compile failed" + + local EVENTLOG="$PR_ADMIN/purs.eventlog" + [[ -f "$EVENTLOG" ]] || error "no eventlog produced at $EVENTLOG" + log "eventlog: $(du -h "$EVENTLOG" | cut -f1)" + + # Convert to JSON + log "converting eventlog to JSON..." + eventlog2html --json "$EVENTLOG" 2>/dev/null \ + || error "eventlog2html failed — install with: cabal install eventlog2html" + + local EVENTLOG_JSON="$EVENTLOG.json" + [[ -f "$EVENTLOG_JSON" ]] || error "eventlog2html produced no JSON" + + # Convert to Chrome trace format + local OUT_NAME="${ID}-profile-${PHASE}.json" + local OUT_PATH="$EXP_DIR/$OUT_NAME" + log "generating chrome trace..." + node "$REPO_ROOT/debug/eventlog-chrome-trace.js" "$EVENTLOG_JSON" > "$OUT_PATH" 2>/dev/null + + local SIZE + SIZE=$(du -h "$OUT_PATH" | cut -f1) + log "profile → $OUT_PATH ($SIZE)" + + # Clean up intermediate files + rm -f "$EVENTLOG" "$EVENTLOG_JSON" + + log "open in chrome://tracing or upload to a PR" +} + +################################################################################ +# Dispatch +################################################################################ + +[[ $# -ge 1 ]] || usage +CMD="$1"; shift +case "$CMD" in + new) cmd_new "$@";; + build-baseline) cmd_build_baseline "$@";; + run) cmd_run "$@";; + profile) cmd_profile "$@";; + report) cmd_report "$@";; + close) cmd_close "$@";; + -h|--help|help) usage;; + *) error "unknown command: $CMD";; +esac diff --git a/experiments/scripts/purs-profiled.sh b/experiments/scripts/purs-profiled.sh new file mode 100755 index 0000000000..b5dec0be75 --- /dev/null +++ b/experiments/scripts/purs-profiled.sh @@ -0,0 +1,2 @@ +#!/bin/bash +exec "$PURS_REAL_BIN" "$@" +RTS -p -RTS diff --git a/experiments/scripts/run-profile.sh b/experiments/scripts/run-profile.sh new file mode 100755 index 0000000000..110c330bff --- /dev/null +++ b/experiments/scripts/run-profile.sh @@ -0,0 +1,459 @@ +#!/bin/bash +set -euo pipefail +# spago sources emits globs like `.spago/aff/v7.1.0/src/**/*.purs`. +# We pass these to purs verbatim so it can do its own (recursive) +# glob expansion — matching what psa/spago do. Without -f, bash +# would shell-expand `**` as a single `*` (globstar isn't on), which +# partially expands some globs, leaves others as literals, and purs +# rejects the resulting mix. +set -f + +# PureScript compiler profiling harness. +# +# Usage: +# run-profile.sh run --experiment --variant \ +# --purs [--scenarios full,nochange,prelude,leaf] \ +# [--runs 5] [--profile] [--baseline-sha ] [--head-sha ] +# +# run-profile.sh build-baseline --sha +# run-profile.sh build +# +# Design notes (see KNOWN-BUGS section at bottom for history): +# - Invokes `purs compile $(spago sources)` directly, NOT `spago build`. +# spago 0.21 picks up node_modules/.bin/purs before honoring our PATH +# shim, which is why the legacy script recorded 1-second "builds" — +# the shim was silently ignored and spago's incremental logic ran +# against a previous purs's outputs. +# - `spago sources` does NOT require purs and is cheap; it just emits +# source globs from spago.dhall. +# - Timing uses `date +%s%N` for ms precision. Bash's $SECONDS is +# integer-seconds-only and caused the "0s" rows in legacy logs. +# - All log output goes to stderr. The only thing written to stdout +# from run_once is the integer millisecond timing, so it can be +# captured via command substitution without contamination. + +SCRIPT_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" +REPO_ROOT="$(cd "$SCRIPT_DIR/../.." && pwd)" +PR_ADMIN_DIR="/workspace/restaumatic/apps/pr-admin" +EXPERIMENTS_DIR="$REPO_ROOT/experiments" +BASELINES_DIR="$EXPERIMENTS_DIR/baselines" + +log() { echo "[$(date '+%H:%M:%S')] $*" >&2; } +error() { echo "[ERROR] $*" >&2; exit 1; } + +usage() { + cat >&2 </results.md. + build Build current branch optimised (stack build). + build-profiled Build current branch with --profile. + build-baseline Build and stash a baseline binary keyed by SHA. + +Run options: + --experiment experiment id (results go to experiments//results.md) + --variant which column the measurement represents + --purs path to the purs binary to measure + --baseline-purs OPTIONAL — measure baseline in same invocation + --scenarios comma-list of full,nochange,prelude,leaf (default: full) + --runs total runs per scenario (default: 5). Run 1 is warm-up + and discarded; median of remaining (n-1) runs is reported. + --profile wrap purs with +RTS -p -hc -RTS and stash the .prof file + into experiments//profiles/ with a .meta.md sidecar. + --baseline-sha short SHA recorded in the results row + --head-sha short SHA recorded in the results row + --notes extra notes column + +build-baseline options: + --sha what to build the baseline from + +Examples: + # Measure current tip of the qualified-intern branch against baseline + run-profile.sh run --experiment qualified-intern --variant head \\ + --purs /workspace/p/qualified-intern/.stack-work/install/.../purs \\ + --baseline-purs experiments/baselines/3fcac773/purs \\ + --scenarios all --runs 5 \\ + --baseline-sha 3fcac773 --head-sha abc1234 + +EOF + exit 1 +} + +################################################################################ +# Low-level: invoke purs directly and time it in milliseconds. +################################################################################ + +# Writes ONLY the elapsed milliseconds (int) to stdout. +# All logging goes to stderr. +run_once() { + local PURS_BIN="$1" + local SCENARIO="$2" # full | nochange | prelude | leaf + local PROFILE_MODE="${3:-}" # empty or "profile" + local LABEL="${4:-current}" + + local OUTPUT_DIR="$PR_ADMIN_DIR/output" + local PRELUDE="/workspace/restaumatic/libs/ps/restaumatic-prelude/src/Restaumatic/Prelude.purs" + local LEAF="" + + case "$SCENARIO" in + full) + rm -rf "$OUTPUT_DIR" + ;; + nochange) + # Caller is responsible for having a populated output/ first; + # run_scenario arranges this with a prior `full` run. + : + ;; + prelude) + [[ -f "$PRELUDE" ]] || error "prelude file not found: $PRELUDE" + cp "$PRELUDE" "$PRELUDE.bak" + echo "-- force-rebuild $(date +%s%N)" >> "$PRELUDE" + ;; + leaf) + LEAF=$(find "$PR_ADMIN_DIR/src" -name '*.purs' -type f 2>/dev/null | head -1) + [[ -n "$LEAF" ]] || error "no leaf .purs found under $PR_ADMIN_DIR/src" + cp "$LEAF" "$LEAF.bak" + echo "-- force-rebuild $(date +%s%N)" >> "$LEAF" + ;; + *) + error "unknown scenario: $SCENARIO" + ;; + esac + + # spago sources emits source globs; grep strips spago's warning lines. + local SOURCES + SOURCES=$(cd "$PR_ADMIN_DIR" && spago sources 2>/dev/null | grep -v '^\[' || true) + [[ -n "$SOURCES" ]] || error "spago sources returned nothing from $PR_ADMIN_DIR" + + local START END ELAPSED_MS PURS_EXIT + START=$(date +%s%N) + + # Invoke purs directly — no PATH shim, no `spago build`. We pick + # the binary ourselves; no chance of node_modules/.bin/purs + # substitution. + # Stderr goes to a tmp file so we can surface real failures. + local PURS_STDERR + PURS_STDERR=$(mktemp) + set +e + ( + cd "$PR_ADMIN_DIR" + if [[ "$PROFILE_MODE" == "profile" ]]; then + "$PURS_BIN" compile $SOURCES +RTS -p -hc -RTS 1>/dev/null 2>"$PURS_STDERR" + else + "$PURS_BIN" compile $SOURCES 1>/dev/null 2>"$PURS_STDERR" + fi + ) + PURS_EXIT=$? + set -e + + END=$(date +%s%N) + ELAPSED_MS=$(( (END - START) / 1000000 )) + + if [[ $PURS_EXIT -ne 0 ]]; then + log "purs compile FAILED (exit $PURS_EXIT) — last stderr lines:" + tail -20 "$PURS_STDERR" >&2 || true + rm -f "$PURS_STDERR" + # Restore any perturbed file before propagating failure + [[ "$SCENARIO" == "prelude" && -f "$PRELUDE.bak" ]] && mv "$PRELUDE.bak" "$PRELUDE" + [[ "$SCENARIO" == "leaf" && -n "$LEAF" && -f "$LEAF.bak" ]] && mv "$LEAF.bak" "$LEAF" + error "purs compile failed for scenario=$SCENARIO label=$LABEL" + fi + rm -f "$PURS_STDERR" + + # Restore any file we perturbed + case "$SCENARIO" in + prelude) mv "$PRELUDE.bak" "$PRELUDE" ;; + leaf) mv "$LEAF.bak" "$LEAF" ;; + esac + + # Relocate .prof/.hp if produced + if [[ "$PROFILE_MODE" == "profile" && -f "$PR_ADMIN_DIR/purs.prof" ]]; then + local TS PROF_TARGET + TS=$(date +%Y%m%d-%H%M%S) + PROF_TARGET="$EXPERIMENTS_DIR/$EXP_ID/profiles/${LABEL}-${SCENARIO}-${TS}.prof" + mkdir -p "$(dirname "$PROF_TARGET")" + mv "$PR_ADMIN_DIR/purs.prof" "$PROF_TARGET" + log "profile → $PROF_TARGET" + [[ -f "$PR_ADMIN_DIR/purs.hp" ]] && mv "$PR_ADMIN_DIR/purs.hp" "${PROF_TARGET%.prof}.hp" + fi + + # ONLY this reaches stdout — the integer ms reading. + echo "$ELAPSED_MS" +} + +################################################################################ +# Multi-run orchestration for one scenario. Discards run 1 as warm-up. +################################################################################ + +# Writes "median min max n" to stdout. +run_scenario() { + local PURS_BIN="$1" + local SCENARIO="$2" + local RUNS="$3" + local PROFILE_MODE="$4" + local LABEL="$5" + + local -a RESULTS=() + for ((i=1; i<=RUNS; i++)); do + # `nochange` needs a populated output/ before the first timed run. + if [[ "$SCENARIO" == "nochange" && $i -eq 1 ]]; then + log " (populating output/ with a full build before first nochange run)" + run_once "$PURS_BIN" "full" "" "$LABEL" >/dev/null + fi + + local T + T=$(run_once "$PURS_BIN" "$SCENARIO" "$PROFILE_MODE" "$LABEL") + if [[ $i -eq 1 ]]; then + log " run $i: ${T} ms (warm-up — discarded)" + else + log " run $i: ${T} ms" + RESULTS+=("$T") + fi + done + + if [[ ${#RESULTS[@]} -eq 0 ]]; then + echo "0 0 0 0" + return + fi + local SORTED N MIN MAX MEDIAN MID + SORTED=$(printf '%s\n' "${RESULTS[@]}" | sort -n) + N=${#RESULTS[@]} + MIN=$(echo "$SORTED" | head -1) + MAX=$(echo "$SORTED" | tail -1) + MID=$(( (N + 1) / 2 )) + MEDIAN=$(echo "$SORTED" | sed -n "${MID}p") + echo "$MEDIAN $MIN $MAX $N" +} + +################################################################################ +# Results file appender (markdown table). +################################################################################ + +append_result_row() { + local RESULTS_FILE="$1" + local DATE="$2" + local SCENARIO="$3" + local BASE_SHA="$4" + local HEAD_SHA="$5" + local BASE_MED="$6" + local HEAD_MED="$7" + local DELTA_PCT="$8" + local NOTES="$9" + + if [[ ! -f "$RESULTS_FILE" ]]; then + local DIR_NAME + DIR_NAME=$(basename "$(dirname "$RESULTS_FILE")") + cat > "$RESULTS_FILE" <> "$RESULTS_FILE" +} + +################################################################################ +# Top-level `run` command. +################################################################################ + +EXP_ID="" +VARIANT="head" +PURS="" +BASELINE_PURS="" +SCENARIOS="full" +RUNS=5 +PROFILE_MODE="" +BASE_SHA="" +HEAD_SHA="" +NOTES="" +SHA_ARG="" + +cmd_run() { + [[ -n "$EXP_ID" ]] || error "--experiment is required" + [[ -n "$PURS" ]] || error "--purs is required" + [[ -x "$PURS" ]] || error "not executable: $PURS" + [[ -z "$BASELINE_PURS" || -x "$BASELINE_PURS" ]] || error "not executable: $BASELINE_PURS" + + local EXP_DIR="$EXPERIMENTS_DIR/$EXP_ID" + mkdir -p "$EXP_DIR" + local RESULTS_FILE="$EXP_DIR/results.md" + local DATE + DATE=$(date '+%Y-%m-%d') + + if [[ "$SCENARIOS" == "all" ]]; then + SCENARIOS="full,nochange,prelude,leaf" + fi + + log "experiment=$EXP_ID variant=$VARIANT" + log "purs=$PURS" + [[ -n "$BASELINE_PURS" ]] && log "baseline-purs=$BASELINE_PURS" + log "scenarios=$SCENARIOS runs=$RUNS (run 1 discarded)" + log "baseline_sha=${BASE_SHA:-unset} head_sha=${HEAD_SHA:-unset}" + + IFS=',' read -r -a SCN_LIST <<< "$SCENARIOS" + for SCN in "${SCN_LIST[@]}"; do + log "=== scenario: $SCN ===" + + local BASE_MED="" HEAD_MED="" HEAD_MIN HEAD_MAX HEAD_N + if [[ -n "$BASELINE_PURS" ]]; then + log "[baseline] running..." + read -r BASE_MED _ _ _ <<< "$(run_scenario "$BASELINE_PURS" "$SCN" "$RUNS" "" "baseline")" + log "[baseline] median=${BASE_MED} ms" + fi + + log "[$VARIANT] running..." + read -r HEAD_MED HEAD_MIN HEAD_MAX HEAD_N <<< "$(run_scenario "$PURS" "$SCN" "$RUNS" "$PROFILE_MODE" "$VARIANT")" + log "[$VARIANT] median=${HEAD_MED} ms (min=${HEAD_MIN}, max=${HEAD_MAX}, n=${HEAD_N})" + + local DELTA_PCT="n/a" + if [[ -n "$BASE_MED" && "$BASE_MED" -gt 0 ]]; then + DELTA_PCT=$(awk -v b="$BASE_MED" -v h="$HEAD_MED" \ + 'BEGIN { printf "%+.1f%%", (h - b) * 100 / b }') + fi + + local ROW_NOTES="median of $((RUNS-1)), ${HEAD_MIN}-${HEAD_MAX} ms" + [[ -n "$NOTES" ]] && ROW_NOTES="$ROW_NOTES; $NOTES" + + append_result_row "$RESULTS_FILE" "$DATE" "$SCN" \ + "$BASE_SHA" "$HEAD_SHA" "${BASE_MED:-0}" "$HEAD_MED" "$DELTA_PCT" "$ROW_NOTES" + done + + log "results appended → $RESULTS_FILE" +} + +################################################################################ +# `build`, `build-profiled`, and `build-baseline`. +################################################################################ + +get_current_purs() { + local BASE + BASE=$(stack path --local-install-root 2>/dev/null) || return 1 + echo "$BASE/bin/purs" +} + +get_profiled_purs() { + local BASE + BASE=$(stack path --local-install-root --profile 2>/dev/null) || return 1 + echo "$BASE/bin/purs" +} + +cmd_build() { + log "stack build (optimised)" + (cd "$REPO_ROOT" && stack build --system-ghc) + log "purs → $(get_current_purs)" +} + +cmd_build_profiled() { + log "stack build --profile" + (cd "$REPO_ROOT" && stack build --profile --system-ghc) + log "purs (profiled) → $(get_profiled_purs)" +} + +cmd_build_baseline() { + [[ -n "$SHA_ARG" ]] || error "--sha required" + + local TMP_WT="/tmp/purs-baseline-$SHA_ARG" + if [[ -d "$TMP_WT" ]]; then + git -C "$REPO_ROOT" worktree remove --force "$TMP_WT" || true + fi + + log "creating detached worktree at $TMP_WT" + git -C "$REPO_ROOT" worktree add --detach "$TMP_WT" "$SHA_ARG" + + local RESOLVED_SHA + RESOLVED_SHA=$(git -C "$TMP_WT" rev-parse --short HEAD) + + log "building from $RESOLVED_SHA" + (cd "$TMP_WT" && stack build --system-ghc) + + local SRC_PURS + SRC_PURS=$(cd "$TMP_WT" && stack path --local-install-root)/bin/purs + + local DEST="$BASELINES_DIR/$RESOLVED_SHA" + mkdir -p "$DEST" + cp "$SRC_PURS" "$DEST/purs" + log "baseline binary → $DEST/purs" + + git -C "$REPO_ROOT" worktree remove --force "$TMP_WT" + + # Append to manifest (insert below header). + local MANIFEST="$BASELINES_DIR/manifest.md" + local GHC_VER STACK_RES TS + GHC_VER=$(ghc --version 2>/dev/null || echo unknown) + STACK_RES=$(grep '^resolver:' "$REPO_ROOT/stack.yaml" 2>/dev/null | head -1 | awk '{print $2}' || echo unknown) + TS=$(date -u '+%Y-%m-%d %H:%M UTC') + + if [[ -f "$MANIFEST" ]] && grep -q '^| ---' "$MANIFEST"; then + awk -v row="| $RESOLVED_SHA | $SHA_ARG | $TS | $GHC_VER | $STACK_RES | $(whoami) | new |" ' + /^\| ---/ && !inserted { print; print row; inserted=1; next } + { print } + ' "$MANIFEST" > "$MANIFEST.tmp" && mv "$MANIFEST.tmp" "$MANIFEST" + fi + log "manifest updated → $MANIFEST" +} + +################################################################################ +# Argument parsing +################################################################################ + +[[ $# -ge 1 ]] || usage +CMD="$1"; shift + +if [[ "$CMD" == "-h" || "$CMD" == "--help" || "$CMD" == "help" ]]; then + usage +fi + +while [[ $# -gt 0 ]]; do + case "$1" in + --experiment) EXP_ID="$2"; shift 2;; + --variant) VARIANT="$2"; shift 2;; + --purs) PURS="$2"; shift 2;; + --baseline-purs) BASELINE_PURS="$2"; shift 2;; + --scenarios) SCENARIOS="$2"; shift 2;; + --runs) RUNS="$2"; shift 2;; + --profile) PROFILE_MODE="profile"; shift;; + --baseline-sha) BASE_SHA="$2"; shift 2;; + --head-sha) HEAD_SHA="$2"; shift 2;; + --notes) NOTES="$2"; shift 2;; + --sha) SHA_ARG="$2"; shift 2;; + -h|--help) usage;; + *) error "unknown option: $1";; + esac +done + +case "$CMD" in + run) cmd_run;; + build) cmd_build;; + build-profiled) cmd_build_profiled;; + build-baseline) cmd_build_baseline;; + *) error "unknown command: $CMD";; +esac + +# ---------------------------------------------------------------------- +# KNOWN-BUGS from legacy script (all addressed in this rewrite): +# 1) PATH shim silently ignored by spago build. spago 0.21 resolved +# `purs` from pr-admin/node_modules/.bin/purs before honoring our +# PATH prefix. Fix: bypass spago build entirely; call +# `purs compile $(spago sources)` ourselves. +# 2) 1-second bogus timings. $SECONDS is integer-second resolution. +# Fix: date +%s%N for millisecond precision. +# 3) Log output contaminating captured value. `log` wrote to stdout +# alongside the timing return. Fix: log to stderr; only numeric +# results reach stdout. +# 4) Baseline/variant interleaved. Legacy alternated baseline-var- +# baseline-var, letting caches leak between them. Fix: run all +# iterations of one binary back-to-back; explicit scenarios for +# warm vs cold states. +# ---------------------------------------------------------------------- diff --git a/experiments/synonym-opt/EXPERIMENT.md b/experiments/synonym-opt/EXPERIMENT.md new file mode 100644 index 0000000000..b585ef1bd3 --- /dev/null +++ b/experiments/synonym-opt/EXPERIMENT.md @@ -0,0 +1,74 @@ +--- +id: synonym-opt +status: in-progress +verdict: tbd +branch: synonym-opt +worktree: /workspace/p/synonym-opt +baseline_sha: 3fcac773 +head_sha: 92bd49e5 +hypothesis: > + Short-circuit the three hot type-tree traversals — replaceAllTypeSynonyms, + replaceTypeWildcards, introduceSkolemScope — by caching structural + properties of each subtree on the type node itself. Most subtrees are + already synonym-free / wildcard-free / scoped, and walking them is + pure overhead. +headline_delta: tbd +tags: [typechecker, synonyms, type-flags] +started: 2026-04-12 +closed: null +--- + +# synonym-opt — per-node TypeFlags for traversal short-circuits + +## Hypothesis + +See frontmatter. The 16.9% `replaceAllTypeSynonyms'.go` cost centre, +along with `replaceTypeWildcards` and `introduceSkolemScope`, walks the +full type tree at ~40 call sites per typecheck. If each `Type` node +carries a small `TypeFlags` field tracking "this subtree is synonym-free +/ wildcard-free / has no unscoped ForAlls", pattern synonyms hide the +field and the hot traversals can short-circuit on an already-clean +subtree. + +## Scope + +In scope: add `TypeFlags` to every `Type` constructor; auto-compute on +construction via pattern synonyms; short-circuit the three named +traversals. + +Out of scope: changing callers or eagerly expanding synonyms at entry +points (that was an alternative approach listed in `TASK.md`). + +## Status + +**In progress.** Four commits on top of `restaumatic` tip: + +- `68330ed5` — Optimize replaceAllTypeSynonyms with per-node TypeFlags +- `d2d682b4` — Remove unused clearFlag, markAllTypeFlags, setTypeFlags +- `16abb5a9` — Add debug assertions to verify TypeFlags invariants +- `92bd49e5` — Document why combineFlags must clear tfSynonymsFree + +No measured numbers recorded in-worktree yet — needs a proper run +through the experiment framework. + +## Measured results + +_Not yet measured under the new framework._ Results will land in +`results.md`. + +## Links + +- Plan: `/workspace/p/synonym-opt/TASK.md` +- Measurement procedure: `/workspace/p/synonym-opt/PROFILING.md` +- Hotspot: `replaceAllTypeSynonyms'.go` (16.9% of full-build time on + the `restaumatic` baseline) + +## Open problems + +- **No measurements yet under the new framework.** Must run all four + scenarios against baseline `3fcac773` before this experiment can move + to `shipped` or `abandoned`. +- **Correctness of `tfSynonymsFree` invariant** — see commit + `92bd49e5` for a subtle case where `combineFlags` must clear the + flag. Assertions added in `16abb5a9` catch violations in debug + builds. diff --git a/experiments/tc-queries/EXPERIMENT.md b/experiments/tc-queries/EXPERIMENT.md new file mode 100644 index 0000000000..7d55dc6801 --- /dev/null +++ b/experiments/tc-queries/EXPERIMENT.md @@ -0,0 +1,84 @@ +--- +id: tc-queries +status: blocked +verdict: no-win +branch: tc-queries +worktree: /workspace/p/tc-queries +baseline_sha: 2e89bd4f +head_sha: ba8d7d25 +hypothesis: > + Converting per-binding-group typecheck operations into Rock queries + enables within-module incrementality — edit a function body without + changing its type, and downstream binding groups in the same module + can be skipped from a persisted cross-build cache. +headline_delta: "+0.1% full, +9% prelude-edit (no-win)" +tags: [incrementality, typechecker, rock, caching] +started: 2025-12-22 +closed: null +--- + +# tc-queries — binding-group Rock queries for within-module incrementality + +## Hypothesis + +See frontmatter. The module-level cache already exists via Rock; the bet +is that breaking the per-module typecheck into binding-group queries +lets us skip downstream groups when a body changes but the type doesn't. + +## Scope + +In scope: extract `kindsOfAll` and `typesOf` (both use +`withFreshSubstitution` — natural boundaries) into Rock queries; add a +persistent cross-build group cache at +`output//groups.cbor`; serialise elaborated `Declaration` for +value groups. + +Out of scope: changing `infer`/`check` or the unification algorithm +itself. Those are internal-to-a-group and not query boundaries. + +## Status + +**Blocked / no-win as measured.** Infrastructure is fully wired (cache +types, fingerprinting, delta compute/apply, persistence, Serialise on +full `Declaration` AST). Runtime caching is enabled only for +`DataBindingGroupDeclaration`; broader caching regressed. + +- Caching cheap decl kinds: fingerprint + delta overhead exceeds the + typecheck work it skips. Adds +4–6% to full builds, +13% to + incremental edits, even with 100% cache hit rate. +- Caching value groups: serialised elaborated `Declaration` blows up + to ~2 GB on pr-admin; full build goes 73s → 217s. + +Current branch matches baseline within noise (+0.1% full, +9% on +prelude-edit). + +## Measured results + +See `/workspace/p/tc-queries/HANDOFF.md` for the full numbers. Headline: + +| Scenario | Baseline (2e89bd4f) | Head (ba8d7d25) | Δ | +| ----------------------------- | ------------------- | --------------- | ----- | +| Full build | 73.4s | 73.5s | +0.1% | +| No change | 1.1s | 1.1s | 0% | +| Prelude edit (1342 retypecheck) | 2.3s | 2.5s | +9% | +| Data-heavy module edit | 3.2s | 3.3s | +3% | + +## Links + +- Plan: `/workspace/p/tc-queries/TASK.md` +- Live state: `/workspace/p/tc-queries/HANDOFF.md` +- Measurement procedure: `/workspace/p/tc-queries/PROFILING.md` +- Key commits: `ba8d7d25`, `f6075ab3`, `42b8665d`, `2e89bd4f`, + `a312cec7`, `9aa391e9`, `65ce13f7`, `a485b425`, `cd4dd1b9` + +## Open problems (what it would take to unblock) + +The unshipped prize is value-group within-module incrementality. Would +require one of: + +1. A smaller cache shape — store env-delta only, refactor codegen to + work from un-elaborated decls plus separately-cached type info. +2. Aggressive compression (zstd) on the elaborated representation. +3. A normalised, source-span-free variant reconstructed on cache hit. + +Each is a significant refactor; none has been attempted. diff --git a/src/Language/PureScript/TypeChecker.hs b/src/Language/PureScript/TypeChecker.hs index fd4e7c7982..4e590fff23 100644 --- a/src/Language/PureScript/TypeChecker.hs +++ b/src/Language/PureScript/TypeChecker.hs @@ -15,6 +15,7 @@ import Control.Monad (when, unless, void, forM, zipWithM_) import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State.Class (modify, gets) import Control.Monad.Writer.Class (tell) +import Debug.Trace (traceMarker) import Data.Foldable (for_, traverse_, toList) import Data.List (nubBy, (\\), sort, group) @@ -35,7 +36,7 @@ import Language.PureScript.Environment (DataDeclType(..), Environment(..), Funct import Language.PureScript.Errors (SimpleErrorMessage(..), addHint, errorMessage, errorMessage', positionedError, rethrow, warnAndRethrow, MultipleErrors) import Language.PureScript.Linter (checkExhaustiveExpr) import Language.PureScript.Linter.Wildcards (ignoreWildcardsUnderCompleteTypeSignatures) -import Language.PureScript.Names (Ident, ModuleName, ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..), coerceProperName, disqualify, isPlainIdent, mkQualified) +import Language.PureScript.Names (Ident, ModuleName, ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..), coerceProperName, disqualify, isPlainIdent, mkQualified, runIdent, runModuleName, runProperName, showQualified) import Language.PureScript.Roles (Role) import Language.PureScript.Sugar.Names.Env (Exports(..)) import Language.PureScript.TypeChecker.Kinds as T @@ -236,6 +237,18 @@ checkTypeSynonyms = void . replaceAllTypeSynonyms -- -- * Process module imports -- +-- | Bracket a typechecking action with eventlog markers for per-declaration +-- profiling. Markers appear as \"tc ModuleName kind:name start/end\" in the +-- eventlog. Zero cost when the binary is not run with @+RTS -l@. +-- See @debug\/README.md@ for the full profiling workflow. +withDeclTrace :: ModuleName -> String -> TypeCheckM a -> TypeCheckM a +withDeclTrace mn label action = do + let tag = "tc " <> T.unpack (runModuleName mn) <> " " <> label + !_ = traceMarker (tag <> " start") () + result <- action + let !_ = traceMarker (tag <> " end") () + return result + typeCheckAll :: ModuleName -> [Declaration] @@ -243,18 +256,20 @@ typeCheckAll typeCheckAll moduleName = traverse go where go :: Declaration -> TypeCheckM Declaration - go (DataDeclaration sa@(ss, _) dtype name args dctors) = do - warnAndRethrow (addHint (ErrorInTypeConstructor name) . addHint (positionedError ss)) $ do - when (dtype == Newtype) $ void $ checkNewtype name dctors - checkDuplicateTypeArguments $ map fst args - (dataCtors, ctorKind) <- kindOfData moduleName (sa, name, args, dctors) - let args' = args `withKinds` ctorKind - env <- getEnv - dctors' <- traverse (replaceTypeSynonymsInDataConstructor . fst) dataCtors - let args'' = args' `withRoles` inferRoles env moduleName name args' dctors' - addDataType moduleName dtype name args'' dataCtors ctorKind - return $ DataDeclaration sa dtype name args dctors - go d@(DataBindingGroupDeclaration tys) = do + go (DataDeclaration sa@(ss, _) dtype name args dctors) = + withDeclTrace moduleName ("data:" <> T.unpack (runProperName name)) $ do + warnAndRethrow (addHint (ErrorInTypeConstructor name) . addHint (positionedError ss)) $ do + when (dtype == Newtype) $ void $ checkNewtype name dctors + checkDuplicateTypeArguments $ map fst args + (dataCtors, ctorKind) <- kindOfData moduleName (sa, name, args, dctors) + let args' = args `withKinds` ctorKind + env <- getEnv + dctors' <- traverse (replaceTypeSynonymsInDataConstructor . fst) dataCtors + let args'' = args' `withRoles` inferRoles env moduleName name args' dctors' + addDataType moduleName dtype name args'' dataCtors ctorKind + return $ DataDeclaration sa dtype name args dctors + go d@(DataBindingGroupDeclaration tys) = + withDeclTrace moduleName (dataGroupLabel tys) $ do let tysList = NEL.toList tys syns = mapMaybe toTypeSynonym tysList dataDecls = mapMaybe toDataDecl tysList @@ -295,85 +310,94 @@ typeCheckAll moduleName = traverse go toRoleDecl _ = Nothing toClassDecl (TypeClassDeclaration sa nm args implies deps decls) = Just (deps, (sa, nm, args, implies, decls)) toClassDecl _ = Nothing - go (TypeSynonymDeclaration sa@(ss, _) name args ty) = do - warnAndRethrow (addHint (ErrorInTypeSynonym name) . addHint (positionedError ss) ) $ do - checkDuplicateTypeArguments $ map fst args - (elabTy, kind) <- kindOfTypeSynonym moduleName (sa, name, args, ty) - let args' = args `withKinds` kind - addTypeSynonym moduleName name args' elabTy kind - return $ TypeSynonymDeclaration sa name args ty - go (KindDeclaration sa@(ss, _) kindFor name ty) = do - warnAndRethrow (addHint (ErrorInKindDeclaration name) . addHint (positionedError ss)) $ do - elabTy <- withFreshSubstitution $ checkKindDeclaration moduleName ty - env <- getEnv - putEnv $ env { types = M.insert (Qualified (ByModuleName moduleName) name) (elabTy, LocalTypeVariable) (types env) } - return $ KindDeclaration sa kindFor name elabTy - go d@(RoleDeclaration rdd) = do - checkRoleDeclaration moduleName rdd - return d + go (TypeSynonymDeclaration sa@(ss, _) name args ty) = + withDeclTrace moduleName ("syn:" <> T.unpack (runProperName name)) $ do + warnAndRethrow (addHint (ErrorInTypeSynonym name) . addHint (positionedError ss) ) $ do + checkDuplicateTypeArguments $ map fst args + (elabTy, kind) <- kindOfTypeSynonym moduleName (sa, name, args, ty) + let args' = args `withKinds` kind + addTypeSynonym moduleName name args' elabTy kind + return $ TypeSynonymDeclaration sa name args ty + go (KindDeclaration sa@(ss, _) kindFor name ty) = + withDeclTrace moduleName ("kind:" <> T.unpack (runProperName name)) $ do + warnAndRethrow (addHint (ErrorInKindDeclaration name) . addHint (positionedError ss)) $ do + elabTy <- withFreshSubstitution $ checkKindDeclaration moduleName ty + env <- getEnv + putEnv $ env { types = M.insert (Qualified (ByModuleName moduleName) name) (elabTy, LocalTypeVariable) (types env) } + return $ KindDeclaration sa kindFor name elabTy + go d@(RoleDeclaration rdd) = + withDeclTrace moduleName ("role:" <> T.unpack (runProperName (rdeclIdent rdd))) $ do + checkRoleDeclaration moduleName rdd + return d go TypeDeclaration{} = internalError "Type declarations should have been removed before typeCheckAlld" - go (ValueDecl sa@(ss, _) name nameKind [] [MkUnguarded val]) = do - env <- getEnv - let declHint = if isPlainIdent name then addHint (ErrorInValueDeclaration name) else id - warnAndRethrow (declHint . addHint (positionedError ss)) $ do - val' <- checkExhaustiveExpr ss env moduleName val - valueIsNotDefined moduleName name - typesOf NonRecursiveBindingGroup moduleName [((sa, name), val')] >>= \case - [(_, (val'', ty))] -> do - addValue moduleName name ty nameKind - return $ ValueDecl sa name nameKind [] [MkUnguarded val''] - _ -> internalError "typesOf did not return a singleton" + go (ValueDecl sa@(ss, _) name nameKind [] [MkUnguarded val]) = + withDeclTrace moduleName ("val:" <> T.unpack (runIdent name)) $ do + env <- getEnv + let declHint = if isPlainIdent name then addHint (ErrorInValueDeclaration name) else id + warnAndRethrow (declHint . addHint (positionedError ss)) $ do + val' <- checkExhaustiveExpr ss env moduleName val + valueIsNotDefined moduleName name + typesOf NonRecursiveBindingGroup moduleName [((sa, name), val')] >>= \case + [(_, (val'', ty))] -> do + addValue moduleName name ty nameKind + return $ ValueDecl sa name nameKind [] [MkUnguarded val''] + _ -> internalError "typesOf did not return a singleton" go ValueDeclaration{} = internalError "Binders were not desugared" go BoundValueDeclaration{} = internalError "BoundValueDeclaration should be desugared" - go (BindingGroupDeclaration vals) = do - env <- getEnv - let sss = fmap (\(((ss, _), _), _, _) -> ss) vals - warnAndRethrow (addHint (ErrorInBindingGroup (fmap (\((_, ident), _, _) -> ident) vals)) . addHint (PositionedError sss)) $ do - for_ vals $ \((_, ident), _, _) -> valueIsNotDefined moduleName ident - vals' <- NEL.toList <$> traverse (\(sai@((ss, _), _), nk, expr) -> (sai, nk,) <$> checkExhaustiveExpr ss env moduleName expr) vals - tys <- typesOf RecursiveBindingGroup moduleName $ fmap (\(sai, _, ty) -> (sai, ty)) vals' - vals'' <- forM [ (sai, val, nameKind, ty) - | (sai@(_, name), nameKind, _) <- vals' - , ((_, name'), (val, ty)) <- tys - , name == name' - ] $ \(sai@(_, name), val, nameKind, ty) -> do - addValue moduleName name ty nameKind - return (sai, nameKind, val) - return . BindingGroupDeclaration $ NEL.fromList vals'' - go d@(ExternDataDeclaration (ss, _) name kind) = do - warnAndRethrow (addHint (ErrorInForeignImportData name) . addHint (positionedError ss)) $ do - elabKind <- withFreshSubstitution $ checkKindDeclaration moduleName kind + go (BindingGroupDeclaration vals) = + withDeclTrace moduleName (valGroupLabel vals) $ do env <- getEnv - let qualName = Qualified (ByModuleName moduleName) name - roles = nominalRolesForKind elabKind - putEnv $ env { types = M.insert qualName (elabKind, ExternData roles) (types env) } + let sss = fmap (\(((ss, _), _), _, _) -> ss) vals + warnAndRethrow (addHint (ErrorInBindingGroup (fmap (\((_, ident), _, _) -> ident) vals)) . addHint (PositionedError sss)) $ do + for_ vals $ \((_, ident), _, _) -> valueIsNotDefined moduleName ident + vals' <- NEL.toList <$> traverse (\(sai@((ss, _), _), nk, expr) -> (sai, nk,) <$> checkExhaustiveExpr ss env moduleName expr) vals + tys <- typesOf RecursiveBindingGroup moduleName $ fmap (\(sai, _, ty) -> (sai, ty)) vals' + vals'' <- forM [ (sai, val, nameKind, ty) + | (sai@(_, name), nameKind, _) <- vals' + , ((_, name'), (val, ty)) <- tys + , name == name' + ] $ \(sai@(_, name), val, nameKind, ty) -> do + addValue moduleName name ty nameKind + return (sai, nameKind, val) + return . BindingGroupDeclaration $ NEL.fromList vals'' + go d@(ExternDataDeclaration (ss, _) name kind) = + withDeclTrace moduleName ("externdata:" <> T.unpack (runProperName name)) $ do + warnAndRethrow (addHint (ErrorInForeignImportData name) . addHint (positionedError ss)) $ do + elabKind <- withFreshSubstitution $ checkKindDeclaration moduleName kind + env <- getEnv + let qualName = Qualified (ByModuleName moduleName) name + roles = nominalRolesForKind elabKind + putEnv $ env { types = M.insert qualName (elabKind, ExternData roles) (types env) } + return d + go d@(ExternDeclaration (ss, _) name ty) = + withDeclTrace moduleName ("extern:" <> T.unpack (runIdent name)) $ do + warnAndRethrow (addHint (ErrorInForeignImport name) . addHint (positionedError ss)) $ do + env <- getEnv + (elabTy, kind) <- withFreshSubstitution $ do + ((unks, ty'), kind) <- kindOfWithUnknowns ty + ty'' <- varIfUnknown unks ty' + pure (ty'', kind) + checkTypeKind elabTy kind + case M.lookup (Qualified (ByModuleName moduleName) name) (names env) of + Just _ -> throwError . errorMessage $ RedefinedIdent name + Nothing -> putEnv (env { names = M.insert (Qualified (ByModuleName moduleName) name) (elabTy, External, Defined) (names env) }) return d - go d@(ExternDeclaration (ss, _) name ty) = do - warnAndRethrow (addHint (ErrorInForeignImport name) . addHint (positionedError ss)) $ do - env <- getEnv - (elabTy, kind) <- withFreshSubstitution $ do - ((unks, ty'), kind) <- kindOfWithUnknowns ty - ty'' <- varIfUnknown unks ty' - pure (ty'', kind) - checkTypeKind elabTy kind - case M.lookup (Qualified (ByModuleName moduleName) name) (names env) of - Just _ -> throwError . errorMessage $ RedefinedIdent name - Nothing -> putEnv (env { names = M.insert (Qualified (ByModuleName moduleName) name) (elabTy, External, Defined) (names env) }) - return d go d@FixityDeclaration{} = return d go d@ImportDeclaration{} = return d - go d@(TypeClassDeclaration sa@(ss, _) pn args implies deps tys) = do - warnAndRethrow (addHint (ErrorInTypeClassDeclaration pn) . addHint (positionedError ss)) $ do - env <- getEnv - let qualifiedClassName = Qualified (ByModuleName moduleName) pn - guardWith (errorMessage (DuplicateTypeClass pn ss)) $ - not (M.member qualifiedClassName (typeClasses env)) - (args', implies', tys', kind) <- kindOfClass moduleName (sa, pn, args, implies, tys) - addTypeClass moduleName qualifiedClassName (fmap Just <$> args') implies' deps tys' kind - return d + go d@(TypeClassDeclaration sa@(ss, _) pn args implies deps tys) = + withDeclTrace moduleName ("class:" <> T.unpack (runProperName pn)) $ do + warnAndRethrow (addHint (ErrorInTypeClassDeclaration pn) . addHint (positionedError ss)) $ do + env <- getEnv + let qualifiedClassName = Qualified (ByModuleName moduleName) pn + guardWith (errorMessage (DuplicateTypeClass pn ss)) $ + not (M.member qualifiedClassName (typeClasses env)) + (args', implies', tys', kind) <- kindOfClass moduleName (sa, pn, args, implies, tys) + addTypeClass moduleName qualifiedClassName (fmap Just <$> args') implies' deps tys' kind + return d go (TypeInstanceDeclaration _ _ _ _ (Left _) _ _ _ _) = internalError "typeCheckAll: type class instance generated name should have been desugared" go d@(TypeInstanceDeclaration sa@(ss, _) _ ch idx (Right dictName) deps className tys body) = + withDeclTrace moduleName ("instance:" <> T.unpack (showQualified runProperName className) <> "_" <> T.unpack (runIdent dictName)) $ rethrow (addHint (ErrorInInstance className tys) . addHint (positionedError ss)) $ do env <- getEnv let qualifiedDictName = Qualified (ByModuleName moduleName) dictName @@ -399,6 +423,26 @@ typeCheckAll moduleName = traverse go addTypeClassDictionaries (ByModuleName moduleName) . M.singleton className $ M.singleton (tcdValue dict) (pure dict) return d + -- Helpers for trace labels on binding groups + dataGroupLabel :: NEL.NonEmpty Declaration -> String + dataGroupLabel tys = + let names = mapMaybe dataGroupName (NEL.toList tys) + first = case names of { (x:_) -> T.unpack (runProperName x); [] -> "anon" } + n = length names + in "datagroup:" <> first <> if n > 1 then "+" <> show (n - 1) else "" + where + dataGroupName (DataDeclaration _ _ n _ _) = Just n + dataGroupName (TypeSynonymDeclaration _ n _ _) = Just n + dataGroupName (TypeClassDeclaration _ n _ _ _ _) = Just (coerceProperName n) + dataGroupName _ = Nothing + + valGroupLabel :: NEL.NonEmpty ((SourceAnn, Ident), NameKind, Expr) -> String + valGroupLabel vals = + let idents = fmap (\((_, i), _, _) -> i) vals + first = T.unpack (runIdent (NEL.head idents)) + n = NEL.length idents + in "bind:" <> first <> if n > 1 then "+" <> show (n - 1) else "" + checkInstanceArity :: Ident -> Qualified (ProperName 'ClassName) -> TypeClassData -> [SourceType] -> TypeCheckM () checkInstanceArity dictName className typeClass tys = do let typeClassArity = length (typeClassArguments typeClass) diff --git a/src/Language/PureScript/TypeChecker/Entailment.hs b/src/Language/PureScript/TypeChecker/Entailment.hs index 7895e541b1..de6875bdf8 100644 --- a/src/Language/PureScript/TypeChecker/Entailment.hs +++ b/src/Language/PureScript/TypeChecker/Entailment.hs @@ -15,6 +15,7 @@ import Protolude (ordNub, headMay) import Control.Arrow (second, (&&&)) import Control.Monad.Error.Class (MonadError(..)) +import Debug.Trace (traceMarker) import Control.Monad.State (MonadState(..), MonadTrans(..), StateT(..), evalStateT, execStateT, gets, modify) import Control.Monad (foldM, guard, join, zipWithM, zipWithM_, (<=<)) import Control.Monad.Writer (MonadWriter(..), WriterT(..)) @@ -39,7 +40,7 @@ import Language.PureScript.AST.Declarations (UnknownsHint(..)) import Language.PureScript.Crash (internalError) import Language.PureScript.Environment (Environment(..), FunctionalDependency(..), TypeClassData(..), dictTypeName, kindRow, tyBoolean, tyInt, tyString) import Language.PureScript.Errors (SimpleErrorMessage(..), addHint, addHints, errorMessage, rethrow) -import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName, ProperName(..), ProperNameType(..), Qualified(..), QualifiedBy(..), byMaybeModuleName, coerceProperName, disqualify, freshIdent, getQual) +import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName, ProperName(..), ProperNameType(..), Qualified(..), QualifiedBy(..), byMaybeModuleName, coerceProperName, disqualify, freshIdent, getQual, showQualified, runProperName, runIdent) import Language.PureScript.TypeChecker.Entailment.Coercible (GivenSolverState(..), WantedSolverState(..), initialGivenSolverState, initialWantedSolverState, insoluble, solveGivens, solveWanteds) import Language.PureScript.TypeChecker.Entailment.IntCompare (mkFacts, mkRelation, solveRelation) import Language.PureScript.TypeChecker.Kinds (elaborateKind, unifyKinds') @@ -175,6 +176,30 @@ instance Semigroup t => Semigroup (Matched t) where instance Monoid t => Monoid (Matched t) where mempty = Match mempty +-- | Abbreviated type representation for eventlog markers. +briefType :: SourceType -> String +briefType (TypeConstructor _ (Qualified _ n)) = T.unpack (runProperName n) +briefType (TypeApp _ f _) = briefType f +briefType (KindApp _ f _) = briefType f +briefType (KindedType _ t _) = briefType t +briefType (TypeLevelString _ s) = "'" <> maybe "?" (take 20 . T.unpack) (decodeString s) <> "'" +briefType (TypeLevelInt _ i) = show i +briefType (TypeVar _ v) = T.unpack v +briefType (RCons _ _ _ _) = "{..}" +briefType (REmpty _) = "()" +briefType (ForAll _ _ _ _ _ _) = "forall.." +briefType (ConstrainedType _ _ _) = "=>.." +briefType (TUnknown _ _) = "?" +briefType _ = "_" + +-- | Abbreviated evidence representation for eventlog markers. +briefEvidence :: Evidence -> String +briefEvidence (NamedInstance (Qualified _ i)) = T.unpack (runIdent i) +briefEvidence EmptyClassInstance = "empty" +briefEvidence (IsSymbolInstance _) = "IsSymbol" +briefEvidence (ReflectableInstance _) = "Reflectable" +briefEvidence (WarnInstance _) = "Warn" + -- | Check that the current set of type class dictionaries entail the specified type class goal, and, if so, -- return a type class dictionary reference. entails @@ -236,7 +261,12 @@ entails SolverOptions{..} constraint context hints = where go :: Int -> [ErrorMessageHint] -> SourceConstraint -> WriterT (Any, [(Ident, InstanceContext, SourceConstraint)]) (StateT InstanceContext TypeCheckM) Expr go work _ (Constraint _ className' _ tys' _) | work > 1000 = throwError . errorMessage $ PossiblyInfiniteInstance className' tys' - go work hints' con@(Constraint _ className' kinds' tys' conInfo) = WriterT . StateT . (withErrorMessageHint (ErrorSolvingConstraint con) .) . runStateT . runWriterT $ do + go work hints' con@(Constraint _ className' kinds' tys' conInfo) = + let cn = T.unpack (showQualified runProperName className') + startTag = "tc-entails " <> cn <> concatMap (\t -> " " <> briefType t) (take 3 tys') <> " start" + endTag = "tc-entails " <> cn <> " end" + in traceMarker startTag $ + WriterT . StateT . (withErrorMessageHint (ErrorSolvingConstraint con) .) . runStateT . runWriterT $ do -- We might have unified types by solving other constraints, so we need to -- apply the latest substitution. latestSubst <- lift . lift $ gets checkSubstitution @@ -283,6 +313,7 @@ entails SolverOptions{..} constraint context hints = $ unknownsInAllCoveringSets (fst . (typeClassArguments !!)) typeClassMembers tys'' typeClassCoveringSets case solution of Solved substs tcd -> do + let !_ = traceMarker ("tc-entails-instance " <> cn <> " " <> briefEvidence (tcdValue tcd)) () -- Note that we solved something. tell (Any True, mempty) -- Make sure the substitution is valid: @@ -307,6 +338,7 @@ entails SolverOptions{..} constraint context hints = initDict (tcdPath tcd) + let !_ = traceMarker endTag () return (if typeClassIsEmpty then Unused match else match) Unsolved unsolved -> do -- Generate a fresh name for the unsolved constraint's new dictionary @@ -319,10 +351,12 @@ entails SolverOptions{..} constraint context hints = modify (combineContexts newContext) -- Mark this constraint for generalization tell (mempty, [(ident, context, unsolved)]) + let !_ = traceMarker endTag () return (Var nullSourceSpan qident) - Deferred -> + Deferred -> do -- Constraint was deferred, just return the dictionary unchanged, -- with no unsolved constraints. Hopefully, we can solve this later. + let !_ = traceMarker endTag () return (TypeClassDictionary (srcConstraint className' kinds'' tys'' conInfo) context hints') where -- When checking functional dependencies, we need to use unification to make diff --git a/src/Language/PureScript/TypeChecker/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs index 6fe4cbf117..322a05baa1 100644 --- a/src/Language/PureScript/TypeChecker/Types.hs +++ b/src/Language/PureScript/TypeChecker/Types.hs @@ -33,6 +33,7 @@ import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.State.Class (MonadState(..), gets) import Control.Monad.Supply.Class (MonadSupply) import Control.Monad.Writer.Class (MonadWriter(..)) +import Debug.Trace (traceMarker) import Data.Bifunctor (bimap) import Data.Either (partitionEithers) @@ -40,6 +41,7 @@ import Data.Functor (($>)) import Data.List (transpose, (\\), partition, delete) import Data.Maybe (fromMaybe) import Data.Text (Text) +import Data.Text qualified as T import Data.Traversable (for) import Data.List.NonEmpty qualified as NEL import Data.Map qualified as M @@ -50,7 +52,7 @@ import Language.PureScript.AST import Language.PureScript.Crash (internalError) import Language.PureScript.Environment import Language.PureScript.Errors (ErrorMessage(..), MultipleErrors, SimpleErrorMessage(..), errorMessage, errorMessage', escalateWarningWhen, internalCompilerError, onErrorMessages, onTypesInErrorMessage, parU) -import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName, Name(..), ProperName(..), ProperNameType(..), Qualified(..), QualifiedBy(..), byMaybeModuleName, coerceProperName, freshIdent) +import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName, Name(..), ProperName(..), ProperNameType(..), Qualified(..), QualifiedBy(..), byMaybeModuleName, coerceProperName, freshIdent, runIdent, runModuleName) import Language.PureScript.TypeChecker.Deriving (deriveInstance) import Language.PureScript.TypeChecker.Entailment (InstanceContext, newDictionaries, replaceTypeClassDictionaries) import Language.PureScript.TypeChecker.Kinds (checkConstraint, checkKind, checkTypeKind, kindOf, kindOfWithScopedVars, unifyKinds', unknownsWithKinds) @@ -91,12 +93,20 @@ typesOf -> [((SourceAnn, Ident), Expr)] -> TypeCheckM [((SourceAnn, Ident), (Expr, SourceType))] typesOf bindingGroupType moduleName vals = withFreshSubstitution $ do + let traceLabel = case vals of + [((_, ident), _)] -> T.unpack (runIdent ident) + _ -> T.unpack (runIdent (snd (fst (head vals)))) <> "+" <> show (length vals - 1) + phase p = "tc-phase " <> T.unpack (runModuleName moduleName) <> " " <> traceLabel <> " " <> p + (tys, wInfer) <- capturingSubstitution tidyUp $ do + let !_ = traceMarker (phase "infer start") () (SplitBindingGroup untyped typed dict, w) <- withoutWarnings $ typeDictionaryForBindingGroup (Just moduleName) vals ds1 <- parU typed $ \e -> withoutWarnings $ checkTypedBindingGroupElement moduleName e dict ds2 <- forM untyped $ \e -> withoutWarnings $ typeForBindingGroupElement e dict + let !_ = traceMarker (phase "infer end") () return (map (False, ) ds1 ++ map (True, ) ds2, w) + let !_ = traceMarker (phase "solve start") () inferred <- forM tys $ \(shouldGeneralize, ((sai@((ss, _), ident), (val, ty)), _)) -> do -- Replace type class dictionary placeholders with actual dictionaries (val', unsolved) <- replaceTypeClassDictionaries shouldGeneralize val @@ -178,6 +188,8 @@ typesOf bindingGroupType moduleName vals = withFreshSubstitution $ do skolemEscapeCheck val' return ((sai, (foldr (Abs . VarBinder nullSourceSpan . (\(x, _, _) -> x)) val' unsolved, generalized)), unsolved) + let !_ = traceMarker (phase "solve end") () + -- Show warnings here, since types in wildcards might have been solved during -- instance resolution (by functional dependencies). finalState <- get