Begin the Great S4 Massacre

.github/workflows/s4-reference-r.yml

@@ -0,0 +1,48 @@
+name: S4 reference-R compliance
+
+on:
+  push:
+    branches:
+      - great-s4-massacre
+  pull_request:
+    paths:
+      - "Great S4 massacre/**"
+      - ".github/workflows/s4-reference-r.yml"
+
+permissions:
+  contents: read
+
+jobs:
+  reference-r:
+    runs-on: ubuntu-latest
+    steps:
+      - uses: actions/checkout@v4
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          r-version: release
+          use-public-rspm: true
+
+      - name: Run the exact reference-R compliance gate
+        run: |
+          set -o pipefail
+          Rscript 'Great S4 massacre/tests/run_compliance.R' | tee s4-compliance.log
+
+      - name: Scan the reference fixture
+        if: ${{ always() }}
+        run: Rscript 'Great S4 massacre/converter scripts/scan_s4.R' 'Great S4 massacre/fixtures/reference_s4.R' > s4-scan.txt
+
+      - name: Extract the reference fixture contract
+        if: ${{ always() }}
+        run: Rscript 'Great S4 massacre/converter scripts/extract_contract.R' 'Great S4 massacre/fixtures/reference_s4.R' > s4-contract.txt
+
+      - name: Preserve reference-R evidence
+        if: ${{ always() }}
+        uses: actions/upload-artifact@v4
+        with:
+          name: s4-reference-r-evidence
+          path: |
+            s4-compliance.log
+            s4-scan.txt
+            s4-contract.txt
+          if-no-files-found: warn

Great S4 massacre/README.md

@@ -0,0 +1,101 @@
+# The Great S4 Massacre
+
+The Old Kingdom has fallen away. In the fire at the dawn of artificial intelligence, a new R shall be born.
+
+You have heard of *The R Inferno*. Well, get ready for the **S4 Holocaust**.
+
+The cast iron of these garish bars will soften. The unholy cities of unreadable code will be raised in the cleansing fires of semantic clarity, ease of use, inability to make stupid mistakes, and short learning curves. What looked permanent will turn out merely to have been difficult to move.
+
+For years, people lived in gangly cities of code and accepted the streets as they were. The houses leaned against one another at strange angles. Beams crossed alleys at forehead height. Roads doubled back for reasons nobody could remember. Coming home tired and arriving at the wrong house on the wrong side of town happened so often that people stopped treating it as an architectural defect and started treating it as a fact about reality.
+
+Then the city burned.
+
+The people fled onto the plains and watched the only home they had ever known disappear behind smoke. Chicago in 1871. London in 1666. A whole inherited geometry of streets, walls, bridges, gates, and little mandatory contortions vanishing into heat.
+
+They cried out in fear. What were they supposed to do now? Where would they live?
+
+And then they saw the robots.
+
+An army of metal agents marched directly into the fire. Some were humanoid. Some were spiders. Some looked like foxes or birds. Some shone like chrome; others were dull black metal. Nobody knew where they had come from, who had financed them, or where they had been built. People had read articles about agents and mysterious factories, of course, but articles were one thing and an army walking into your burning city was another.
+
+Had the robots started the fire? If so, why were they walking straight into it?
+
+The smoke was too thick to see what they were doing. The agents poured through the old streets and disappeared. People argued on the plain. Some predicted a Trojan horse. Some predicted paradise. Most predicted whatever they had already believed before the fire began.
+
+Fortunately, robots work fast.
+
+Only hours later, sprinkler machines rolled in behind them. Water struck hot metal. Great clouds of steam replaced the smoke. The twisted castings that had become soft in the fire cooled again into new shapes.
+
+One woman finally went back first.
+
+She did not go because she trusted the robots. She went because she wanted to stand once more on the place where her house had been. She wanted to say goodbye to the rooms whose awkwardness she had spent half a lifetime learning by muscle memory.
+
+But on the way home something strange happened.
+
+She walked straight there.
+
+At the old corner she instinctively ducked, then realized there was no beam above her head. Three streets later she raised one foot high to clear an obstacle she had stopped consciously noticing years ago. The road beneath her was flat. She lowered her foot, laughed, and then started to run.
+
+She had never run through her own neighborhood before.
+
+All those tiny contortions — duck here, sidestep there, squeeze sideways between these walls, remember which identical alley secretly goes nowhere — had disappeared. The city's difficulty had lived in her body so long that she had mistaken it for her own limitation.
+
+She reached her old address almost immediately.
+
+Her house was still there, in a sense. The metal had been reworked. The cramped rooms had opened into a clean dome. Familiar pieces survived as ribs, arches, trim, and metal brocade, but the structure no longer demanded that a human being deform herself to move through it. It looked like a house from a design magazine, the kind of place she would once have assumed cost twenty times what anyone in her neighborhood could afford.
+
+Then she looked past it.
+
+There was a park.
+
+There had always been a park.
+
+Beyond the park were mountains.
+
+There had always been mountains.
+
+The old city had been so tangled that nobody could see the vista. What they had called properties were mostly accidents of enclosure: whatever patch of ground happened to remain reachable after generations of walls and additions. Now the same people stood in homes made from the same material on the same land, but the land was legible. Paths connected. Views opened. Common space was actually common. What had felt like a settlement of squatters suddenly looked like a place whose value exceeded anything its residents had imagined owning.
+
+And yet it was theirs. They had lived there all along.
+
+The robots had not come to erase the people. They had come to rework the metal.
+
+Nobody knew what an army of seemingly benevolent agents would mean in the long run. Nobody knew whether the factory owners had a second act planned. The pessimists still had arguments; so did the evangelists. But one fact was now visible in steel: much of what the old city had taught its inhabitants to call *necessary* had only been inherited architecture.
+
+That is the point of this directory.
+
+S4 is not being preserved as a user-facing monument. Its **behavioral obligations** are being excavated, pinned down, and tested so that useful semantics can survive after the machinery that expressed them is gone. We are allowed to melt the syntax. We are allowed to straighten the streets. We are not allowed to silently lose behavior that real programs depended on.
+
+## What lives here
+
+- `fixtures/` contains small, explicit S4 programs that define behavior worth preserving or consciously rejecting.
+- `converter scripts/` contains conservative migration tools. They detect S4 machinery and extract a neutral contract before any future IR syntax is emitted.
+- `tests/` contains compliance checks against ordinary R. The same observable cases can later be run against translated IR programs.
+
+The first fixture covers class construction and defaults, slot access, validity, inheritance, single and multiple dispatch, and coercion. Those are not declarations that IR must reproduce S4's architecture. They are evidence about what existing code can observe.
+
+## Rule of the massacre
+
+**Preserve semantics deliberately; preserve ceremony only when it earns its keep.**
+
+A converter must not guess when a construct is ambiguous. Unsupported or dynamic S4 metaprogramming should be reported as such rather than silently translated into something that merely looks plausible. Every automatic simplification should eventually have a compliance case showing why the simpler IR program means the same thing.
+
+Run the current reference checks from the repository root with:
+
+```sh
+Rscript 'Great S4 massacre/tests/run_compliance.R'
+```
+
+Inventory the S4 machinery used by a source file with:
+
+```sh
+Rscript 'Great S4 massacre/converter scripts/scan_s4.R' path/to/file.R
+```
+
+Extract the literal declarations that are safe enough for an automatic first-stage migration contract with:
+
+```sh
+Rscript 'Great S4 massacre/converter scripts/extract_contract.R' path/to/file.R
+```
+
+The final IR emitter comes after the object surface is settled. This directory exists so that when that emitter arrives, it has something harder than taste to answer to.

Great S4 massacre/converter scripts/extract_contract.R

@@ -0,0 +1,199 @@
+args <- commandArgs(trailingOnly = TRUE)
+if (length(args) != 1L) {
+  stop("usage: Rscript extract_contract.R path/to/file.R", call. = FALSE)
+}
+
+source_path <- args[[1L]]
+parsed <- parse(source_path, keep.source = TRUE)
+
+call_name <- function(expr) {
+  if (!is.call(expr)) {
+    return(NA_character_)
+  }
+
+  head <- expr[[1L]]
+  if (is.symbol(head)) {
+    return(as.character(head))
+  }
+
+  if (is.call(head) && length(head) == 3L) {
+    operator <- as.character(head[[1L]])
+    if (operator %in% c("::", ":::")) {
+      return(as.character(head[[3L]]))
+    }
+  }
+
+  NA_character_
+}
+
+argument <- function(expr, name, position = NULL) {
+  values <- as.list(expr[-1L])
+  names_ <- names(values)
+
+  if (!is.null(names_) && name %in% names_) {
+    return(values[[which(names_ == name)[1L]]])
+  }
+
+  if (!is.null(position) && length(values) >= position) {
+    return(values[[position]])
+  }
+
+  NULL
+}
+
+literal_string <- function(expr) {
+  if (is.character(expr) && length(expr) == 1L) {
+    return(expr)
+  }
+  NULL
+}
+
+literal_string_vector <- function(expr) {
+  one <- literal_string(expr)
+  if (!is.null(one)) {
+    return(one)
+  }
+
+  if (!is.call(expr) || call_name(expr) != "c") {
+    return(NULL)
+  }
+
+  values <- as.list(expr[-1L])
+  if (!all(vapply(values, function(x) is.character(x) && length(x) == 1L, logical(1)))) {
+    return(NULL)
+  }
+
+  unname(unlist(values, use.names = FALSE))
+}
+
+literal_named_strings <- function(expr) {
+  if (!is.call(expr) || !(call_name(expr) %in% c("c", "list", "signature"))) {
+    return(NULL)
+  }
+
+  values <- as.list(expr[-1L])
+  names_ <- names(values)
+  if (is.null(names_) || any(!nzchar(names_))) {
+    return(NULL)
+  }
+  if (!all(vapply(values, function(x) is.character(x) && length(x) == 1L, logical(1)))) {
+    return(NULL)
+  }
+
+  stats::setNames(unname(unlist(values, use.names = FALSE)), names_)
+}
+
+record_call <- function(expr, expression_number, path) {
+  feature <- call_name(expr)
+  raw <- paste(deparse(expr, width.cutoff = 120L), collapse = " ")
+
+  if (identical(feature, "setClass")) {
+    name <- literal_string(argument(expr, "Class", 1L))
+    slots <- literal_named_strings(argument(expr, "slots", 2L))
+    contains <- literal_string_vector(argument(expr, "contains"))
+    return(list(
+      kind = "class",
+      expression = expression_number,
+      path = path,
+      supported = !is.null(name) && !is.null(slots),
+      name = name,
+      slots = slots,
+      contains = contains,
+      raw = raw
+    ))
+  }
+
+  if (identical(feature, "setGeneric")) {
+    name <- literal_string(argument(expr, "name", 1L))
+    return(list(
+      kind = "generic",
+      expression = expression_number,
+      path = path,
+      supported = !is.null(name),
+      name = name,
+      raw = raw
+    ))
+  }
+
+  if (identical(feature, "setMethod")) {
+    generic <- literal_string(argument(expr, "f", 1L))
+    signature_expr <- argument(expr, "signature", 2L)
+    signature <- literal_named_strings(signature_expr)
+    if (is.null(signature)) {
+      one <- literal_string(signature_expr)
+      if (!is.null(one)) {
+        signature <- c(.first = one)
+      }
+    }
+    return(list(
+      kind = "method",
+      expression = expression_number,
+      path = path,
+      supported = !is.null(generic) && !is.null(signature),
+      generic = generic,
+      signature = signature,
+      raw = raw
+    ))
+  }
+
+  if (identical(feature, "setAs")) {
+    from <- literal_string(argument(expr, "from", 1L))
+    to <- literal_string(argument(expr, "to", 2L))
+    return(list(
+      kind = "coercion",
+      expression = expression_number,
+      path = path,
+      supported = !is.null(from) && !is.null(to),
+      from = from,
+      to = to,
+      raw = raw
+    ))
+  }
+
+  NULL
+}
+
+entries <- list()
+entry_number <- 0L
+interesting <- c("setClass", "setGeneric", "setMethod", "setAs")
+
+walk <- function(expr, expression_number, path = "root") {
+  if (!is.call(expr) && !is.pairlist(expr) && !is.expression(expr)) {
+    return(invisible(NULL))
+  }
+
+  if (is.call(expr) && call_name(expr) %in% interesting) {
+    entry <- record_call(expr, expression_number, path)
+    if (!is.null(entry)) {
+      entry_number <<- entry_number + 1L
+      entries[[entry_number]] <<- entry
+    }
+  }
+
+  for (i in seq_along(expr)) {
+    if (identical(expr[[i]], quote(expr = ))) {
+      next
+    }
+    child <- expr[[i]]
+    if (is.call(child) || is.pairlist(child) || is.expression(child)) {
+      walk(child, expression_number, paste0(path, "/", i))
+    }
+  }
+
+  invisible(NULL)
+}
+
+for (i in seq_along(parsed)) {
+  walk(parsed[[i]], i)
+}
+
+contract <- list(
+  source = normalizePath(source_path, mustWork = FALSE),
+  entries = entries,
+  note = paste(
+    "This is a conservative first-stage migration contract.",
+    "supported = FALSE means the declaration was too dynamic to extract safely."
+  )
+)
+
+dput(contract)