Replace the interpreter sections with the two-head machine and translating organism proved in Rocq, prove the hosted constructor in full, compute the restoration bound in C, add independent reproductions of the paper's constructions and measurements, and cut the paper to 36 pages

.gitignore

@@ -6,3 +6,19 @@ paper/*.log
 paper/*.aux
 paper/*.out
 paper/runs/datapath_layers.npz
+rocq/Makefile
+rocq/Makefile.conf
+rocq/.Makefile.d
+rocq/*.vo
+rocq/*.vok
+rocq/*.vos
+rocq/*.glob
+rocq/.*.aux
+rocq/.lia.cache
+rocq/extract/physnet.ml
+rocq/extract/physnet.mli
+rocq/.nia.cache
+rocq/extract/dump
+rocq/extract/*.cm*
+rocq/extract/*.o
+src/independent/.work/

README.md

@@ -574,12 +574,14 @@ host, its initial memory and its own description tape; each generation is
 instantiated from the bytes the last one emitted, by parsing that output,
 rebuilding the netlist from its first field, and building the evaluator from
 that netlist. It also shows where the restriction to {-1, 0, 1} is paid for,
-that an organism stored in the interpreter of `neural_reflect` builds any record
-image from its description, copies the description and hands over, so that with
-its own description it reproduces generation after generation by the
-interpreter's dynamics, that a larger interpreter runs a netlist realizing a
-smaller one, and that the constructor itself runs as a netlist stored in the
-interpreter's state. Its robustness section gives the margin every orbit has
+that a fixed ternary network of 45,891 units, the two-head machine of
+`src/twohead_net.py`, holds a stored network in its state and evaluates one
+record per step, that an organism of 133 records on it translates a description
+of 2930 bits into the idle bank, copies the description and hands over, so that
+started on its own description it reproduces in every generation, the proofs of
+which are checked in Rocq in `rocq/`, that a larger record interpreter of
+`neural_reflect` runs a netlist realizing a smaller one, and that the
+constructor itself runs as a netlist stored in that interpreter's state. Its robustness section gives the margin every orbit has
 against perturbation, a certificate of the leakage an orbit tolerates from the
 inputs active along it, and the amplified host of `src/redundant.py`: every row
 of the levelized host replaced by r rows reading all r copies of its inputs,
@@ -596,10 +598,11 @@ generation is 1,664,939 steps of a map of 41,967 units, and the amplified host
 reproduces itself in 33,796,449 steps of 125,901 units. The scripts that produce
 every figure are `src/selfrep.py`, `src/netlist_io.py`, `src/host_family.py`,
 `src/paper_stats.py`, `src/paper_verify.py`, `src/paper_runs.py`,
-`src/organism.py`, `src/check_c.py`, `src/hierarchy.py`, `src/hosted_constructor.py`,
-`src/throughput.py`, `src/noise.py`, `src/redundant.py`, `src/fanin2.py`,
-`src/neuromorphic.py` and the `src/check_*.py` set, and their records are in
-`paper/runs/`.
+`src/twohead.py`, `src/twohead_net.py`, `src/check_c.py`, `src/hierarchy.py`,
+`src/hosted_constructor.py`, `src/throughput.py`, `src/noise.py`,
+`src/redundant.py`, `src/fanin2.py`, `src/neuromorphic.py` and the
+`src/check_*.py` set, and their records are in `paper/runs/`; `rocq/` holds the
+Rocq development, which `src/check_rocq.py` builds.
 
 ---
 
@@ -994,13 +997,24 @@ src/                                the library (run scripts as `python src/<nam
   ├── paper_stats.py                unit counts, levelization sizes, effective fan-in
   ├── paper_verify.py               codec, framing, serialization, datapath, interpreter
   ├── paper_runs.py                 self-description, three generations, lockstep
-  ├── organism.py                   the organism: decodes a description into the idle bank,
-  │                                 copies it and hands over, generation after generation
+  ├── organism.py                   an organism on neural_reflect: decodes a description into
+  │                                 the idle bank, copies it and hands over
   ├── host_family.py                the host family H_A: a constant-depth SUBLEQ step for
   │                                 every word width, and its serialization in build order
   ├── netlist_eval.c                an evaluator of the host family, the amplified host and the
   │                                 interpreter in C, the levels of a large netlist in parallel
-  ├── check_c.py                    the host and the organism on the evaluator in C
+  ├── check_c.py                    the host on the evaluator in C
+  ├── twohead.py                    the two-head machine, transcribed, the description code
+  │                                 and the translating organism; writes rocq/Organism.v
+  ├── twohead_net.py                the two-head machine as a ternary netlist N_{G,L}: its
+  │                                 check, its file, the organism on it in C, and the
+  │                                 comparison with the netlist extracted from rocq/
+  ├── twohead_lockstep.c            the organism on N_{G,L} beside the transcription, in C
+  ├── restore_bound.c               the restoration bound of the amplified host along the orbit
+  ├── check_rocq.py                 builds rocq/ and prints the assumptions of its theorems
+  ├── independent/                  separate code written from the paper's definitions: the host
+  │                                 family, the levelization, the record interpreter, a noise
+  │                                 simulator in C, weight error, and the neuromorphic datapath
   ├── redundant.py                  the amplified host N_r: r-fold redundancy with the restoring
   │                                 organ inside every unit, its self-reproduction, its runs
   │                                 under read noise
@@ -1018,6 +1032,9 @@ src/                                the library (run scripts as `python src/<nam
                                     host family, levelization, framing, settling, dependence,
                                     serialization, all 29 machines
 paper/                              the manuscript, and the record of every run it reports
+rocq/                               Rocq proofs: the netlist of the two-head machine computes its
+                                    step, the organism builds every image from any description
+                                    of it and reproduces in every generation
 tools/                              build_all.py (build + quantize + verify every profile),
                                     cpu_programs.py (assembler + CPU program suite), test_cpu.py
                                     (program suite vs a variant), play.py (interactive demo),

paper/README.md

@@ -22,9 +22,11 @@ proposition and theorem, and none of its checks runs the full instance. Tier two
 executes every construction end to end: the self-describing instance and three
 generations of the self-reproducing instance on the integer reference, the
 constructor on four machines of the family through the netlist that
-`variants/neural_subleq8io_netlist.safetensors` denotes, and the interpreted
-machines of the interpreter section. The two together take about forty minutes
-and cover every claim the paper makes.
+`variants/neural_subleq8io_netlist.safetensors` denotes, the record interpreters
+of Section 9, the translating organism on the two-head machine and on its
+netlist in C, and the Rocq development of Sections 7 and 8, which needs Rocq 9.1
+and ocamlfind on the PATH. The two together take about forty minutes and cover
+every claim the paper makes.
 
 Tier three runs the self-reproducing instance itself on the threshold
 evaluators, runs the constructor on all twenty-nine machines of the artifact,
@@ -52,7 +54,6 @@ the cost of any one run is a multiplication.
 | `src/check_codec.py` | `paper_codec.json` | the recipe codec at every boundary of the token format |
 | `src/check_optimal.py` | `paper_optimal.json` | the length bound is optimal on run-free strings |
 | `src/check_steps.py` | `paper_steps.json` | the closed forms for the step counts |
-| `src/check_total.py` | `paper_total.json` | behaviour on tapes that are not recipes, and the total program |
 | `src/check_device.py` | `paper_device.json` | the device against its definition |
 | `src/check_host.py` | `paper_host.json` | the reference machine against its definition |
 | `src/check_lev.py` | `paper_lev.json` | the levelization against gate-by-gate evaluation |
@@ -60,20 +61,22 @@ the cost of any one run is a multiplication.
 | `src/check_ternarity.py` | `paper_ternarity.json` | no ternary unit computes the branch predicate |
 | `src/check_environment.py` | `paper_environment.json` | the cost of the environment against the cost of the network |
 | `src/check_sigma.py` | — | sigma is a function, injective, and inverted by the parser |
-| `src/check_settle.py` | `paper_settle.json` | order-independent settling, the full adder under all 9! record orders |
 | `src/fanin2.py` | `paper_fanin2.json` | the fan-in-two rewriting, on the host, the interpreter and every small ternary unit |
-| `src/check_dependence.py` | — | the dependence hypothesis of the size proposition |
 | `src/check_family.py` | `paper_runs_family.json` | the constructor emits all 29 machines |
 | `src/check_family_gate.py` | `paper_runs_family_gate.json` | four of them on the netlist of sigma |
-| `src/organism.py` | `paper_organism.json` | the organism: universal construction and self-reproduction by the dynamics |
-| `src/check_interp.py` | `paper_interp.json` | the one-record semantics on the netlists of U and U+ |
-| `src/check_c.py` | `paper_c_evaluator.json` | the host and the organism on the evaluator in C, `src/netlist_eval.c` |
+| `src/check_interp.py` | `paper_interp.json` | the record interpreter's netlist against its definition |
+| `src/check_c.py` | `paper_c_evaluator.json` | the host on the evaluator in C, `src/netlist_eval.c` |
+| `src/check_host_fold.py` | `paper_host_fold.json` | the folded host family, depth 11, against SUBLEQ_A for A = 3 to 12 |
+| `src/twohead.py` | `paper_twohead.json` | the translating organism on the two-head machine, three generations |
+| `src/twohead_net.py` | `paper_twohead_net.json` | the netlist N_{G,L} against the machine, its file, the organism on it in C, and the netlist extracted from Rocq |
+| `src/check_rocq.py` | `paper_rocq.json` | the Rocq development of `rocq/`: the netlist computes the step, construction and self-reproduction by the dynamics |
 | `src/hierarchy.py` | `paper_hierarchy.json` | a larger interpreter runs a smaller one transition by transition |
 | `src/hosted_constructor.py` | `paper_hosted.json` | the constructor as a netlist stored in the interpreter |
 | `src/throughput.py` | `paper_throughput.json` | the rate of each evaluator |
 | `src/noise.py` | `paper_noise_*.json` | read noise, the deviation curve, weight error with leakage, the active-input counts of the orbit certificate |
-| `src/redundant.py` | `paper_redundant_*.json` | the amplified host N_3: one step against SUBLEQ on replicated states, the margin 3/2, exact self-reproduction in C, the run under noise, the deviation curve and its bound by layer, the failure rate of the state read by majority and the restoration bound |
+| `src/redundant.py` | `paper_redundant_*.json` | the amplified host N_3: one step against SUBLEQ on replicated states, the margin 3/2, exact self-reproduction in C, the run under noise, the deviation curve and its bound by layer, the failure rate of the state read by majority and the restoration bound, computed by `src/restore_bound.c` |
 | `src/neuromorphic.py` | `paper_neuromorphic.json` | the datapath on the Loihi and Akida neuron models |
+| `src/independent/*.py`, `nsim.c` | `independent_*.json` | separate code written from the paper's definitions: H_A rebuilt from Construction 3.8 for A = 3 to 12, Lev(N_host) from sigma, Definition 9.1 with the hierarchy and the hosted constructor, Tables 4 to 7 with a separate noise simulator, and the datapath on Loihi and Akida |
 
 `src/neuromorphic.py run` needs Lava, which requires Python 3.10; everything
 else runs in the environment of the repository.

paper/runs/independent_host_family.json

@@ -0,0 +1,1682 @@
+[
+ {
+  "A": 3,
+  "fold": false,
+  "states": 65536,
+  "disagree": 0,
+  "halted_not_fixed": 0,
+  "formula_units": 289,
+  "units": 289,
+  "edges": 723,
+  "depth": 13,
+  "bias_range": [
+   -3,
+   1
+  ],
+  "block_layers": {
+   "P": [
+    1,
+    1
+   ],
+   "HP": [
+    1,
+    1
+   ],
+   "FA": [
+    2,
+    2
+   ],
+   "Q": [
+    2,
+    2
+   ],
+   "F": [
+    3,
+    3
+   ],
+   "PAB": [
+    4,
+    4
+   ],
+   "AC": [
+    4,
+    4
+   ],
+   "W": [
+    5,
+    5
+   ],
+   "RXY": [
+    5,
+    5
+   ],
+   "KP": [
+    6,
+    6
+   ],
+   "XY": [
+    6,
+    6
+   ],
+   "sub": [
+    7,
+    11
+   ],
+   "eq": [
+    7,
+    9
+   ],
+   "LEQ": [
+    11,
+    11
+   ],
+   "NP": [
+    12,
+    13
+   ],
+   "NH": [
+    12,
+    13
+   ],
+   "NM": [
+    9,
+    13
+   ]
+  },
+  "seconds": 0.1
+ },
+ {
+  "A": 3,
+  "fold": true,
+  "states": 65536,
+  "disagree": 0,
+  "halted_not_fixed": 0,
+  "formula_units": null,
+  "units": 273,
+  "edges": 931,
+  "depth": 11,
+  "bias_range": [
+   -4,
+   1
+  ],
+  "block_layers": {
+   "P": [
+    1,
+    1
+   ],
+   "HP": [
+    1,
+    1
+   ],
+   "FA": [
+    1,
+    1
+   ],
+   "Q": [
+    2,
+    2
+   ],
+   "F": [
+    2,
+    2
+   ],
+   "AC": [
+    3,
+    3
+   ],
+   "W": [
+    3,
+    3
+   ],
+   "RXY": [
+    3,
+    3
+   ],
+   "KP": [
+    4,
+    4
+   ],
+   "XY": [
+    4,
+    4
+   ],
+   "sub": [
+    5,
+    9
+   ],
+   "eq": [
+    5,
+    7
+   ],
+   "LEQ": [
+    9,
+    9
+   ],
+   "NP": [
+    10,
+    11
+   ],
+   "NH": [
+    10,
+    11
+   ],
+   "NM": [
+    7,
+    11
+   ]
+  },
+  "seconds": 0.1
+ },
+ {
+  "A": 4,
+  "fold": false,
+  "states": 65536,
+  "disagree": 0,
+  "halted_not_fixed": 0,
+  "formula_units": 664,
+  "units": 664,
+  "edges": 1768,
+  "depth": 13,
+  "bias_range": [
+   -4,
+   1
+  ],
+  "block_layers": {
+   "P": [
+    1,
+    1
+   ],
+   "HP": [
+    1,
+    1
+   ],
+   "FA": [
+    2,
+    2
+   ],
+   "Q": [
+    2,
+    2
+   ],
+   "F": [
+    3,
+    3
+   ],
+   "PAB": [
+    4,
+    4
+   ],
+   "AC": [
+    4,
+    4
+   ],
+   "W": [
+    5,
+    5
+   ],
+   "RXY": [
+    5,
+    5
+   ],
+   "KP": [
+    6,
+    6
+   ],
+   "XY": [
+    6,
+    6
+   ],
+   "sub": [
+    7,
+    11
+   ],
+   "eq": [
+    7,
+    9
+   ],
+   "LEQ": [
+    11,
+    11
+   ],
+   "NP": [
+    12,
+    13
+   ],
+   "NH": [
+    12,
+    13
+   ],
+   "NM": [
+    9,
+    13
+   ]
+  },
+  "seconds": 0.3
+ },
+ {
+  "A": 4,
+  "fold": true,
+  "states": 65536,
+  "disagree": 0,
+  "halted_not_fixed": 0,
+  "formula_units": null,
+  "units": 632,
+  "edges": 2648,
+  "depth": 11,
+  "bias_range": [
+   -5,
+   1
+  ],
+  "block_layers": {
+   "P": [
+    1,
+    1
+   ],
+   "HP": [
+    1,
+    1
+   ],
+   "FA": [
+    1,
+    1
+   ],
+   "Q": [
+    2,
+    2
+   ],
+   "F": [
+    2,
+    2
+   ],
+   "AC": [
+    3,
+    3
+   ],
+   "W": [
+    3,
+    3
+   ],
+   "RXY": [
+    3,
+    3
+   ],
+   "KP": [
+    4,
+    4
+   ],
+   "XY": [
+    4,
+    4
+   ],
+   "sub": [
+    5,
+    9
+   ],
+   "eq": [
+    5,
+    7
+   ],
+   "LEQ": [
+    9,
+    9
+   ],
+   "NP": [
+    10,
+    11
+   ],
+   "NH": [
+    10,
+    11
+   ],
+   "NM": [
+    7,
+    11
+   ]
+  },
+  "seconds": 0.3
+ },
+ {
+  "A": 5,
+  "fold": false,
+  "states": 65536,
+  "disagree": 0,
+  "halted_not_fixed": 0,
+  "formula_units": 1520,
+  "units": 1520,
+  "edges": 4208,
+  "depth": 13,
+  "bias_range": [
+   -5,
+   1
+  ],
+  "block_layers": {
+   "P": [
+    1,
+    1
+   ],
+   "HP": [
+    1,
+    1
+   ],
+   "FA": [
+    2,
+    2
+   ],
+   "Q": [
+    2,
+    2
+   ],
+   "F": [
+    3,
+    3
+   ],
+   "PAB": [
+    4,
+    4
+   ],
+   "AC": [
+    4,
+    4
+   ],
+   "W": [
+    5,
+    5
+   ],
+   "RXY": [
+    5,
+    5
+   ],
+   "KP": [
+    6,
+    6
+   ],
+   "XY": [
+    6,
+    6
+   ],
+   "sub": [
+    7,
+    11
+   ],
+   "eq": [
+    7,
+    9
+   ],
+   "LEQ": [
+    11,
+    11
+   ],
+   "NP": [
+    12,
+    13
+   ],
+   "NH": [
+    12,
+    13
+   ],
+   "NM": [
+    9,
+    13
+   ]
+  },
+  "seconds": 0.7
+ },
+ {
+  "A": 5,
+  "fold": true,
+  "states": 65536,
+  "disagree": 0,
+  "halted_not_fixed": 0,
+  "formula_units": null,
+  "units": 1456,
+  "edges": 7216,
+  "depth": 11,
+  "bias_range": [
+   -6,
+   1
+  ],
+  "block_layers": {
+   "P": [
+    1,
+    1
+   ],
+   "HP": [
+    1,
+    1
+   ],
+   "FA": [
+    1,
+    1
+   ],
+   "Q": [
+    2,
+    2
+   ],
+   "F": [
+    2,
+    2
+   ],
+   "AC": [
+    3,
+    3
+   ],
+   "W": [
+    3,
+    3
+   ],
+   "RXY": [
+    3,
+    3
+   ],
+   "KP": [
+    4,
+    4
+   ],
+   "XY": [
+    4,
+    4
+   ],
+   "sub": [
+    5,
+    9
+   ],
+   "eq": [
+    5,
+    7
+   ],
+   "LEQ": [
+    9,
+    9
+   ],
+   "NP": [
+    10,
+    11
+   ],
+   "NH": [
+    10,
+    11
+   ],
+   "NM": [
+    7,
+    11
+   ]
+  },
+  "seconds": 0.8
+ },
+ {
+  "A": 6,
+  "fold": false,
+  "states": 65536,
+  "disagree": 0,
+  "halted_not_fixed": 0,
+  "formula_units": 3465,
+  "units": 3465,
+  "edges": 9824,
+  "depth": 13,
+  "bias_range": [
+   -6,
+   1
+  ],
+  "block_layers": {
+   "P": [
+    1,
+    1
+   ],
+   "HP": [
+    1,
+    1
+   ],
+   "FA": [
+    2,
+    2
+   ],
+   "Q": [
+    2,
+    2
+   ],
+   "F": [
+    3,
+    3
+   ],
+   "PAB": [
+    4,
+    4
+   ],
+   "AC": [
+    4,
+    4
+   ],
+   "W": [
+    5,
+    5
+   ],
+   "RXY": [
+    5,
+    5
+   ],
+   "KP": [
+    6,
+    6
+   ],
+   "XY": [
+    6,
+    6
+   ],
+   "sub": [
+    7,
+    11
+   ],
+   "eq": [
+    7,
+    9
+   ],
+   "LEQ": [
+    11,
+    11
+   ],
+   "NP": [
+    12,
+    13
+   ],
+   "NH": [
+    12,
+    13
+   ],
+   "NM": [
+    9,
+    13
+   ]
+  },
+  "seconds": 1.7
+ },
+ {
+  "A": 6,
+  "fold": true,
+  "states": 65536,
+  "disagree": 0,
+  "halted_not_fixed": 0,
+  "formula_units": null,
+  "units": 3337,
+  "edges": 18976,
+  "depth": 11,
+  "bias_range": [
+   -7,
+   1
+  ],
+  "block_layers": {
+   "P": [
+    1,
+    1
+   ],
+   "HP": [
+    1,
+    1
+   ],
+   "FA": [
+    1,
+    1
+   ],
+   "Q": [
+    2,
+    2
+   ],
+   "F": [
+    2,
+    2
+   ],
+   "AC": [
+    3,
+    3
+   ],
+   "W": [
+    3,
+    3
+   ],
+   "RXY": [
+    3,
+    3
+   ],
+   "KP": [
+    4,
+    4
+   ],
+   "XY": [
+    4,
+    4
+   ],
+   "sub": [
+    5,
+    9
+   ],
+   "eq": [
+    5,
+    7
+   ],
+   "LEQ": [
+    9,
+    9
+   ],
+   "NP": [
+    10,
+    11
+   ],
+   "NH": [
+    10,
+    11
+   ],
+   "NM": [
+    7,
+    11
+   ]
+  },
+  "seconds": 2.0
+ },
+ {
+  "A": 7,
+  "fold": false,
+  "states": 65536,
+  "disagree": 0,
+  "halted_not_fixed": 0,
+  "formula_units": 7843,
+  "units": 7843,
+  "edges": 22569,
+  "depth": 13,
+  "bias_range": [
+   -7,
+   1
+  ],
+  "block_layers": {
+   "P": [
+    1,
+    1
+   ],
+   "HP": [
+    1,
+    1
+   ],
+   "FA": [
+    2,
+    2
+   ],
+   "Q": [
+    2,
+    2
+   ],
+   "F": [
+    3,
+    3
+   ],
+   "PAB": [
+    4,
+    4
+   ],
+   "AC": [
+    4,
+    4
+   ],
+   "W": [
+    5,
+    5
+   ],
+   "RXY": [
+    5,
+    5
+   ],
+   "KP": [
+    6,
+    6
+   ],
+   "XY": [
+    6,
+    6
+   ],
+   "sub": [
+    7,
+    11
+   ],
+   "eq": [
+    7,
+    9
+   ],
+   "LEQ": [
+    11,
+    11
+   ],
+   "NP": [
+    12,
+    13
+   ],
+   "NH": [
+    12,
+    13
+   ],
+   "NM": [
+    9,
+    13
+   ]
+  },
+  "seconds": 5.5
+ },
+ {
+  "A": 7,
+  "fold": true,
+  "states": 65536,
+  "disagree": 0,
+  "halted_not_fixed": 0,
+  "formula_units": null,
+  "units": 7587,
+  "edges": 48425,
+  "depth": 11,
+  "bias_range": [
+   -8,
+   1
+  ],
+  "block_layers": {
+   "P": [
+    1,
+    1
+   ],
+   "HP": [
+    1,
+    1
+   ],
+   "FA": [
+    1,
+    1
+   ],
+   "Q": [
+    2,
+    2
+   ],
+   "F": [
+    2,
+    2
+   ],
+   "AC": [
+    3,
+    3
+   ],
+   "W": [
+    3,
+    3
+   ],
+   "RXY": [
+    3,
+    3
+   ],
+   "KP": [
+    4,
+    4
+   ],
+   "XY": [
+    4,
+    4
+   ],
+   "sub": [
+    5,
+    9
+   ],
+   "eq": [
+    5,
+    7
+   ],
+   "LEQ": [
+    9,
+    9
+   ],
+   "NP": [
+    10,
+    11
+   ],
+   "NH": [
+    10,
+    11
+   ],
+   "NM": [
+    7,
+    11
+   ]
+  },
+  "seconds": 6.3
+ },
+ {
+  "A": 8,
+  "fold": false,
+  "states": 65536,
+  "disagree": 0,
+  "halted_not_fixed": 0,
+  "formula_units": 17598,
+  "units": 17598,
+  "edges": 51132,
+  "depth": 13,
+  "bias_range": [
+   -8,
+   1
+  ],
+  "block_layers": {
+   "P": [
+    1,
+    1
+   ],
+   "HP": [
+    1,
+    1
+   ],
+   "FA": [
+    2,
+    2
+   ],
+   "Q": [
+    2,
+    2
+   ],
+   "F": [
+    3,
+    3
+   ],
+   "PAB": [
+    4,
+    4
+   ],
+   "AC": [
+    4,
+    4
+   ],
+   "W": [
+    5,
+    5
+   ],
+   "RXY": [
+    5,
+    5
+   ],
+   "KP": [
+    6,
+    6
+   ],
+   "XY": [
+    6,
+    6
+   ],
+   "sub": [
+    7,
+    11
+   ],
+   "eq": [
+    7,
+    9
+   ],
+   "LEQ": [
+    11,
+    11
+   ],
+   "NP": [
+    12,
+    13
+   ],
+   "NH": [
+    12,
+    13
+   ],
+   "NM": [
+    9,
+    13
+   ]
+  },
+  "seconds": 23.3
+ },
+ {
+  "A": 8,
+  "fold": true,
+  "states": 65536,
+  "disagree": 0,
+  "halted_not_fixed": 0,
+  "formula_units": null,
+  "units": 17086,
+  "edges": 120508,
+  "depth": 11,
+  "bias_range": [
+   -9,
+   1
+  ],
+  "block_layers": {
+   "P": [
+    1,
+    1
+   ],
+   "HP": [
+    1,
+    1
+   ],
+   "FA": [
+    1,
+    1
+   ],
+   "Q": [
+    2,
+    2
+   ],
+   "F": [
+    2,
+    2
+   ],
+   "AC": [
+    3,
+    3
+   ],
+   "W": [
+    3,
+    3
+   ],
+   "RXY": [
+    3,
+    3
+   ],
+   "KP": [
+    4,
+    4
+   ],
+   "XY": [
+    4,
+    4
+   ],
+   "sub": [
+    5,
+    9
+   ],
+   "eq": [
+    5,
+    7
+   ],
+   "LEQ": [
+    9,
+    9
+   ],
+   "NP": [
+    10,
+    11
+   ],
+   "NH": [
+    10,
+    11
+   ],
+   "NM": [
+    7,
+    11
+   ]
+  },
+  "seconds": 29.3
+ },
+ {
+  "A": 9,
+  "fold": false,
+  "states": 65536,
+  "disagree": 0,
+  "halted_not_fixed": 0,
+  "formula_units": 39130,
+  "units": 39130,
+  "edges": 114458,
+  "depth": 13,
+  "bias_range": [
+   -9,
+   1
+  ],
+  "block_layers": {
+   "P": [
+    1,
+    1
+   ],
+   "HP": [
+    1,
+    1
+   ],
+   "FA": [
+    2,
+    2
+   ],
+   "Q": [
+    2,
+    2
+   ],
+   "F": [
+    3,
+    3
+   ],
+   "PAB": [
+    4,
+    4
+   ],
+   "AC": [
+    4,
+    4
+   ],
+   "W": [
+    5,
+    5
+   ],
+   "RXY": [
+    5,
+    5
+   ],
+   "KP": [
+    6,
+    6
+   ],
+   "XY": [
+    6,
+    6
+   ],
+   "sub": [
+    7,
+    11
+   ],
+   "eq": [
+    7,
+    9
+   ],
+   "LEQ": [
+    11,
+    11
+   ],
+   "NP": [
+    12,
+    13
+   ],
+   "NH": [
+    12,
+    13
+   ],
+   "NM": [
+    9,
+    13
+   ]
+  },
+  "seconds": 55.3
+ },
+ {
+  "A": 9,
+  "fold": true,
+  "states": 65536,
+  "disagree": 0,
+  "halted_not_fixed": 0,
+  "formula_units": null,
+  "units": 38106,
+  "edges": 293658,
+  "depth": 11,
+  "bias_range": [
+   -10,
+   1
+  ],
+  "block_layers": {
+   "P": [
+    1,
+    1
+   ],
+   "HP": [
+    1,
+    1
+   ],
+   "FA": [
+    1,
+    1
+   ],
+   "Q": [
+    2,
+    2
+   ],
+   "F": [
+    2,
+    2
+   ],
+   "AC": [
+    3,
+    3
+   ],
+   "W": [
+    3,
+    3
+   ],
+   "RXY": [
+    3,
+    3
+   ],
+   "KP": [
+    4,
+    4
+   ],
+   "XY": [
+    4,
+    4
+   ],
+   "sub": [
+    5,
+    9
+   ],
+   "eq": [
+    5,
+    7
+   ],
+   "LEQ": [
+    9,
+    9
+   ],
+   "NP": [
+    10,
+    11
+   ],
+   "NH": [
+    10,
+    11
+   ],
+   "NM": [
+    7,
+    11
+   ]
+  },
+  "seconds": 66.7
+ },
+ {
+  "A": 10,
+  "fold": false,
+  "states": 65536,
+  "disagree": 0,
+  "halted_not_fixed": 0,
+  "formula_units": 86263,
+  "units": 86263,
+  "edges": 253572,
+  "depth": 13,
+  "bias_range": [
+   -10,
+   1
+  ],
+  "block_layers": {
+   "P": [
+    1,
+    1
+   ],
+   "HP": [
+    1,
+    1
+   ],
+   "FA": [
+    2,
+    2
+   ],
+   "Q": [
+    2,
+    2
+   ],
+   "F": [
+    3,
+    3
+   ],
+   "PAB": [
+    4,
+    4
+   ],
+   "AC": [
+    4,
+    4
+   ],
+   "W": [
+    5,
+    5
+   ],
+   "RXY": [
+    5,
+    5
+   ],
+   "KP": [
+    6,
+    6
+   ],
+   "XY": [
+    6,
+    6
+   ],
+   "sub": [
+    7,
+    11
+   ],
+   "eq": [
+    7,
+    9
+   ],
+   "LEQ": [
+    11,
+    11
+   ],
+   "NP": [
+    12,
+    13
+   ],
+   "NH": [
+    12,
+    13
+   ],
+   "NM": [
+    9,
+    13
+   ]
+  },
+  "seconds": 127.2
+ },
+ {
+  "A": 10,
+  "fold": true,
+  "states": 65536,
+  "disagree": 0,
+  "halted_not_fixed": 0,
+  "formula_units": null,
+  "units": 84215,
+  "edges": 703108,
+  "depth": 11,
+  "bias_range": [
+   -11,
+   1
+  ],
+  "block_layers": {
+   "P": [
+    1,
+    1
+   ],
+   "HP": [
+    1,
+    1
+   ],
+   "FA": [
+    1,
+    1
+   ],
+   "Q": [
+    2,
+    2
+   ],
+   "F": [
+    2,
+    2
+   ],
+   "AC": [
+    3,
+    3
+   ],
+   "W": [
+    3,
+    3
+   ],
+   "RXY": [
+    3,
+    3
+   ],
+   "KP": [
+    4,
+    4
+   ],
+   "XY": [
+    4,
+    4
+   ],
+   "sub": [
+    5,
+    9
+   ],
+   "eq": [
+    5,
+    7
+   ],
+   "LEQ": [
+    9,
+    9
+   ],
+   "NP": [
+    10,
+    11
+   ],
+   "NH": [
+    10,
+    11
+   ],
+   "NM": [
+    7,
+    11
+   ]
+  },
+  "seconds": 124.7
+ },
+ {
+  "A": 11,
+  "fold": false,
+  "states": 32768,
+  "disagree": 0,
+  "halted_not_fixed": 0,
+  "formula_units": 188693,
+  "units": 188693,
+  "edges": 556795,
+  "depth": 13,
+  "bias_range": [
+   -11,
+   1
+  ],
+  "block_layers": {
+   "P": [
+    1,
+    1
+   ],
+   "HP": [
+    1,
+    1
+   ],
+   "FA": [
+    2,
+    2
+   ],
+   "Q": [
+    2,
+    2
+   ],
+   "F": [
+    3,
+    3
+   ],
+   "PAB": [
+    4,
+    4
+   ],
+   "AC": [
+    4,
+    4
+   ],
+   "W": [
+    5,
+    5
+   ],
+   "RXY": [
+    5,
+    5
+   ],
+   "KP": [
+    6,
+    6
+   ],
+   "XY": [
+    6,
+    6
+   ],
+   "sub": [
+    7,
+    11
+   ],
+   "eq": [
+    7,
+    9
+   ],
+   "LEQ": [
+    11,
+    11
+   ],
+   "NP": [
+    12,
+    13
+   ],
+   "NH": [
+    12,
+    13
+   ],
+   "NM": [
+    9,
+    13
+   ]
+  },
+  "seconds": 473.5
+ },
+ {
+  "A": 11,
+  "fold": true,
+  "states": 32768,
+  "disagree": 0,
+  "halted_not_fixed": 0,
+  "formula_units": null,
+  "units": 184597,
+  "edges": 1658619,
+  "depth": 11,
+  "bias_range": [
+   -12,
+   1
+  ],
+  "block_layers": {
+   "P": [
+    1,
+    1
+   ],
+   "HP": [
+    1,
+    1
+   ],
+   "FA": [
+    1,
+    1
+   ],
+   "Q": [
+    2,
+    2
+   ],
+   "F": [
+    2,
+    2
+   ],
+   "AC": [
+    3,
+    3
+   ],
+   "W": [
+    3,
+    3
+   ],
+   "RXY": [
+    3,
+    3
+   ],
+   "KP": [
+    4,
+    4
+   ],
+   "XY": [
+    4,
+    4
+   ],
+   "sub": [
+    5,
+    9
+   ],
+   "eq": [
+    5,
+    7
+   ],
+   "LEQ": [
+    9,
+    9
+   ],
+   "NP": [
+    10,
+    11
+   ],
+   "NH": [
+    10,
+    11
+   ],
+   "NM": [
+    7,
+    11
+   ]
+  },
+  "seconds": 629.0
+ },
+ {
+  "A": 12,
+  "fold": false,
+  "states": 16384,
+  "disagree": 0,
+  "halted_not_fixed": 0,
+  "formula_units": 409908,
+  "units": 409908,
+  "edges": 1213312,
+  "depth": 13,
+  "bias_range": [
+   -12,
+   1
+  ],
+  "block_layers": {
+   "P": [
+    1,
+    1
+   ],
+   "HP": [
+    1,
+    1
+   ],
+   "FA": [
+    2,
+    2
+   ],
+   "Q": [
+    2,
+    2
+   ],
+   "F": [
+    3,
+    3
+   ],
+   "PAB": [
+    4,
+    4
+   ],
+   "AC": [
+    4,
+    4
+   ],
+   "W": [
+    5,
+    5
+   ],
+   "RXY": [
+    5,
+    5
+   ],
+   "KP": [
+    6,
+    6
+   ],
+   "XY": [
+    6,
+    6
+   ],
+   "sub": [
+    7,
+    11
+   ],
+   "eq": [
+    7,
+    9
+   ],
+   "LEQ": [
+    11,
+    11
+   ],
+   "NP": [
+    12,
+    13
+   ],
+   "NH": [
+    12,
+    13
+   ],
+   "NM": [
+    9,
+    13
+   ]
+  },
+  "seconds": 316.1
+ },
+ {
+  "A": 12,
+  "fold": true,
+  "states": 16384,
+  "disagree": 0,
+  "halted_not_fixed": 0,
+  "formula_units": null,
+  "units": 401716,
+  "edges": 3863424,
+  "depth": 11,
+  "bias_range": [
+   -13,
+   1
+  ],
+  "block_layers": {
+   "P": [
+    1,
+    1
+   ],
+   "HP": [
+    1,
+    1
+   ],
+   "FA": [
+    1,
+    1
+   ],
+   "Q": [
+    2,
+    2
+   ],
+   "F": [
+    2,
+    2
+   ],
+   "AC": [
+    3,
+    3
+   ],
+   "W": [
+    3,
+    3
+   ],
+   "RXY": [
+    3,
+    3
+   ],
+   "KP": [
+    4,
+    4
+   ],
+   "XY": [
+    4,
+    4
+   ],
+   "sub": [
+    5,
+    9
+   ],
+   "eq": [
+    5,
+    7
+   ],
+   "LEQ": [
+    9,
+    9
+   ],
+   "NP": [
+    10,
+    11
+   ],
+   "NH": [
+    10,
+    11
+   ],
+   "NM": [
+    7,
+    11
+   ]
+  },
+  "seconds": 375.0
+ }
+]

paper/runs/independent_interpreter.json

@@ -0,0 +1,40 @@
+{
+ "hierarchy": {
+  "small_units": 816,
+  "small_state_bits": 131,
+  "fanin2_units": 1403,
+  "signals": 1534,
+  "changed": 35,
+  "records": 1438,
+  "big": {
+   "A": 17,
+   "G": 2088,
+   "b": 62,
+   "span": 1616
+  },
+  "states": 48,
+  "passes": 4,
+  "disagree": 0,
+  "seconds": 5.6
+ },
+ "hosted": {
+  "records": 494,
+  "noops": 41,
+  "tail_noops": true,
+  "decode_matches": true,
+  "recipes": 41,
+  "recipes_ok": 41,
+  "first": {
+   "recipe_len": 9,
+   "out_len": 12,
+   "steps": 83,
+   "passes": 83,
+   "applications": 44358,
+   "ok": true
+  },
+  "random_states": 2000,
+  "random_halting_steps": 297,
+  "random_disagree": 0,
+  "seconds": 20.4
+ }
+}

paper/runs/independent_levelize.json

@@ -0,0 +1,38 @@
+{
+ "depth": 13,
+ "state_bits": 2057,
+ "M": 41967,
+ "nnz": 75501,
+ "max_width": 8210,
+ "identity_like": 24370,
+ "dense_entries": 124165940,
+ "r_H": 144891,
+ "tau": 144996,
+ "ser": 305508,
+ "ser_sha": "c5950d3fec6bcf70e8111586a030d21b2dfa55bd69a1c7fe5f016cb06e7fb523",
+ "sigma_sha": "55c555bd64302190d5bde57ee0cd41b36dac5cf65066d0ed3468567a57e85fa3",
+ "registry": {
+  "halt": [
+   8,
+   1
+  ],
+  "mem": [
+   9,
+   256,
+   8
+  ],
+  "pc": [
+   0,
+   8
+  ]
+ },
+ "io": {
+  "c_eot": 250,
+  "c_rd": 252,
+  "c_rw": 251,
+  "c_wr": 249,
+  "halt_pc": 255,
+  "r_in": 253,
+  "r_out": 254
+ }
+}

paper/runs/independent_neuromorphic.json

@@ -0,0 +1,34 @@
+{
+ "datapath": {
+  "units": 106,
+  "depth": 5,
+  "widths": [
+   48,
+   58,
+   23,
+   23,
+   9
+  ]
+ },
+ "akida": {
+  "backend": "akida 2.19.3",
+  "patterns": 65536,
+  "failures": 0
+ },
+ "lava_vth_16": {
+  "backend": "lava fixed_pt",
+  "vth": 16,
+  "patterns": 4096,
+  "failures": 0,
+  "margin_firing_side": 128,
+  "margin_quiet_side": 0
+ },
+ "lava_vth_17": {
+  "backend": "lava fixed_pt",
+  "vth": 17,
+  "patterns": 4096,
+  "failures": 0,
+  "margin_firing_side": 64,
+  "margin_quiet_side": 64
+ }
+}

paper/runs/independent_noise.json

@@ -0,0 +1,419 @@
+{
+ "exact_self_describing": {
+  "steps": 10000,
+  "halted": 0,
+  "bytes": 1971,
+  "wrong_bytes": 0,
+  "Kstar_first": 8,
+  "Astar_first": 349,
+  "Kstar": 8,
+  "Astar": 349,
+  "head": 1981
+ },
+ "exact_self_reproducing": {
+  "steps": 1664939,
+  "halted": 1,
+  "bytes": 305508,
+  "wrong_bytes": 0,
+  "Kstar_first": 0,
+  "Astar_first": 0,
+  "Kstar": 8,
+  "Astar": 441,
+  "head": 144996
+ },
+ "profile": {
+  "at_one_half": 30890.76275,
+  "at_three_halves": 10399.84975,
+  "at_five_halves": 176.70375,
+  "beyond": 499.68375,
+  "fraction_at_one_half": 0.7360726940214931
+ },
+ "curve": [
+  {
+   "s": 0.02,
+   "r": 1,
+   "deviated": 0,
+   "copies": 256,
+   "T": 3000,
+   "median": null,
+   "exposure": 768000,
+   "rate": 0.0,
+   "profile_bound": 9.442771918931676e-134,
+   "bound_on_count": 7.252048833739527e-128,
+   "rMp": 2.5656078135354018e-133
+  },
+  {
+   "s": 0.04,
+   "r": 1,
+   "deviated": 0,
+   "copies": 256,
+   "T": 3000,
+   "median": null,
+   "exposure": 768000,
+   "rate": 0.0,
+   "profile_bound": 1.1530667492607755e-31,
+   "bound_on_count": 8.855552634322756e-26,
+   "rMp": 3.132890518620101e-31
+  },
+  {
+   "s": 0.06,
+   "r": 1,
+   "deviated": 0,
+   "copies": 256,
+   "T": 3000,
+   "median": null,
+   "exposure": 768000,
+   "rate": 0.0,
+   "profile_bound": 1.2140196453929234e-12,
+   "bound_on_count": 9.323670876617651e-07,
+   "rMp": 3.298499968807918e-12
+  },
+  {
+   "s": 0.08,
+   "r": 1,
+   "deviated": 13,
+   "copies": 256,
+   "T": 4000,
+   "median": 793.0,
+   "exposure": 985633,
+   "rate": 1.3189493452431077e-05,
+   "profile_bound": 6.33959690544171e-06,
+   "bound_on_count": 6.248515916701229,
+   "rMp": 1.7225467833232754e-05
+  },
+  {
+   "s": 0.09,
+   "r": 1,
+   "deviated": 197,
+   "copies": 256,
+   "T": 4000,
+   "median": 1522.0,
+   "exposure": 547019,
+   "rate": 0.00036013374306925354,
+   "profile_bound": 0.00042742505876279367,
+   "bound_on_count": 233.80962821936464,
+   "rMp": 0.001161353542861366
+  },
+  {
+   "s": 0.1,
+   "r": 1,
+   "deviated": 256,
+   "copies": 256,
+   "T": 4000,
+   "median": 93.0,
+   "exposure": 30676,
+   "rate": 0.008345286217238231,
+   "profile_bound": 0.008847495682648844,
+   "bound_on_count": 271.4057775609359,
+   "rMp": 0.024059813034108396
+  },
+  {
+   "s": 0.11,
+   "r": 1,
+   "deviated": 256,
+   "copies": 256,
+   "T": 4000,
+   "median": 10.0,
+   "exposure": 3411,
+   "rate": 0.07505130460275579,
+   "profile_bound": 0.08418094216915373,
+   "bound_on_count": 287.14119373898336,
+   "rMp": 0.2300497758854446
+  },
+  {
+   "s": 0.12,
+   "r": 1,
+   "deviated": 256,
+   "copies": 256,
+   "T": 4000,
+   "median": 2.0,
+   "exposure": 719,
+   "rate": 0.3560500695410292,
+   "profile_bound": 0.47334746680411344,
+   "bound_on_count": 340.33682863215756,
+   "rMp": 1.2971409545186365
+  },
+  {
+   "s": 0.15,
+   "r": 1,
+   "deviated": 256,
+   "copies": 256,
+   "T": 4000,
+   "median": 1.0,
+   "exposure": 256,
+   "rate": 1.0,
+   "profile_bound": 13.037856344852248,
+   "bound_on_count": 3337.6912242821754,
+   "rMp": 36.01275000654335
+  },
+  {
+   "s": 0.2,
+   "r": 1,
+   "deviated": 256,
+   "copies": 256,
+   "T": 4000,
+   "median": 1.0,
+   "exposure": 256,
+   "rate": 1.0,
+   "profile_bound": 188.69310025470685,
+   "bound_on_count": 48305.43366520495,
+   "rMp": 521.2020494536948
+  }
+ ],
+ "curve_s008_seeds": [
+  {
+   "s": 0.08,
+   "r": 1,
+   "deviated": 2,
+   "copies": 256,
+   "T": 4000,
+   "median": 2085.5,
+   "exposure": 1020171,
+   "rate": 1.960455649101964e-06,
+   "profile_bound": 6.339599062688867e-06,
+   "bound_on_count": 6.467475115382364,
+   "rMp": 1.7225467833232754e-05
+  },
+  {
+   "s": 0.08,
+   "r": 1,
+   "deviated": 8,
+   "copies": 256,
+   "T": 4000,
+   "median": 908.5,
+   "exposure": 1001668,
+   "rate": 7.986678220727825e-06,
+   "profile_bound": 6.339598785236791e-06,
+   "bound_on_count": 6.350173236010566,
+   "rMp": 1.7225467833232754e-05
+  },
+  {
+   "s": 0.08,
+   "r": 1,
+   "deviated": 8,
+   "copies": 256,
+   "T": 4000,
+   "median": 1954.5,
+   "exposure": 1008387,
+   "rate": 7.933462053755156e-06,
+   "profile_bound": 6.339601330610503e-06,
+   "bound_on_count": 6.3927715669703336,
+   "rMp": 1.7225467833232754e-05
+  },
+  {
+   "s": 0.08,
+   "r": 1,
+   "deviated": 3,
+   "copies": 256,
+   "T": 4000,
+   "median": 3281.0,
+   "exposure": 1021724,
+   "rate": 2.936213693717677e-06,
+   "profile_bound": 6.339598076523146e-06,
+   "bound_on_count": 6.477319505137535,
+   "rMp": 1.7225467833232754e-05
+  },
+  {
+   "s": 0.08,
+   "r": 1,
+   "deviated": 8,
+   "copies": 256,
+   "T": 4000,
+   "median": 2604.0,
+   "exposure": 1009754,
+   "rate": 7.922721771837498e-06,
+   "profile_bound": 6.339601364521121e-06,
+   "bound_on_count": 6.401437836230659,
+   "rMp": 1.7225467833232754e-05
+  },
+  {
+   "s": 0.08,
+   "r": 1,
+   "deviated": 5,
+   "copies": 256,
+   "T": 4000,
+   "median": 2655.0,
+   "exposure": 1017231,
+   "rate": 4.915304390054963e-06,
+   "profile_bound": 6.339598359797664e-06,
+   "bound_on_count": 6.448835979135338,
+   "rMp": 1.7225467833232754e-05
+  },
+  {
+   "s": 0.08,
+   "r": 1,
+   "deviated": 3,
+   "copies": 256,
+   "T": 4000,
+   "median": 242.0,
+   "exposure": 1016202,
+   "rate": 2.9521689585338346e-06,
+   "profile_bound": 6.339597357778424e-06,
+   "bound_on_count": 6.44231151416915,
+   "rMp": 1.7225467833232754e-05
+  },
+  {
+   "s": 0.08,
+   "r": 1,
+   "deviated": 5,
+   "copies": 256,
+   "T": 4000,
+   "median": 1338.0,
+   "exposure": 1010974,
+   "rate": 4.945725607186733e-06,
+   "profile_bound": 6.339595356770662e-06,
+   "bound_on_count": 6.409166076215863,
+   "rMp": 1.7225467833232754e-05
+  }
+ ],
+ "deviation_N3": [
+  {
+   "s": 0.24,
+   "r": 3,
+   "deviated": 1,
+   "copies": 256,
+   "T": 4000,
+   "median": 1881.0,
+   "exposure": 1021881,
+   "rate": 9.785875263362368e-07,
+   "profile_bound": 1.901879314530951e-05,
+   "bound_on_count": 19.434943358122027,
+   "rMp": 5.167640349969784e-05
+  },
+  {
+   "s": 0.27,
+   "r": 3,
+   "deviated": 71,
+   "copies": 256,
+   "T": 4000,
+   "median": 1985.0,
+   "exposure": 882963,
+   "rate": 8.041107045255578e-05,
+   "profile_bound": 0.0012822653962512223,
+   "bound_on_count": 1132.1929010701679,
+   "rMp": 0.00348406062858411
+  },
+  {
+   "s": 0.3,
+   "r": 3,
+   "deviated": 256,
+   "copies": 256,
+   "T": 4000,
+   "median": 349.0,
+   "exposure": 122498,
+   "rate": 0.0020898300380414376,
+   "profile_bound": 0.02656427119623429,
+   "bound_on_count": 3254.070092996308,
+   "rMp": 0.07217943910232472
+  },
+  {
+   "s": 0.33,
+   "r": 3,
+   "deviated": 256,
+   "copies": 256,
+   "T": 4000,
+   "median": 28.0,
+   "exposure": 10512,
+   "rate": 0.0243531202435312,
+   "profile_bound": 0.2530678549145467,
+   "bound_on_count": 2660.2492908617146,
+   "rMp": 0.6901493276563357
+  }
+ ],
+ "failure_N3": [
+  {
+   "s": 0.27,
+   "failed": 4,
+   "copies": 64,
+   "exposure": 1219247,
+   "rate": 3.2807134239411704e-06
+  },
+  {
+   "s": 0.3,
+   "failed": 63,
+   "copies": 64,
+   "exposure": 296746,
+   "rate": 0.00021230277745951082
+  },
+  {
+   "s": 0.33,
+   "failed": 64,
+   "copies": 64,
+   "exposure": 20935,
+   "rate": 0.003057081442560306
+  },
+  {
+   "s": 0.36,
+   "failed": 64,
+   "copies": 64,
+   "exposure": 2034,
+   "rate": 0.03146509341199607
+  }
+ ],
+ "complete_runs": [
+  {
+   "s": 0.05,
+   "r": 1,
+   "seed": 906,
+   "steps": 1664939,
+   "bytes": 305508,
+   "outcome": "the whole instance"
+  },
+  {
+   "s": 0.1,
+   "r": 1,
+   "seed": 911,
+   "steps": 756,
+   "bytes": 143,
+   "outcome": "a wrong byte"
+  },
+  {
+   "s": 0.15,
+   "r": 1,
+   "seed": 916,
+   "steps": 157,
+   "bytes": 0,
+   "outcome": "the halt bit set"
+  },
+  {
+   "s": 0.2,
+   "r": 1,
+   "seed": 921,
+   "steps": 1,
+   "bytes": 0,
+   "outcome": "the halt bit set"
+  },
+  {
+   "s": 0.1,
+   "r": 3,
+   "seed": 913,
+   "steps": 1664939,
+   "bytes": 305508,
+   "outcome": "the whole instance"
+  },
+  {
+   "s": 0.15,
+   "r": 3,
+   "seed": 918,
+   "steps": 1664939,
+   "bytes": 305508,
+   "outcome": "the whole instance"
+  },
+  {
+   "s": 0.2,
+   "r": 3,
+   "seed": 923,
+   "steps": 1664939,
+   "bytes": 305508,
+   "outcome": "the whole instance"
+  },
+  {
+   "s": 0.25,
+   "r": 3,
+   "seed": 928,
+   "steps": 1664939,
+   "bytes": 305508,
+   "outcome": "the whole instance"
+  }
+ ]
+}

paper/runs/independent_weight_error.json

@@ -0,0 +1,80 @@
+[
+ {
+  "eps": 0,
+  "gamma": 3.0454379339749056e-05,
+  "outcome": "exact for 10000 steps",
+  "seconds": 141.5
+ },
+ {
+  "eps": 0,
+  "gamma": 5.4817882811548304e-05,
+  "outcome": "exact for 10000 steps",
+  "seconds": 97.5
+ },
+ {
+  "eps": 0,
+  "gamma": 9.136313801924717e-05,
+  "outcome": "exact for 10000 steps",
+  "seconds": 88.2
+ },
+ {
+  "eps": 0,
+  "gamma": 0.00024363503471799245,
+  "outcome": "exact for 10000 steps",
+  "seconds": 62.7
+ },
+ {
+  "eps": 0,
+  "gamma": 0.0009745401388719698,
+  "outcome": "exact for 10000 steps",
+  "seconds": 55.4
+ },
+ {
+  "eps": 0,
+  "gamma": 0.003898160555487879,
+  "outcome": "exact for 10000 steps",
+  "seconds": 38.1
+ },
+ {
+  "eps": 0,
+  "gamma": 0.015592642221951517,
+  "outcome": "deviates at step 1",
+  "seconds": 0.0
+ },
+ {
+  "eps": 0.0009765625,
+  "gamma": 1.5227189669874528e-05,
+  "outcome": "exact for 10000 steps",
+  "seconds": 36.9
+ },
+ {
+  "eps": 0.001953125,
+  "gamma": 0,
+  "outcome": "exact for 10000 steps",
+  "seconds": 40.9
+ },
+ {
+  "eps": 0.00390625,
+  "gamma": 0,
+  "outcome": "exact for 10000 steps",
+  "seconds": 42.8
+ },
+ {
+  "eps": 0.015625,
+  "gamma": 0,
+  "outcome": "exact for 10000 steps",
+  "seconds": 39.1
+ },
+ {
+  "eps": 0.0625,
+  "gamma": 0,
+  "outcome": "exact for 10000 steps",
+  "seconds": 31.0
+ },
+ {
+  "eps": 0.25,
+  "gamma": 0,
+  "outcome": "deviates at step 1",
+  "seconds": 0.0
+ }
+]

paper/runs/paper_environment.json

@@ -1,20 +1,20 @@
 {
  "sigma_entries": 88385,
  "sigma_bytes": 160240,
- "sigma_seconds": 0.1279831129941158,
- "build_seconds": 0.09118957800092176,
+ "sigma_seconds": 0.27736951599945314,
+ "build_seconds": 0.25672924499667715,
  "inst_bytes": 305508,
- "inst_seconds": 1.931125996634364e-05,
- "sigma_inverse_seconds": 0.08041474440251477,
+ "inst_seconds": 3.054764005355537e-05,
+ "sigma_inverse_seconds": 0.1788786249991972,
  "lev_units_in": 17598,
  "lev_units_out": 41967,
  "lev_nonzero": 75501,
  "lev_layers": 13,
- "lev_seconds": 2.1859134749975055,
+ "lev_seconds": 3.347311844001524,
  "lev_entries": 124165940,
  "steps": 1664939,
  "emitted_bytes": 305508,
- "reference_seconds": 0.39680202698218636,
+ "reference_seconds": 0.912805063999258,
  "environment_ops": 2248155,
  "network_ops": 69872495013,
  "ratio": 3.217510695133648e-05

paper/runs/paper_fanin2.json

@@ -22,6 +22,6 @@
    "agrees_on_random_inputs": true
   }
  },
- "seconds": 2.961936319974484,
+ "seconds": 7.610988596003153,
  "ok": true
 }

paper/runs/paper_host_family.json

@@ -8,7 +8,7 @@
    "states": 65536,
    "result": "random states: 65536 tested, 0 disagree with SUBLEQ, 0 halt-latch mismatches, 0 halted batches not fixed",
    "ok": true,
-   "seconds": 0.01500199901056476
+   "seconds": 0.042346542002633214
   },
   {
    "A": 4,
@@ -18,7 +18,7 @@
    "states": 65536,
    "result": "random states: 65536 tested, 0 disagree with SUBLEQ, 0 halt-latch mismatches, 0 halted batches not fixed",
    "ok": true,
-   "seconds": 0.03776371100684628
+   "seconds": 0.05908905100659467
   },
   {
    "A": 5,
@@ -28,7 +28,7 @@
    "states": 65536,
    "result": "random states: 65536 tested, 0 disagree with SUBLEQ, 0 halt-latch mismatches, 0 halted batches not fixed",
    "ok": true,
-   "seconds": 0.06280311100999825
+   "seconds": 0.08752579499559943
   },
   {
    "A": 6,
@@ -38,7 +38,7 @@
    "states": 65536,
    "result": "random states: 65536 tested, 0 disagree with SUBLEQ, 0 halt-latch mismatches, 0 halted batches not fixed",
    "ok": true,
-   "seconds": 0.12102672000764869
+   "seconds": 0.15457569500722457
   },
   {
    "A": 7,
@@ -48,7 +48,7 @@
    "states": 65536,
    "result": "random states: 65536 tested, 0 disagree with SUBLEQ, 0 halt-latch mismatches, 0 halted batches not fixed",
    "ok": true,
-   "seconds": 0.3255250339861959
+   "seconds": 0.4722272030048771
   },
   {
    "A": 8,
@@ -58,7 +58,7 @@
    "states": 65536,
    "result": "random states: 65536 tested, 0 disagree with SUBLEQ, 0 halt-latch mismatches, 0 halted batches not fixed",
    "ok": true,
-   "seconds": 0.30383163699298166
+   "seconds": 0.9474435150041245
   },
   {
    "A": 9,
@@ -68,7 +68,7 @@
    "states": 65536,
    "result": "random states: 65536 tested, 0 disagree with SUBLEQ, 0 halt-latch mismatches, 0 halted batches not fixed",
    "ok": true,
-   "seconds": 0.9685272219940089
+   "seconds": 2.029002010007389
   },
   {
    "A": 10,
@@ -78,7 +78,7 @@
    "states": 65536,
    "result": "random states: 65536 tested, 0 disagree with SUBLEQ, 0 halt-latch mismatches, 0 halted batches not fixed",
    "ok": true,
-   "seconds": 1.8736297989962623
+   "seconds": 3.9046387170092203
   },
   {
    "A": 11,
@@ -88,7 +88,7 @@
    "states": 32768,
    "result": "random states: 32768 tested, 0 disagree with SUBLEQ, 0 halt-latch mismatches, 0 halted batches not fixed",
    "ok": true,
-   "seconds": 1.9215046949975658
+   "seconds": 4.922111371997744
   },
   {
    "A": 12,
@@ -98,7 +98,7 @@
    "states": 16384,
    "result": "random states: 16384 tested, 0 disagree with SUBLEQ, 0 halt-latch mismatches, 0 halted batches not fixed",
    "ok": true,
-   "seconds": 2.6124302610114682
+   "seconds": 6.758391187002417
   }
  ],
  "ok": true

paper/runs/paper_host_fold.json

@@ -0,0 +1,135 @@
+{
+ "rows": [
+  {
+   "A": 3,
+   "units": 273,
+   "edges": 931,
+   "depth": 11,
+   "depth_unfolded": 13,
+   "units_unfolded": 289,
+   "edges_unfolded": 723,
+   "states": 65536,
+   "result": "random states: 65536 tested, 0 disagree with SUBLEQ, 0 halt-latch mismatches, 0 halted batches not fixed",
+   "agrees": true,
+   "seconds": 0.0
+  },
+  {
+   "A": 4,
+   "units": 632,
+   "edges": 2648,
+   "depth": 11,
+   "depth_unfolded": 13,
+   "units_unfolded": 664,
+   "edges_unfolded": 1768,
+   "states": 65536,
+   "result": "random states: 65536 tested, 0 disagree with SUBLEQ, 0 halt-latch mismatches, 0 halted batches not fixed",
+   "agrees": true,
+   "seconds": 0.1
+  },
+  {
+   "A": 5,
+   "units": 1456,
+   "edges": 7216,
+   "depth": 11,
+   "depth_unfolded": 13,
+   "units_unfolded": 1520,
+   "edges_unfolded": 4208,
+   "states": 65536,
+   "result": "random states: 65536 tested, 0 disagree with SUBLEQ, 0 halt-latch mismatches, 0 halted batches not fixed",
+   "agrees": true,
+   "seconds": 0.2
+  },
+  {
+   "A": 6,
+   "units": 3337,
+   "edges": 18976,
+   "depth": 11,
+   "depth_unfolded": 13,
+   "units_unfolded": 3465,
+   "edges_unfolded": 9824,
+   "states": 65536,
+   "result": "random states: 65536 tested, 0 disagree with SUBLEQ, 0 halt-latch mismatches, 0 halted batches not fixed",
+   "agrees": true,
+   "seconds": 0.3
+  },
+  {
+   "A": 7,
+   "units": 7587,
+   "edges": 48425,
+   "depth": 11,
+   "depth_unfolded": 13,
+   "units_unfolded": 7843,
+   "edges_unfolded": 22569,
+   "states": 65536,
+   "result": "random states: 65536 tested, 0 disagree with SUBLEQ, 0 halt-latch mismatches, 0 halted batches not fixed",
+   "agrees": true,
+   "seconds": 0.6
+  },
+  {
+   "A": 8,
+   "units": 17086,
+   "edges": 120508,
+   "depth": 11,
+   "depth_unfolded": 13,
+   "units_unfolded": 17598,
+   "edges_unfolded": 51132,
+   "states": 65536,
+   "result": "random states: 65536 tested, 0 disagree with SUBLEQ, 0 halt-latch mismatches, 0 halted batches not fixed",
+   "agrees": true,
+   "seconds": 1.6
+  },
+  {
+   "A": 9,
+   "units": 38106,
+   "edges": 293658,
+   "depth": 11,
+   "depth_unfolded": 13,
+   "units_unfolded": 39130,
+   "edges_unfolded": 114458,
+   "states": 65536,
+   "result": "random states: 65536 tested, 0 disagree with SUBLEQ, 0 halt-latch mismatches, 0 halted batches not fixed",
+   "agrees": true,
+   "seconds": 3.6
+  },
+  {
+   "A": 10,
+   "units": 84215,
+   "edges": 703108,
+   "depth": 11,
+   "depth_unfolded": 13,
+   "units_unfolded": 86263,
+   "edges_unfolded": 253572,
+   "states": 65536,
+   "result": "random states: 65536 tested, 0 disagree with SUBLEQ, 0 halt-latch mismatches, 0 halted batches not fixed",
+   "agrees": true,
+   "seconds": 7.9
+  },
+  {
+   "A": 11,
+   "units": 184597,
+   "edges": 1658619,
+   "depth": 11,
+   "depth_unfolded": 13,
+   "units_unfolded": 188693,
+   "edges_unfolded": 556795,
+   "states": 32768,
+   "result": "random states: 32768 tested, 0 disagree with SUBLEQ, 0 halt-latch mismatches, 0 halted batches not fixed",
+   "agrees": true,
+   "seconds": 12.5
+  },
+  {
+   "A": 12,
+   "units": 401716,
+   "edges": 3863424,
+   "depth": 11,
+   "depth_unfolded": 13,
+   "units_unfolded": 409908,
+   "edges_unfolded": 1213312,
+   "states": 16384,
+   "result": "random states: 16384 tested, 0 disagree with SUBLEQ, 0 halt-latch mismatches, 0 halted batches not fixed",
+   "agrees": true,
+   "seconds": 19.4
+  }
+ ],
+ "all_agree": true
+}

paper/runs/paper_interp.json

@@ -13,22 +13,7 @@
    "halted_not_fixed": 0,
    "counter_wrong": 0,
    "ok": true,
-   "seconds": 2.7823171920026653
-  },
-  {
-   "A": 13,
-   "S": 8192,
-   "G": 33,
-   "banks": 2,
-   "units": 90862,
-   "fields": 576,
-   "fields_wrong": 0,
-   "random": 1024,
-   "random_wrong": 0,
-   "halted_not_fixed": 0,
-   "counter_wrong": 0,
-   "ok": true,
-   "seconds": 9.55269223099458
+   "seconds": 7.045043751000776
   }
  ],
  "ok": true

paper/runs/paper_neuromorphic.json

@@ -1,13 +1,12 @@
 {
  "backend": "Lava 0.10.0, fixed_pt tag (Loihi neuron model)",
  "units": 106,
- "layers": 6,
+ "layers": 5,
  "widths": [
   48,
   58,
   23,
   23,
-  9,
   9
  ],
  "worst_accumulation": 16,
@@ -20,7 +19,7 @@
  "ok": true,
  "akida": {
   "backend": "akida 2.19.3, software backend",
-  "layers": 6,
+  "layers": 5,
   "patterns": 65536,
   "failures": 0,
   "weights_bits": 2,

paper/runs/paper_redundant_bound_r3.json

@@ -1,134 +1,126 @@
 {
  "r": 3,
+ "eps_rel": 1e-20,
+ "warm": 20,
+ "steps": 20000,
  "rows": [
   {
    "sigma": 0.1,
-   "p": 3.6709661993128594e-51,
-   "sigma_link": 2.866515718791946e-07,
-   "converged": true,
-   "second_term_uncapped": 2.13025075311841e-57,
-   "a_max": 3.671774358064498e-51,
-   "a_state_max": 3.670975669925945e-51,
-   "first_term": 1.657595730962774e-94,
-   "second_term": 2.130250753116143e-57,
-   "per_step": 2.130250753116143e-57,
-   "one_step_map_norm": 1.1207102716990636e-69,
-   "G_max": 2.177572163092903e-08,
+   "mean_per_step": 8.62378451004601e-59,
+   "copy_fails_within": 1.724756902009202e-54,
+   "max_per_step": 9.775048270320726e-59,
    "first_order_per_step": 9.243566309193767e-46,
-   "seconds": 44.994851198003744
+   "seconds": 11.711842716002138
   },
   {
    "sigma": 0.15,
-   "p": 7.619853024160593e-24,
-   "sigma_link": 0.00042906033319683735,
-   "converged": true,
-   "second_term_uncapped": 9.96281774740883e-24,
-   "a_max": 1.0137246671296701e-23,
-   "a_state_max": 7.649365999909047e-24,
-   "first_term": 7.1820241657899036e-40,
-   "second_term": 9.962793936252263e-24,
-   "per_step": 9.962793936252263e-24,
-   "one_step_map_norm": 2.121416036030206e-28,
-   "G_max": 0.048788884933895625,
+   "mean_per_step": 4.0163365923558445e-25,
+   "copy_fails_within": 8.032673184711689e-21,
+   "max_per_step": 4.552440693343307e-25,
    "first_order_per_step": 1.9186942311896616e-18,
-   "seconds": 44.644577098995796
+   "seconds": 6.760910181008512
   },
   {
    "sigma": 0.2,
-   "p": 3.19089167291092e-14,
-   "sigma_link": 0.006209665325776139,
-   "converged": true,
-   "second_term_uncapped": 9.84392269671024e-12,
-   "a_max": 1.9232583156861574e-13,
-   "a_state_max": 3.3772509678220235e-14,
-   "first_term": 1.3839563909399713e-20,
-   "second_term": 2.284341310002908e-12,
-   "per_step": 2.284341323842472e-12,
-   "one_step_map_norm": 2.5928274635601137e-13,
-   "G_max": 10.318938219834262,
+   "mean_per_step": 3.594224435004788e-13,
+   "copy_fails_within": 7.188448870009576e-09,
+   "max_per_step": 4.073045627177968e-13,
    "first_order_per_step": 8.034729050223154e-09,
-   "seconds": 44.76692351400561
+   "seconds": 7.53932050599542
   },
   {
    "sigma": 0.22,
-   "p": 4.6099955192965596e-12,
-   "sigma_link": 0.011521310043880927,
-   "converged": true,
-   "second_term_uncapped": 6.1655968721159675e-09,
-   "a_max": 5.2390139649676e-11,
-   "a_state_max": 5.1292274254447534e-12,
-   "first_term": 3.3417127781326887e-16,
-   "second_term": 1.7924312135933292e-09,
-   "per_step": 1.7924315477646071e-09,
-   "one_step_map_norm": 8.005921428622896e-10,
-   "G_max": 36.378198953846095,
+   "mean_per_step": 1.8216161263773102e-10,
+   "copy_fails_within": 3.64323225275462e-06,
+   "max_per_step": 2.0637830182951588e-10,
    "first_order_per_step": 1.1608060917499123e-06,
-   "seconds": 44.5916818560072
+   "seconds": 8.331472831996507
   },
   {
    "sigma": 0.25,
-   "p": 9.865876450377012e-10,
-   "sigma_link": 0.02275013194817922,
-   "converged": true,
-   "second_term_uncapped": 1.2221903683727557e-05,
-   "a_max": 3.464062637574069e-08,
-   "a_state_max": 1.2256411202374905e-09,
-   "first_term": 2.955875675535229e-11,
-   "second_term": 2.101305150682518e-06,
-   "per_step": 2.101334709439273e-06,
-   "one_step_map_norm": 5.554923106754895e-06,
-   "G_max": 160.96107083907205,
+   "mean_per_step": 1.5844223950469426e-07,
+   "copy_fails_within": 0.0031688447900938854,
+   "max_per_step": 1.793891680047805e-07,
    "first_order_per_step": 0.00024842474219578326,
-   "seconds": 44.780106067002635
+   "seconds": 10.571515559990075
   },
   {
    "sigma": 0.27,
-   "p": 1.3836508957768842e-08,
-   "sigma_link": 0.03202354974072154,
-   "converged": true,
-   "second_term_uncapped": 0.0008325628286829023,
-   "a_max": 1.2542660971875762e-06,
-   "a_state_max": 1.896662835974905e-08,
-   "first_term": 1.5422649474591534e-08,
-   "second_term": 9.280154361716902e-05,
-   "per_step": 9.28169662666436e-05,
-   "one_step_map_norm": 0.0004731405980891133,
-   "G_max": 502.241185749977,
+   "mean_per_step": 4.564830837465998e-06,
+   "copy_fails_within": 0.09129661674931996,
+   "max_per_step": 5.164752301158859e-06,
    "first_order_per_step": 0.00348406062858411,
-   "seconds": 44.378902162992745
+   "weighted_per_step": 4.565395070557826e-06,
+   "measured_per_step": 4.04038771560519e-06,
+   "bound_over_measured": 1.1299398453581324,
+   "seconds": 9.429403156012995
   },
   {
    "sigma": 0.3,
-   "p": 2.866515718791946e-07,
-   "sigma_link": 0.0477903522728147,
-   "converged": true,
-   "second_term_uncapped": 0.26158463232188245,
-   "a_max": 0.00011903221609335197,
-   "a_state_max": 5.40858095381371e-07,
-   "first_term": 5.502587076206081e-05,
-   "second_term": 0.01129871498942794,
-   "per_step": 0.011353740860190002,
-   "one_step_map_norm": 0.08616087624087705,
-   "G_max": 9637.91625882214,
+   "mean_per_step": 0.00022503609474087795,
+   "copy_fails_within": 4.500721894817559,
+   "max_per_step": 0.00025420950016006276,
    "first_order_per_step": 0.07217943910232472,
-   "seconds": 45.34780544799287
+   "weighted_per_step": 0.00022623484530688985,
+   "measured_per_step": 0.00021344138662366218,
+   "bound_over_measured": 1.0599389784971036,
+   "seconds": 11.259821197003475
   },
   {
    "sigma": 0.33,
-   "p": 2.740841326345048e-06,
-   "sigma_link": 0.06486701914733445,
-   "converged": false,
+   "mean_per_step": 0.0042965643210881085,
+   "copy_fails_within": 85.93128642176217,
+   "max_per_step": 0.004841570236397044,
    "first_order_per_step": 0.6901493276563357,
-   "seconds": 0.13191196900152136
+   "weighted_per_step": 0.004338162717970295,
+   "measured_per_step": 0.003663003663003663,
+   "bound_over_measured": 1.1843184220058904,
+   "seconds": 13.271249087993056
   },
   {
    "sigma": 0.36,
-   "p": 1.5454296882296004e-05,
-   "sigma_link": 0.08243326987395455,
-   "converged": false,
-   "one_step_map_norm": 103.09080918475902,
+   "mean_per_step": 0.04307517775881877,
+   "copy_fails_within": 861.5035551763755,
+   "max_per_step": 0.04851092063154471,
    "first_order_per_step": 3.8914228635558983,
-   "seconds": 45.01266609299637
+   "weighted_per_step": 0.043002531462667054,
+   "measured_per_step": 0.029250457038391225,
+   "bound_over_measured": 1.4701490443799299,
+   "seconds": 14.450505137006985
+  }
+ ],
+ "whole_run": [
+  {
+   "sigma": 0.2,
+   "steps": 1664939,
+   "halted": true,
+   "sum": 6.13298895984149e-07,
+   "first_order": 0.013377333750149488,
+   "seconds": 1009.8898845410004
+  },
+  {
+   "sigma": 0.22,
+   "steps": 1664939,
+   "halted": true,
+   "sum": 0.00031088108794885024,
+   "first_order": 1.9326713335920072,
+   "seconds": 718.5945065489941
+  },
+  {
+   "sigma": 0.25,
+   "steps": 1664939,
+   "halted": true,
+   "sum": 0.2705024543907856,
+   "first_order": 413.61204184670515,
+   "seconds": 895.1203591780068
+  },
+  {
+   "sigma": 0.27,
+   "steps": 1664939,
+   "halted": true,
+   "sum": 7.796025562214103,
+   "first_order": 5800.7484188942,
+   "seconds": 800.8464757290058
   }
  ]
 }

paper/runs/paper_redundant_r3.json

@@ -25,7 +25,7 @@
  "bias_min": -23,
  "bias_max": 4,
  "max_fanin": 768,
- "build_seconds": 0.3552343150076922,
+ "build_seconds": 1.416611548003857,
  "sigma_roundtrip": true,
  "c_random": "random states: 65536 tested, 0 disagree with SUBLEQ, 0 halt-latch mismatches, 0 halted batches not fixed",
  "c_random_ok": true,

paper/runs/paper_rocq.json

@@ -0,0 +1,22 @@
+{
+ "rocq": "The Rocq Prover, version 9.1.1",
+ "files": 25,
+ "build_seconds": 220.6,
+ "theorems": {
+  "PhysMain.netlist_step": "closed",
+  "PhysFacts.phys_size": "closed",
+  "PhysFacts.phys_ternary": "closed",
+  "NetMain.network_orbit": "closed",
+  "NetMain.network_reproduces": "closed",
+  "Complete.describe_complete": "closed",
+  "PassLemma.machine_pass": "closed",
+  "Run.universal_construction": "closed",
+  "Main.builds_every_image": "closed",
+  "Main.reproduces_forever": "closed",
+  "Main.every_generation": "closed",
+  "SelfRep.self_reproduction": "closed",
+  "SelfRep.second_generation": "closed",
+  "SelfRep.periodic": "closed"
+ },
+ "extraction_identical": true
+}

paper/runs/paper_twohead.json

@@ -0,0 +1,38 @@
+{
+ "records": 133,
+ "bank_bits": 3458,
+ "description_bits": 2930,
+ "description_over_bank": 0.847,
+ "escaped_records": 0,
+ "window_cells_used": 36,
+ "generations": [
+  {
+   "generation": 1,
+   "steps": 920892,
+   "passes": 6924,
+   "kappa": 1,
+   "banks_hold_organism": true,
+   "tapes_hold_description": true
+  },
+  {
+   "generation": 2,
+   "steps": 920892,
+   "passes": 6924,
+   "kappa": 0,
+   "banks_hold_organism": true,
+   "tapes_hold_description": true
+  },
+  {
+   "generation": 3,
+   "steps": 920892,
+   "passes": 6924,
+   "kappa": 1,
+   "banks_hold_organism": true,
+   "tapes_hold_description": true
+  }
+ ],
+ "state_after_generation_3_equals_after_1": true,
+ "sha256_organism": "e798ce81da252d6717b0f99321aa401924637b48fe09558a6590006de2e2ffe1",
+ "sha256_description": "59c917d4b2602b253bbae19d9866869587abea197730197fee8054acc8781d54",
+ "seconds": 23.9
+}

paper/runs/paper_twohead_net.json

@@ -0,0 +1,51 @@
+{
+ "random_states": {
+  "small": {
+   "G": 5,
+   "L": 40,
+   "states": 300,
+   "disagreements": 0
+  },
+  "full": {
+   "G": 133,
+   "L": 2930,
+   "states": 20,
+   "disagreements": 0
+  },
+  "netlist": {
+   "units": 45891,
+   "edges": 99602,
+   "depth": 15,
+   "state_bits": 12837
+  },
+  "seconds": 4.9
+ },
+ "netlist": {
+  "path": "variants/twohead_physics.bin",
+  "bytes": 816896,
+  "sha256": "0b86fbe2da1d67beafb252a445738794f4eb35ad4aa8987030c65d3612aa50fe",
+  "G": 133,
+  "L": 2930,
+  "units": 45891,
+  "edges": 99602,
+  "depth": 15,
+  "state_bits": 12837
+ },
+ "lockstep": {
+  "generations": 3,
+  "output": [
+   "generation 1: 920892 steps; netlist child bank == rho: 1, child description == description: 1",
+   "generation 2: 920892 steps; netlist child bank == rho: 1, child description == description: 1",
+   "generation 3: 920892 steps; netlist child bank == rho: 1, child description == description: 1",
+   "2762676 steps in lockstep, 0 state mismatches"
+  ],
+  "seconds": 322.4
+ },
+ "extraction": {
+  "N": 3458,
+  "L": 2930,
+  "identical": true,
+  "sha256_generator": "0b86fbe2da1d67beafb252a445738794f4eb35ad4aa8987030c65d3612aa50fe",
+  "sha256_rocq": "0b86fbe2da1d67beafb252a445738794f4eb35ad4aa8987030c65d3612aa50fe"
+ }
+}

paper/runs/paper_verify_times.json

@@ -1,75 +1,75 @@
 {
  "tier": 1,
- "total_seconds": 216.7869739710004,
+ "total_seconds": 214.8219217349979,
  "failures": 0,
  "checks": {
   "check_device.py": {
    "ok": true,
-   "seconds": 0.09231512798578478
+   "seconds": 0.14191210998978931
   },
   "check_framing.py": {
    "ok": true,
-   "seconds": 0.17911755401291884
+   "seconds": 0.5073039440030698
+  },
+  "twohead_net.py check": {
+   "ok": true,
+   "seconds": 5.247474653995596
   },
   "check_steps.py": {
    "ok": true,
-   "seconds": 2.2958479310036637
+   "seconds": 5.269182780990377
   },
   "check_optimal.py": {
    "ok": true,
-   "seconds": 3.6308434630045667
+   "seconds": 7.710004391003167
   },
   "check_codec.py": {
    "ok": true,
-   "seconds": 3.947353489988018
+   "seconds": 7.851285790995462
   },
-  "fanin2.py": {
+  "check_sigma.py": {
    "ok": true,
-   "seconds": 4.518770915979985
+   "seconds": 11.03636751799786
   },
-  "check_sigma.py": {
+  "fanin2.py": {
    "ok": true,
-   "seconds": 5.175890774000436
+   "seconds": 12.635428726993268
   },
   "check_environment.py": {
    "ok": true,
-   "seconds": 5.701369293004973
+   "seconds": 12.856029444010346
+  },
+  "check_interp.py": {
+   "ok": true,
+   "seconds": 13.257643950011698
   },
   "check_host.py": {
    "ok": true,
-   "seconds": 6.32508270299877
+   "seconds": 14.019029688002774
   },
   "check_ternarity.py": {
    "ok": true,
-   "seconds": 8.431314966001082
+   "seconds": 15.632652968997718
   },
   "check_host_family.py": {
    "ok": true,
-   "seconds": 10.549088745989138
+   "seconds": 26.31405289299437
   },
-  "check_interp.py": {
+  "check_lev.py": {
    "ok": true,
-   "seconds": 14.438120546983555
+   "seconds": 32.38079876700067
   },
-  "check_lev.py": {
+  "check_host_fold.py": {
    "ok": true,
-   "seconds": 15.03564253100194
+   "seconds": 51.92139666900039
   },
   "check_total.py": {
    "ok": true,
-   "seconds": 96.9719200199761
+   "seconds": 205.5435071989923
   },
   "redundant.py build": {
    "ok": true,
-   "seconds": 129.28355920300237
-  },
-  "check_dependence.py": {
-   "ok": true,
-   "seconds": 194.36693952101632
-  },
-  "check_settle.py": {
-   "ok": true,
-   "seconds": 216.78103429600014
+   "seconds": 214.77837346300657
   }
  }
 }

paper/universal_construction_ternary.pdf

@@ -1,3 +1,3 @@
 version https://git-lfs.github.com/spec/v1
-oid sha256:7fd39d35508b4bb0fe06b400fdfea99d23c4d7a79b39a204fa9d35e3c238d4af
-size 354694
+oid sha256:d05a260a7e12935b1e20bb7bc6e5690f2f29d9c04de210aaa7eb3618ab4280e1
+size 356867

rocq/Abstract.v

@@ -0,0 +1,371 @@
+(* Within one pass, a tape is seen through the cells from its head that the pass may touch
+   and the number of cells it has moved; the program bank through the index of the record
+   in front of it. One step of the physics refines one step of this abstract machine. *)
+From Stdlib Require Import List Bool Arith ZArith Lia.
+Import ListNotations.
+From TH Require Import TwoHead Tapes Iter.
+
+Record atape := mkA { pre : list bool; mv : nat }.
+
+Definition ahd (t : atape) : bool := nth (mv t) (pre t) false.
+Definition awr (t : atape) (v : bool) : atape := mkA (upd (pre t) (mv t) v) (mv t).
+Definition aturn (t : atape) : atape := mkA (pre t) (S (mv t)).
+Definition aok (t : atape) : bool := Nat.ltb (mv t) (length (pre t)).
+
+Record ast := mkAS { aw : list bool; aR : atape; aA : atape; aK : atape; ai : nat; bad : bool }.
+
+Definition acell (t : ast) (x : nat) : bool :=
+  if Nat.eqb x RD then ahd (aR t)
+  else if Nat.eqb x ARM then ahd (aA t)
+  else if Nat.eqb x CPY then ahd (aK t)
+  else wget (aw t) x.
+
+(* an operand with a nonzero weight on a tape cell must lie inside the touched cells *)
+Definition opok (t : ast) (x : nat) (w : Z) : bool :=
+  if Z.eqb w 0 then true
+  else if Nat.eqb x RD then aok (aR t)
+  else if Nat.eqb x ARM then aok (aA t)
+  else if Nat.eqb x CPY then aok (aK t)
+  else true.
+
+Definition astep (rs : list rec) (t : ast) : ast :=
+  match nth_error rs (ai t) with
+  | None => mkAS (aw t) (aR t) (aA t) (aK t) (ai t) true
+  | Some (Rec a0 w0 a1 w1 beta ao) =>
+      let v := Z.leb 0 (w0 * b2z (acell t a0) + w1 * b2z (acell t a1) + beta)%Z in
+      let wn := if Nat.eqb ao RD || Nat.eqb ao ARM || Nat.eqb ao CPY then aw t
+                else upd (aw t) ao v in
+      let A1 := if Nat.eqb ao ARM then awr (aA t) v else aA t in
+      let K1 := if Nat.eqb ao CPY then awr (aK t) v else aK t in
+      let okw := (if Nat.eqb ao ARM then aok (aA t) else true)
+                 && (if Nat.eqb ao CPY then aok (aK t) else true) in
+      let okk := negb (Nat.eqb ao KAPPA) || Nat.eqb (S (ai t)) (length rs) in
+      let A2 := if wget wn AA then aturn A1 else A1 in
+      let R2 := if wget wn AR then aturn (aR t) else aR t in
+      let K2 := if wget wn AC then aturn K1 else K1 in
+      let w2 := upd (upd (upd wn AA false) AR false) AC false in
+      mkAS w2 R2 A2 K2 (S (ai t))
+           (bad t || negb (opok t a0 w0 && opok t a1 w1 && okw && okk))
+  end.
+
+Fixpoint aiter (n : nat) (rs : list rec) (t : ast) : ast :=
+  match n with O => t | S m => aiter m rs (astep rs t) end.
+
+Definition enc (rs : list rec) : list bool := concat (map enc_rec rs).
+
+(* the concrete state s and the abstract state t agree, the roles of the tapes being those
+   of the bank bit k0 *)
+Definition rel (k0 : bool) (rs : list rec) (restR restA restK : list bool) (s : st) (t : ast) : Prop :=
+  (forall x, x <> RD -> x <> ARM -> x <> CPY -> wget (win s) x = wget (aw t) x)
+  /\ length (win s) = 64 /\ length (aw t) = 64
+  /\ contents (if k0 then d1 s else d0 s) = rotn (mv (aR t)) (pre (aR t) ++ restR)
+  /\ contents (if k0 then q0 s else q1 s) = rotn (mv (aA t)) (pre (aA t) ++ restA)
+  /\ contents (if k0 then d0 s else d1 s) = rotn (mv (aK t)) (pre (aK t) ++ restK)
+  /\ contents (if k0 then q1 s else q0 s) = rotn (26 * ai t) (enc rs).
+
+(* ---- facts about the record layout -------------------------------------- *)
+Lemma enc_rec_length : forall r, length (enc_rec r) = 26.
+Proof.
+  intros [a0 w0 a1 w1 beta ao]; unfold enc_rec.
+  assert (Hw : forall w, length (enc_w w) = 2) by
+    (intro w; unfold enc_w; destruct (Z.eqb w 1); [reflexivity|destruct (Z.eqb w (-1)); reflexivity]).
+  assert (Hn : forall k v, length (nat2bits k v) = k) by
+    (induction k as [|k IH]; intro v; simpl; auto).
+  rewrite !length_app, !Hw, !Hn. reflexivity.
+Qed.
+
+Lemma enc_length : forall rs, length (enc rs) = 26 * length rs.
+Proof.
+  induction rs as [|r rs IH]; unfold enc in *; simpl; auto.
+  rewrite length_app, enc_rec_length, IH. lia.
+Qed.
+
+Lemma enc_app : forall a b, enc (a ++ b) = enc a ++ enc b.
+Proof. intros a b; unfold enc. rewrite map_app, concat_app. reflexivity. Qed.
+
+Lemma rotn_plus : forall a b l, rotn (a + b) l = rotn b (rotn a l).
+Proof. induction a as [|a IH]; intros b l; simpl; auto. Qed.
+
+Lemma rotn_rec : forall rs i r, nth_error rs i = Some r ->
+  firstn 26 (rotn (26 * i) (enc rs)) = enc_rec r.
+Proof.
+  intros rs i r H.
+  destruct (nth_error_split rs i H) as (l1 & l2 & -> & Hl).
+  rewrite enc_app.
+  assert (E : enc (r :: l2) = enc_rec r ++ enc l2) by reflexivity.
+  rewrite E.
+  replace (26 * i) with (length (enc l1)) by (rewrite enc_length; lia).
+  rewrite rotn_app, <- app_assoc.
+  rewrite firstn_app, enc_rec_length, Nat.sub_diag, firstn_O, app_nil_r.
+  apply firstn_all2. rewrite enc_rec_length. lia.
+Qed.
+
+(* ---- one step of the physics, unfolded ----------------------------------- *)
+Definition cellof (s : st) (k : bool) (a : nat) : bool :=
+  if Nat.eqb a RD then hd_t (if k then d1 s else d0 s)
+  else if Nat.eqb a ARM then hd_t (if k then q0 s else q1 s)
+  else if Nat.eqb a CPY then hd_t (if k then d0 s else d1 s)
+  else wget (win s) a.
+
+Definition wnext (w : list bool) (ao : nat) (v : bool) : list bool :=
+  if Nat.eqb ao RD || Nat.eqb ao ARM || Nat.eqb ao CPY then w else upd w ao v.
+
+Definition clearq (w : list bool) : list bool := upd (upd (upd w AA false) AR false) AC false.
+
+Definition stepres (s : st) (k : bool) (qa' : tape) (ao : nat) (v : bool) : st :=
+  let qi := if k then q0 s else q1 s in
+  let da := if k then d1 s else d0 s in
+  let di := if k then d0 s else d1 s in
+  let wn := wnext (win s) ao v in
+  let qi1 := if Nat.eqb ao ARM then wr_t qi v else qi in
+  let di1 := if Nat.eqb ao CPY then wr_t di v else di in
+  let qi2 := if wget wn AA then turn1 qi1 else qi1 in
+  let da2 := if wget wn AR then turn1 da else da in
+  let di2 := if wget wn AC then turn1 di1 else di1 in
+  if k then mkS (clearq wn) qi2 qa' di2 da2 else mkS (clearq wn) qa' qi2 da2 di2.
+
+Lemma step_char : forall s k bits qa' a0 w0 a1 w1 beta ao v,
+  wget (win s) KAPPA = k ->
+  popn 26 (if k then q1 s else q0 s) = (bits, qa') ->
+  decode bits = Rec a0 w0 a1 w1 beta ao ->
+  v = Z.leb 0 (w0 * b2z (cellof s k a0) + w1 * b2z (cellof s k a1) + beta)%Z ->
+  step s = stepres s k qa' ao v.
+Proof.
+  intros s k bits qa' a0 w0 a1 w1 beta ao v Hk Hp Hd Hv.
+  unfold step, stepres, cellof, wnext, clearq. cbv zeta. rewrite Hk, Hp, Hd. subst v. reflexivity.
+Qed.
+
+Definition astepres (rs : list rec) (t : ast) (a0 : nat) (w0 : Z) (a1 : nat) (w1 : Z) (ao : nat) (v : bool) : ast :=
+  let wn := wnext (aw t) ao v in
+  let A1 := if Nat.eqb ao ARM then awr (aA t) v else aA t in
+  let K1 := if Nat.eqb ao CPY then awr (aK t) v else aK t in
+  let okw := (if Nat.eqb ao ARM then aok (aA t) else true)
+             && (if Nat.eqb ao CPY then aok (aK t) else true) in
+  let okk := negb (Nat.eqb ao KAPPA) || Nat.eqb (S (ai t)) (length rs) in
+  let A2 := if wget wn AA then aturn A1 else A1 in
+  let R2 := if wget wn AR then aturn (aR t) else aR t in
+  let K2 := if wget wn AC then aturn K1 else K1 in
+  mkAS (clearq wn) R2 A2 K2 (S (ai t))
+       (bad t || negb (opok t a0 w0 && opok t a1 w1 && okw && okk)).
+
+Lemma astep_char : forall rs t a0 w0 a1 w1 beta ao,
+  nth_error rs (ai t) = Some (Rec a0 w0 a1 w1 beta ao) ->
+  astep rs t = astepres rs t a0 w0 a1 w1 ao
+                 (Z.leb 0 (w0 * b2z (acell t a0) + w1 * b2z (acell t a1) + beta)%Z).
+Proof. intros rs t a0 w0 a1 w1 beta ao H. unfold astep, astepres, wnext, clearq. rewrite H. reflexivity. Qed.
+
+(* ---- windows -------------------------------------------------------------- *)
+Lemma wget_upd : forall w i v x,
+  wget (upd w i v) x = if Nat.eqb x i && Nat.ltb i (length w) then v else wget w x.
+Proof.
+  unfold wget. induction w as [|y w IH]; intros i v x.
+  - simpl. rewrite andb_false_r. destruct x; reflexivity.
+  - destruct i as [|i], x as [|x]; simpl; try reflexivity; rewrite IH; reflexivity.
+Qed.
+
+Definition agree (w w' : list bool) : Prop :=
+  forall x, x <> RD -> x <> ARM -> x <> CPY -> wget w x = wget w' x.
+
+Lemma agree_upd : forall w w' i v, agree w w' -> length w = length w' ->
+  agree (upd w i v) (upd w' i v).
+Proof.
+  intros w w' i v H Hl x H1 H2 H3. rewrite !wget_upd, Hl.
+  destruct (Nat.eqb x i && Nat.ltb i (length w')); auto.
+Qed.
+
+Lemma b2z_mul0 : forall b, (0 * b2z b = 0)%Z.
+Proof. intros [|]; reflexivity. Qed.
+
+Lemma rotn_length : forall n l, length (rotn n l) = length l.
+Proof. induction n as [|n IH]; intro l; simpl; auto. rewrite IH, rot1_length. reflexivity. Qed.
+
+(* reading the head of a related tape *)
+Lemma hd_rel : forall tc ta rest, contents tc = rotn (mv ta) (pre ta ++ rest) ->
+  aok ta = true -> hd_t tc = ahd ta.
+Proof.
+  intros tc ta rest H Hok. unfold aok in Hok. apply Nat.ltb_lt in Hok.
+  rewrite hd_t_contents, H. apply hd_rotn_prefix. exact Hok.
+Qed.
+
+(* writing then turning a related tape *)
+Lemma wr_rel : forall tc ta rest v, contents tc = rotn (mv ta) (pre ta ++ rest) ->
+  aok ta = true -> contents (wr_t tc v) = rotn (mv (awr ta v)) (pre (awr ta v) ++ rest).
+Proof.
+  intros tc ta rest v H Hok. unfold aok in Hok. apply Nat.ltb_lt in Hok.
+  rewrite wr_t_contents, H. simpl. apply wr_rotn_prefix. exact Hok.
+Qed.
+
+Lemma turn_rel : forall tc ta rest, contents tc = rotn (mv ta) (pre ta ++ rest) ->
+  contents (turn1 tc) = rotn (mv (aturn ta)) (pre (aturn ta) ++ rest).
+Proof. intros tc ta rest H. rewrite turn1_contents, H. simpl. apply rotn_S. Qed.
+
+Lemma operand_eq : forall (cc : nat -> bool) t a w,
+  opok t a w = true ->
+  (forall x, x <> RD -> x <> ARM -> x <> CPY -> cc x = wget (aw t) x) ->
+  (aok (aR t) = true -> cc RD = ahd (aR t)) ->
+  (aok (aA t) = true -> cc ARM = ahd (aA t)) ->
+  (aok (aK t) = true -> cc CPY = ahd (aK t)) ->
+  (w * b2z (cc a) = w * b2z (acell t a))%Z.
+Proof.
+  intros cc t a w Hok Hw HR HA HK. unfold opok in Hok. unfold acell.
+  destruct (Z.eqb w 0) eqn:Ew; [apply Z.eqb_eq in Ew; subst; reflexivity|].
+  destruct (Nat.eqb a RD) eqn:E1; [apply Nat.eqb_eq in E1; subst; rewrite HR; auto|].
+  destruct (Nat.eqb a ARM) eqn:E2; [apply Nat.eqb_eq in E2; subst; rewrite HA; auto|].
+  destruct (Nat.eqb a CPY) eqn:E3; [apply Nat.eqb_eq in E3; subst; rewrite HK; auto|].
+  apply Nat.eqb_neq in E1, E2, E3. rewrite Hw; auto.
+Qed.
+
+Lemma length_wnext : forall w ao v, length (wnext w ao v) = length w.
+Proof. intros w ao v; unfold wnext. destruct (_ || _ || _); auto using upd_length. Qed.
+
+Lemma length_clearq : forall w, length (clearq w) = length w.
+Proof. intro w; unfold clearq. rewrite !upd_length. reflexivity. Qed.
+
+Lemma agree_wnext : forall w w' ao v, agree w w' -> length w = length w' ->
+  agree (wnext w ao v) (wnext w' ao v).
+Proof. intros w w' ao v H Hl; unfold wnext. destruct (_ || _ || _); auto using agree_upd. Qed.
+
+Lemma agree_clearq : forall w w', agree w w' -> length w = length w' -> agree (clearq w) (clearq w').
+Proof.
+  intros w w' H Hl; unfold clearq.
+  repeat (apply agree_upd; [|rewrite ?upd_length; auto]). exact H.
+Qed.
+
+Lemma wget_clearq_other : forall w x, x <> AA -> x <> AR -> x <> AC -> wget (clearq w) x = wget w x.
+Proof.
+  intros w x H1 H2 H3; unfold clearq. rewrite !wget_upd.
+  rewrite (proj2 (Nat.eqb_neq _ _) H1), (proj2 (Nat.eqb_neq _ _) H2), (proj2 (Nat.eqb_neq _ _) H3).
+  reflexivity.
+Qed.
+
+Lemma wget_wnext_other : forall w ao v x, x <> ao -> wget (wnext w ao v) x = wget w x.
+Proof.
+  intros w ao v x H; unfold wnext. destruct (_ || _ || _); auto.
+  rewrite wget_upd, (proj2 (Nat.eqb_neq _ _) H). reflexivity.
+Qed.
+
+Lemma tape_after : forall tc ta rest (wr tn : bool) v,
+  contents tc = rotn (mv ta) (pre ta ++ rest) ->
+  (wr = true -> aok ta = true) ->
+  contents (if tn then turn1 (if wr then wr_t tc v else tc) else (if wr then wr_t tc v else tc))
+  = rotn (mv (if tn then aturn (if wr then awr ta v else ta) else (if wr then awr ta v else ta)))
+         (pre (if tn then aturn (if wr then awr ta v else ta) else (if wr then awr ta v else ta)) ++ rest).
+Proof.
+  intros tc ta rest wr tn v H Hok.
+  destruct wr, tn; try apply turn_rel; try apply wr_rel; auto.
+Qed.
+
+Lemma tape_turn : forall tc ta rest (tn : bool),
+  contents tc = rotn (mv ta) (pre ta ++ rest) ->
+  contents (if tn then turn1 tc else tc)
+  = rotn (mv (if tn then aturn ta else ta)) (pre (if tn then aturn ta else ta) ++ rest).
+Proof. intros tc ta rest tn H; destruct tn; [apply turn_rel|]; exact H. Qed.
+
+Lemma step_refines : forall k0 rs restR restA restK s t,
+  Forall (fun r => decode (enc_rec r) = r) rs ->
+  rel k0 rs restR restA restK s t ->
+  wget (win s) KAPPA = k0 ->
+  ai t < length rs ->
+  bad (astep rs t) = false ->
+  rel k0 rs restR restA restK (step s) (astep rs t)
+  /\ (S (ai t) < length rs -> wget (win (step s)) KAPPA = k0).
+Proof.
+  intros k0 rs restR restA restK s t Hdec Hrel Hk Hi Hbad.
+  destruct Hrel as (Hw & Hls & Hlt & HR & HA & HK & HQ).
+  destruct (nth_error rs (ai t)) as [r|] eqn:Er.
+  2:{ apply nth_error_None in Er. lia. }
+  assert (Hdr : decode (enc_rec r) = r).
+  { rewrite Forall_forall in Hdec. apply Hdec. eapply nth_error_In. exact Er. }
+  destruct (popn 26 (if k0 then q1 s else q0 s)) as [bits qa'] eqn:Ep.
+  assert (Hlq : length (contents (if k0 then q1 s else q0 s)) = 26 * length rs)
+    by (rewrite HQ, rotn_length, enc_length; reflexivity).
+  assert (Hbits : bits = enc_rec r).
+  { pose proof (popn_reads 26 (if k0 then q1 s else q0 s)) as P. rewrite Ep in P. cbn [fst snd] in P.
+    rewrite P by lia. rewrite HQ. apply rotn_rec. exact Er. }
+  assert (Hqa' : contents qa' = rotn (26 * S (ai t)) (enc rs)).
+  { pose proof (popn_turns 26 (if k0 then q1 s else q0 s)) as P. rewrite Ep in P. cbn [fst snd] in P.
+    rewrite P, HQ, <- rotn_plus. f_equal. lia. }
+  subst bits. destruct r as [a0 w0 a1 w1 beta ao].
+  set (va := Z.leb 0 (w0 * b2z (acell t a0) + w1 * b2z (acell t a1) + beta)%Z).
+  rewrite (astep_char rs t a0 w0 a1 w1 beta ao Er) in *.
+  unfold astepres in Hbad. cbv zeta in Hbad. cbn [bad] in Hbad.
+  apply orb_false_iff in Hbad as [Hb0 Hb]. apply negb_false_iff in Hb.
+  apply andb_prop in Hb as [Hb Hokk]. apply andb_prop in Hb as [Hb Hokw].
+  apply andb_prop in Hb as [Hop0 Hop1].
+  assert (Hc : forall x w, opok t x w = true -> (w * b2z (cellof s k0 x) = w * b2z (acell t x))%Z).
+  { intros x w Hx. apply operand_eq; auto.
+    - intros y H1 H2 H3. unfold cellof.
+      rewrite (proj2 (Nat.eqb_neq _ _) H1), (proj2 (Nat.eqb_neq _ _) H2), (proj2 (Nat.eqb_neq _ _) H3).
+      apply Hw; auto.
+    - intro H. unfold cellof. simpl. eapply hd_rel; eauto.
+    - intro H. unfold cellof. simpl. eapply hd_rel; eauto.
+    - intro H. unfold cellof. simpl. eapply hd_rel; eauto. }
+  assert (Hvc : va = Z.leb 0 (w0 * b2z (cellof s k0 a0) + w1 * b2z (cellof s k0 a1) + beta)%Z).
+  { unfold va. rewrite (Hc a0 w0 Hop0), (Hc a1 w1 Hop1). reflexivity. }
+  rewrite (step_char s k0 _ qa' a0 w0 a1 w1 beta ao va Hk Ep Hdr Hvc).
+  assert (Hl2 : length (win s) = length (aw t)) by congruence.
+  assert (Hag : agree (wnext (win s) ao va) (wnext (aw t) ao va)) by (apply agree_wnext; auto).
+  assert (HAA : wget (wnext (win s) ao va) AA = wget (wnext (aw t) ao va) AA) by (apply Hag; discriminate).
+  assert (HAR : wget (wnext (win s) ao va) AR = wget (wnext (aw t) ao va) AR) by (apply Hag; discriminate).
+  assert (HAC : wget (wnext (win s) ao va) AC = wget (wnext (aw t) ao va) AC) by (apply Hag; discriminate).
+  assert (OkA : Nat.eqb ao ARM = true -> aok (aA t) = true).
+  { intro E. rewrite E in Hokw. apply andb_prop in Hokw as [H _]. exact H. }
+  assert (OkK : Nat.eqb ao CPY = true -> aok (aK t) = true).
+  { intro E. rewrite E in Hokw. apply andb_prop in Hokw as [_ H]. exact H. }
+  unfold stepres, astepres. cbv zeta. rewrite HAA, HAR, HAC.
+  split.
+  - unfold rel. destruct k0; cbn [d0 d1 q0 q1 win aw aR aA aK ai];
+      refine (conj _ (conj _ (conj _ (conj _ (conj _ (conj _ _)))))).
+    all: first
+      [ exact Hqa'
+      | rewrite length_clearq, length_wnext; assumption
+      | apply tape_turn; assumption
+      | apply tape_after; assumption
+      | change (agree (clearq (wnext (win s) ao va)) (clearq (wnext (aw t) ao va)));
+        apply agree_clearq; [exact Hag | rewrite !length_wnext; exact Hl2] ].
+  - intro Hlt'. destruct (Nat.eqb ao KAPPA) eqn:Eao.
+    + rewrite ?Eao in Hokk. cbn [negb orb] in Hokk. apply Nat.eqb_eq in Hokk. lia.
+    + apply Nat.eqb_neq in Eao.
+      destruct k0; cbn [win]; rewrite wget_clearq_other by discriminate;
+        rewrite wget_wnext_other by congruence; exact Hk.
+Qed.
+
+Lemma bad_mono : forall n rs t, bad t = true -> bad (aiter n rs t) = true.
+Proof.
+  induction n as [|n IH]; intros rs t H; cbn [aiter]; auto.
+  apply IH. unfold astep. destruct (nth_error rs (ai t)) as [[a0 w0 a1 w1 beta ao]|].
+  - cbn [bad]. rewrite H. reflexivity.
+  - reflexivity.
+Qed.
+
+Lemma astep_ai : forall rs t, ai t < length rs -> ai (astep rs t) = S (ai t).
+Proof.
+  intros rs t H. unfold astep. destruct (nth_error rs (ai t)) as [[a0 w0 a1 w1 beta ao]|] eqn:E.
+  - reflexivity.
+  - apply nth_error_None in E. lia.
+Qed.
+
+Lemma pass_refines : forall n k0 rs restR restA restK s t,
+  Forall (fun r => decode (enc_rec r) = r) rs ->
+  rel k0 rs restR restA restK s t ->
+  wget (win s) KAPPA = k0 ->
+  ai t + n <= length rs ->
+  bad (aiter n rs t) = false ->
+  rel k0 rs restR restA restK (itern n s) (aiter n rs t).
+Proof.
+  induction n as [|n IH]; intros k0 rs restR restA restK s t Hdec Hrel Hk Hn Hbad.
+  - exact Hrel.
+  - cbn [itern aiter] in *.
+    assert (Hb1 : bad (astep rs t) = false).
+    { destruct (bad (astep rs t)) eqn:E; auto. rewrite (bad_mono n rs _ E) in Hbad. discriminate. }
+    destruct (step_refines k0 rs restR restA restK s t Hdec Hrel Hk ltac:(lia) Hb1) as [Hr Hk'].
+    destruct n as [|n'].
+    + exact Hr.
+    + apply IH; auto.
+      * apply Hk'. lia.
+      * rewrite astep_ai by lia. lia.
+Qed.
+
+(* after a whole pass the program bank is back where it started *)
+Lemma bank_full : forall rs, rotn (26 * length rs) (enc rs) = enc rs.
+Proof. intro rs. rewrite <- enc_length. apply rotn_full. Qed.

rocq/Assumptions.v

@@ -0,0 +1,17 @@
+(* The assumptions of the main theorems, printed by src/check_rocq.py after the build. *)
+From TH Require Import PhysMain PhysFacts NetMain Complete Run PassLemma Main SelfRep.
+
+Print Assumptions PhysMain.netlist_step.
+Print Assumptions PhysFacts.phys_size.
+Print Assumptions PhysFacts.phys_ternary.
+Print Assumptions NetMain.network_orbit.
+Print Assumptions NetMain.network_reproduces.
+Print Assumptions Complete.describe_complete.
+Print Assumptions PassLemma.machine_pass.
+Print Assumptions Run.universal_construction.
+Print Assumptions Main.builds_every_image.
+Print Assumptions Main.reproduces_forever.
+Print Assumptions Main.every_generation.
+Print Assumptions SelfRep.self_reproduction.
+Print Assumptions SelfRep.second_generation.
+Print Assumptions SelfRep.periodic.

rocq/Complete.v

@@ -0,0 +1,103 @@
+(* Every record image has a description: translate inverts describe. *)
+From Stdlib Require Import List Bool Arith Lia.
+Import ListNotations.
+From TH Require Import TwoHead Decoder.
+
+Definition seg (r : list bool) : list bool :=
+  match find_codon candidates (firstn 8 r) with
+  | Some c => c ++ skipn 8 r
+  | None => ESC ++ r
+  end.
+
+Lemma describe_eq : forall X, describe X = concat (map seg (chunks (length X) X)) ++ ENDC.
+Proof. reflexivity. Qed.
+
+Lemma find_codon_some : forall cs g c, find_codon cs g = Some c ->
+  exists k a b, In (k, a, b) cs /\ gate_bits k a b = g /\ c = codon_bits k a b.
+Proof.
+  induction cs as [|[[k a] b] cs IH]; intros g c H; cbn [find_codon] in H; [discriminate|].
+  destruct (lbeq (gate_bits k a b) g) eqn:E.
+  - apply some_inj in H. subst c. exists k, a, b.
+    split; [left; reflexivity|]. split; [apply lbeq_true; exact E | reflexivity].
+  - destruct (IH g c H) as (k' & a' & b' & Hin & Hg & Hc).
+    exists k', a', b'. split; [right; exact Hin|]. split; assumption.
+Qed.
+
+Lemma candidates_kind : forall k a b, In (k, a, b) candidates -> k <= 2.
+Proof.
+  intros k a b H. unfold candidates in H.
+  repeat (destruct H as [H|H]; [injection H as <- <- <-; lia|]). destruct H.
+Qed.
+
+Lemma translate_codon : forall f k a b X, k <= 2 ->
+  translate_aux (S f) (codon_bits k a b ++ X)
+  = option_map (fun t => gate_bits k a b ++ firstn 18 X ++ t) (translate_aux f (skipn 18 X)).
+Proof.
+  intros f k a b X Hk. unfold codon_bits. cbn [app]. rewrite translate_aux_S.
+  destruct k as [|[|[|k]]]; [| | | lia]; cbn [Nat.eqb orb andb]; reflexivity.
+Qed.
+
+Lemma translate_esc : forall f r rest, length r = 26 ->
+  translate_aux (S f) (ESC ++ r ++ rest) = option_map (fun t => r ++ t) (translate_aux f rest).
+Proof.
+  intros f r rest Hr. unfold ESC. cbn [app]. rewrite translate_aux_S. cbn [andb].
+  replace (Nat.eqb (length (r ++ rest)) 0) with false
+    by (symmetry; apply Nat.eqb_neq; rewrite length_app; lia).
+  rewrite (firstn_app_exact r rest 26 Hr), (skipn_app_exact r rest 26 Hr). reflexivity.
+Qed.
+
+Lemma seg_translate : forall f r rest, length r = 26 ->
+  translate_aux (S f) (seg r ++ rest) = option_map (fun t => r ++ t) (translate_aux f rest).
+Proof.
+  intros f r rest Hr. unfold seg.
+  destruct (find_codon candidates (firstn 8 r)) as [c|] eqn:Ef.
+  - destruct (find_codon_some _ _ _ Ef) as (k & a & b & Hin & Hg & ->).
+    assert (H18 : length (skipn 8 r) = 18) by (rewrite length_skipn; lia).
+    rewrite <- app_assoc, translate_codon by exact (candidates_kind k a b Hin).
+    rewrite (firstn_app_exact _ rest 18 H18), (skipn_app_exact _ rest 18 H18), Hg.
+    destruct (translate_aux f rest) as [t|]; cbn [option_map]; [|reflexivity].
+    rewrite app_assoc, firstn_skipn. reflexivity.
+  - rewrite <- app_assoc. apply translate_esc. exact Hr.
+Qed.
+
+Lemma seg_long : forall r, 1 <= length (seg r).
+Proof.
+  intro r. unfold seg. destruct (find_codon candidates (firstn 8 r)) as [c|] eqn:Ef.
+  - destruct (find_codon_some _ _ _ Ef) as (k & a & b & _ & _ & ->).
+    rewrite length_app. unfold codon_bits. cbn [length]. lia.
+  - unfold ESC. rewrite length_app. cbn [length]. lia.
+Qed.
+
+Lemma chunks_S : forall f l, l <> [] -> chunks (S f) l = firstn 26 l :: chunks f (skipn 26 l).
+Proof. intros f [|x l] H; [congruence|reflexivity]. Qed.
+
+Lemma chunks_nil : forall f, chunks f [] = [].
+Proof. intros [|f]; reflexivity. Qed.
+
+Lemma describe_aux : forall n X f f', length X = 26 * n -> n <= f ->
+  length (concat (map seg (chunks f X)) ++ ENDC) <= f' ->
+  translate_aux f' (concat (map seg (chunks f X)) ++ ENDC) = Some X.
+Proof.
+  induction n as [|n IH]; intros X f f' HX Hf Hf'.
+  - destruct X; [|discriminate]. rewrite chunks_nil in *. cbn [map concat app] in *.
+    destruct f' as [|f']; [cbn [length ENDC] in Hf'; lia|].
+    unfold ENDC. rewrite translate_aux_S. reflexivity.
+  - destruct f as [|f]; [lia|].
+    destruct (split_at X 26 ltac:(lia)) as (r & X' & -> & Hr).
+    rewrite length_app, Hr in HX.
+    assert (Hne : r ++ X' <> []) by (destruct r; [discriminate | intro H; discriminate]).
+    rewrite chunks_S in Hf' |- * by exact Hne.
+    rewrite (firstn_app_exact r X' 26 Hr), (skipn_app_exact r X' 26 Hr) in Hf' |- *.
+    cbn [map concat] in Hf' |- *. rewrite <- app_assoc in Hf' |- *.
+    rewrite length_app in Hf'. pose proof (seg_long r).
+    destruct f' as [|f']; [lia|].
+    rewrite seg_translate by exact Hr.
+    rewrite (IH X' f f') by lia. reflexivity.
+Qed.
+
+(* Every image of n records has the description describe X, which translate reads back. *)
+Theorem describe_complete : forall X n, length X = 26 * n -> translate (describe X) = Some X.
+Proof.
+  intros X n HX. unfold translate. rewrite describe_eq.
+  apply describe_aux with (n := n); [exact HX | lia | lia].
+Qed.

rocq/Decoder.v

@@ -0,0 +1,579 @@
+(* The pass of the spec iterated on whole tapes: the read tape R, the arm A and the copy
+   tape K, each listed from its head. *)
+From Stdlib Require Import List Bool Arith Lia.
+Import ListNotations.
+From TH Require Import TwoHead Tapes Spec.
+
+Record dst := mkD { dc : cfg; dk : bool; dR : list bool; dA : list bool; dK : list bool }.
+
+Definition dstep (t : dst) : dst :=
+  let r := hd false (dR t) in
+  let o := dpass (dc t) (dk t) r in
+  mkD (ncf o) (nk o)
+      (if cons o then rot1 (dR t) else dR t)
+      (if emit o then rot1 (av o :: tl (dA t)) else dA t)
+      (if cw o then rot1 (r :: tl (dK t)) else dK t).
+
+Fixpoint dsteps (n : nat) (t : dst) : dst :=
+  match n with O => t | S m => dsteps m (dstep t) end.
+
+Lemma dsteps_S : forall n t, dsteps (S n) t = dsteps n (dstep t).
+Proof. reflexivity. Qed.
+
+Lemma dsteps_add : forall a b t, dsteps (a + b) t = dsteps b (dsteps a t).
+Proof. induction a as [|a IH]; intros b t; cbn [dsteps Nat.add]; auto. Qed.
+
+Lemma rot1_cons_app : forall (b : bool) l1 l2, rot1 (b :: l1 ++ l2) = l1 ++ (l2 ++ [b]).
+Proof. intros. cbn [rot1]. rewrite app_assoc. reflexivity. Qed.
+
+Lemma tl_app_ne : forall (U W : list bool), U <> [] -> tl (U ++ W) = tl U ++ W.
+Proof. intros [|u U] W H; [congruence|reflexivity]. Qed.
+
+(* one pass, the tapes written as what lies ahead of the head and what lies behind it *)
+Lemma dstep_eq : forall cf k b rest done U W V C o,
+  o = dpass cf k b ->
+  (emit o = true -> U <> []) -> (cw o = true -> V <> []) ->
+  dstep (mkD cf k ((b :: rest) ++ done) (U ++ W) (V ++ C))
+  = mkD (ncf o) (nk o)
+        (if cons o then rest ++ (done ++ [b]) else (b :: rest) ++ done)
+        (if emit o then tl U ++ (W ++ [av o]) else U ++ W)
+        (if cw o then tl V ++ (C ++ [b]) else V ++ C).
+Proof.
+  intros cf k b rest done U W V C o Eo HU HV.
+  unfold dstep. cbn [dc dk dR dA dK]. change (hd false ((b :: rest) ++ done)) with b.
+  rewrite <- Eo. f_equal.
+  - destruct (cons o); [|reflexivity]. cbn [app]. apply rot1_cons_app.
+  - destruct (emit o); [|reflexivity]. rewrite tl_app_ne by (apply HU; reflexivity).
+    apply rot1_cons_app.
+  - destruct (cw o); [|reflexivity]. rewrite tl_app_ne by (apply HV; reflexivity).
+    apply rot1_cons_app.
+Qed.
+
+(* ---- one pass in each phase ---------------------------------------------- *)
+Lemma pass_PA : forall n e3 e2 e1 e0 m k b R A K,
+  dstep (mkD (mkC PA n e3 e2 e1 e0 m) k (b :: R) A K)
+  = mkD (if Nat.eqb n 0 then mkC PC 3 e3 e2 e1 e0 m else mkC PA (n - 1) e3 e2 e1 e0 m) k
+        (R ++ [b])
+        (if m then A else rot1 (b :: tl A))
+        (if m then rot1 (b :: tl K) else K).
+Proof.
+  intros. unfold dstep. cbn [dc dk dR dA dK hd].
+  unfold dpass. cbn [ph Spec.z Spec.c3 Spec.c2 Spec.c1 Spec.c0 mo ncf nk cons emit av cw rot1].
+  destruct (Nat.eqb n 0); destruct m; reflexivity.
+Qed.
+
+Lemma pass_PG : forall n e3 e2 e1 e0 m k R A K,
+  dstep (mkD (mkC PG n e3 e2 e1 e0 m) k R A K)
+  = let e := is_esc e3 e2 e1 e0 in
+    let a := if e then hd false R else table e3 e2 e1 e0 n in
+    mkD (if Nat.eqb n 0 then mkC PA 17 e3 e2 e1 e0 m else mkC PG (n - 1) e3 e2 e1 e0 m) k
+        (if e then rot1 R else R)
+        (if m then A else rot1 (a :: tl A))
+        (if m && e then rot1 (hd false R :: tl K) else K).
+Proof.
+  intros. unfold dstep. cbn [dc dk dR dA dK].
+  unfold dpass. cbn [ph Spec.z Spec.c3 Spec.c2 Spec.c1 Spec.c0 mo ncf nk cons emit av cw].
+  destruct (Nat.eqb n 0); destruct m; reflexivity.
+Qed.
+
+Lemma pass_PC : forall n e3 e2 e1 e0 m k b R A K,
+  dstep (mkD (mkC PC n e3 e2 e1 e0 m) k (b :: R) A K)
+  = mkD (if Nat.eqb n 0 then
+           (if is_end e2 e1 e0 b then mkC PC 3 e2 e1 e0 b (negb m)
+            else if negb m || is_esc e2 e1 e0 b then mkC PG 7 e2 e1 e0 b m
+            else mkC PA 17 e2 e1 e0 b m)
+         else mkC PC (n - 1) e2 e1 e0 b m)
+        (if Nat.eqb n 0 then (if is_end e2 e1 e0 b then xorb k m else k) else k)
+        (R ++ [b]) A
+        (if m then rot1 (b :: tl K) else K).
+Proof.
+  intros. unfold dstep. cbn [dc dk dR dA dK hd].
+  unfold dpass. cbn [ph Spec.z Spec.c3 Spec.c2 Spec.c1 Spec.c0 mo ncf nk cons emit av cw rot1].
+  destruct (Nat.eqb n 0); [|destruct m; reflexivity].
+  destruct (is_end e2 e1 e0 b); [destruct m; reflexivity|].
+  destruct (negb m || is_esc e2 e1 e0 b); destruct m; reflexivity.
+Qed.
+
+(* ---- the phases ---------------------------------------------------------- *)
+Fixpoint down (n : nat) : list nat := match n with O => [0] | S m => n :: down m end.
+
+Lemma pa_construct : forall n e3 e2 e1 e0 k bs rest done U W K,
+  length bs = S n -> S n <= length U ->
+  dsteps (S n) (mkD (mkC PA n e3 e2 e1 e0 false) k (bs ++ rest ++ done) (U ++ W) K)
+  = mkD (mkC PC 3 e3 e2 e1 e0 false) k (rest ++ done ++ bs) (skipn (S n) U ++ W ++ bs) K.
+Proof.
+  induction n as [|n IH]; intros e3 e2 e1 e0 k bs rest done U W K Hb HU;
+    (destruct bs as [|b bs]; [discriminate|]);
+    (destruct U as [|u U]; [cbn in HU; lia|]);
+    rewrite dsteps_S; cbn [app]; rewrite pass_PA; cbn [Nat.eqb tl rot1].
+  - destruct bs; [|discriminate]. cbn [dsteps skipn app]. rewrite <- !app_assoc. reflexivity.
+  - replace (S n - 1) with n by lia. rewrite <- !app_assoc.
+    rewrite IH by (cbn in Hb, HU; lia).
+    cbn [skipn]. rewrite <- !app_assoc. reflexivity.
+Qed.
+
+Lemma pa_copy : forall n e3 e2 e1 e0 k bs rest done A V C,
+  length bs = S n -> S n <= length V ->
+  dsteps (S n) (mkD (mkC PA n e3 e2 e1 e0 true) k (bs ++ rest ++ done) A (V ++ C))
+  = mkD (mkC PC 3 e3 e2 e1 e0 true) k (rest ++ done ++ bs) A (skipn (S n) V ++ C ++ bs).
+Proof.
+  induction n as [|n IH]; intros e3 e2 e1 e0 k bs rest done A V C Hb HV;
+    (destruct bs as [|b bs]; [discriminate|]);
+    (destruct V as [|v V]; [cbn in HV; lia|]);
+    rewrite dsteps_S; cbn [app]; rewrite pass_PA; cbn [Nat.eqb tl rot1].
+  - destruct bs; [|discriminate]. cbn [dsteps skipn app]. rewrite <- !app_assoc. reflexivity.
+  - replace (S n - 1) with n by lia. rewrite <- !app_assoc.
+    rewrite IH by (cbn in Hb, HV; lia).
+    cbn [skipn]. rewrite <- !app_assoc. reflexivity.
+Qed.
+
+Lemma pg_gate : forall n e3 e2 e1 e0 k R U W K,
+  is_esc e3 e2 e1 e0 = false -> S n <= length U ->
+  dsteps (S n) (mkD (mkC PG n e3 e2 e1 e0 false) k R (U ++ W) K)
+  = mkD (mkC PA 17 e3 e2 e1 e0 false) k R
+        (skipn (S n) U ++ W ++ map (table e3 e2 e1 e0) (down n)) K.
+Proof.
+  induction n as [|n IH]; intros e3 e2 e1 e0 k R U W K He HU;
+    (destruct U as [|u U]; [cbn in HU; lia|]);
+    rewrite dsteps_S; rewrite pass_PG; cbv zeta; rewrite He; cbn [Nat.eqb andb app tl rot1].
+  - cbn [dsteps skipn down map]. rewrite <- !app_assoc. reflexivity.
+  - replace (S n - 1) with n by lia. rewrite <- !app_assoc.
+    rewrite IH by (auto; cbn in HU; lia).
+    cbn [skipn down map]. rewrite <- !app_assoc. reflexivity.
+Qed.
+
+Lemma pg_esc_construct : forall n e3 e2 e1 e0 k bs rest done U W K,
+  is_esc e3 e2 e1 e0 = true -> length bs = S n -> S n <= length U ->
+  dsteps (S n) (mkD (mkC PG n e3 e2 e1 e0 false) k (bs ++ rest ++ done) (U ++ W) K)
+  = mkD (mkC PA 17 e3 e2 e1 e0 false) k (rest ++ done ++ bs) (skipn (S n) U ++ W ++ bs) K.
+Proof.
+  induction n as [|n IH]; intros e3 e2 e1 e0 k bs rest done U W K He Hb HU;
+    (destruct bs as [|b bs]; [discriminate|]);
+    (destruct U as [|u U]; [cbn in HU; lia|]);
+    rewrite dsteps_S; rewrite pass_PG; cbv zeta; rewrite He; cbn [Nat.eqb andb app tl hd rot1].
+  - destruct bs; [|discriminate]. cbn [dsteps skipn app]. rewrite <- !app_assoc. reflexivity.
+  - replace (S n - 1) with n by lia. rewrite <- !app_assoc.
+    rewrite IH by (auto; cbn in Hb, HU; lia).
+    cbn [skipn]. rewrite <- !app_assoc. reflexivity.
+Qed.
+
+Lemma pg_esc_copy : forall n e3 e2 e1 e0 k bs rest done A V C,
+  is_esc e3 e2 e1 e0 = true -> length bs = S n -> S n <= length V ->
+  dsteps (S n) (mkD (mkC PG n e3 e2 e1 e0 true) k (bs ++ rest ++ done) A (V ++ C))
+  = mkD (mkC PA 17 e3 e2 e1 e0 true) k (rest ++ done ++ bs) A (skipn (S n) V ++ C ++ bs).
+Proof.
+  induction n as [|n IH]; intros e3 e2 e1 e0 k bs rest done A V C He Hb HV;
+    (destruct bs as [|b bs]; [discriminate|]);
+    (destruct V as [|v V]; [cbn in HV; lia|]);
+    rewrite dsteps_S; rewrite pass_PG; cbv zeta; rewrite He; cbn [Nat.eqb andb app tl hd rot1].
+  - destruct bs; [|discriminate]. cbn [dsteps skipn app]. rewrite <- !app_assoc. reflexivity.
+  - replace (S n - 1) with n by lia. rewrite <- !app_assoc.
+    rewrite IH by (auto; cbn in Hb, HV; lia).
+    cbn [skipn]. rewrite <- !app_assoc. reflexivity.
+Qed.
+
+Definition dispatch (e3 e2 e1 e0 m : bool) : cfg :=
+  if is_end e3 e2 e1 e0 then mkC PC 3 e3 e2 e1 e0 (negb m)
+  else if negb m || is_esc e3 e2 e1 e0 then mkC PG 7 e3 e2 e1 e0 m
+  else mkC PA 17 e3 e2 e1 e0 m.
+
+Lemma pc_construct : forall b3 b2 b1 b0 k e3 e2 e1 e0 rest done A K,
+  dsteps 4 (mkD (mkC PC 3 b3 b2 b1 b0 false) k ([e3; e2; e1; e0] ++ rest ++ done) A K)
+  = mkD (dispatch e3 e2 e1 e0 false) k (rest ++ done ++ [e3; e2; e1; e0]) A K.
+Proof.
+  intros. cbn [dsteps app].
+  rewrite pass_PC. cbn [Nat.eqb Nat.sub app]. rewrite pass_PC. cbn [Nat.eqb Nat.sub app].
+  rewrite pass_PC. cbn [Nat.eqb Nat.sub app]. rewrite pass_PC. cbn [Nat.eqb Nat.sub app].
+  rewrite <- !app_assoc. cbn [app]. unfold dispatch.
+  destruct (is_end e3 e2 e1 e0); [rewrite xorb_false_r|]; reflexivity.
+Qed.
+
+Lemma pc_copy : forall b3 b2 b1 b0 k e3 e2 e1 e0 rest done A V C,
+  4 <= length V ->
+  dsteps 4 (mkD (mkC PC 3 b3 b2 b1 b0 true) k ([e3; e2; e1; e0] ++ rest ++ done) A (V ++ C))
+  = mkD (dispatch e3 e2 e1 e0 true) (if is_end e3 e2 e1 e0 then negb k else k)
+        (rest ++ done ++ [e3; e2; e1; e0]) A (skipn 4 V ++ C ++ [e3; e2; e1; e0]).
+Proof.
+  intros b3 b2 b1 b0 k e3 e2 e1 e0 rest done A V C HV.
+  destruct V as [|v1 [|v2 [|v3 [|v4 V]]]]; cbn in HV; try lia.
+  cbn [dsteps app].
+  rewrite pass_PC. cbn [Nat.eqb Nat.sub app tl rot1]. rewrite pass_PC. cbn [Nat.eqb Nat.sub app tl rot1].
+  rewrite pass_PC. cbn [Nat.eqb Nat.sub app tl rot1]. rewrite pass_PC. cbn [Nat.eqb Nat.sub app tl rot1].
+  rewrite <- !app_assoc. cbn [app skipn]. unfold dispatch.
+  destruct (is_end e3 e2 e1 e0); [rewrite xorb_true_r|]; reflexivity.
+Qed.
+
+(* ---- the bank bit changes only on a pass from PC with z = 0 ---------------- *)
+Definition stable (k : bool) (n : nat) (t : dst) : Prop := forall j, j < n -> dk (dsteps j t) = k.
+
+Lemma stable_add : forall k a b t, stable k a t -> stable k b (dsteps a t) -> stable k (a + b) t.
+Proof.
+  intros k a b t Ha Hb j Hj. destruct (Nat.lt_ge_cases j a) as [H|H]; [apply Ha; exact H|].
+  replace j with (a + (j - a)) by lia. rewrite dsteps_add. apply Hb. lia.
+Qed.
+
+Lemma stable_eq : forall k n t t', t = t' -> stable k n t' -> stable k n t.
+Proof. intros; subst; assumption. Qed.
+
+Lemma step_loop : forall p n e3 e2 e1 e0 m k R A K,
+  p <> PC ->
+  dk (dstep (mkD (mkC p (S n) e3 e2 e1 e0 m) k R A K)) = k
+  /\ dc (dstep (mkD (mkC p (S n) e3 e2 e1 e0 m) k R A K)) = mkC p n e3 e2 e1 e0 m.
+Proof.
+  intros p n e3 e2 e1 e0 m k R A K Hp. unfold dstep, dpass.
+  cbn [dc dk ph Spec.z Spec.c3 Spec.c2 Spec.c1 Spec.c0 mo ncf nk Nat.eqb].
+  destruct p; [congruence| |]; cbn [ncf nk]; replace (S n - 1) with n by lia; split; reflexivity.
+Qed.
+
+Lemma stable_loop : forall n p e3 e2 e1 e0 m k R A K,
+  p <> PC -> stable k (S n) (mkD (mkC p n e3 e2 e1 e0 m) k R A K).
+Proof.
+  induction n as [|n IH]; intros p e3 e2 e1 e0 m k R A K Hp j Hj.
+  - replace j with 0 by lia. reflexivity.
+  - destruct j as [|j]; [reflexivity|]. rewrite dsteps_S.
+    destruct (step_loop p n e3 e2 e1 e0 m k R A K Hp) as [Hk Hc].
+    destruct (dstep (mkD (mkC p (S n) e3 e2 e1 e0 m) k R A K)) as [c k' R' A' K'].
+    cbn [dk dc] in Hk, Hc. subst c k'. apply IH; [exact Hp | lia].
+Qed.
+
+Lemma step_pc : forall n e3 e2 e1 e0 m k R A K,
+  dk (dstep (mkD (mkC PC (S n) e3 e2 e1 e0 m) k R A K)) = k
+  /\ dc (dstep (mkD (mkC PC (S n) e3 e2 e1 e0 m) k R A K)) = mkC PC n e2 e1 e0 (hd false R) m.
+Proof.
+  intros. unfold dstep, dpass.
+  cbn [dc dk ph Spec.z Spec.c3 Spec.c2 Spec.c1 Spec.c0 mo ncf nk Nat.eqb].
+  replace (S n - 1) with n by lia. split; reflexivity.
+Qed.
+
+Lemma stable_pc : forall n e3 e2 e1 e0 m k R A K,
+  stable k (S n) (mkD (mkC PC n e3 e2 e1 e0 m) k R A K).
+Proof.
+  induction n as [|n IH]; intros e3 e2 e1 e0 m k R A K j Hj.
+  - replace j with 0 by lia. reflexivity.
+  - destruct j as [|j]; [reflexivity|]. rewrite dsteps_S.
+    destruct (step_pc n e3 e2 e1 e0 m k R A K) as [Hk Hc].
+    destruct (dstep (mkD (mkC PC (S n) e3 e2 e1 e0 m) k R A K)) as [c k' R' A' K'].
+    cbn [dk dc] in Hk, Hc. subst c k'. apply IH. lia.
+Qed.
+
+(* ---- one record of the description, and its end ------------------------------ *)
+Definition kind_of (e3 e2 : bool) : nat := if e3 then 2 else if e2 then 1 else 0.
+
+Lemma table_gate : forall e3 e2 s0 s1, e3 && e2 = false ->
+  map (table e3 e2 s0 s1) (down 7) = gate_bits (kind_of e3 e2) s0 s1.
+Proof. intros [] [] [] [] H; try discriminate; reflexivity. Qed.
+
+Lemma app_assoc4 : forall (a b c d : list bool), (a ++ b) ++ c ++ d = a ++ b ++ c ++ d.
+Proof. intros. rewrite <- app_assoc. reflexivity. Qed.
+
+Lemma seg_gate : forall b3 b2 b1 b0 k e3 e2 s0 s1 addr rest done U W K,
+  e3 && e2 = false -> length addr = 18 -> 26 <= length U ->
+  stable k 30 (mkD (mkC PC 3 b3 b2 b1 b0 false) k ((e3 :: e2 :: s0 :: s1 :: addr ++ rest) ++ done) (U ++ W) K)
+  /\ dsteps 30 (mkD (mkC PC 3 b3 b2 b1 b0 false) k ((e3 :: e2 :: s0 :: s1 :: addr ++ rest) ++ done) (U ++ W) K)
+     = mkD (mkC PC 3 e3 e2 s0 s1 false) k (rest ++ done ++ [e3; e2; s0; s1] ++ addr)
+           (skipn 26 U ++ W ++ gate_bits (kind_of e3 e2) s0 s1 ++ addr) K.
+Proof.
+  intros b3 b2 b1 b0 k e3 e2 s0 s1 addr rest done U W K H32 Ha HU.
+  change ((e3 :: e2 :: s0 :: s1 :: addr ++ rest) ++ done) with ([e3; e2; s0; s1] ++ (addr ++ rest) ++ done).
+  assert (Hd : dispatch e3 e2 s0 s1 false = mkC PG 7 e3 e2 s0 s1 false)
+    by (unfold dispatch, is_end, is_esc; rewrite H32; reflexivity).
+  assert (He : is_esc e3 e2 s0 s1 = false) by (unfold is_esc; rewrite H32; reflexivity).
+  pose proof (pc_construct b3 b2 b1 b0 k e3 e2 s0 s1 (addr ++ rest) done (U ++ W) K) as P1.
+  rewrite Hd in P1.
+  pose proof (pg_gate 7 e3 e2 s0 s1 k ((addr ++ rest) ++ done ++ [e3; e2; s0; s1]) U W K He
+                ltac:(lia)) as P2.
+  rewrite table_gate in P2 by exact H32.
+  pose proof (pa_construct 17 e3 e2 s0 s1 k addr rest (done ++ [e3; e2; s0; s1]) (skipn 8 U)
+                (W ++ gate_bits (kind_of e3 e2) s0 s1) K Ha ltac:(rewrite length_skipn; lia)) as P3.
+  replace 30 with (4 + (8 + 18)) by reflexivity.
+  split.
+  - apply stable_add; [apply stable_pc|]. rewrite P1.
+    apply stable_add; [apply stable_loop; discriminate|]. rewrite P2.
+    apply stable_loop; discriminate.
+  - rewrite !dsteps_add, P1, P2, app_assoc4, P3. rewrite skipn_skipn.
+    rewrite <- !app_assoc. reflexivity.
+Qed.
+
+Lemma seg_esc : forall b3 b2 b1 b0 k s0 s1 lit addr rest done U W K,
+  s0 && s1 = false -> length lit = 8 -> length addr = 18 -> 26 <= length U ->
+  stable k 30 (mkD (mkC PC 3 b3 b2 b1 b0 false) k
+                   ((true :: true :: s0 :: s1 :: lit ++ addr ++ rest) ++ done) (U ++ W) K)
+  /\ dsteps 30 (mkD (mkC PC 3 b3 b2 b1 b0 false) k
+                    ((true :: true :: s0 :: s1 :: lit ++ addr ++ rest) ++ done) (U ++ W) K)
+     = mkD (mkC PC 3 true true s0 s1 false) k (rest ++ done ++ [true; true; s0; s1] ++ lit ++ addr)
+           (skipn 26 U ++ W ++ lit ++ addr) K.
+Proof.
+  intros b3 b2 b1 b0 k s0 s1 lit addr rest done U W K Hs Hl Ha HU.
+  change ((true :: true :: s0 :: s1 :: lit ++ addr ++ rest) ++ done)
+    with ([true; true; s0; s1] ++ (lit ++ addr ++ rest) ++ done).
+  assert (Hd : dispatch true true s0 s1 false = mkC PG 7 true true s0 s1 false)
+    by (unfold dispatch, is_end, is_esc; cbn [andb]; rewrite Hs; reflexivity).
+  assert (He : is_esc true true s0 s1 = true) by (unfold is_esc; cbn [andb]; rewrite Hs; reflexivity).
+  pose proof (pc_construct b3 b2 b1 b0 k true true s0 s1 (lit ++ addr ++ rest) done (U ++ W) K) as P1.
+  rewrite Hd in P1.
+  pose proof (pg_esc_construct 7 true true s0 s1 k lit (addr ++ rest) (done ++ [true; true; s0; s1])
+                U W K He Hl ltac:(lia)) as P2.
+  pose proof (pa_construct 17 true true s0 s1 k addr rest ((done ++ [true; true; s0; s1]) ++ lit)
+                (skipn 8 U) (W ++ lit) K Ha ltac:(rewrite length_skipn; lia)) as P3.
+  replace 30 with (4 + (8 + 18)) by reflexivity.
+  split.
+  - apply stable_add; [apply stable_pc|]. rewrite P1, app_assoc4.
+    apply stable_add; [apply stable_loop; discriminate|]. rewrite P2.
+    apply stable_loop; discriminate.
+  - rewrite !dsteps_add, P1, app_assoc4, P2, app_assoc4, P3. rewrite skipn_skipn.
+    rewrite <- !app_assoc. reflexivity.
+Qed.
+
+Lemma seg_end : forall b3 b2 b1 b0 k done A K,
+  stable k 4 (mkD (mkC PC 3 b3 b2 b1 b0 false) k ([true; true; true; true] ++ done) A K)
+  /\ dsteps 4 (mkD (mkC PC 3 b3 b2 b1 b0 false) k ([true; true; true; true] ++ done) A K)
+     = mkD (mkC PC 3 true true true true true) k (done ++ [true; true; true; true]) A K.
+Proof.
+  intros. split; [apply stable_pc|].
+  change ([true; true; true; true] ++ done) with ([true; true; true; true] ++ [] ++ done).
+  rewrite pc_construct. reflexivity.
+Qed.
+
+Lemma seg_copy_gate : forall b3 b2 b1 b0 k e3 e2 s0 s1 addr rest done A V C,
+  e3 && e2 = false -> length addr = 18 -> 22 <= length V ->
+  stable k 22 (mkD (mkC PC 3 b3 b2 b1 b0 true) k ((e3 :: e2 :: s0 :: s1 :: addr ++ rest) ++ done) A (V ++ C))
+  /\ dsteps 22 (mkD (mkC PC 3 b3 b2 b1 b0 true) k ((e3 :: e2 :: s0 :: s1 :: addr ++ rest) ++ done) A (V ++ C))
+     = mkD (mkC PC 3 e3 e2 s0 s1 true) k (rest ++ done ++ [e3; e2; s0; s1] ++ addr)
+           A (skipn 22 V ++ C ++ [e3; e2; s0; s1] ++ addr).
+Proof.
+  intros b3 b2 b1 b0 k e3 e2 s0 s1 addr rest done A V C H32 Ha HV.
+  change ((e3 :: e2 :: s0 :: s1 :: addr ++ rest) ++ done) with ([e3; e2; s0; s1] ++ (addr ++ rest) ++ done).
+  assert (Hd : dispatch e3 e2 s0 s1 true = mkC PA 17 e3 e2 s0 s1 true)
+    by (unfold dispatch, is_end, is_esc; rewrite H32; reflexivity).
+  assert (Hn : is_end e3 e2 s0 s1 = false) by (unfold is_end; rewrite H32; reflexivity).
+  pose proof (pc_copy b3 b2 b1 b0 k e3 e2 s0 s1 (addr ++ rest) done A V C ltac:(lia)) as P1.
+  rewrite Hd, Hn in P1.
+  pose proof (pa_copy 17 e3 e2 s0 s1 k addr rest (done ++ [e3; e2; s0; s1]) A (skipn 4 V)
+                (C ++ [e3; e2; s0; s1]) Ha ltac:(rewrite length_skipn; lia)) as P2.
+  replace 22 with (4 + 18) by reflexivity.
+  split.
+  - apply stable_add; [apply stable_pc|]. rewrite P1. apply stable_loop; discriminate.
+  - rewrite !dsteps_add, P1, app_assoc4, P2. rewrite skipn_skipn.
+    rewrite <- !app_assoc. reflexivity.
+Qed.
+
+Lemma seg_copy_esc : forall b3 b2 b1 b0 k s0 s1 lit addr rest done A V C,
+  s0 && s1 = false -> length lit = 8 -> length addr = 18 -> 30 <= length V ->
+  stable k 30 (mkD (mkC PC 3 b3 b2 b1 b0 true) k
+                   ((true :: true :: s0 :: s1 :: lit ++ addr ++ rest) ++ done) A (V ++ C))
+  /\ dsteps 30 (mkD (mkC PC 3 b3 b2 b1 b0 true) k
+                    ((true :: true :: s0 :: s1 :: lit ++ addr ++ rest) ++ done) A (V ++ C))
+     = mkD (mkC PC 3 true true s0 s1 true) k (rest ++ done ++ [true; true; s0; s1] ++ lit ++ addr)
+           A (skipn 30 V ++ C ++ [true; true; s0; s1] ++ lit ++ addr).
+Proof.
+  intros b3 b2 b1 b0 k s0 s1 lit addr rest done A V C Hs Hl Ha HV.
+  change ((true :: true :: s0 :: s1 :: lit ++ addr ++ rest) ++ done)
+    with ([true; true; s0; s1] ++ (lit ++ addr ++ rest) ++ done).
+  assert (Hd : dispatch true true s0 s1 true = mkC PG 7 true true s0 s1 true)
+    by (unfold dispatch, is_end, is_esc; cbn [andb]; rewrite Hs; reflexivity).
+  assert (Hn : is_end true true s0 s1 = false) by (unfold is_end; cbn [andb]; exact Hs).
+  assert (He : is_esc true true s0 s1 = true) by (unfold is_esc; cbn [andb]; rewrite Hs; reflexivity).
+  pose proof (pc_copy b3 b2 b1 b0 k true true s0 s1 (lit ++ addr ++ rest) done A V C ltac:(lia)) as P1.
+  rewrite Hd, Hn in P1.
+  pose proof (pg_esc_copy 7 true true s0 s1 k lit (addr ++ rest) (done ++ [true; true; s0; s1])
+                A (skipn 4 V) (C ++ [true; true; s0; s1]) He Hl ltac:(rewrite length_skipn; lia)) as P2.
+  pose proof (pa_copy 17 true true s0 s1 k addr rest ((done ++ [true; true; s0; s1]) ++ lit) A
+                (skipn 8 (skipn 4 V)) ((C ++ [true; true; s0; s1]) ++ lit) Ha
+                ltac:(rewrite !length_skipn; lia)) as P3.
+  replace 30 with (4 + (8 + 18)) by reflexivity.
+  split.
+  - apply stable_add; [apply stable_pc|]. rewrite P1, app_assoc4.
+    apply stable_add; [apply stable_loop; discriminate|]. rewrite P2.
+    apply stable_loop; discriminate.
+  - rewrite !dsteps_add, P1, app_assoc4, P2, app_assoc4, P3. rewrite !skipn_skipn.
+    rewrite <- !app_assoc. reflexivity.
+Qed.
+
+Lemma seg_copy_end : forall b3 b2 b1 b0 k done A V C,
+  4 <= length V ->
+  stable k 4 (mkD (mkC PC 3 b3 b2 b1 b0 true) k ([true; true; true; true] ++ done) A (V ++ C))
+  /\ dsteps 4 (mkD (mkC PC 3 b3 b2 b1 b0 true) k ([true; true; true; true] ++ done) A (V ++ C))
+     = mkD (mkC PC 3 true true true true false) (negb k) (done ++ [true; true; true; true])
+           A (skipn 4 V ++ C ++ [true; true; true; true]).
+Proof.
+  intros b3 b2 b1 b0 k done A V C HV. split; [apply stable_pc|].
+  change ([true; true; true; true] ++ done) with ([true; true; true; true] ++ [] ++ done).
+  rewrite pc_copy by exact HV. reflexivity.
+Qed.
+
+(* ---- the description read in construct mode ------------------------------------ *)
+Lemma translate_aux_long : forall f l X, translate_aux f l = Some X -> 4 <= length l.
+Proof.
+  intros [|f] l X H; [discriminate|]. cbn [translate_aux] in H.
+  destruct l as [|a [|b [|c [|d l]]]]; try discriminate. cbn [length]. lia.
+Qed.
+
+Lemma translate_aux_S : forall f c3 c2 s0 s1 rest,
+  translate_aux (S f) (c3 :: c2 :: s0 :: s1 :: rest) =
+  if c3 && c2 then
+    if s0 && s1 then match rest with [] => Some [] | _ => None end
+    else if Nat.eqb (length rest) 0 then None
+    else option_map (fun t => firstn 26 rest ++ t) (translate_aux f (skipn 26 rest))
+  else option_map (fun t => gate_bits (if c3 then 2 else if c2 then 1 else 0) s0 s1 ++ firstn 18 rest ++ t)
+                  (translate_aux f (skipn 18 rest)).
+Proof. reflexivity. Qed.
+
+Lemma some_inj : forall (A : Type) (a b : A), Some a = Some b -> a = b.
+Proof. intros A a b H. injection H. auto. Qed.
+
+Lemma split_at : forall (l : list bool) n, n <= length l -> exists a c, l = a ++ c /\ length a = n.
+Proof.
+  intros l n H. exists (firstn n l), (skipn n l). split; [symmetry; apply firstn_skipn|].
+  apply firstn_length_le. exact H.
+Qed.
+
+Lemma skipn_app_exact : forall (a b : list bool) n, length a = n -> skipn n (a ++ b) = b.
+Proof. intros a b n <-. induction a as [|x a IH]; [reflexivity|]. exact IH. Qed.
+
+Lemma firstn_app_exact : forall (a b : list bool) n, length a = n -> firstn n (a ++ b) = a.
+Proof.
+  intros a b n <-. induction a as [|x a IH]; [reflexivity|]. cbn [length firstn app].
+  rewrite IH. reflexivity.
+Qed.
+
+Lemma construct_phase : forall f rest Xr done U W K k b3 b2 b1 b0,
+  translate_aux f rest = Some Xr -> length U = length Xr ->
+  exists nrec, length Xr = 26 * nrec
+    /\ stable k (30 * nrec + 4) (mkD (mkC PC 3 b3 b2 b1 b0 false) k (rest ++ done) (U ++ W) K)
+    /\ dsteps (30 * nrec + 4) (mkD (mkC PC 3 b3 b2 b1 b0 false) k (rest ++ done) (U ++ W) K)
+       = mkD (mkC PC 3 true true true true true) k (done ++ rest) (W ++ Xr) K.
+Proof.
+  induction f as [|f IH]; intros rest Xr done U W K k b3 b2 b1 b0 Ht HU; [discriminate|].
+  destruct rest as [|e3 [|e2 [|s0 [|s1 rest1]]]]; try discriminate.
+  rewrite translate_aux_S in Ht.
+  destruct (e3 && e2) eqn:E32.
+  - apply andb_prop in E32 as [-> ->].
+    destruct (s0 && s1) eqn:Es.
+    + (* the end codon *)
+      destruct rest1; [|discriminate]. apply some_inj in Ht. subst Xr.
+      apply andb_prop in Es as [-> ->].
+      destruct U; [|discriminate].
+      exists 0. replace (30 * 0 + 4) with 4 by reflexivity.
+      rewrite app_nil_l, app_nil_r. split; [reflexivity|].
+      exact (seg_end b3 b2 b1 b0 k done W K).
+    + (* an escaped record *)
+      destruct (Nat.eqb (length rest1) 0) eqn:El; [discriminate|].
+      destruct (translate_aux f (skipn 26 rest1)) as [X'|] eqn:Ht'; [|discriminate].
+      cbn [option_map] in Ht. apply some_inj in Ht. subst Xr.
+      pose proof (translate_aux_long _ _ _ Ht') as Hlong. rewrite length_skipn in Hlong.
+      destruct (split_at rest1 8 ltac:(lia)) as (lit & r1 & -> & Hl).
+      destruct (split_at r1 18 ltac:(rewrite length_app in Hlong; lia)) as (addr & rest2 & -> & Ha).
+      assert (Hs26 : skipn 26 (lit ++ addr ++ rest2) = rest2)
+        by (rewrite app_assoc; apply skipn_app_exact; rewrite length_app; lia).
+      assert (Hf26 : firstn 26 (lit ++ addr ++ rest2) = lit ++ addr)
+        by (rewrite app_assoc; apply firstn_app_exact; rewrite length_app; lia).
+      rewrite Hs26 in Ht'. rewrite Hf26 in HU |- *.
+      rewrite !length_app in HU.
+      destruct (seg_esc b3 b2 b1 b0 k s0 s1 lit addr rest2 done U W K Es Hl Ha ltac:(lia)) as [S1 E1].
+      destruct (IH rest2 X' (done ++ [true; true; s0; s1] ++ lit ++ addr) (skipn 26 U)
+                  (W ++ lit ++ addr) K k true true s0 s1 Ht' ltac:(rewrite length_skipn; lia))
+        as (nrec & Hn & S2 & E2).
+      exists (S nrec). replace (30 * S nrec + 4) with (30 + (30 * nrec + 4)) by lia.
+      split; [rewrite !length_app; lia|]. split.
+      * apply stable_add; [exact S1|]. rewrite E1. exact S2.
+      * rewrite dsteps_add, E1, E2. rewrite <- !app_assoc. reflexivity.
+  - (* a record named by its gate codon *)
+    destruct (translate_aux f (skipn 18 rest1)) as [X'|] eqn:Ht'; [|discriminate].
+    cbn [option_map] in Ht. apply some_inj in Ht. subst Xr.
+    pose proof (translate_aux_long _ _ _ Ht') as Hlong. rewrite length_skipn in Hlong.
+    destruct (split_at rest1 18 ltac:(lia)) as (addr & rest2 & -> & Ha).
+    rewrite (skipn_app_exact addr rest2 18 Ha) in Ht'.
+    rewrite (firstn_app_exact addr rest2 18 Ha) in HU |- *.
+    change (if e3 then 2 else if e2 then 1 else 0) with (kind_of e3 e2) in HU |- *.
+    assert (Hg : length (gate_bits (kind_of e3 e2) s0 s1) = 8)
+      by (unfold gate_bits, kind_of; destruct e3, e2; reflexivity).
+    rewrite !length_app, Hg in HU.
+    destruct (seg_gate b3 b2 b1 b0 k e3 e2 s0 s1 addr rest2 done U W K E32 Ha ltac:(lia)) as [S1 E1].
+    destruct (IH rest2 X' (done ++ [e3; e2; s0; s1] ++ addr) (skipn 26 U)
+                (W ++ gate_bits (kind_of e3 e2) s0 s1 ++ addr) K k e3 e2 s0 s1 Ht'
+                ltac:(rewrite length_skipn; lia))
+      as (nrec & Hn & S2 & E2).
+    exists (S nrec). replace (30 * S nrec + 4) with (30 + (30 * nrec + 4)) by lia.
+    split; [rewrite !length_app, Hg; lia|]. split.
+    + apply stable_add; [exact S1|]. rewrite E1. exact S2.
+    + rewrite dsteps_add, E1, E2. rewrite <- !app_assoc. reflexivity.
+Qed.
+
+(* ---- the description read again in copy mode ------------------------------------ *)
+Lemma copy_phase : forall f rest Xr done A V C k b3 b2 b1 b0,
+  translate_aux f rest = Some Xr -> length V = length rest ->
+  stable k (length rest) (mkD (mkC PC 3 b3 b2 b1 b0 true) k (rest ++ done) A (V ++ C))
+  /\ dsteps (length rest) (mkD (mkC PC 3 b3 b2 b1 b0 true) k (rest ++ done) A (V ++ C))
+     = mkD (mkC PC 3 true true true true false) (negb k) (done ++ rest) A (C ++ rest).
+Proof.
+  induction f as [|f IH]; intros rest Xr done A V C k b3 b2 b1 b0 Ht HV; [discriminate|].
+  destruct rest as [|e3 [|e2 [|s0 [|s1 rest1]]]]; try discriminate.
+  rewrite translate_aux_S in Ht.
+  destruct (e3 && e2) eqn:E32.
+  - apply andb_prop in E32 as [-> ->].
+    destruct (s0 && s1) eqn:Es.
+    + (* the end codon *)
+      destruct rest1; [|discriminate]. apply andb_prop in Es as [-> ->].
+      destruct (seg_copy_end b3 b2 b1 b0 k done A V C ltac:(cbn [length] in HV; lia)) as [S1 E1].
+      replace (skipn 4 V) with (@nil bool) in E1
+        by (symmetry; apply length_zero_iff_nil; rewrite length_skipn; cbn [length] in HV; lia).
+      change (length [true; true; true; true]) with 4.
+      split; [exact S1|]. rewrite E1. reflexivity.
+    + (* an escaped record *)
+      destruct (Nat.eqb (length rest1) 0) eqn:El; [discriminate|].
+      destruct (translate_aux f (skipn 26 rest1)) as [X'|] eqn:Ht'; [|discriminate].
+      pose proof (translate_aux_long _ _ _ Ht') as Hlong. rewrite length_skipn in Hlong.
+      destruct (split_at rest1 8 ltac:(lia)) as (lit & r1 & -> & Hl).
+      destruct (split_at r1 18 ltac:(rewrite length_app in Hlong; lia)) as (addr & rest2 & -> & Ha).
+      assert (Hs26 : skipn 26 (lit ++ addr ++ rest2) = rest2)
+        by (rewrite app_assoc; apply skipn_app_exact; rewrite length_app; lia).
+      rewrite Hs26 in Ht'.
+      assert (Hlen : length (true :: true :: s0 :: s1 :: lit ++ addr ++ rest2) = 30 + length rest2)
+        by (cbn [length]; rewrite !length_app; lia).
+      rewrite Hlen in HV |- *.
+      destruct (seg_copy_esc b3 b2 b1 b0 k s0 s1 lit addr rest2 done A V C Es Hl Ha ltac:(lia)) as [S1 E1].
+      destruct (IH rest2 X' (done ++ [true; true; s0; s1] ++ lit ++ addr) A (skipn 30 V)
+                  (C ++ [true; true; s0; s1] ++ lit ++ addr) k true true s0 s1 Ht'
+                  ltac:(rewrite length_skipn; lia)) as [S2 E2].
+      split.
+      * apply stable_add; [exact S1|]. rewrite E1. exact S2.
+      * rewrite dsteps_add, E1, E2. rewrite <- !app_assoc. reflexivity.
+  - (* a record named by its gate codon *)
+    destruct (translate_aux f (skipn 18 rest1)) as [X'|] eqn:Ht'; [|discriminate].
+    pose proof (translate_aux_long _ _ _ Ht') as Hlong. rewrite length_skipn in Hlong.
+    destruct (split_at rest1 18 ltac:(lia)) as (addr & rest2 & -> & Ha).
+    rewrite (skipn_app_exact addr rest2 18 Ha) in Ht'.
+    assert (Hlen : length (e3 :: e2 :: s0 :: s1 :: addr ++ rest2) = 22 + length rest2)
+      by (cbn [length]; rewrite !length_app; lia).
+    rewrite Hlen in HV |- *.
+    destruct (seg_copy_gate b3 b2 b1 b0 k e3 e2 s0 s1 addr rest2 done A V C E32 Ha ltac:(lia)) as [S1 E1].
+    destruct (IH rest2 X' (done ++ [e3; e2; s0; s1] ++ addr) A (skipn 22 V)
+                (C ++ [e3; e2; s0; s1] ++ addr) k e3 e2 s0 s1 Ht'
+                ltac:(rewrite length_skipn; lia)) as [S2 E2].
+    split.
+    + apply stable_add; [exact S1|]. rewrite E1. exact S2.
+    + rewrite dsteps_add, E1, E2. rewrite <- !app_assoc. reflexivity.
+Qed.
+
+(* ---- one generation ---------------------------------------------------------------- *)
+(* From the start of a codon in construct mode, with the description d under the read head,
+   an arm as long as the record image X that d describes and a copy tape as long as d, the
+   pass is iterated 30 times per record of X, 4 times on the end codon and once per bit of d.
+   The bank bit holds its value until the last pass and flips there; the arm then holds X, the
+   copy tape d, the read tape d again, and the configuration is back at a codon start. *)
+Theorem generation : forall d X k A0 K0 b3 b2 b1 b0,
+  translate d = Some X -> length A0 = length X -> length K0 = length d ->
+  exists nrec, length X = 26 * nrec
+    /\ stable k (30 * nrec + 4 + length d) (mkD (mkC PC 3 b3 b2 b1 b0 false) k d A0 K0)
+    /\ dsteps (30 * nrec + 4 + length d) (mkD (mkC PC 3 b3 b2 b1 b0 false) k d A0 K0)
+       = mkD (mkC PC 3 true true true true false) (negb k) d X d.
+Proof.
+  intros d X k A0 K0 b3 b2 b1 b0 Ht HA HK. unfold translate in Ht.
+  destruct (construct_phase (length d) d X [] A0 [] K0 k b3 b2 b1 b0 Ht HA) as (nrec & Hn & S1 & E1).
+  rewrite !app_nil_r in S1, E1. rewrite !app_nil_l in E1.
+  destruct (copy_phase (length d) d X [] X K0 [] k true true true true Ht HK) as [S2 E2].
+  rewrite !app_nil_r in S2, E2. rewrite !app_nil_l in E2.
+  exists nrec. split; [exact Hn|]. split.
+  - apply stable_add; [exact S1|]. rewrite E1. exact S2.
+  - rewrite dsteps_add, E1, E2. reflexivity.
+Qed.

rocq/Extract.v

@@ -0,0 +1,5 @@
+From Stdlib Require Import Extraction ExtrOcamlBasic ExtrOcamlNatInt ExtrOcamlZInt.
+From TH Require Import Net Phys.
+Extraction Language OCaml.
+Set Extraction Output Directory "extract".
+Extraction "physnet.ml" phys_units phys_next nst.

rocq/Gates.v

@@ -0,0 +1,82 @@
+(* Conjunctions and disjunctions of literals as ternary threshold units. *)
+From Stdlib Require Import List Bool Arith ZArith Lia.
+Import ListNotations.
+From TH Require Import TwoHead Net.
+
+(* a literal: a signal and its polarity *)
+Definition lit := (sref * bool)%type.
+
+Definition lw (l : lit) : sref * Z := (fst l, if snd l then 1%Z else (-1)%Z).
+Definition npos (ls : list lit) : nat := length (filter snd ls).
+Definition nneg (ls : list lit) : nat := length (filter (fun l => negb (snd l)) ls).
+
+(* H(sum of the positive literals - sum of the negated ones - #positive) and
+   H(sum of the positive literals - sum of the negated ones + #negated - 1) *)
+Definition sAND (ls : list lit) : su := SU (- Z.of_nat (npos ls)) (map lw ls).
+Definition sOR (ls : list lit) : su := SU (Z.of_nat (nneg ls) - 1) (map lw ls).
+
+(* a two-way choice placed at units r0, r0 + 1, r0 + 2 of member j of block b *)
+Definition mux3 (b j r0 : nat) (sel a c : sref) : list su :=
+  [sAND [(sel, true); (a, true)]; sAND [(sel, false); (c, true)];
+   sOR [(SRef b j r0, true); (SRef b j (S r0), true)]].
+
+Definition litv (V : sref -> bool) (l : lit) : bool := Bool.eqb (V (fst l)) (snd l).
+
+Lemma swsum_lits : forall ls V,
+  swsum (map lw ls) V = (Z.of_nat (length (filter (litv V) ls)) - Z.of_nat (nneg ls))%Z.
+Proof.
+  induction ls as [|[x p] t IH]; intro V; [reflexivity|].
+  unfold nneg in *. cbn [map swsum lw fst snd filter] in *. rewrite IH.
+  change (litv V (x, p)) with (Bool.eqb (V x) p).
+  destruct p, (V x); cbn [Bool.eqb negb length b2z]; rewrite ?Nat2Z.inj_succ; lia.
+Qed.
+
+Lemma filter_length_le : forall (A : Type) (f : A -> bool) l, length (filter f l) <= length l.
+Proof. intros A f l. induction l as [|x t IH]; cbn [filter length]; [lia|]. destruct (f x); cbn [length]; lia. Qed.
+
+Lemma filter_all : forall (A : Type) (f : A -> bool) l, length (filter f l) = length l <-> forallb f l = true.
+Proof.
+  intros A f l. induction l as [|x t IH]; cbn [filter length forallb]; [tauto|].
+  pose proof (filter_length_le A f t). destruct (f x); cbn [length andb].
+  - rewrite <- IH. lia.
+  - split; [lia | discriminate].
+Qed.
+
+Lemma filter_some : forall (A : Type) (f : A -> bool) l, 1 <= length (filter f l) <-> existsb f l = true.
+Proof.
+  intros A f l. induction l as [|x t IH]; cbn [filter length existsb]; [split; [lia|discriminate]|].
+  destruct (f x); cbn [length orb]; [split; [reflexivity|lia]|exact IH].
+Qed.
+
+Lemma npos_nneg : forall ls, npos ls + nneg ls = length ls.
+Proof.
+  induction ls as [|[x p] t IH]; [reflexivity|]. unfold npos, nneg in *.
+  cbn [filter length snd negb]. destruct p; cbn [length negb]; lia.
+Qed.
+
+Lemma sAND_fire : forall ls V, sfire' (sAND ls) V = forallb (litv V) ls.
+Proof.
+  intros ls V. unfold sfire', sAND. cbn [sb sin]. rewrite swsum_lits.
+  pose proof (npos_nneg ls). pose proof (filter_length_le _ (litv V) ls).
+  destruct (forallb (litv V) ls) eqn:E.
+  - apply filter_all in E. apply Z.leb_le. lia.
+  - apply Z.leb_gt. destruct (Nat.eq_dec (length (filter (litv V) ls)) (length ls)) as [H1|H1].
+    + apply filter_all in H1. congruence.
+    + lia.
+Qed.
+
+Lemma sOR_fire : forall ls V, sfire' (sOR ls) V = existsb (litv V) ls.
+Proof.
+  intros ls V. unfold sfire', sOR. cbn [sb sin]. rewrite swsum_lits.
+  destruct (existsb (litv V) ls) eqn:E.
+  - apply filter_some in E. apply Z.leb_le. lia.
+  - apply Z.leb_gt. destruct (Nat.le_gt_cases 1 (length (filter (litv V) ls))) as [H1|H1].
+    + apply filter_some in H1. congruence.
+    + lia.
+Qed.
+
+Lemma litv_pos : forall V x, litv V (x, true) = V x.
+Proof. intros V x. unfold litv. cbn [fst snd]. destruct (V x); reflexivity. Qed.
+
+Lemma litv_neg : forall V x, litv V (x, false) = negb (V x).
+Proof. intros V x. unfold litv. cbn [fst snd]. destruct (V x); reflexivity. Qed.

rocq/Indep.v

@@ -0,0 +1,141 @@
+(* Cells a pass writes before it reads them carry nothing from one pass to the next. *)
+From Stdlib Require Import List Bool Arith ZArith Lia.
+Import ListNotations.
+From TH Require Import TwoHead Tapes Iter Abstract.
+
+Definition ao_of (r : rec) : nat := match r with Rec _ _ _ _ _ ao => ao end.
+
+Definition reads_ok (istmp : nat -> bool) (written : list nat) (a : nat) (w : Z) : bool :=
+  Z.eqb w 0 || Nat.eqb a RD || Nat.eqb a ARM || Nat.eqb a CPY || negb (istmp a)
+  || existsb (Nat.eqb a) written.
+
+Fixpoint wbr_from (rs : list rec) (istmp : nat -> bool) (written : list nat) : bool :=
+  match rs with
+  | [] => true
+  | Rec a0 w0 a1 w1 _ ao :: t =>
+      reads_ok istmp written a0 w0 && reads_ok istmp written a1 w1
+      && wbr_from t istmp (written ++ [ao])
+  end.
+
+Definition wagree (istmp : nat -> bool) (written : list nat) (w1 w2 : list bool) : Prop :=
+  forall x, (istmp x = false \/ In x written) -> x <> RD -> x <> ARM -> x <> CPY ->
+            wget w1 x = wget w2 x.
+
+Lemma acell_agree : forall istmp written t1 t2 a w,
+  aR t1 = aR t2 -> aA t1 = aA t2 -> aK t1 = aK t2 ->
+  wagree istmp written (aw t1) (aw t2) ->
+  reads_ok istmp written a w = true ->
+  (w * b2z (acell t1 a) = w * b2z (acell t2 a))%Z.
+Proof.
+  intros istmp written t1 t2 a w HR HA HK Hw Hok. unfold reads_ok in Hok. unfold acell.
+  rewrite HR, HA, HK.
+  destruct (Z.eqb w 0) eqn:Ew; [apply Z.eqb_eq in Ew; subst; reflexivity|].
+  destruct (Nat.eqb a RD) eqn:E1; [reflexivity|].
+  destruct (Nat.eqb a ARM) eqn:E2; [reflexivity|].
+  destruct (Nat.eqb a CPY) eqn:E3; [reflexivity|].
+  rewrite ?Ew, ?E1, ?E2, ?E3 in Hok. cbn [orb] in Hok.
+  apply Nat.eqb_neq in E1, E2, E3.
+  rewrite Hw; auto.
+  destruct (istmp a) eqn:Et; [right | left; reflexivity].
+  cbn [negb orb] in Hok. apply existsb_exists in Hok as (y & Hy & Hey).
+  apply Nat.eqb_eq in Hey. subst. exact Hy.
+Qed.
+
+Lemma opok_tapes : forall t1 t2 a w,
+  aR t1 = aR t2 -> aA t1 = aA t2 -> aK t1 = aK t2 -> opok t1 a w = opok t2 a w.
+Proof. intros t1 t2 a w HR HA HK. unfold opok. rewrite HR, HA, HK. reflexivity. Qed.
+
+Lemma wagree_step : forall istmp written w1 w2 ao v,
+  wagree istmp written w1 w2 -> length w1 = length w2 ->
+  istmp AA = false -> istmp AR = false -> istmp AC = false ->
+  wagree istmp (written ++ [ao]) (clearq (wnext w1 ao v)) (clearq (wnext w2 ao v)).
+Proof.
+  intros istmp written w1 w2 ao v H Hl HAA HAR HAC x Hx H1 H2 H3.
+  unfold clearq. rewrite !wget_upd, !upd_length, !length_wnext, Hl.
+  destruct (Nat.eqb x AC && Nat.ltb AC (length w2)); [reflexivity|].
+  destruct (Nat.eqb x AR && Nat.ltb AR (length w2)); [reflexivity|].
+  destruct (Nat.eqb x AA && Nat.ltb AA (length w2)); [reflexivity|].
+  unfold wnext.
+  destruct (Nat.eqb ao RD || Nat.eqb ao ARM || Nat.eqb ao CPY) eqn:Eao.
+  - apply H; auto. destruct Hx as [Hx|Hx]; [left; exact Hx|].
+    apply in_app_or in Hx as [Hx|Hx]; [right; exact Hx|].
+    destruct Hx as [Hx|[]]. subst x.
+    apply orb_true_iff in Eao as [Eao|Eao]; [apply orb_true_iff in Eao as [Eao|Eao]|];
+      apply Nat.eqb_eq in Eao; contradiction.
+  - rewrite !wget_upd, Hl.
+    destruct (Nat.eqb x ao && Nat.ltb ao (length w2)) eqn:Ex; [reflexivity|].
+    destruct Hx as [Hx|Hx]; [apply H; auto|].
+    apply in_app_or in Hx as [Hx|Hx]; [apply H; auto|].
+    destruct Hx as [Hx|[]]. subst x.
+    rewrite Nat.eqb_refl in Ex. cbn [andb] in Ex. apply Nat.ltb_ge in Ex.
+    (* ao lies beyond the window: neither list holds it *)
+    unfold wget. rewrite !nth_overflow by lia. reflexivity.
+Qed.
+
+Lemma firstn_S_nth : forall (rs : list rec) j r, nth_error rs j = Some r ->
+  firstn (S j) rs = firstn j rs ++ [r].
+Proof.
+  induction rs as [|y rs IH]; intros [|j] r H; cbn in *; try discriminate.
+  - injection H as ->. reflexivity.
+  - rewrite (IH j r H). reflexivity.
+Qed.
+
+Lemma skipn_nth : forall (rs : list rec) j r, nth_error rs j = Some r ->
+  skipn j rs = r :: skipn (S j) rs.
+Proof.
+  induction rs as [|y rs IH]; intros [|j] r H; cbn in *; try discriminate.
+  - injection H as ->. reflexivity.
+  - apply IH. exact H.
+Qed.
+
+Lemma aiter_indep : forall n rs istmp t1 t2,
+  istmp AA = false -> istmp AR = false -> istmp AC = false ->
+  wbr_from (skipn (ai t1) rs) istmp (map ao_of (firstn (ai t1) rs)) = true ->
+  ai t1 = ai t2 -> aR t1 = aR t2 -> aA t1 = aA t2 -> aK t1 = aK t2 -> bad t1 = bad t2 ->
+  length (aw t1) = length (aw t2) ->
+  wagree istmp (map ao_of (firstn (ai t1) rs)) (aw t1) (aw t2) ->
+  ai (aiter n rs t1) = ai (aiter n rs t2)
+  /\ aR (aiter n rs t1) = aR (aiter n rs t2)
+  /\ aA (aiter n rs t1) = aA (aiter n rs t2)
+  /\ aK (aiter n rs t1) = aK (aiter n rs t2)
+  /\ bad (aiter n rs t1) = bad (aiter n rs t2)
+  /\ (forall x, istmp x = false -> x <> RD -> x <> ARM -> x <> CPY ->
+        wget (aw (aiter n rs t1)) x = wget (aw (aiter n rs t2)) x).
+Proof.
+  induction n as [|n IH]; intros rs istmp t1 t2 HAA HAR HAC Hwbr Hi HR HA HK Hb Hl Hw.
+  - cbn [aiter]. repeat split; auto; try (intros x Hx H1 H2 H3; apply Hw; auto).
+  - cbn [aiter].
+    destruct (nth_error rs (ai t1)) as [r|] eqn:Er.
+    + assert (Er2 : nth_error rs (ai t2) = Some r) by (rewrite <- Hi; exact Er).
+      rewrite (skipn_nth rs _ r Er) in Hwbr.
+      destruct r as [a0 w0 a1 w1 beta ao]. cbn [wbr_from] in Hwbr.
+      apply andb_prop in Hwbr as [Hrd Hwbr]. apply andb_prop in Hrd as [Hr0 Hr1].
+      rewrite (astep_char rs t1 a0 w0 a1 w1 beta ao Er), (astep_char rs t2 a0 w0 a1 w1 beta ao Er2).
+      rewrite (acell_agree istmp _ t1 t2 a0 w0 HR HA HK Hw Hr0),
+              (acell_agree istmp _ t1 t2 a1 w1 HR HA HK Hw Hr1).
+      apply IH; auto; unfold astepres; cbv zeta; cbn [ai aR aA aK bad aw].
+      * rewrite (firstn_S_nth rs _ _ Er), map_app. exact Hwbr.
+      * rewrite Hi; reflexivity.
+      * assert (Hq : wget (wnext (aw t1) ao (Z.leb 0 (w0 * b2z (acell t2 a0) + w1 * b2z (acell t2 a1) + beta)%Z)) AR
+                     = wget (wnext (aw t2) ao (Z.leb 0 (w0 * b2z (acell t2 a0) + w1 * b2z (acell t2 a1) + beta)%Z)) AR).
+        { unfold wnext. destruct (_ || _ || _); [apply Hw; auto; discriminate|].
+          rewrite !wget_upd, Hl. destruct (_ && _); [reflexivity|]. apply Hw; auto; discriminate. }
+        rewrite Hq, HR. reflexivity.
+      * assert (Hq : wget (wnext (aw t1) ao (Z.leb 0 (w0 * b2z (acell t2 a0) + w1 * b2z (acell t2 a1) + beta)%Z)) AA
+                     = wget (wnext (aw t2) ao (Z.leb 0 (w0 * b2z (acell t2 a0) + w1 * b2z (acell t2 a1) + beta)%Z)) AA).
+        { unfold wnext. destruct (_ || _ || _); [apply Hw; auto; discriminate|].
+          rewrite !wget_upd, Hl. destruct (_ && _); [reflexivity|]. apply Hw; auto; discriminate. }
+        rewrite Hq, HA. reflexivity.
+      * assert (Hq : wget (wnext (aw t1) ao (Z.leb 0 (w0 * b2z (acell t2 a0) + w1 * b2z (acell t2 a1) + beta)%Z)) AC
+                     = wget (wnext (aw t2) ao (Z.leb 0 (w0 * b2z (acell t2 a0) + w1 * b2z (acell t2 a1) + beta)%Z)) AC).
+        { unfold wnext. destruct (_ || _ || _); [apply Hw; auto; discriminate|].
+          rewrite !wget_upd, Hl. destruct (_ && _); [reflexivity|]. apply Hw; auto; discriminate. }
+        rewrite Hq, HK. reflexivity.
+      * rewrite Hb, (opok_tapes t1 t2 a0 w0 HR HA HK), (opok_tapes t1 t2 a1 w1 HR HA HK), HA, HK, Hi.
+        reflexivity.
+      * rewrite !length_clearq, !length_wnext. exact Hl.
+      * rewrite (firstn_S_nth rs _ _ Er), map_app. apply wagree_step; auto.
+    + assert (Er2 : nth_error rs (ai t2) = None) by (rewrite <- Hi; exact Er).
+      unfold astep. rewrite Er, Er2.
+      apply IH; cbn [ai aR aA aK bad aw]; auto.
+Qed.

rocq/Iter.v

@@ -0,0 +1,72 @@
+(* Iterating the step: one step at a time, and in binary for evaluation. *)
+From Stdlib Require Import List Bool Arith ZArith Lia.
+Import ListNotations.
+From TH Require Import TwoHead.
+
+Fixpoint itern (n : nat) (s : st) : st :=
+  match n with O => s | S m => itern m (step s) end.
+
+Lemma itern_add : forall a b s, itern (a + b) s = itern b (itern a s).
+Proof. induction a as [|a IH]; intros b s; simpl; auto. Qed.
+
+Lemma iterp_itern : forall p s, iterp p s = itern (Pos.to_nat p) s.
+Proof.
+  induction p as [p IH|p IH|]; intro s; simpl iterp.
+  - rewrite Pos2Nat.inj_xI.
+    replace (S (2 * Pos.to_nat p)) with (Pos.to_nat p + Pos.to_nat p + 1) by lia.
+    rewrite !itern_add, !IH. reflexivity.
+  - rewrite Pos2Nat.inj_xO.
+    replace (2 * Pos.to_nat p) with (Pos.to_nat p + Pos.to_nat p) by lia.
+    rewrite itern_add, !IH. reflexivity.
+  - reflexivity.
+Qed.
+
+(* kfp p s: the state after p steps, provided kappa is false at each of the p states left *)
+Fixpoint kfp (p : positive) (s : st) : option st :=
+  match p with
+  | xH => if wget (win s) KAPPA then None else Some (step s)
+  | xO q => match kfp q s with None => None | Some s1 => kfp q s1 end
+  | xI q =>
+      match kfp q s with
+      | None => None
+      | Some s1 =>
+          match kfp q s1 with
+          | None => None
+          | Some s2 => if wget (win s2) KAPPA then None else Some (step s2)
+          end
+      end
+  end.
+
+Lemma kfp_sound : forall p s t, kfp p s = Some t ->
+  t = itern (Pos.to_nat p) s
+  /\ (forall n, n < Pos.to_nat p -> wget (win (itern n s)) KAPPA = false).
+Proof.
+  induction p as [q IH|q IH|]; intros s t H; simpl in H.
+  - destruct (kfp q s) as [s1|] eqn:E1; [|discriminate].
+    destruct (kfp q s1) as [s2|] eqn:E2; [|discriminate].
+    destruct (wget (win s2) KAPPA) eqn:Ek; [discriminate|].
+    injection H as <-.
+    destruct (IH _ _ E1) as [H1 K1]; destruct (IH _ _ E2) as [H2 K2]; subst s1 s2.
+    rewrite Pos2Nat.inj_xI. split.
+    + replace (S (2 * Pos.to_nat q)) with (Pos.to_nat q + Pos.to_nat q + 1) by lia.
+      rewrite !itern_add. reflexivity.
+    + intros n Hn.
+      destruct (Nat.lt_ge_cases n (Pos.to_nat q)) as [Hlt|Hge]; [auto|].
+      destruct (Nat.lt_ge_cases n (Pos.to_nat q + Pos.to_nat q)) as [Hlt2|Hge2].
+      * replace n with (Pos.to_nat q + (n - Pos.to_nat q)) by lia.
+        rewrite itern_add. apply K2. lia.
+      * replace n with (Pos.to_nat q + Pos.to_nat q) by lia.
+        rewrite itern_add. exact Ek.
+  - destruct (kfp q s) as [s1|] eqn:E1; [|discriminate].
+    destruct (IH _ _ E1) as [H1 K1]; destruct (IH _ _ H) as [H2 K2]; subst s1 t.
+    rewrite Pos2Nat.inj_xO. split.
+    + replace (2 * Pos.to_nat q) with (Pos.to_nat q + Pos.to_nat q) by lia.
+      rewrite itern_add. reflexivity.
+    + intros n Hn.
+      destruct (Nat.lt_ge_cases n (Pos.to_nat q)) as [Hlt|Hge]; [auto|].
+      replace n with (Pos.to_nat q + (n - Pos.to_nat q)) by lia.
+      rewrite itern_add. apply K2. lia.
+  - destruct (wget (win s) KAPPA) eqn:Ek; [discriminate|].
+    injection H as <-. split; [reflexivity|].
+    intros n Hn. replace n with 0 by lia. exact Ek.
+Qed.

rocq/Main.v

@@ -0,0 +1,100 @@
+(* Universal construction by the organism, and its self-reproduction in every generation. *)
+From Stdlib Require Import List Bool Arith ZArith Lia.
+Import ListNotations.
+From TH Require Import TwoHead Tapes Iter Abstract Spec Organism PassCheck PassLemma Decoder Run Complete.
+
+(* Every image X of n >= 1 records is built from its description describe X. *)
+Theorem builds_every_image : forall X n k A0 K0 s b3 b2 b1 b0,
+  1 <= n -> length X = 26 * n -> length A0 = length X -> length K0 = length (describe X) ->
+  matches k (mkD (mkC PC 3 b3 b2 b1 b0 false) k (describe X) A0 K0) s ->
+  matches k (mkD (mkC PC 3 true true true true false) (negb k) (describe X) X (describe X))
+          (itern ((30 * n + 4 + length (describe X)) * G) s).
+Proof.
+  intros X n k A0 K0 s b3 b2 b1 b0 Hn HX HA HK Hm.
+  assert (HXn : X <> []) by (intro E; subst X; cbn [length] in HX; lia).
+  destruct (universal_construction (describe X) X k A0 K0 s b3 b2 b1 b0
+              (describe_complete X n HX) HXn HA HK Hm) as (nrec & Hr & Hm').
+  replace nrec with n in Hm' by lia. exact Hm'.
+Qed.
+
+(* ---- the organism's own description ----------------------------------------- *)
+Lemma rho_enc : rho = enc organism.
+Proof. reflexivity. Qed.
+
+Lemma length_rho : length rho = 26 * 133.
+Proof. rewrite rho_enc, enc_length. reflexivity. Qed.
+
+Lemma length_desc : length desc = 2930.
+Proof. vm_compute. reflexivity. Qed.
+
+Lemma translate_desc : translate desc = Some rho.
+Proof. exact (describe_complete rho 133 length_rho). Qed.
+
+(* one generation: 30 passes per record, 4 on the end codon and one per bit of the
+   description, each pass G = 133 steps *)
+Definition gen_steps : nat := (30 * 133 + 4 + 2930) * G.
+
+Definition c_start : cfg := mkC PC 3 false false false false false.
+Definition c_gen : cfg := mkC PC 3 true true true true false.
+
+Lemma s0_matches : matches false
+  (mkD c_start false desc (repeat false (length rho)) (repeat false (length desc))) s0.
+Proof.
+  unfold matches, s0, tape_of, contents. cbn [win q0 q1 d0 d1 dc dk dR dA dK fr bk rev].
+  rewrite !app_nil_r.
+  refine (conj eq_refl (conj _ (conj eq_refl (conj eq_refl (conj eq_refl rho_enc))))).
+  intros i H. do 21 (destruct i as [|i]; [reflexivity|]).
+  exfalso. unfold relevant in H. cbn in H. discriminate.
+Qed.
+
+(* after a generation the bank just built holds the organism too, so the roles turn over *)
+Lemma turn_over : forall k s,
+  matches k (mkD c_gen (negb k) desc rho desc) s ->
+  matches (negb k) (mkD c_gen (negb k) desc rho desc) s.
+Proof.
+  intros k s (Hl & Hw & HR & HA & HK & HQ). unfold matches. cbn [dc dk dR dA dK] in *.
+  rewrite <- rho_enc in HQ |- *. destruct k; cbn [negb] in *; tauto.
+Qed.
+
+Lemma generation_step : forall k s,
+  matches k (mkD c_gen k desc rho desc) s ->
+  matches (negb k) (mkD c_gen (negb k) desc rho desc) (itern gen_steps s).
+Proof.
+  intros k s Hm.
+  destruct (universal_construction desc rho k rho desc s true true true true translate_desc
+              ltac:(rewrite rho_enc; discriminate) eq_refl eq_refl Hm) as (nrec & Hr & Hm').
+  rewrite length_rho in Hr. rewrite length_desc in Hm'.
+  replace (30 * nrec + 4 + 2930) with (30 * 133 + 4 + 2930) in Hm' by lia.
+  apply turn_over. exact Hm'.
+Qed.
+
+(* After g + 1 generations the bank bit is even g, both
+   banks hold the organism and both tapes its description, and the window is at a codon start. *)
+Theorem reproduces_forever : forall g,
+  matches (Nat.even g) (mkD c_gen (Nat.even g) desc rho desc) (itern (S g * gen_steps) s0).
+Proof.
+  induction g as [|g IH].
+  - destruct (universal_construction desc rho false (repeat false (length rho))
+                (repeat false (length desc)) s0 false false false false translate_desc
+                ltac:(rewrite rho_enc; discriminate) (repeat_length _ _) (repeat_length _ _)
+                s0_matches) as (nrec & Hr & Hm).
+    rewrite length_rho in Hr. rewrite length_desc in Hm.
+    replace (30 * nrec + 4 + 2930) with (30 * 133 + 4 + 2930) in Hm by lia.
+    rewrite Nat.mul_1_l. exact (turn_over false _ Hm).
+  - rewrite Nat.even_succ, <- Nat.negb_even.
+    replace (S (S g) * gen_steps) with (S g * gen_steps + gen_steps) by lia.
+    rewrite itern_add. apply generation_step. exact IH.
+Qed.
+
+Corollary every_generation : forall g,
+  wget (win (itern (S g * gen_steps) s0)) KAPPA = Nat.even g
+  /\ contents (q0 (itern (S g * gen_steps) s0)) = rho
+  /\ contents (q1 (itern (S g * gen_steps) s0)) = rho
+  /\ contents (d0 (itern (S g * gen_steps) s0)) = desc
+  /\ contents (d1 (itern (S g * gen_steps) s0)) = desc.
+Proof.
+  intro g. destruct (reproduces_forever g) as (Hl & Hw & HR & HA & HK & HQ).
+  cbn [dc dk dR dA dK] in *. rewrite <- rho_enc in HQ.
+  split; [change KAPPA with 0; rewrite (Hw 0 eq_refl); reflexivity|].
+  destruct (Nat.even g); tauto.
+Qed.

rocq/Net.v

@@ -0,0 +1,281 @@
+(* Netlists of ternary threshold units, flat and in blocks, and the valuations they compute. *)
+From Stdlib Require Import List Bool Arith ZArith Lia.
+Import ListNotations.
+From TH Require Import TwoHead.
+
+(* ---- flat netlists ------------------------------------------------------------- *)
+(* a unit: its bias and its predecessors, each a signal index with a weight *)
+Record tu := TU { tb : Z; tin : list (nat * Z) }.
+
+Fixpoint wsum (ins : list (nat * Z)) (E : nat -> bool) : Z :=
+  match ins with [] => 0%Z | (i, w) :: t => (w * b2z (E i) + wsum t E)%Z end.
+
+Definition fire (u : tu) (E : nat -> bool) : bool := Z.leb 0 (tb u + wsum (tin u) E).
+
+Definition setv (E : nat -> bool) (m : nat) (b : bool) : nat -> bool :=
+  fun i => if Nat.eqb i m then b else E i.
+
+(* the units evaluated in order, the first at signal m *)
+Fixpoint run (us : list tu) (m : nat) (E : nat -> bool) : nat -> bool :=
+  match us with [] => E | u :: t => run t (S m) (setv E m (fire u E)) end.
+
+(* one step of a clocked netlist on n state bits: next value i is signal nx_i *)
+Definition netstep (n : nat) (us : list tu) (nx : list nat) (x : list bool) : list bool :=
+  let F := run us n (fun i => nth i x false) in map F nx.
+
+Lemma run_prefix : forall us m E i, i < m -> run us m E i = E i.
+Proof.
+  induction us as [|u t IH]; intros m E i H; cbn [run]; [reflexivity|].
+  rewrite IH by lia. unfold setv. destruct (Nat.eqb_spec i m); [lia|reflexivity].
+Qed.
+
+Lemma wsum_ext : forall ins E E', (forall i w, In (i, w) ins -> E i = E' i) -> wsum ins E = wsum ins E'.
+Proof.
+  induction ins as [|[i w] t IH]; intros E E' H; cbn [wsum]; [reflexivity|].
+  rewrite (H i w (or_introl eq_refl)), (IH E E'); [reflexivity|].
+  intros i' w' Hin. apply (H i' w'). right. exact Hin.
+Qed.
+
+Lemma fire_ext : forall u E E', (forall i w, In (i, w) (tin u) -> E i = E' i) -> fire u E = fire u E'.
+Proof. intros u E E' H. unfold fire. rewrite (wsum_ext _ E E' H). reflexivity. Qed.
+
+Definition reads_below (u : tu) (m : nat) : Prop := forall i w, In (i, w) (tin u) -> i < m.
+
+Definition tu0 : tu := TU 0 [].
+
+Lemma run_at : forall us m E j, j < length us ->
+  (forall k, k < length us -> reads_below (nth k us tu0) (m + k)) ->
+  run us m E (m + j) = fire (nth j us tu0) (run us m E).
+Proof.
+  induction us as [|u t IH]; intros m E j Hj Hwf; cbn [length] in Hj, Hwf; [lia|].
+  destruct j as [|j].
+  - cbn [nth run]. rewrite Nat.add_0_r, run_prefix by lia. unfold setv at 1. rewrite Nat.eqb_refl.
+    apply fire_ext. intros i w Hin. rewrite run_prefix by (specialize (Hwf 0 ltac:(lia) i w Hin); lia).
+    unfold setv. destruct (Nat.eqb_spec i m); [specialize (Hwf 0 ltac:(lia) i w Hin); lia|reflexivity].
+  - cbn [nth run]. replace (m + S j) with (S m + j) by lia. apply IH; [lia|].
+    intros k Hk i w Hin. specialize (Hwf (S k) ltac:(lia) i w Hin). lia.
+Qed.
+
+(* ---- netlists in blocks ---------------------------------------------------------- *)
+(* a signal is a state bit, or unit r of member j of block b *)
+Inductive sref := SIn (i : nat) | SRef (b j r : nat).
+Record su := SU { sb : Z; sin : list (sref * Z) }.
+(* a block: count members of size units each; shape j lists the units of member j *)
+Record block := Blk { bcount : nat; bsize : nat; bshape : nat -> list su }.
+
+Definition blk0 : block := Blk 0 0 (fun _ => []).
+Definition su0 : su := SU 0 [].
+
+Fixpoint boff (bs : list block) (b : nat) : nat :=
+  match bs, b with
+  | _, O => 0
+  | [], S _ => 0
+  | blk :: t, S b' => bcount blk * bsize blk + boff t b'
+  end.
+
+Definition idx (n : nat) (bs : list block) (x : sref) : nat :=
+  match x with
+  | SIn i => i
+  | SRef b j r => n + boff bs b + bsize (nth b bs blk0) * j + r
+  end.
+
+Definition flat_unit (n : nat) (bs : list block) (u : su) : tu :=
+  TU (sb u) (map (fun p => (idx n bs (fst p), snd p)) (sin u)).
+
+Definition flat_block (n : nat) (bs : list block) (blk : block) : list tu :=
+  concat (map (fun j => map (flat_unit n bs) (bshape blk j)) (seq 0 (bcount blk))).
+
+Definition compile (n : nat) (bs : list block) : list tu := concat (map (flat_block n bs) bs).
+
+Definition shaped (blk : block) : Prop := forall j, j < bcount blk -> length (bshape blk j) = bsize blk.
+
+Definition sunit (bs : list block) (b j r : nat) : su := nth r (bshape (nth b bs blk0) j) su0.
+
+Definition valid (bs : list block) (n : nat) (x : sref) : Prop :=
+  match x with
+  | SIn i => i < n
+  | SRef b j r => b < length bs /\ j < bcount (nth b bs blk0) /\ r < bsize (nth b bs blk0)
+  end.
+
+(* each unit reads state bits, units of earlier blocks, or earlier units of its own member *)
+Definition reads_back (bs : list block) (n b j r : nat) (x : sref) : Prop :=
+  match x with
+  | SIn i => i < n
+  | SRef b' j' r' => (b' < b /\ j' < bcount (nth b' bs blk0) /\ r' < bsize (nth b' bs blk0))
+                     \/ (b' = b /\ j' = j /\ r' < r)
+  end.
+
+Definition wf (bs : list block) (n : nat) : Prop :=
+  Forall shaped bs
+  /\ forall b j r x w, b < length bs -> j < bcount (nth b bs blk0) -> r < bsize (nth b bs blk0) ->
+       In (x, w) (sin (sunit bs b j r)) -> reads_back bs n b j r x.
+
+Lemma length_concat_const : forall (A : Type) (ls : list (list A)) sz,
+  Forall (fun l => length l = sz) ls -> length (concat ls) = length ls * sz.
+Proof.
+  intros A ls sz H. induction H as [|l ls Hl H IH]; [reflexivity|].
+  cbn [concat length]. rewrite length_app, IH, Hl. lia.
+Qed.
+
+Lemma length_flat_block : forall n bs blk, shaped blk ->
+  length (flat_block n bs blk) = bcount blk * bsize blk.
+Proof.
+  intros n bs blk Hs. unfold flat_block.
+  rewrite length_concat_const with (sz := bsize blk).
+  - rewrite length_map, length_seq. reflexivity.
+  - apply Forall_forall. intros l Hl. apply in_map_iff in Hl as (j & <- & Hj).
+    apply in_seq in Hj. rewrite length_map. apply Hs. lia.
+Qed.
+
+Lemma nth_concat_const : forall (A : Type) (d : A) (ls : list (list A)) sz j r,
+  Forall (fun l => length l = sz) ls -> j < length ls -> r < sz ->
+  nth (sz * j + r) (concat ls) d = nth r (nth j ls []) d.
+Proof.
+  intros A d ls sz j r Hall. revert j. induction Hall as [|l ls Hl Hall IH]; intros j Hj Hr;
+    cbn [length] in Hj; [lia|].
+  cbn [concat]. destruct j as [|j].
+  - rewrite Nat.mul_0_r, Nat.add_0_l, app_nth1 by lia. reflexivity.
+  - rewrite app_nth2 by nia. rewrite Hl. replace (sz * S j + r - sz) with (sz * j + r) by nia.
+    apply IH; [lia | exact Hr].
+Qed.
+
+Lemma nth_map_seq : forall (A : Type) (f : nat -> A) c j d, j < c -> nth j (map f (seq 0 c)) d = f j.
+Proof.
+  intros A f c j d Hj. rewrite (nth_indep _ d (f 0)) by (rewrite length_map, length_seq; exact Hj).
+  rewrite map_nth, seq_nth by exact Hj. reflexivity.
+Qed.
+
+Lemma nth_map_d : forall (A B : Type) (g : A -> B) l r d d', r < length l -> nth r (map g l) d = g (nth r l d').
+Proof.
+  intros A B g l r d d' Hr. rewrite (nth_indep _ d (g d')) by (rewrite length_map; exact Hr).
+  apply map_nth.
+Qed.
+
+Lemma flat_block_nth : forall n bs blk j r, shaped blk -> j < bcount blk -> r < bsize blk ->
+  nth (bsize blk * j + r) (flat_block n bs blk) tu0 = flat_unit n bs (nth r (bshape blk j) su0).
+Proof.
+  intros n bs blk j r Hs Hj Hr. unfold flat_block.
+  rewrite nth_concat_const with (sz := bsize blk); [| | rewrite length_map, length_seq; exact Hj | exact Hr].
+  - rewrite (nth_map_seq _ (fun j => map (flat_unit n bs) (bshape blk j)) (bcount blk) j [] Hj).
+    apply nth_map_d. rewrite Hs by exact Hj. exact Hr.
+  - apply Forall_forall. intros l Hl. apply in_map_iff in Hl as (j' & <- & Hj').
+    apply in_seq in Hj'. rewrite length_map. apply Hs. lia.
+Qed.
+
+Lemma compile_nth : forall n bs b j r, Forall shaped bs -> b < length bs ->
+  j < bcount (nth b bs blk0) -> r < bsize (nth b bs blk0) ->
+  nth (boff bs b + bsize (nth b bs blk0) * j + r) (compile n bs) tu0
+  = flat_unit n bs (sunit bs b j r).
+Proof.
+  intros n bs. unfold compile, sunit.
+  assert (G : forall pre, Forall shaped pre ->
+    forall b j r, b < length pre -> j < bcount (nth b pre blk0) -> r < bsize (nth b pre blk0) ->
+    nth (boff pre b + bsize (nth b pre blk0) * j + r) (concat (map (flat_block n bs) pre)) tu0
+    = flat_unit n bs (nth r (bshape (nth b pre blk0) j) su0)).
+  { induction pre as [|blk t IH]; intros Hsh b j r Hb Hj Hr; cbn [length] in Hb; [lia|].
+    inversion Hsh as [|? ? Hs1 Hst]; subst.
+    cbn [map concat]. destruct b as [|b].
+    - cbn [boff nth] in *. rewrite Nat.add_0_l, app_nth1.
+      + apply flat_block_nth; assumption.
+      + rewrite length_flat_block by exact Hs1. nia.
+    - cbn [boff nth] in *. rewrite app_nth2 by (rewrite length_flat_block by exact Hs1; lia).
+      rewrite length_flat_block by exact Hs1.
+      replace (bcount blk * bsize blk + boff t b + bsize (nth b t blk0) * j + r - bcount blk * bsize blk)
+        with (boff t b + bsize (nth b t blk0) * j + r) by lia.
+      apply IH; [exact Hst | lia | exact Hj | exact Hr]. }
+  intros b j r Hsh Hb Hj Hr. apply G; assumption.
+Qed.
+
+Lemma length_compile_gen : forall n bs0 bs, Forall shaped bs ->
+  length (concat (map (flat_block n bs0) bs)) = boff bs (length bs).
+Proof.
+  intros n bs0 bs H. induction H as [|blk t Hs Ht IH]; [reflexivity|].
+  cbn [map concat length boff]. rewrite length_app, length_flat_block by exact Hs. rewrite IH. reflexivity.
+Qed.
+
+Lemma length_compile : forall n bs, Forall shaped bs -> length (compile n bs) = boff bs (length bs).
+Proof. intros n bs H. apply length_compile_gen. exact H. Qed.
+
+Lemma boff_mono : forall bs b b', b' < b -> b <= length bs ->
+  boff bs b' + bcount (nth b' bs blk0) * bsize (nth b' bs blk0) <= boff bs b.
+Proof.
+  induction bs as [|blk t IH]; intros b b' Hb Hl; cbn [length] in Hl; [lia|].
+  destruct b as [|b]; [lia|]. destruct b' as [|b'].
+  - cbn [boff nth]. lia.
+  - cbn [boff nth]. specialize (IH b b' ltac:(lia) ltac:(lia)). lia.
+Qed.
+
+Lemma idx_lt : forall bs n b j r, b < length bs -> j < bcount (nth b bs blk0) -> r < bsize (nth b bs blk0) ->
+  idx n bs (SRef b j r) < n + boff bs (S b).
+Proof.
+  intros bs n b j r Hb Hj Hr. cbn [idx].
+  pose proof (boff_mono bs (S b) b ltac:(lia) ltac:(lia)). nia.
+Qed.
+
+Lemma idx_lt_total : forall bs n x, valid bs n x -> idx n bs x < n + boff bs (length bs).
+Proof.
+  intros bs n [i|b j r] Hv; cbn [valid] in Hv; [cbn [idx]; lia|].
+  destruct Hv as (Hb & Hj & Hr). pose proof (idx_lt bs n b j r Hb Hj Hr).
+  destruct (Nat.eq_dec (S b) (length bs)) as [E|E]; [rewrite <- E; exact H|].
+  pose proof (boff_mono bs (length bs) (S b) ltac:(lia) ltac:(lia)). lia.
+Qed.
+
+(* the structured unit fired on a valuation of its signals *)
+Fixpoint swsum (ins : list (sref * Z)) (V : sref -> bool) : Z :=
+  match ins with [] => 0%Z | (x, w) :: t => (w * b2z (V x) + swsum t V)%Z end.
+
+Definition sfire' (u : su) (V : sref -> bool) : bool := Z.leb 0 (sb u + swsum (sin u) V).
+
+Lemma wsum_flat : forall n bs ins E,
+  wsum (map (fun p => (idx n bs (fst p), snd p)) ins) E = swsum ins (fun x => E (idx n bs x)).
+Proof. intros n bs ins E. induction ins as [|[x w] t IH]; cbn [map wsum swsum fst snd]; [reflexivity|]. rewrite IH. reflexivity. Qed.
+
+Lemma swsum_ext : forall ins V V', (forall x w, In (x, w) ins -> V x = V' x) -> swsum ins V = swsum ins V'.
+Proof.
+  induction ins as [|[x w] t IH]; intros V V' H; cbn [swsum]; [reflexivity|].
+  rewrite (H x w (or_introl eq_refl)), (IH V V'); [reflexivity|].
+  intros x' w' Hin. apply (H x' w'). right. exact Hin.
+Qed.
+
+Lemma wf_reads_below : forall bs n, wf bs n ->
+  forall k, k < length (compile n bs) -> reads_below (nth k (compile n bs) tu0) (n + k).
+Proof.
+  intros bs n [Hsh Hrd] k Hk. rewrite length_compile in Hk by exact Hsh.
+  assert (Hloc : exists b j r, b < length bs /\ j < bcount (nth b bs blk0) /\ r < bsize (nth b bs blk0)
+                               /\ k = boff bs b + bsize (nth b bs blk0) * j + r).
+  { clear -Hk Hsh. revert k Hk. induction Hsh as [|blk t Hs Ht IH]; intros k Hk; cbn [boff length] in Hk; [lia|].
+    destruct (Nat.lt_ge_cases k (bcount blk * bsize blk)) as [Hl|Hg].
+    - exists 0, (k / bsize blk), (k mod bsize blk).
+      assert (bsize blk <> 0) by (intro E; rewrite E in Hl; lia).
+      cbn [nth length boff]. split; [lia|]. split; [apply Nat.Div0.div_lt_upper_bound; nia|].
+      split; [apply Nat.mod_upper_bound; exact H|]. rewrite (Nat.div_mod k (bsize blk)) at 1 by exact H. lia.
+    - destruct (IH (k - bcount blk * bsize blk) ltac:(lia)) as (b & j & r & Hb & Hj & Hr & Hk').
+      exists (S b), j, r. cbn [nth length boff]. split; [lia|]. split; [exact Hj|]. split; [exact Hr|]. lia. }
+  destruct Hloc as (b & j & r & Hb & Hj & Hr & ->).
+  rewrite compile_nth by assumption.
+  intros i w Hin. unfold flat_unit in Hin. cbn [tin] in Hin.
+  apply in_map_iff in Hin as ([x w'] & Heq & Hin). cbn [fst snd] in Heq. injection Heq as <- <-.
+  specialize (Hrd b j r x w' Hb Hj Hr Hin).
+  destruct x as [i|b' j' r']; cbn [reads_back idx] in *; [lia|].
+  destruct Hrd as [(Hb' & Hj' & Hr')|(-> & -> & Hr')]; [|lia].
+  pose proof (boff_mono bs b b' Hb' ltac:(lia)). nia.
+Qed.
+
+(* the value of a state bit, and of a unit from the values of its predecessors *)
+Lemma net_in : forall bs n X i, i < n -> run (compile n bs) n X (idx n bs (SIn i)) = X i.
+Proof. intros bs n X i H. cbn [idx]. apply run_prefix. exact H. Qed.
+
+Lemma net_unit : forall bs n X b j r, wf bs n ->
+  b < length bs -> j < bcount (nth b bs blk0) -> r < bsize (nth b bs blk0) ->
+  run (compile n bs) n X (idx n bs (SRef b j r))
+  = sfire' (sunit bs b j r) (fun x => run (compile n bs) n X (idx n bs x)).
+Proof.
+  intros bs n X b j r Hwf Hb Hj Hr. cbn [idx].
+  replace (n + boff bs b + bsize (nth b bs blk0) * j + r) with (n + (boff bs b + bsize (nth b bs blk0) * j + r)) by lia.
+  rewrite run_at.
+  - rewrite compile_nth by (destruct Hwf; assumption). unfold fire, flat_unit, sfire'. cbn [tb tin].
+    rewrite wsum_flat. reflexivity.
+  - rewrite length_compile by (destruct Hwf; assumption).
+    pose proof (idx_lt_total bs n (SRef b j r) (conj Hb (conj Hj Hr))) as H. cbn [idx] in H. lia.
+  - apply wf_reads_below. exact Hwf.
+Qed.

rocq/NetMain.v

@@ -0,0 +1,57 @@
+(* The threshold network itself: its orbit is the machine's, and the organism it carries
+   reproduces in every generation. *)
+From Stdlib Require Import List Bool Arith ZArith Lia.
+Import ListNotations.
+From TH Require Import TwoHead Tapes Iter Abstract Organism Net Phys PhysSem PhysMain Main.
+
+(* the network iterated on its state bits *)
+Fixpoint netiter (N L n : nat) (x : list bool) : list bool :=
+  match n with O => x | S m => netiter N L m (netstep (nst N L) (phys_units N L) (phys_next N L) x) end.
+
+Definition shaped_st (N L : nat) (s : st) : Prop :=
+  length (win s) = 64 /\ length (contents (q0 s)) = N /\ length (contents (q1 s)) = N
+  /\ length (contents (d0 s)) = L /\ length (contents (d1 s)) = L.
+
+Lemma step_shaped : forall N L s, 26 <= N -> 1 <= L -> shaped_st N L s -> shaped_st N L (step s).
+Proof.
+  intros N L s HN HL (Hw & H0 & H1 & H2 & H3).
+  destruct (step_eq N L s HN HL H0 H1 H2 H3 Hw) as (qa' & Hqa & Hst).
+  pose proof (tapes_step N L s HN HL H0 H1 H2 H3 Hw qa' Hqa) as T. cbv zeta in T.
+  rewrite <- Hst in T. destruct T as (T0 & T1 & T2 & T3).
+  refine (conj _ (conj _ (conj _ (conj _ _)))).
+  - rewrite Hst, win_stepres. unfold clearq. rewrite !upd_length, length_wnext. exact Hw.
+  - rewrite T0. destruct (kk s), (advA s); rewrite ?rot1_length, ?length_wrote, ?rotn_length; assumption.
+  - rewrite T1. destruct (kk s), (advA s); rewrite ?rot1_length, ?length_wrote, ?rotn_length; assumption.
+  - rewrite T2. destruct (kk s), (advC s), (advR s); rewrite ?rot1_length, ?length_wrotec; assumption.
+  - rewrite T3. destruct (kk s), (advC s), (advR s); rewrite ?rot1_length, ?length_wrotec; assumption.
+Qed.
+
+(* every orbit of the network on encoded states is the encoding of the machine's orbit *)
+Theorem network_orbit : forall N L n s, 26 <= N -> 1 <= L -> shaped_st N L s ->
+  netiter N L n (encode s) = encode (itern n s).
+Proof.
+  intros N L n. induction n as [|n IH]; intros s HN HL Hs; [reflexivity|].
+  cbn [netiter itern]. pose proof Hs as (Hw & H0 & H1 & H2 & H3).
+  rewrite (netlist_step N L s HN HL Hw H0 H1 H2 H3).
+  apply IH; [exact HN | exact HL |]. apply step_shaped; [exact HN | exact HL | exact Hs].
+Qed.
+
+Lemma s0_shaped : shaped_st (26 * 133) 2930 s0.
+Proof.
+  unfold shaped_st, s0, tape_of, contents. cbn [win q0 q1 d0 d1 fr bk rev]. rewrite !app_nil_r.
+  rewrite !repeat_length, length_rho, length_desc. repeat split; reflexivity.
+Qed.
+
+(* The network on 26 * 133 bank bits and 2930 description bits, started from the encoding of
+   s0, holds after g + 1 generations the encoding of a state in which the bank bit is even g,
+   both banks hold the organism and both description tapes its description. *)
+Theorem network_reproduces : forall g,
+  exists t, netiter (26 * 133) 2930 (S g * gen_steps) (encode s0) = encode t
+    /\ wget (win t) KAPPA = Nat.even g
+    /\ contents (q0 t) = rho /\ contents (q1 t) = rho
+    /\ contents (d0 t) = desc /\ contents (d1 t) = desc.
+Proof.
+  intro g. exists (itern (S g * gen_steps) s0). split.
+  - apply network_orbit; [lia | lia | exact s0_shaped].
+  - exact (every_generation g).
+Qed.

rocq/Organism.v

@@ -0,0 +1,151 @@
+(* The organism: 133 records, generated by src/twohead.py. *)
+From Stdlib Require Import List Bool Arith ZArith.
+Import ListNotations.
+From TH Require Import TwoHead.
+
+Definition organism : list rec := [
+  Rec 16 (-1)%Z 17 (-1)%Z 0%Z 21;
+  Rec 21 1%Z 18 (-1)%Z (-1)%Z 21;
+  Rec 21 1%Z 19 (-1)%Z (-1)%Z 21;
+  Rec 21 1%Z 20 (-1)%Z (-1)%Z 21;
+  Rec 14 1%Z 13 1%Z (-2)%Z 22;
+  Rec 12 1%Z 1 1%Z (-2)%Z 23;
+  Rec 22 1%Z 23 1%Z (-2)%Z 24;
+  Rec 22 1%Z 23 (-1)%Z (-1)%Z 22;
+  Rec 9 1%Z 21 1%Z (-2)%Z 23;
+  Rec 23 1%Z 24 1%Z (-2)%Z 25;
+  Rec 23 1%Z 24 (-1)%Z (-1)%Z 23;
+  Rec 15 1%Z 14 1%Z (-2)%Z 24;
+  Rec 13 1%Z 12 1%Z (-2)%Z 26;
+  Rec 24 1%Z 26 (-1)%Z (-1)%Z 24;
+  Rec 10 1%Z 24 1%Z (-2)%Z 26;
+  Rec 9 1%Z 11 1%Z (-1)%Z 27;
+  Rec 27 1%Z 26 1%Z (-1)%Z 26;
+  Rec 10 1%Z 11 1%Z (-1)%Z 27;
+  Rec 27 1%Z 8 (-1)%Z (-1)%Z 27;
+  Rec 10 1%Z 24 (-1)%Z (-1)%Z 24;
+  Rec 8 1%Z 26 1%Z (-2)%Z 28;
+  Rec 15 1%Z 14 (-1)%Z (-1)%Z 29;
+  Rec 13 1%Z 12 1%Z (-1)%Z 30;
+  Rec 13 (-1)%Z 12 (-1)%Z 1%Z 31;
+  Rec 30 1%Z 31 1%Z (-2)%Z 30;
+  Rec 13 1%Z 12 1%Z (-2)%Z 31;
+  Rec 13 1%Z 12 1%Z (-1)%Z 32;
+  Rec 14 1%Z 31 1%Z (-2)%Z 31;
+  Rec 14 (-1)%Z 32 1%Z (-1)%Z 32;
+  Rec 31 1%Z 32 1%Z (-1)%Z 31;
+  Rec 15 1%Z 13 1%Z (-2)%Z 32;
+  Rec 15 (-1)%Z 31 1%Z (-1)%Z 31;
+  Rec 32 1%Z 31 1%Z (-1)%Z 31;
+  Rec 14 1%Z 30 1%Z (-1)%Z 32;
+  Rec 14 (-1)%Z 30 (-1)%Z 1%Z 30;
+  Rec 32 1%Z 30 1%Z (-2)%Z 30;
+  Rec 15 1%Z 13 1%Z (-2)%Z 32;
+  Rec 15 (-1)%Z 30 1%Z (-1)%Z 30;
+  Rec 32 1%Z 30 1%Z (-1)%Z 30;
+  Rec 29 (-1)%Z 12 (-1)%Z 0%Z 32;
+  Rec 29 (-1)%Z 12 1%Z (-1)%Z 29;
+  Rec 16 1%Z 13 (-1)%Z (-1)%Z 33;
+  Rec 16 (-1)%Z 13 1%Z (-1)%Z 34;
+  Rec 33 1%Z 34 1%Z (-1)%Z 33;
+  Rec 16 1%Z 32 1%Z (-2)%Z 32;
+  Rec 16 (-1)%Z 29 1%Z (-1)%Z 29;
+  Rec 32 1%Z 29 1%Z (-1)%Z 29;
+  Rec 17 1%Z 33 1%Z (-2)%Z 32;
+  Rec 17 (-1)%Z 29 1%Z (-1)%Z 29;
+  Rec 32 1%Z 29 1%Z (-1)%Z 29;
+  Rec 17 1%Z 16 1%Z (-1)%Z 32;
+  Rec 32 1%Z 31 1%Z (-2)%Z 31;
+  Rec 32 (-1)%Z 30 1%Z (-1)%Z 30;
+  Rec 31 1%Z 30 1%Z (-1)%Z 30;
+  Rec 18 1%Z 29 1%Z (-2)%Z 29;
+  Rec 18 (-1)%Z 30 1%Z (-1)%Z 30;
+  Rec 29 1%Z 30 1%Z (-1)%Z 29;
+  Rec 24 1%Z 29 1%Z (-2)%Z 29;
+  Rec 24 (-1)%Z 1 1%Z (-1)%Z 24;
+  Rec 29 1%Z 24 1%Z (-1)%Z 24;
+  Rec 9 1%Z 21 (-1)%Z (-1)%Z 29;
+  Rec 29 1%Z 25 1%Z (-1)%Z 29;
+  Rec 11 1%Z 21 1%Z (-2)%Z 30;
+  Rec 29 1%Z 30 1%Z (-1)%Z 29;
+  Rec 8 (-1)%Z 22 1%Z 0%Z 22;
+  Rec 23 1%Z 22 1%Z (-2)%Z 30;
+  Rec 10 1%Z 21 (-1)%Z (-1)%Z 31;
+  Rec 30 1%Z 31 1%Z (-1)%Z 30;
+  Rec 23 1%Z 22 (-1)%Z (-1)%Z 22;
+  Rec 10 1%Z 21 1%Z (-2)%Z 23;
+  Rec 22 1%Z 23 1%Z (-1)%Z 22;
+  Rec 11 1%Z 21 (-1)%Z (-1)%Z 23;
+  Rec 22 1%Z 23 1%Z (-1)%Z 22;
+  Rec 16 (-1)%Z 7 0%Z 0%Z 23;
+  Rec 16 (-1)%Z 7 0%Z 0%Z 31;
+  Rec 17 1%Z 31 1%Z (-1)%Z 32;
+  Rec 17 (-1)%Z 31 (-1)%Z 1%Z 33;
+  Rec 32 1%Z 33 1%Z (-2)%Z 32;
+  Rec 31 1%Z 17 (-1)%Z (-1)%Z 31;
+  Rec 18 1%Z 31 1%Z (-1)%Z 33;
+  Rec 18 (-1)%Z 31 (-1)%Z 1%Z 34;
+  Rec 33 1%Z 34 1%Z (-2)%Z 33;
+  Rec 31 1%Z 18 (-1)%Z (-1)%Z 31;
+  Rec 19 1%Z 31 1%Z (-1)%Z 34;
+  Rec 19 (-1)%Z 31 (-1)%Z 1%Z 35;
+  Rec 34 1%Z 35 1%Z (-2)%Z 34;
+  Rec 31 1%Z 19 (-1)%Z (-1)%Z 31;
+  Rec 20 1%Z 31 1%Z (-1)%Z 35;
+  Rec 20 (-1)%Z 31 (-1)%Z 1%Z 31;
+  Rec 35 1%Z 31 1%Z (-2)%Z 31;
+  Rec 29 1%Z 30 1%Z (-1)%Z 35;
+  Rec 21 1%Z 23 1%Z (-1)%Z 16;
+  Rec 21 1%Z 35 1%Z (-2)%Z 23;
+  Rec 21 (-1)%Z 32 1%Z (-1)%Z 32;
+  Rec 23 1%Z 32 1%Z (-1)%Z 17;
+  Rec 21 1%Z 30 1%Z (-2)%Z 23;
+  Rec 21 (-1)%Z 33 1%Z (-1)%Z 32;
+  Rec 23 1%Z 32 1%Z (-1)%Z 18;
+  Rec 21 (-1)%Z 34 1%Z (-1)%Z 19;
+  Rec 21 1%Z 22 1%Z (-2)%Z 23;
+  Rec 21 (-1)%Z 31 1%Z (-1)%Z 21;
+  Rec 23 1%Z 21 1%Z (-1)%Z 20;
+  Rec 9 1%Z 14 1%Z (-2)%Z 21;
+  Rec 9 (-1)%Z 15 1%Z (-1)%Z 23;
+  Rec 21 1%Z 23 1%Z (-1)%Z 15;
+  Rec 9 1%Z 13 1%Z (-2)%Z 21;
+  Rec 9 (-1)%Z 14 1%Z (-1)%Z 23;
+  Rec 21 1%Z 23 1%Z (-1)%Z 14;
+  Rec 9 1%Z 12 1%Z (-2)%Z 21;
+  Rec 9 (-1)%Z 13 1%Z (-1)%Z 23;
+  Rec 21 1%Z 23 1%Z (-1)%Z 13;
+  Rec 9 1%Z 1 1%Z (-2)%Z 21;
+  Rec 9 (-1)%Z 12 1%Z (-1)%Z 23;
+  Rec 21 1%Z 23 1%Z (-1)%Z 12;
+  Rec 27 1%Z 24 1%Z (-2)%Z 21;
+  Rec 27 (-1)%Z 2 1%Z (-1)%Z 23;
+  Rec 21 1%Z 23 1%Z (-1)%Z 2;
+  Rec 28 1%Z 1 1%Z (-2)%Z 21;
+  Rec 28 (-1)%Z 3 1%Z (-1)%Z 23;
+  Rec 21 1%Z 23 1%Z (-1)%Z 3;
+  Rec 8 1%Z 25 1%Z (-2)%Z 21;
+  Rec 29 1%Z 7 0%Z (-1)%Z 9;
+  Rec 30 1%Z 7 0%Z (-1)%Z 10;
+  Rec 22 1%Z 7 0%Z (-1)%Z 11;
+  Rec 8 1%Z 25 1%Z (-1)%Z 22;
+  Rec 8 (-1)%Z 25 (-1)%Z 1%Z 23;
+  Rec 22 1%Z 23 1%Z (-2)%Z 8;
+  Rec 27 1%Z 7 0%Z (-1)%Z 5;
+  Rec 28 1%Z 7 0%Z (-1)%Z 6;
+  Rec 26 1%Z 7 0%Z (-1)%Z 4;
+  Rec 0 1%Z 21 1%Z (-1)%Z 22;
+  Rec 0 (-1)%Z 21 (-1)%Z 1%Z 21;
+  Rec 22 1%Z 21 1%Z (-2)%Z 0
+].
+
+(* m = 8, C = 9, G = 10, Ad = 11, c0 = 12, c1 = 13, c2 = 14, c3 = 15, z0 = 16, z1 = 17, z2 = 18, z3 = 19, z4 = 20; the pass starts in C with z = 3. *)
+Definition init_win : list bool :=
+  map (fun i => Nat.eqb i 9 || Nat.eqb i 16 || Nat.eqb i 17) (seq 0 64).
+
+Definition rho : list bool := concat (map enc_rec organism).
+Definition desc : list bool := describe rho.
+
+Definition s0 : st :=
+  mkS init_win (tape_of rho) (tape_of (repeat false (length rho)))
+      (tape_of desc) (tape_of (repeat false (length desc))).

rocq/PassCheck.v

@@ -0,0 +1,62 @@
+(* One pass of the organism, checked against the spec in every configuration a run can visit. *)
+From Stdlib Require Import List Bool Arith ZArith Lia.
+Import ListNotations.
+From TH Require Import TwoHead Tapes Iter Abstract Indep Spec Organism.
+
+Definition G := length organism.
+
+Definition rec_eqb (r s : rec) : bool :=
+  match r, s with
+  | Rec a b c d e f, Rec a' b' c' d' e' f' =>
+      Nat.eqb a a' && Z.eqb b b' && Nat.eqb c c' && Z.eqb d d' && Z.eqb e e' && Nat.eqb f f'
+  end.
+
+Lemma rec_eqb_true : forall r s, rec_eqb r s = true -> r = s.
+Proof.
+  intros [a b c d e f] [a' b' c' d' e' f'] H. cbn in H.
+  repeat match goal with H : _ && _ = true |- _ => apply andb_prop in H as [? ?] end.
+  repeat match goal with
+         | H : Nat.eqb _ _ = true |- _ => apply Nat.eqb_eq in H
+         | H : Z.eqb _ _ = true |- _ => apply Z.eqb_eq in H
+         end.
+  subst. reflexivity.
+Qed.
+
+Lemma decode_organism : Forall (fun r => decode (enc_rec r) = r) organism.
+Proof.
+  apply Forall_forall. intros r Hr.
+  assert (H : forallb (fun r => rec_eqb (decode (enc_rec r)) r) organism = true)
+    by (vm_compute; reflexivity).
+  rewrite forallb_forall in H. apply rec_eqb_true. apply H. exact Hr.
+Qed.
+
+Lemma wbr_organism : wbr_from organism istmp [] = true.
+Proof. vm_compute. reflexivity. Qed.
+
+(* what a pass must leave behind, judged on the abstract state t it reaches *)
+Definition chk (o : out) (t : ast) (r x y : bool) : bool :=
+  negb (bad t)
+  && forallb (fun i => Bool.eqb (wget (aw t) i) (wget (wcfg (ncf o) (nk o)) i))
+             (filter relevant (seq 0 64))
+  && Nat.eqb (mv (aR t)) (if cons o then 1 else 0) && lbeq (pre (aR t)) [r]
+  && Nat.eqb (mv (aA t)) (if emit o then 1 else 0) && lbeq (pre (aA t)) [if emit o then av o else x]
+  && Nat.eqb (mv (aK t)) (if cw o then 1 else 0) && lbeq (pre (aK t)) [if cw o then r else y].
+
+Definition all_cfgs : list cfg :=
+  flat_map (fun p =>
+    flat_map (fun zz =>
+      flat_map (fun b3 => flat_map (fun b2 => flat_map (fun b1 => flat_map (fun b0 =>
+        map (fun mm => mkC p zz b3 b2 b1 b0 mm) [false; true])
+        [false; true]) [false; true]) [false; true]) [false; true])
+      (seq 0 (match p with PC => 4 | PG => 8 | PA => 18 end)))
+    [PC; PG; PA].
+
+Definition bools := [false; true].
+
+(* the abstract pass from every configuration a run can visit, with one cell under each head *)
+Lemma pass_check_ok :
+  forallb (fun cf => forallb (fun k => forallb (fun r => forallb (fun x => forallb (fun y =>
+    chk (dpass cf k r)
+        (aiter G organism (mkAS (wcfg cf k) (mkA [r] 0) (mkA [x] 0) (mkA [y] 0) 0 false)) r x y)
+    bools) bools) bools) bools) all_cfgs = true.
+Proof. vm_compute. reflexivity. Qed.

rocq/PassLemma.v

@@ -0,0 +1,161 @@
+(* One pass of the physics with the organism in the active bank does what the spec says. *)
+From Stdlib Require Import List Bool Arith ZArith Lia.
+Import ListNotations.
+From TH Require Import TwoHead Tapes Iter Abstract Indep Spec Organism PassCheck.
+
+Lemma aiter_ai : forall n rs t, ai t + n <= length rs -> ai (aiter n rs t) = ai t + n.
+Proof.
+  induction n as [|n IH]; intros rs t H; cbn [aiter]; [lia|].
+  rewrite IH; rewrite ?astep_ai; lia.
+Qed.
+
+Lemma in_all_cfgs : forall cf, reachable cf = true -> In cf all_cfgs.
+Proof.
+  intros [p zz b3 b2 b1 b0 mm] H. unfold all_cfgs.
+  apply in_flat_map. exists p. split; [destruct p; simpl; tauto|].
+  apply in_flat_map. exists zz. split.
+  - apply in_seq. unfold reachable in H. cbn [ph z] in H. destruct p; apply Nat.leb_le in H; lia.
+  - apply in_flat_map; exists b3; split; [destruct b3; simpl; tauto|].
+    apply in_flat_map; exists b2; split; [destruct b2; simpl; tauto|].
+    apply in_flat_map; exists b1; split; [destruct b1; simpl; tauto|].
+    apply in_flat_map; exists b0; split; [destruct b0; simpl; tauto|].
+    apply in_map. destruct mm; simpl; tauto.
+Qed.
+
+Lemma in_bools : forall b, In b bools.
+Proof. intros [|]; simpl; tauto. Qed.
+
+Lemma expect_from_check : forall cf k r x y, reachable cf = true ->
+  chk (dpass cf k r)
+      (aiter G organism (mkAS (wcfg cf k) (mkA [r] 0) (mkA [x] 0) (mkA [y] 0) 0 false)) r x y = true.
+Proof.
+  intros cf k r x y H.
+  pose proof pass_check_ok as P.
+  rewrite forallb_forall in P. specialize (P cf (in_all_cfgs cf H)).
+  rewrite forallb_forall in P. specialize (P k (in_bools k)).
+  rewrite forallb_forall in P. specialize (P r (in_bools r)).
+  rewrite forallb_forall in P. specialize (P x (in_bools x)).
+  rewrite forallb_forall in P. specialize (P y (in_bools y)).
+  exact P.
+Qed.
+
+Lemma relevant_small : forall i, relevant i = true -> i < 21.
+Proof.
+  intros i H. unfold relevant in H.
+  repeat (apply orb_true_iff in H as [H|H]);
+    try (apply andb_prop in H as [Ha Hb]; apply Nat.leb_le in Ha, Hb);
+    try apply Nat.eqb_eq in H; lia.
+Qed.
+
+Lemma relevant_not_tape : forall i, relevant i = true -> i <> RD /\ i <> ARM /\ i <> CPY.
+Proof.
+  intros i H. unfold relevant in H. unfold RD, ARM, CPY.
+  repeat (apply orb_true_iff in H as [H|H]);
+    try (apply andb_prop in H as [Ha Hb]; apply Nat.leb_le in Ha, Hb);
+    try apply Nat.eqb_eq in H; lia.
+Qed.
+
+Lemma relevant_not_tmp : forall i, relevant i = true -> istmp i = false.
+Proof. intros i H. unfold istmp. rewrite H. reflexivity. Qed.
+
+Lemma relevant_of_not_tmp : forall i, istmp i = false -> i <> RD -> i <> ARM -> i <> CPY ->
+  relevant i = true.
+Proof.
+  intros i H H1 H2 H3. unfold istmp in H. apply negb_false_iff in H.
+  apply orb_true_iff in H as [H|H]; [exact H|].
+  apply andb_prop in H as [Ha Hb]. apply Nat.leb_le in Ha, Hb.
+  unfold RD, ARM, CPY in *. lia.
+Qed.
+
+(* what the check says about the state a pass reaches *)
+Lemma chk_spec : forall o t r x y, chk o t r x y = true ->
+  bad t = false
+  /\ (forall i, relevant i = true -> wget (aw t) i = wget (wcfg (ncf o) (nk o)) i)
+  /\ mv (aR t) = (if cons o then 1 else 0) /\ pre (aR t) = [r]
+  /\ mv (aA t) = (if emit o then 1 else 0) /\ pre (aA t) = [if emit o then av o else x]
+  /\ mv (aK t) = (if cw o then 1 else 0) /\ pre (aK t) = [if cw o then r else y].
+Proof.
+  intros o t r x y E. unfold chk in E.
+  apply andb_prop in E as [E HpK]. apply andb_prop in E as [E HmK].
+  apply andb_prop in E as [E HpA]. apply andb_prop in E as [E HmA].
+  apply andb_prop in E as [E HpR]. apply andb_prop in E as [E HmR].
+  apply andb_prop in E as [Hnb Hcells].
+  apply negb_true_iff in Hnb. apply Nat.eqb_eq in HmR, HmA, HmK.
+  apply lbeq_true in HpR, HpA, HpK.
+  refine (conj Hnb (conj _ (conj HmR (conj HpR (conj HmA (conj HpA (conj HmK HpK))))))).
+  intros i Hi. rewrite forallb_forall in Hcells.
+  apply Bool.eqb_prop. apply Hcells. apply filter_In. split; [|exact Hi].
+  apply in_seq. pose proof (relevant_small i Hi). lia.
+Qed.
+
+Lemma length_wcfg : forall cf k, length (wcfg cf k) = 64.
+Proof. intros. unfold wcfg. rewrite length_map, length_seq. reflexivity. Qed.
+
+Lemma rotn_0 : forall l, rotn 0 l = l.
+Proof. reflexivity. Qed.
+
+Theorem machine_pass : forall cf k r x y restR restA restK s,
+  reachable cf = true ->
+  length (win s) = 64 ->
+  (forall i, relevant i = true -> wget (win s) i = wget (wcfg cf k) i) ->
+  contents (if k then d1 s else d0 s) = r :: restR ->
+  contents (if k then q0 s else q1 s) = x :: restA ->
+  contents (if k then d0 s else d1 s) = y :: restK ->
+  contents (if k then q1 s else q0 s) = enc organism ->
+  forall o s', o = dpass cf k r -> s' = itern G s ->
+  (forall i, relevant i = true -> wget (win s') i = wget (wcfg (ncf o) (nk o)) i)
+  /\ length (win s') = 64
+  /\ contents (if k then d1 s' else d0 s') = rotn (if cons o then 1 else 0) (r :: restR)
+  /\ contents (if k then q0 s' else q1 s') =
+       rotn (if emit o then 1 else 0) ((if emit o then av o else x) :: restA)
+  /\ contents (if k then d0 s' else d1 s') = rotn (if cw o then 1 else 0) ((if cw o then r else y) :: restK)
+  /\ contents (if k then q1 s' else q0 s') = enc organism.
+Proof.
+  intros cf k r x y restR restA restK s Hreach Hlen Hw HR HA HK HQ o s' Eo Es'.
+  destruct (chk_spec _ _ _ _ _ (expect_from_check cf k r x y Hreach))
+    as (Hnb & Hcells & HmR & HpR & HmA & HpA & HmK & HpK).
+  rewrite <- Eo in Hcells, HmR, HmA, HpA, HmK, HpK.
+  remember (mkAS (wcfg cf k) (mkA [r] 0) (mkA [x] 0) (mkA [y] 0) 0 false) as te eqn:Ete in *.
+  remember (mkAS (win s) (mkA [r] 0) (mkA [x] 0) (mkA [y] 0) 0 false) as tr eqn:Etr in *.
+  (* the real and the enumerated abstract runs agree away from the temporaries *)
+  assert (Hwbr : wbr_from (skipn (ai tr) organism) istmp (map ao_of (firstn (ai tr) organism)) = true).
+  { rewrite Etr. cbn [ai skipn firstn map]. exact wbr_organism. }
+  assert (Hagr : wagree istmp (map ao_of (firstn (ai tr) organism)) (aw tr) (aw te)).
+  { rewrite Etr, Ete. cbn [ai aw firstn map].
+    intros i Hi H1 H2 H3. destruct Hi as [Hi|[]].
+    apply Hw. apply relevant_of_not_tmp; assumption. }
+  assert (Hlw : length (aw tr) = length (aw te)).
+  { rewrite Etr, Ete. cbn [aw]. rewrite Hlen, length_wcfg. reflexivity. }
+  destruct (aiter_indep G organism istmp tr te eq_refl eq_refl eq_refl Hwbr
+              ltac:(rewrite Etr, Ete; reflexivity) ltac:(rewrite Etr, Ete; reflexivity)
+              ltac:(rewrite Etr, Ete; reflexivity) ltac:(rewrite Etr, Ete; reflexivity)
+              ltac:(rewrite Etr, Ete; reflexivity) Hlw Hagr)
+    as (_ & HaR & HaA & HaK & Hbd & Hwin).
+  (* the physics refines the real abstract run *)
+  assert (Hrel : rel k organism restR restA restK s tr).
+  { unfold rel. rewrite Etr. cbn [aw aR aA aK ai pre mv].
+    refine (conj _ (conj Hlen (conj Hlen (conj _ (conj _ (conj _ _)))))).
+    - intros i _ _ _. reflexivity.
+    - rewrite rotn_0. exact HR.
+    - rewrite rotn_0. exact HA.
+    - rewrite rotn_0. exact HK.
+    - rewrite Nat.mul_0_r, rotn_0. exact HQ. }
+  assert (Hk : wget (win s) KAPPA = k).
+  { change KAPPA with 0. rewrite (Hw 0 eq_refl). reflexivity. }
+  assert (Hn : ai tr + G <= length organism).
+  { rewrite Etr. cbn [ai]. unfold G. lia. }
+  assert (Hb : bad (aiter G organism tr) = false).
+  { rewrite Hbd. exact Hnb. }
+  pose proof (pass_refines G k organism restR restA restK s tr decode_organism Hrel Hk Hn Hb) as Hr.
+  rewrite <- Es' in Hr.
+  pose proof (aiter_ai G organism tr Hn) as Hai.
+  destruct Hr as (Hrw & Hrl & _ & HrR & HrA & HrK & HrQ).
+  refine (conj _ (conj Hrl (conj _ (conj _ (conj _ _))))).
+  - intros i Hi. destruct (relevant_not_tape i Hi) as (H1 & H2 & H3).
+    rewrite (Hrw i H1 H2 H3), (Hwin i (relevant_not_tmp i Hi) H1 H2 H3).
+    exact (Hcells i Hi).
+  - rewrite HrR, HaR, HmR, HpR. reflexivity.
+  - rewrite HrA, HaA, HmA, HpA. reflexivity.
+  - rewrite HrK, HaK, HmK, HpK. reflexivity.
+  - rewrite HrQ, Hai, Etr. cbn [ai]. unfold G. apply bank_full.
+Qed.

rocq/Phys.v

@@ -0,0 +1,102 @@
+(* The two-head physics as a netlist of ternary threshold units, unit for unit in the order of
+   the generator, for banks of N bits and description tapes of L bits. *)
+From Stdlib Require Import List Bool Arith ZArith Lia.
+Import ListNotations.
+From TH Require Import TwoHead Tapes Net Gates.
+
+Section Phys.
+Variables N L : nat.
+
+(* the state: the 61 window cells other than 1, 2 and 3, then Q0, Q1, D0, D1 *)
+Definition realcell (j : nat) : nat := if Nat.eqb j 0 then 0 else j + 3.
+Definition oq0 : nat := 61.
+Definition oq1 : nat := 61 + N.
+Definition od0 : nat := 61 + 2 * N.
+Definition od1 : nat := 61 + 2 * N + L.
+Definition nst : nat := 61 + 2 * N + 2 * L.
+
+Definition kap : sref := SIn 0.
+Definition fld (j : nat) : sref := SRef 0 j 2.
+
+Definition head_src (j : nat) : nat * nat :=
+  match j with 0 => (od1, od0) | 1 => (oq0, oq1) | _ => (od0, od1) end.
+
+Definition bitsof (a t : nat) : bool := Nat.testbit a (5 - t).
+
+Definition cellref (a : nat) : sref :=
+  if Nat.eqb a 1 || Nat.eqb a 2 || Nat.eqb a 3 then SRef 1 (a - 1) 2
+  else SIn (if Nat.eqb a 0 then 0 else a - 3).
+
+Definition xsref (i : nat) : sref := if Nat.eqb i 0 then SRef 6 0 0 else SRef 8 0 0.
+
+Definition vand_bge (i : nat) : nat := match i with 0 => 2 | 1 => 1 | 2 => 0 | 3 => 3 | _ => 4 end.
+
+Definition hatq (bh base m : nat) : sref := if Nat.eqb m 0 then SRef bh 0 5 else SIn (base + m).
+Definition hatd (dh base m : nat) : sref := if Nat.eqb m 0 then SRef dh 0 6 else SIn (base + m).
+
+(* 0: the record in front of the active bank *)
+Definition blk_fld : block := Blk 26 3 (fun j => mux3 0 j 0 kap (SIn (oq1 + j)) (SIn (oq0 + j))).
+(* 1: the cells under the read head, the arm and the copy head *)
+Definition blk_head : block :=
+  Blk 3 3 (fun j => mux3 1 j 0 kap (SIn (fst (head_src j))) (SIn (snd (head_src j)))).
+(* 2, 3, 4: the decode lines of the two operand addresses and the output address *)
+Definition blk_dec (o : nat) : block :=
+  Blk 64 1 (fun a => [sAND (map (fun t => (fld (o + t), bitsof a t)) (seq 0 6))]).
+(* 5 to 8: the two operands *)
+Definition blk_term (bdec : nat) : block := Blk 64 1 (fun a => [sAND [(SRef bdec a 0, true); (cellref a, true)]]).
+Definition blk_xs (bterm : nat) : block := Blk 1 1 (fun _ => [sOR (map (fun a => (SRef bterm a 0, true)) (seq 0 64))]).
+(* 9 to 17: the weights, the bias and the threshold *)
+Definition blk_pos : block := Blk 2 1 (fun i => [sAND [(fld (2 * i), false); (fld (2 * i + 1), true)]]).
+Definition blk_neg : block := Blk 2 1 (fun i => [sAND [(fld (2 * i), true); (fld (2 * i + 1), false)]]).
+Definition blk_mt : block := Blk 2 1 (fun i => [sAND [(SRef 9 i 0, true); (xsref i, true)]]).
+Definition blk_nt : block := Blk 2 1 (fun i => [sAND [(SRef 10 i 0, true); (xsref i, true)]]).
+Definition blk_pge : block :=
+  Blk 5 1 (fun i => [SU (2 - Z.of_nat i)
+                       [(SRef 11 0 0, 1%Z); (SRef 11 1 0, 1%Z); (SRef 12 0 0, (-1)%Z); (SRef 12 1 0, (-1)%Z)]]).
+Definition blk_b4 : block :=
+  Blk 1 4 (fun _ => [sOR [(fld 5, true); (fld 6, true); (fld 7, true)]; sOR [(fld 5, true); (fld 6, true)];
+                     sAND [(fld 5, true); (fld 6, true); (fld 7, true)]; sAND [(fld 5, true); (fld 6, true)]]).
+Definition blk_bge : block :=
+  Blk 1 5 (fun _ => [sAND [(fld 4, false)]; sAND [(fld 4, false); (SRef 14 0 0, true)];
+                     sAND [(fld 4, false); (SRef 14 0 1, true)];
+                     sOR [(fld 4, false); (SRef 14 0 2, true)]; sOR [(fld 4, false); (SRef 14 0 3, true)]]).
+Definition blk_vand : block := Blk 5 1 (fun i => [sAND [(SRef 13 i 0, true); (SRef 15 0 (vand_bge i), true)]]).
+Definition blk_v : block := Blk 1 1 (fun _ => [sOR (map (fun i => (SRef 16 i 0, true)) (seq 0 5))]).
+(* 18, 19: the window after the write, and the cleared request cells *)
+Definition blk_xhat : block := Blk 61 3 (fun j => mux3 18 j 0 (SRef 4 (realcell j) 0) (SRef 17 0 0) (SIn j)).
+Definition blk_zero : block := Blk 1 1 (fun _ => [sOR []]).
+(* 20 to 23: the banks; idlep is the value of kappa for which the bank is idle *)
+Definition blk_bankh (bh : nat) (idlep : bool) (base : nat) : block :=
+  Blk 1 6 (fun _ => [sAND [(kap, idlep); (SRef 18 2 2, true)]; sAND [(kap, idlep); (SRef 18 2 2, false)];
+                     sAND [(SRef 4 2 0, true); (kap, idlep)]] ++ mux3 bh 0 3 (SRef bh 0 2) (SRef 17 0 0) (SIn base)).
+Definition blk_bank (bb bh : nat) (idlep : bool) (base : nat) : block :=
+  Blk N 4 (fun i => [sAND [(kap, negb idlep); (SIn (base + (i + 26) mod N), true)];
+                     sAND [(SRef bh 0 0, true); (hatq bh base ((i + 1) mod N), true)];
+                     sAND [(SRef bh 0 1, true); (hatq bh base i, true)];
+                     sOR [(SRef bb i 0, true); (SRef bb i 1, true); (SRef bb i 2, true)]]).
+(* 24 to 27: the description tapes *)
+Definition blk_desch (dh : nat) (idlep : bool) (base : nat) : block :=
+  Blk 1 7 (fun _ => [sAND [(kap, negb idlep); (SRef 18 1 2, true)]; sAND [(kap, idlep); (SRef 18 3 2, true)];
+                     sOR [(SRef dh 0 0, true); (SRef dh 0 1, true)];
+                     sAND [(SRef 4 3 0, true); (kap, idlep)]] ++ mux3 dh 0 4 (SRef dh 0 3) (SRef 17 0 0) (SIn base)).
+Definition blk_desc (db dh base : nat) : block :=
+  Blk L 3 (fun i => mux3 db i 0 (SRef dh 0 2) (hatd dh base ((i + 1) mod L)) (hatd dh base i)).
+
+Definition phys_blocks : list block :=
+  [blk_fld; blk_head; blk_dec 8; blk_dec 14; blk_dec 20; blk_term 2; blk_xs 5; blk_term 3; blk_xs 7;
+   blk_pos; blk_neg; blk_mt; blk_nt; blk_pge; blk_b4; blk_bge; blk_vand; blk_v; blk_xhat; blk_zero;
+   blk_bankh 20 true oq0; blk_bank 21 20 true oq0; blk_bankh 22 false oq1; blk_bank 23 22 false oq1;
+   blk_desch 24 true od0; blk_desc 25 24 od0; blk_desch 26 false od1; blk_desc 27 26 od1].
+
+(* the unit computing the next value of each state bit *)
+Definition out_ref (i : nat) : sref :=
+  if i <? 61 then (if Nat.eqb i 1 || Nat.eqb i 2 || Nat.eqb i 3 then SRef 19 0 0 else SRef 18 i 2)
+  else if i <? oq1 then SRef 21 (i - oq0) 3
+  else if i <? od0 then SRef 23 (i - oq1) 3
+  else if i <? od1 then SRef 25 (i - od0) 2
+  else SRef 27 (i - od1) 2.
+
+Definition phys_units : list tu := compile nst phys_blocks.
+Definition phys_next : list nat := map (fun i => idx nst phys_blocks (out_ref i)) (seq 0 nst).
+
+End Phys.

rocq/PhysFacts.v

@@ -0,0 +1,65 @@
+(* The size of the physics netlist, and its weights, each +1 or -1. *)
+From Stdlib Require Import List Bool Arith ZArith Lia.
+Import ListNotations.
+From TH Require Import TwoHead Net Gates Phys PhysWF.
+
+Lemma phys_size : forall N L, length (phys_units N L) = 647 + 8 * N + 6 * L.
+Proof.
+  intros N L. unfold phys_units. rewrite length_compile by apply phys_shaped.
+  rewrite phys_length. cbn [phys_blocks boff bcount bsize blk_fld blk_head blk_dec blk_term blk_xs blk_pos
+    blk_neg blk_mt blk_nt blk_pge blk_b4 blk_bge blk_vand blk_v blk_xhat blk_zero blk_bankh blk_bank
+    blk_desch blk_desc]. lia.
+Qed.
+
+Definition ter (u : su) : Prop := forall x w, In (x, w) (sin u) -> w = 1%Z \/ w = (-1)%Z.
+
+Lemma ter_lits : forall b ls, ter (SU b (map lw ls)).
+Proof.
+  intros b ls x w H. cbn [sin] in H. apply in_map_iff in H as ([y p] & E & _).
+  unfold lw in E. cbn [fst snd] in E. injection E as _ <-. destruct p; [left|right]; reflexivity.
+Qed.
+
+Lemma ter_and : forall ls, ter (sAND ls).
+Proof. intro ls. apply ter_lits. Qed.
+
+Lemma ter_or : forall ls, ter (sOR ls).
+Proof. intro ls. apply ter_lits. Qed.
+
+Lemma ter_mux : forall b j r0 sel a c, Forall ter (mux3 b j r0 sel a c).
+Proof. intros. unfold mux3. repeat apply Forall_cons; try apply Forall_nil; apply ter_lits. Qed.
+
+Lemma ter_nth : forall l r, Forall ter l -> ter (nth r l su0).
+Proof.
+  intros l r H. revert r. induction H as [|u l Hu H IH]; intro r.
+  - destruct r; intros x w Hin; destruct Hin.
+  - destruct r; [exact Hu | apply IH].
+Qed.
+
+Lemma ter_shapes : forall N L b j, Forall ter (bshape (nth b (phys_blocks N L) blk0) j).
+Proof.
+  intros N L b j.
+  do 28 (destruct b as [|b];
+    [ cbn [nth phys_blocks bshape blk_fld blk_head blk_dec blk_term blk_xs blk_pos blk_neg blk_mt blk_nt
+           blk_pge blk_b4 blk_bge blk_vand blk_v blk_xhat blk_zero blk_bankh blk_bank blk_desch blk_desc];
+      repeat first [ apply Forall_app; split | apply ter_mux | apply Forall_cons | apply Forall_nil
+                   | apply ter_and | apply ter_or ];
+      try (intros x w Hin; cbn [sin] in Hin;
+           repeat (destruct Hin as [Hin|Hin]; [injection Hin as _ <-; lia|]); destruct Hin)
+    | ]).
+  destruct b; cbn [nth phys_blocks bshape blk0]; apply Forall_nil.
+Qed.
+
+(* every unit of the netlist reads its predecessors with weight +1 or -1 *)
+Theorem phys_ternary : forall N L u, In u (phys_units N L) ->
+  forall i w, In (i, w) (tin u) -> w = 1%Z \/ w = (-1)%Z.
+Proof.
+  intros N L u Hu i w Hin. unfold phys_units, compile in Hu.
+  apply in_concat in Hu as (us & Hus & Hu). apply in_map_iff in Hus as (blk & <- & Hblk).
+  unfold flat_block in Hu. apply in_concat in Hu as (us & Hus & Hu).
+  apply in_map_iff in Hus as (j & <- & Hj). apply in_map_iff in Hu as (v & <- & Hv).
+  unfold flat_unit in Hin. cbn [tin] in Hin. apply in_map_iff in Hin as ([x w'] & E & Hin).
+  cbn [fst snd] in E. injection E as _ <-.
+  apply In_nth with (d := blk0) in Hblk as (b & _ & <-).
+  apply In_nth with (d := su0) in Hv as (r & _ & <-).
+  exact (ter_nth _ r (ter_shapes N L b j) x w' Hin).
+Qed.

rocq/PhysMain.v

@@ -0,0 +1,91 @@
+(* The netlist of ternary threshold units computes one step of the two-head machine. *)
+From Stdlib Require Import List Bool Arith ZArith Lia.
+Import ListNotations.
+From TH Require Import TwoHead Tapes Abstract Net Gates Phys PhysWF PhysSem.
+
+Lemma F_unfold : forall N L s x,
+  run (phys_units N L) (nst N L) (fun i => nth i (encode s) false) (idx (nst N L) (phys_blocks N L) x) = F N L s x.
+Proof. intros. unfold F, X. reflexivity. Qed.
+
+Lemma wget_clearq_req : forall w a, length w = 64 -> a = 4 \/ a = 5 \/ a = 6 -> wget (clearq w) a = false.
+Proof.
+  intros w a Hw Ha. unfold clearq, AA, AR, AC. rewrite !wget_upd, !upd_length, Hw.
+  destruct Ha as [-> | [-> | ->]]; reflexivity.
+Qed.
+
+Lemma win_stepres : forall s k qa' ao v, win (stepres s k qa' ao v) = clearq (wnext (win s) ao v).
+Proof. intros s k qa' ao v. unfold stepres. cbv zeta. destruct k; reflexivity. Qed.
+
+Lemma length_wrote : forall s l h, length (wrote s l h) = length l.
+Proof. intros s l h. unfold wrote. destruct h; [apply wr0_length|reflexivity]. Qed.
+
+Lemma length_wrotec : forall s l h, length (wrotec s l h) = length l.
+Proof. intros s l h. unfold wrotec. destruct h; [apply wr0_length|reflexivity]. Qed.
+
+(* From any state whose banks hold N >= 26 bits, whose description tapes hold L >= 1 bits and
+   whose window has 64 cells, the netlist, evaluated unit by unit on the encoded state, gives
+   the encoding of the next state. *)
+Theorem netlist_step : forall N L s, 26 <= N -> 1 <= L -> length (win s) = 64 ->
+  length (contents (q0 s)) = N -> length (contents (q1 s)) = N ->
+  length (contents (d0 s)) = L -> length (contents (d1 s)) = L ->
+  netstep (nst N L) (phys_units N L) (phys_next N L) (encode s) = encode (step s).
+Proof.
+  intros N L s HN HL Hw H0 H1 H2 H3.
+  destruct (step_eq N L s HN HL H0 H1 H2 H3 Hw) as (qa' & Hqa & Hst).
+  pose proof (tapes_step N L s HN HL H0 H1 H2 H3 Hw qa' Hqa) as T. cbv zeta in T.
+  rewrite <- Hst in T. destruct T as (T0 & T1 & T2 & T3).
+  assert (L0 : length (contents (q0 (step s))) = N)
+    by (rewrite T0; destruct (kk s), (advA s); rewrite ?rot1_length, ?length_wrote, ?rotn_length; assumption).
+  assert (L1 : length (contents (q1 (step s))) = N)
+    by (rewrite T1; destruct (kk s), (advA s); rewrite ?rot1_length, ?length_wrote, ?rotn_length; assumption).
+  assert (L2 : length (contents (d0 (step s))) = L)
+    by (rewrite T2; destruct (kk s), (advC s), (advR s); rewrite ?rot1_length, ?length_wrotec; assumption).
+  assert (L3 : length (contents (d1 (step s))) = L)
+    by (rewrite T3; destruct (kk s), (advC s), (advR s); rewrite ?rot1_length, ?length_wrotec; assumption).
+  unfold netstep, phys_next. rewrite map_map.
+  apply nth_ext with (d := false) (d' := false).
+  { rewrite length_map, length_seq, (length_encode (step s) N L L0 L1 L2 L3). reflexivity. }
+  intros i Hi. rewrite length_map, length_seq in Hi.
+  rewrite (nth_map_seq _ (fun i => run (phys_units N L) (nst N L) (fun i0 => nth i0 (encode s) false)
+                                   (idx (nst N L) (phys_blocks N L) (out_ref N L i))) (nst N L) i false Hi).
+  rewrite F_unfold.
+  rewrite (nth_encode (step s) N L i L0 L1 L2 L3).
+  unfold out_ref, oq0, oq1, od0, od1, nst in *.
+  destruct (Nat.ltb_spec i 61) as [Hw61|Hw61].
+  - (* the window *)
+    rewrite Hst, win_stepres.
+    destruct (Nat.eqb i 1 || Nat.eqb i 2 || Nat.eqb i 3) eqn:E.
+    + rewrite (F_zero N L s HN HL H0 H1 H2 H3). symmetry. apply wget_clearq_req; [rewrite length_wnext; exact Hw|].
+      unfold realcell. apply orb_true_iff in E as [E|E]; [apply orb_true_iff in E as [E|E]|];
+        apply Nat.eqb_eq in E; subst i; cbn; lia.
+    + rewrite (F_xhat N L s HN HL H0 H1 H2 H3 i Hw61).
+      apply orb_false_iff in E as [E E3]. apply orb_false_iff in E as [E1 E2].
+      apply Nat.eqb_neq in E1, E2, E3.
+      assert (Hr : realcell i < 64 /\ realcell i <> 1 /\ realcell i <> 2 /\ realcell i <> 3
+                   /\ realcell i <> AA /\ realcell i <> AR /\ realcell i <> AC)
+        by (unfold realcell, AA, AR, AC; destruct (Nat.eqb_spec i 0); lia).
+      destruct Hr as (R0 & R1 & R2 & R3 & R4 & R5 & R6).
+      rewrite wget_clearq_other by assumption. rewrite (wget_wn N L s) by assumption. reflexivity.
+  - destruct (Nat.ltb_spec i (61 + N)) as [Hq|Hq].
+    + (* bank 0 *)
+      rewrite (F_bank N L s HN HL H0 H1 H2 H3 20 21 true 61 (q0 s)
+                 ltac:(left; repeat split) (i - 61) ltac:(lia)).
+      rewrite T0. destruct (kk s); reflexivity.
+    + destruct (Nat.ltb_spec i (61 + 2 * N)) as [Hq'|Hq'].
+      * (* bank 1 *)
+        replace (i - (61 + N)) with (i - 61 - N) by lia.
+        rewrite (F_bank N L s HN HL H0 H1 H2 H3 22 23 false (oq1 N) (q1 s)
+                   ltac:(right; repeat split) (i - 61 - N) ltac:(lia)).
+        rewrite T1. destruct (kk s); reflexivity.
+      * destruct (Nat.ltb_spec i (61 + 2 * N + L)) as [Hd|Hd].
+        -- (* description tape 0 *)
+           replace (i - (61 + 2 * N)) with (i - 61 - 2 * N) by lia.
+           rewrite (F_desc N L s HN HL H0 H1 H2 H3 24 25 true (od0 N) (d0 s)
+                      ltac:(left; repeat split) (i - 61 - 2 * N) ltac:(lia)).
+           rewrite T2. destruct (kk s); reflexivity.
+        -- (* description tape 1 *)
+           replace (i - (61 + 2 * N + L)) with (i - 61 - 2 * N - L) by lia.
+           rewrite (F_desc N L s HN HL H0 H1 H2 H3 26 27 false (od1 N L) (d1 s)
+                      ltac:(right; repeat split) (i - 61 - 2 * N - L) ltac:(lia)).
+           rewrite T3. destruct (kk s); reflexivity.
+Qed.

rocq/PhysSem.v

@@ -0,0 +1,655 @@
+(* What each block of the physics netlist computes, from a state of the two-head machine. *)
+From Stdlib Require Import List Bool Arith ZArith Lia.
+Import ListNotations.
+From TH Require Import TwoHead Tapes Abstract Net Gates Phys PhysWF.
+
+(* the state bits of a machine state, in the order of the netlist *)
+Definition encode (s : st) : list bool :=
+  map (fun j => wget (win s) (realcell j)) (seq 0 61)
+  ++ contents (q0 s) ++ contents (q1 s) ++ contents (d0 s) ++ contents (d1 s).
+
+Lemma length_encode : forall s N L,
+  length (contents (q0 s)) = N -> length (contents (q1 s)) = N ->
+  length (contents (d0 s)) = L -> length (contents (d1 s)) = L ->
+  length (encode s) = nst N L.
+Proof.
+  intros s N L H1 H2 H3 H4. unfold encode, nst.
+  rewrite !length_app, length_map, length_seq, H1, H2, H3, H4. lia.
+Qed.
+
+Section Sem.
+Variables (N L : nat) (s : st).
+Hypotheses (HN : 26 <= N) (HL : 1 <= L)
+  (Hq0 : length (contents (q0 s)) = N) (Hq1 : length (contents (q1 s)) = N)
+  (Hd0 : length (contents (d0 s)) = L) (Hd1 : length (contents (d1 s)) = L).
+
+Definition X (i : nat) : bool := nth i (encode s) false.
+Definition F (x : sref) : bool := run (phys_units N L) (nst N L) X (idx (nst N L) (phys_blocks N L) x).
+
+Lemma X_win : forall j, j < 61 -> X j = wget (win s) (realcell j).
+Proof.
+  intros j Hj. unfold X, encode. rewrite app_nth1 by (rewrite length_map, length_seq; exact Hj).
+  exact (nth_map_seq _ (fun j => wget (win s) (realcell j)) 61 j false Hj).
+Qed.
+
+Lemma X_tape : forall i,
+  (i < N -> X (oq0 + i) = nth i (contents (q0 s)) false)
+  /\ (i < N -> X (oq1 N + i) = nth i (contents (q1 s)) false)
+  /\ (i < L -> X (od0 N + i) = nth i (contents (d0 s)) false)
+  /\ (i < L -> X (od1 N L + i) = nth i (contents (d1 s)) false).
+Proof.
+  intro i. unfold X, encode, oq0, oq1, od0, od1.
+  repeat split; intro Hi; rewrite app_nth2 by (rewrite length_map, length_seq; lia);
+    rewrite length_map, length_seq.
+  - rewrite app_nth1 by lia. f_equal. lia.
+  - rewrite app_nth2 by lia. rewrite app_nth1 by lia. f_equal. lia.
+  - rewrite app_nth2 by lia. rewrite app_nth2 by lia. rewrite app_nth1 by lia. f_equal. lia.
+  - rewrite app_nth2 by lia. rewrite app_nth2 by lia. rewrite app_nth2 by lia. f_equal. lia.
+Qed.
+
+Lemma F_in : forall i, i < nst N L -> F (SIn i) = X i.
+Proof. intros i H. unfold F, phys_units. apply net_in. exact H. Qed.
+
+Lemma F_unit : forall b j r, b < 28 ->
+  j < bcount (nth b (phys_blocks N L) blk0) -> r < bsize (nth b (phys_blocks N L) blk0) ->
+  F (SRef b j r) = sfire' (sunit (phys_blocks N L) b j r) F.
+Proof.
+  intros b j r Hb Hj Hr. unfold F, phys_units. apply net_unit; [apply phys_wf; assumption| |assumption|assumption].
+  rewrite phys_length. exact Hb.
+Qed.
+
+Lemma F_and : forall b j r ls, b < 28 ->
+  j < bcount (nth b (phys_blocks N L) blk0) -> r < bsize (nth b (phys_blocks N L) blk0) ->
+  sunit (phys_blocks N L) b j r = sAND ls -> F (SRef b j r) = forallb (litv F) ls.
+Proof. intros b j r ls Hb Hj Hr E. rewrite F_unit, E by assumption. apply sAND_fire. Qed.
+
+Lemma F_or : forall b j r ls, b < 28 ->
+  j < bcount (nth b (phys_blocks N L) blk0) -> r < bsize (nth b (phys_blocks N L) blk0) ->
+  sunit (phys_blocks N L) b j r = sOR ls -> F (SRef b j r) = existsb (litv F) ls.
+Proof. intros b j r ls Hb Hj Hr E. rewrite F_unit, E by assumption. apply sOR_fire. Qed.
+
+Lemma F_mux : forall b j r0 sel a c, b < 28 ->
+  j < bcount (nth b (phys_blocks N L) blk0) -> S (S r0) < bsize (nth b (phys_blocks N L) blk0) ->
+  sunit (phys_blocks N L) b j r0 = sAND [(sel, true); (a, true)] ->
+  sunit (phys_blocks N L) b j (S r0) = sAND [(sel, false); (c, true)] ->
+  sunit (phys_blocks N L) b j (S (S r0)) = sOR [(SRef b j r0, true); (SRef b j (S r0), true)] ->
+  F (SRef b j (S (S r0))) = if F sel then F a else F c.
+Proof.
+  intros b j r0 sel a c Hb Hj Hr E0 E1 E2.
+  rewrite (F_or b j (S (S r0)) _ Hb Hj Hr E2). cbn [existsb]. rewrite !litv_pos.
+  rewrite (F_and b j r0 _ Hb Hj ltac:(lia) E0), (F_and b j (S r0) _ Hb Hj ltac:(lia) E1).
+  cbn [forallb]. rewrite !litv_pos, litv_neg. destruct (F sel), (F a), (F c); reflexivity.
+Qed.
+
+(* ---- the semantic quantities of one step ------------------------------------------ *)
+Definition kk : bool := wget (win s) 0.
+Definition qa : list bool := contents (if kk then q1 s else q0 s).
+
+Lemma F_kap : F kap = kk.
+Proof. unfold kap. rewrite F_in by (unfold nst; lia). rewrite X_win by lia. reflexivity. Qed.
+
+Ltac blk_compute := cbn [nth phys_blocks bcount bsize bshape blk_fld blk_head blk_dec blk_term blk_xs blk_pos
+  blk_neg blk_mt blk_nt blk_pge blk_b4 blk_bge blk_vand blk_v blk_xhat blk_zero blk_bankh blk_bank
+  blk_desch blk_desc sunit mux3 app].
+
+(* block 0: the record in front of the active bank *)
+Lemma F_fld : forall j, j < 26 -> F (fld j) = nth j qa false.
+Proof.
+  intros j Hj. unfold fld.
+  rewrite (F_mux 0 j 0 kap (SIn (oq1 N + j)) (SIn (oq0 + j))) by (blk_compute; first [lia | reflexivity]).
+  rewrite F_kap, !F_in by (unfold nst, oq0, oq1; lia).
+  destruct (X_tape j) as (T0 & T1 & _ & _). rewrite T0, T1 by lia.
+  unfold qa. destruct kk; reflexivity.
+Qed.
+
+(* block 1: the cells under the read head, the arm and the copy head *)
+Definition rdv : bool := hd0 (contents (if kk then d1 s else d0 s)).
+Definition armv : bool := hd0 (contents (if kk then q0 s else q1 s)).
+Definition cpyv : bool := hd0 (contents (if kk then d0 s else d1 s)).
+
+Lemma nth0_hd0 : forall l, nth 0 l false = hd0 l.
+Proof. intros [|x l]; reflexivity. Qed.
+
+Lemma F_heads : F (SRef 1 0 2) = rdv /\ F (SRef 1 1 2) = armv /\ F (SRef 1 2 2) = cpyv.
+Proof.
+  destruct (X_tape 0) as (T0 & T1 & T2 & T3).
+  rewrite <- !plus_n_O in T0, T1, T2, T3.
+  repeat split;
+    (rewrite F_mux with (sel := kap)
+       (a := SIn (fst (head_src N L _))) (c := SIn (snd (head_src N L _))) by (blk_compute; first [lia | reflexivity]));
+    cbn [head_src fst snd]; rewrite F_kap, !F_in by (unfold nst, oq0, oq1, od0, od1; lia);
+    rewrite ?T0, ?T1, ?T2, ?T3 by lia; unfold rdv, armv, cpyv; rewrite <- ?nth0_hd0; destruct kk; reflexivity.
+Qed.
+
+(* ---- blocks 2 to 8: the three addresses and the two operands --------------------- *)
+Lemma bits2nat_nat2bits : forall a, a < 64 -> bits2nat (nat2bits 6 a) = a.
+Proof. intros a Ha. do 64 (destruct a as [|a]; [reflexivity|]). lia. Qed.
+
+Lemma nat2bits_bits2nat : forall f, length f = 6 -> nat2bits 6 (bits2nat f) = f.
+Proof.
+  intros f Hf. destruct f as [|b0 [|b1 [|b2 [|b3 [|b4 [|b5 [|? ?]]]]]]]; cbn [length] in Hf; try lia.
+  destruct b0, b1, b2, b3, b4, b5; reflexivity.
+Qed.
+
+Lemma lbeq_refl : forall l, lbeq l l = true.
+Proof. induction l as [|x l IH]; [reflexivity|]. cbn [lbeq]. rewrite IH, eqb_reflx. reflexivity. Qed.
+
+Lemma dec_ok : forall f a, length f = 6 -> a < 64 ->
+  forallb (fun t => Bool.eqb (nth t f false) (bitsof a t)) (seq 0 6) = Nat.eqb (bits2nat f) a.
+Proof.
+  intros f a Hf Ha.
+  assert (E : forallb (fun t => Bool.eqb (nth t f false) (bitsof a t)) (seq 0 6) = lbeq f (nat2bits 6 a)).
+  { destruct f as [|b0 [|b1 [|b2 [|b3 [|b4 [|b5 [|? ?]]]]]]]; cbn [length] in Hf; try lia.
+    unfold bitsof. cbn - [Nat.testbit Bool.eqb]. rewrite !andb_true_r. reflexivity. }
+  rewrite E. destruct (lbeq f (nat2bits 6 a)) eqn:El; destruct (Nat.eqb (bits2nat f) a) eqn:En; auto.
+  - apply lbeq_true in El. subst f. rewrite bits2nat_nat2bits in En by exact Ha.
+    rewrite Nat.eqb_refl in En. discriminate.
+  - apply Nat.eqb_eq in En. rewrite <- En, nat2bits_bits2nat, lbeq_refl in El by exact Hf. discriminate.
+Qed.
+
+Lemma length_qa : length qa = N.
+Proof. unfold qa. destruct kk; assumption. Qed.
+
+Definition field (o : nat) : list bool := firstn 6 (skipn o qa).
+
+Lemma length_field : forall o, o + 6 <= 26 -> length (field o) = 6.
+Proof. intros o Ho. unfold field. rewrite length_firstn, length_skipn, length_qa. lia. Qed.
+
+Lemma nth_field : forall o t, t < 6 -> nth t (field o) false = nth (o + t) qa false.
+Proof. intros o t Ht. unfold field. rewrite nth_firstn. destruct (Nat.ltb_spec t 6); [|lia]. apply nth_skipn. Qed.
+
+Lemma forallb_map' : forall (A B : Type) (f : B -> bool) (g : A -> B) l, forallb f (map g l) = forallb (fun x => f (g x)) l.
+Proof. intros A B f g l. induction l as [|x l IH]; [reflexivity|]. cbn [map forallb]. rewrite IH. reflexivity. Qed.
+
+Lemma existsb_map' : forall (A B : Type) (f : B -> bool) (g : A -> B) l, existsb f (map g l) = existsb (fun x => f (g x)) l.
+Proof. intros A B f g l. induction l as [|x l IH]; [reflexivity|]. cbn [map existsb]. rewrite IH. reflexivity. Qed.
+
+Lemma forallb_ext_in : forall (A : Type) (f g : A -> bool) l, (forall x, In x l -> f x = g x) -> forallb f l = forallb g l.
+Proof. intros A f g l H. induction l as [|x l IH]; [reflexivity|]. cbn [forallb]. rewrite H, IH; [reflexivity| |left; reflexivity]. intros y Hy. apply H. right. exact Hy. Qed.
+
+Lemma existsb_ext_in : forall (A : Type) (f g : A -> bool) l, (forall x, In x l -> f x = g x) -> existsb f l = existsb g l.
+Proof. intros A f g l H. induction l as [|x l IH]; [reflexivity|]. cbn [existsb]. rewrite H, IH; [reflexivity| |left; reflexivity]. intros y Hy. apply H. right. exact Hy. Qed.
+
+Lemma F_dec : forall b o a, (b = 2 /\ o = 8) \/ (b = 3 /\ o = 14) \/ (b = 4 /\ o = 20) -> a < 64 ->
+  F (SRef b a 0) = Nat.eqb (bits2nat (field o)) a.
+Proof.
+  intros b o a Hbo Ha.
+  assert (Hs : sunit (phys_blocks N L) b a 0 = sAND (map (fun t => (fld (o + t), bitsof a t)) (seq 0 6)))
+    by (destruct Hbo as [[-> ->]|[[-> ->]|[-> ->]]]; reflexivity).
+  rewrite (F_and b a 0 _ ltac:(lia) ltac:(destruct Hbo as [[-> ->]|[[-> ->]|[-> ->]]]; blk_compute; lia)
+             ltac:(destruct Hbo as [[-> ->]|[[-> ->]|[-> ->]]]; blk_compute; lia) Hs).
+  rewrite forallb_map'. rewrite <- dec_ok by (try apply length_field; lia).
+  apply forallb_ext_in. intros t Ht. apply in_seq in Ht.
+  unfold litv. cbn [fst snd]. rewrite F_fld by lia. rewrite nth_field by lia. reflexivity.
+Qed.
+
+Definition cellv (a : nat) : bool :=
+  if Nat.eqb a 1 then rdv else if Nat.eqb a 2 then armv else if Nat.eqb a 3 then cpyv else wget (win s) a.
+
+Lemma F_cellref : forall a, a < 64 -> F (cellref a) = cellv a.
+Proof.
+  intros a Ha. destruct F_heads as (H1 & H2 & H3). unfold cellref, cellv.
+  destruct (Nat.eqb_spec a 1) as [->|E1]; [exact H1|].
+  destruct (Nat.eqb_spec a 2) as [->|E2]; [exact H2|].
+  destruct (Nat.eqb_spec a 3) as [->|E3]; [exact H3|]. cbn [orb].
+  destruct (Nat.eqb_spec a 0) as [->|E0].
+  - rewrite F_in by (unfold nst; lia). rewrite X_win by lia. reflexivity.
+  - rewrite F_in by (unfold nst; lia). rewrite X_win by lia. unfold realcell.
+    destruct (Nat.eqb_spec (a - 3) 0); [lia|]. f_equal. lia.
+Qed.
+
+Lemma existsb_pick : forall (g : nat -> bool) c n m,
+  existsb (fun a => Nat.eqb c a && g a) (seq m n) = if (m <=? c) && (c <? m + n) then g c else false.
+Proof.
+  intros g c n. induction n as [|n IH]; intro m; cbn [seq existsb].
+  - destruct (Nat.leb_spec m c), (Nat.ltb_spec c (m + 0)); cbn [andb]; try reflexivity; lia.
+  - rewrite IH. destruct (Nat.eqb_spec c m) as [E|E].
+    + subst c. rewrite Nat.leb_refl.
+      replace (m <? m + S n) with true by (symmetry; apply Nat.ltb_lt; lia).
+      replace (S m <=? m) with false by (symmetry; apply Nat.leb_gt; lia).
+      cbn [andb orb]. destruct (g m); reflexivity.
+    + cbn [andb orb].
+      destruct (Nat.leb_spec m c), (Nat.leb_spec (S m) c), (Nat.ltb_spec c (S m + n)), (Nat.ltb_spec c (m + S n));
+        cbn [andb]; try reflexivity; lia.
+Qed.
+
+Definition fa (o : nat) : nat := bits2nat (field o).
+
+Lemma fa_lt : forall o, o + 6 <= 26 -> fa o < 64.
+Proof.
+  intros o Ho. unfold fa. pose proof (length_field o Ho) as H.
+  rewrite <- (nat2bits_bits2nat (field o) H). remember (field o) as f eqn:Ef. clear Ef.
+  destruct f as [|b0 [|b1 [|b2 [|b3 [|b4 [|b5 [|? ?]]]]]]]; cbn [length] in H; try lia.
+  destruct b0, b1, b2, b3, b4, b5; cbn; lia.
+Qed.
+
+Lemma F_xs : forall i, i < 2 -> F (xsref i) = cellv (fa (8 + 6 * i)).
+Proof.
+  intros i Hi. unfold xsref.
+  assert (Hlt := fa_lt (8 + 6 * i) ltac:(lia)).
+  destruct (Nat.eqb_spec i 0) as [->|E].
+  - rewrite (F_or 6 0 0 (map (fun a => (SRef 5 a 0, true)) (seq 0 64))) by (blk_compute; first [lia | reflexivity]).
+    rewrite existsb_map'.
+    rewrite (existsb_ext_in _ _ (fun a => Nat.eqb (fa 8) a && cellv a)).
+    + rewrite existsb_pick. cbn [Nat.mul Nat.add] in Hlt.
+      replace (0 <=? fa 8) with true by (symmetry; apply Nat.leb_le; lia).
+      replace (fa 8 <? 0 + 64) with true by (symmetry; apply Nat.ltb_lt; lia).
+      reflexivity.
+    + intros a Ha. apply in_seq in Ha. rewrite litv_pos.
+      rewrite (F_and 5 a 0 [(SRef 2 a 0, true); (cellref a, true)]) by (blk_compute; first [lia | reflexivity]).
+      cbn [forallb]. rewrite !litv_pos, andb_true_r.
+      rewrite F_dec with (o := 8) by (lia || (left; split; reflexivity)).
+      rewrite F_cellref by lia. reflexivity.
+  - replace i with 1 in * by lia.
+    rewrite (F_or 8 0 0 (map (fun a => (SRef 7 a 0, true)) (seq 0 64))) by (blk_compute; first [lia | reflexivity]).
+    rewrite existsb_map'.
+    rewrite (existsb_ext_in _ _ (fun a => Nat.eqb (fa 14) a && cellv a)).
+    + rewrite existsb_pick. cbn [Nat.mul Nat.add] in Hlt.
+      replace (0 <=? fa 14) with true by (symmetry; apply Nat.leb_le; lia).
+      replace (fa 14 <? 0 + 64) with true by (symmetry; apply Nat.ltb_lt; lia).
+      reflexivity.
+    + intros a Ha. apply in_seq in Ha. rewrite litv_pos.
+      rewrite (F_and 7 a 0 [(SRef 3 a 0, true); (cellref a, true)]) by (blk_compute; first [lia | reflexivity]).
+      cbn [forallb]. rewrite !litv_pos, andb_true_r.
+      rewrite F_dec with (o := 14) by (lia || (right; left; split; reflexivity)).
+      rewrite F_cellref by lia. reflexivity.
+Qed.
+
+(* ---- blocks 9 to 17: the weights, the bias and the threshold -------------------------- *)
+Definition fb (j : nat) : bool := nth j qa false.
+
+Definition beta4 (b3 b2 b1 b0 : bool) : Z :=
+  let braw := Z.of_nat (bits2nat [b3; b2; b1; b0]) in if Z.leb 8 braw then (braw - 16)%Z else braw.
+
+(* the threshold as its units compute it, on the ten bits it reads *)
+Definition vnet (f0 f1 f2 f3 f4 f5 f6 f7 y0 y1 : bool) : bool :=
+  let mt0 := negb f0 && f1 && y0 in let mt1 := negb f2 && f3 && y1 in
+  let nt0 := f0 && negb f1 && y0 in let nt1 := f2 && negb f3 && y1 in
+  let pge (c : Z) := Z.leb 0 (- c + b2z mt0 + b2z mt1 - b2z nt0 - b2z nt1)%Z in
+  let bge0 := negb f4 in let bge1 := negb f4 && (f5 || f6 || f7) in let bge2 := negb f4 && (f5 || f6) in
+  let bgem1 := negb f4 || (f5 && f6 && f7) in let bgem2 := negb f4 || (f5 && f6) in
+  (pge (-2)%Z && bge2) || (pge (-1)%Z && bge1) || (pge 0%Z && bge0) || (pge 1%Z && bgem1) || (pge 2%Z && bgem2).
+
+Lemma vnet_ok : forall f0 f1 f2 f3 f4 f5 f6 f7 y0 y1,
+  vnet f0 f1 f2 f3 f4 f5 f6 f7 y0 y1
+  = Z.leb 0 (wcode f0 f1 * b2z y0 + wcode f2 f3 * b2z y1 + beta4 f4 f5 f6 f7)%Z.
+Proof. intros. destruct f0, f1, f2, f3, f4, f5, f6, f7, y0, y1; reflexivity. Qed.
+
+Lemma F_fb : forall j, j < 26 -> F (fld j) = fb j.
+Proof. exact F_fld. Qed.
+
+Lemma F_v : F (SRef 17 0 0) =
+  vnet (fb 0) (fb 1) (fb 2) (fb 3) (fb 4) (fb 5) (fb 6) (fb 7) (F (xsref 0)) (F (xsref 1)).
+Proof.
+  rewrite (F_or 17 0 0 (map (fun i => (SRef 16 i 0, true)) (seq 0 5))) by (blk_compute; first [lia | reflexivity]).
+  cbn [map seq existsb]. rewrite !litv_pos, orb_false_r.
+  (* the five conjunctions of a lower bound on the weighted inputs with a lower bound on the bias *)
+  assert (Hvand : forall i, i < 5 -> F (SRef 16 i 0) = F (SRef 13 i 0) && F (SRef 15 0 (vand_bge i))).
+  { intros i Hi. rewrite (F_and 16 i 0 [(SRef 13 i 0, true); (SRef 15 0 (vand_bge i), true)])
+      by (blk_compute; first [lia | reflexivity]).
+    cbn [forallb]. rewrite !litv_pos, andb_true_r. reflexivity. }
+  rewrite !Hvand by lia. cbn [vand_bge].
+  (* the bias bounds *)
+  assert (Hb4 : F (SRef 14 0 0) = fb 5 || fb 6 || fb 7 /\ F (SRef 14 0 1) = fb 5 || fb 6
+                /\ F (SRef 14 0 2) = fb 5 && fb 6 && fb 7 /\ F (SRef 14 0 3) = fb 5 && fb 6).
+  { repeat split;
+      first [ rewrite F_or with (ls := [(fld 5, true); (fld 6, true); (fld 7, true)]) by (blk_compute; first [lia | reflexivity])
+            | rewrite F_or with (ls := [(fld 5, true); (fld 6, true)]) by (blk_compute; first [lia | reflexivity])
+            | rewrite F_and with (ls := [(fld 5, true); (fld 6, true); (fld 7, true)]) by (blk_compute; first [lia | reflexivity])
+            | rewrite F_and with (ls := [(fld 5, true); (fld 6, true)]) by (blk_compute; first [lia | reflexivity]) ];
+      cbn [forallb existsb]; rewrite !litv_pos, !F_fb by lia; rewrite ?orb_false_r, ?andb_true_r, ?orb_assoc, ?andb_assoc;
+      reflexivity. }
+  destruct Hb4 as (B0 & B1 & B2 & B3).
+  rewrite (F_and 15 0 0 [(fld 4, false)]) by (blk_compute; first [lia | reflexivity]).
+  rewrite (F_and 15 0 1 [(fld 4, false); (SRef 14 0 0, true)]) by (blk_compute; first [lia | reflexivity]).
+  rewrite (F_and 15 0 2 [(fld 4, false); (SRef 14 0 1, true)]) by (blk_compute; first [lia | reflexivity]).
+  rewrite (F_or 15 0 3 [(fld 4, false); (SRef 14 0 2, true)]) by (blk_compute; first [lia | reflexivity]).
+  rewrite (F_or 15 0 4 [(fld 4, false); (SRef 14 0 3, true)]) by (blk_compute; first [lia | reflexivity]).
+  cbn [forallb existsb]. rewrite ?litv_pos, ?litv_neg, B0, B1, B2, B3, !F_fb by lia.
+  (* the weighted-input bounds *)
+  assert (Hp : forall i, i < 5 -> F (SRef 13 i 0)
+            = Z.leb 0 (2 - Z.of_nat i + (1 * b2z (F (SRef 11 0 0)) + (1 * b2z (F (SRef 11 1 0))
+                       + (-1 * b2z (F (SRef 12 0 0)) + (-1 * b2z (F (SRef 12 1 0)) + 0)))))%Z).
+  { intros i Hi. rewrite F_unit by (blk_compute; lia). reflexivity. }
+  rewrite !Hp by lia.
+  assert (Hm : forall i, i < 2 -> F (SRef 11 i 0) = negb (fb (2 * i)) && fb (2 * i + 1) && F (xsref i)
+                         /\ F (SRef 12 i 0) = fb (2 * i) && negb (fb (2 * i + 1)) && F (xsref i)).
+  { intros i Hi. split.
+    - rewrite (F_and 11 i 0 [(SRef 9 i 0, true); (xsref i, true)]) by (blk_compute; first [lia | reflexivity]).
+      cbn [forallb]. rewrite !litv_pos, andb_true_r.
+      rewrite (F_and 9 i 0 [(fld (2 * i), false); (fld (2 * i + 1), true)]) by (blk_compute; first [lia | reflexivity]).
+      cbn [forallb]. rewrite ?litv_pos, ?litv_neg, !F_fb by lia. rewrite !andb_true_r. reflexivity.
+    - rewrite (F_and 12 i 0 [(SRef 10 i 0, true); (xsref i, true)]) by (blk_compute; first [lia | reflexivity]).
+      cbn [forallb]. rewrite !litv_pos, andb_true_r.
+      rewrite (F_and 10 i 0 [(fld (2 * i), true); (fld (2 * i + 1), false)]) by (blk_compute; first [lia | reflexivity]).
+      cbn [forallb]. rewrite ?litv_pos, ?litv_neg, !F_fb by lia. rewrite !andb_true_r. reflexivity. }
+  destruct (Hm 0 ltac:(lia)) as [M0 N0]. destruct (Hm 1 ltac:(lia)) as [M1 N1].
+  cbn [Nat.mul Nat.add] in M0, N0, M1, N1. rewrite M0, N0, M1, N1.
+  unfold vnet. generalize (fb 0) (fb 1) (fb 2) (fb 3) (fb 4) (fb 5) (fb 6) (fb 7) (F (xsref 0)) (F (xsref 1)).
+  intros f0 f1 f2 f3 f4 f5 f6 f7 y0 y1.
+  destruct f0, f1, f2, f3, f4, f5, f6, f7, y0, y1; reflexivity.
+Qed.
+
+(* ---- blocks 18 and 19: the window after the write --------------------------------- *)
+Definition vsem : bool := vnet (fb 0) (fb 1) (fb 2) (fb 3) (fb 4) (fb 5) (fb 6) (fb 7) (cellv (fa 8)) (cellv (fa 14)).
+Definition aosem : nat := fa 20.
+
+Lemma F_vsem : F (SRef 17 0 0) = vsem.
+Proof. rewrite F_v, (F_xs 0), (F_xs 1) by lia. reflexivity. Qed.
+
+Lemma F_lo : forall a, a < 64 -> F (SRef 4 a 0) = Nat.eqb aosem a.
+Proof. intros a Ha. apply F_dec; [right; right; split; reflexivity | exact Ha]. Qed.
+
+Lemma realcell_lt : forall j, j < 61 -> realcell j < 64.
+Proof. intros j Hj. unfold realcell. destruct (Nat.eqb j 0); lia. Qed.
+
+Lemma F_xhat : forall j, j < 61 ->
+  F (SRef 18 j 2) = if Nat.eqb aosem (realcell j) then vsem else wget (win s) (realcell j).
+Proof.
+  intros j Hj.
+  rewrite (F_mux 18 j 0 (SRef 4 (realcell j) 0) (SRef 17 0 0) (SIn j)) by (blk_compute; first [lia | reflexivity]).
+  rewrite F_lo by (apply realcell_lt; exact Hj). rewrite F_vsem, F_in by (unfold nst; lia).
+  rewrite X_win by exact Hj. reflexivity.
+Qed.
+
+Lemma F_zero : F (SRef 19 0 0) = false.
+Proof. rewrite (F_or 19 0 0 []) by (blk_compute; first [lia | reflexivity]). reflexivity. Qed.
+
+(* the request cells after the write *)
+Definition advR : bool := if Nat.eqb aosem 4 then vsem else wget (win s) 4.
+Definition advA : bool := if Nat.eqb aosem 5 then vsem else wget (win s) 5.
+Definition advC : bool := if Nat.eqb aosem 6 then vsem else wget (win s) 6.
+
+Lemma F_adv : F (SRef 18 1 2) = advR /\ F (SRef 18 2 2) = advA /\ F (SRef 18 3 2) = advC.
+Proof. repeat split; rewrite F_xhat by lia; reflexivity. Qed.
+
+Lemma nth_rot1 : forall l i, i < length l -> nth i (rot1 l) false = nth ((i + 1) mod length l) l false.
+Proof.
+  intros [|x t] i Hi; cbn [length] in Hi; [lia|]. cbn [rot1 length].
+  destruct (Nat.lt_ge_cases i (length t)) as [H|H].
+  - rewrite app_nth1 by exact H. rewrite Nat.mod_small by lia. rewrite Nat.add_1_r. reflexivity.
+  - assert (E : i = length t) by lia. subst i. rewrite app_nth2 by lia. rewrite Nat.sub_diag.
+    rewrite Nat.add_1_r, Nat.Div0.mod_same. reflexivity.
+Qed.
+
+Lemma nth_rotn : forall n l i, i < length l -> nth i (rotn n l) false = nth ((i + n) mod length l) l false.
+Proof.
+  induction n as [|n IH]; intros l i Hi.
+  - cbn [rotn]. rewrite Nat.add_0_r, Nat.mod_small by exact Hi. reflexivity.
+  - cbn [rotn]. rewrite IH by (rewrite rot1_length; exact Hi). rewrite rot1_length.
+    rewrite nth_rot1 by (apply Nat.mod_upper_bound; lia).
+    rewrite Nat.Div0.add_mod_idemp_l. f_equal. f_equal. lia.
+Qed.
+
+(* ---- blocks 20 to 23: the banks --------------------------------------------------- *)
+(* the idle bank after the arm's write, as a list *)
+Definition wrote (l : list bool) (here : bool) : list bool := if here then wr0 l vsem else l.
+
+Lemma nth_wrote : forall l here m, m < length l ->
+  nth m (wrote l here) false = if Nat.eqb m 0 then (if here then vsem else nth 0 l false) else nth m l false.
+Proof.
+  intros l here m Hm. unfold wrote. destruct l as [|x l]; cbn [length] in Hm; [lia|].
+  destruct here; destruct m; reflexivity.
+Qed.
+
+Lemma F_bank : forall bh bb idlep base T, (bh = 20 /\ bb = 21 /\ idlep = true /\ base = oq0 /\ T = q0 s)
+                                        \/ (bh = 22 /\ bb = 23 /\ idlep = false /\ base = oq1 N /\ T = q1 s) ->
+  forall i, i < N ->
+  F (SRef bb i 3) =
+    if Bool.eqb kk idlep
+    then nth i (if advA then rot1 (wrote (contents T) (Nat.eqb aosem 2)) else wrote (contents T) (Nat.eqb aosem 2)) false
+    else nth i (rotn 26 (contents T)) false.
+Proof.
+  intros bh bb idlep base T Hsel i Hi.
+  assert (HT : length (contents T) = N) by (destruct Hsel as [(_ & _ & _ & _ & ->)|(_ & _ & _ & _ & ->)]; assumption).
+  assert (Hx : forall m, m < N -> X (base + m) = nth m (contents T) false).
+  { intros m Hm. destruct (X_tape m) as (T0 & T1 & _ & _).
+    destruct Hsel as [(_ & _ & _ & -> & ->)|(_ & _ & _ & -> & ->)]; [apply T0|apply T1]; exact Hm. }
+  assert (Hb : base + N <= nst N L) by (destruct Hsel as [(_ & _ & _ & -> & _)|(_ & _ & _ & -> & _)]; unfold nst, oq0, oq1; lia).
+  assert (Hc : forall j r, j < N -> r < 4 -> bb < 28 /\ j < bcount (nth bb (phys_blocks N L) blk0)
+                                          /\ r < bsize (nth bb (phys_blocks N L) blk0))
+    by (intros; destruct Hsel as [(_ & -> & _)|(_ & -> & _)]; blk_compute; lia).
+  assert (Hh : forall r, r < 6 -> bh < 28 /\ 0 < bcount (nth bh (phys_blocks N L) blk0)
+                                   /\ r < bsize (nth bh (phys_blocks N L) blk0))
+    by (intros; destruct Hsel as [(-> & _)|(-> & _)]; blk_compute; lia).
+  assert (Hsu : forall j, sunit (phys_blocks N L) bb j 3 = sOR [(SRef bb j 0, true); (SRef bb j 1, true); (SRef bb j 2, true)]
+                /\ sunit (phys_blocks N L) bb j 0 = sAND [(kap, negb idlep); (SIn (base + (j + 26) mod N), true)]
+                /\ sunit (phys_blocks N L) bb j 1 = sAND [(SRef bh 0 0, true); (hatq bh base ((j + 1) mod N), true)]
+                /\ sunit (phys_blocks N L) bb j 2 = sAND [(SRef bh 0 1, true); (hatq bh base j, true)])
+    by (intro j; destruct Hsel as [(-> & -> & -> & -> & _)|(-> & -> & -> & -> & _)]; repeat split; reflexivity).
+  destruct (Hsu i) as (S3 & S0 & S1 & S2).
+  destruct (Hc i 3 Hi ltac:(lia)) as (C1 & C2 & C3).
+  rewrite (F_or bb i 3 _ C1 C2 C3 S3). cbn [existsb]. rewrite !litv_pos, orb_false_r.
+  destruct (Hc i 0 Hi ltac:(lia)) as (D1 & D2 & D3). rewrite (F_and bb i 0 _ D1 D2 D3 S0).
+  destruct (Hc i 1 Hi ltac:(lia)) as (E1 & E2 & E3). rewrite (F_and bb i 1 _ E1 E2 E3 S1).
+  destruct (Hc i 2 Hi ltac:(lia)) as (G1 & G2 & G3). rewrite (F_and bb i 2 _ G1 G2 G3 S2).
+  cbn [forallb]. rewrite !litv_pos, !andb_true_r.
+  (* the header: ia, ih, wa and the head cell after the write *)
+  assert (Hhd : F (SRef bh 0 0) = Bool.eqb kk idlep && advA /\ F (SRef bh 0 1) = Bool.eqb kk idlep && negb advA
+                /\ F (SRef bh 0 5) = if Nat.eqb aosem 2 && Bool.eqb kk idlep then vsem else nth 0 (contents T) false).
+  { destruct F_adv as (_ & HA & _).
+    destruct (Hh 0 ltac:(lia)) as (H01 & H02 & H03). destruct (Hh 1 ltac:(lia)) as (H11 & H12 & H13).
+    destruct (Hh 2 ltac:(lia)) as (H21 & H22 & H23). destruct (Hh 5 ltac:(lia)) as (H51 & H52 & H53).
+    assert (U : sunit (phys_blocks N L) bh 0 0 = sAND [(kap, idlep); (SRef 18 2 2, true)]
+                /\ sunit (phys_blocks N L) bh 0 1 = sAND [(kap, idlep); (SRef 18 2 2, false)]
+                /\ sunit (phys_blocks N L) bh 0 2 = sAND [(SRef 4 2 0, true); (kap, idlep)]
+                /\ sunit (phys_blocks N L) bh 0 3 = sAND [(SRef bh 0 2, true); (SRef 17 0 0, true)]
+                /\ sunit (phys_blocks N L) bh 0 4 = sAND [(SRef bh 0 2, false); (SIn base, true)]
+                /\ sunit (phys_blocks N L) bh 0 5 = sOR [(SRef bh 0 3, true); (SRef bh 0 4, true)])
+      by (destruct Hsel as [(-> & -> & -> & -> & _)|(-> & -> & -> & -> & _)]; repeat split; reflexivity).
+    destruct U as (U0 & U1 & U2 & U3 & U4 & U5).
+    split; [|split].
+    - rewrite (F_and bh 0 0 _ H01 H02 H03 U0). cbn [forallb]. unfold litv. cbn [fst snd].
+      rewrite F_kap, HA. destruct kk, idlep, advA; reflexivity.
+    - rewrite (F_and bh 0 1 _ H11 H12 H13 U1). cbn [forallb]. unfold litv. cbn [fst snd].
+      rewrite F_kap, HA. destruct kk, idlep, advA; reflexivity.
+    - rewrite (F_mux bh 0 3 (SRef bh 0 2) (SRef 17 0 0) (SIn base) H51 H52 H53 U3 U4 U5).
+      rewrite (F_and bh 0 2 _ H21 H22 H23 U2). cbn [forallb]. unfold litv. cbn [fst snd].
+      rewrite F_lo, F_kap, F_vsem, F_in by (lia || (pose proof (Hx 0 ltac:(lia)); lia)).
+      rewrite <- (Nat.add_0_r base), Hx by lia.
+      destruct (Nat.eqb aosem 2), kk, idlep; reflexivity. }
+  destruct Hhd as (Hia & Hih & Hh0).
+  assert (Hhat : forall m, m < N -> F (hatq bh base m)
+                 = nth m (wrote (contents T) (Nat.eqb aosem 2 && Bool.eqb kk idlep)) false).
+  { intros m Hm. rewrite nth_wrote by lia. unfold hatq. destruct (Nat.eqb_spec m 0) as [->|E].
+    - rewrite Hh0. reflexivity.
+    - rewrite F_in by lia. apply Hx. exact Hm. }
+  pose proof (Nat.mod_upper_bound (i + 1) N ltac:(lia)). pose proof (Nat.mod_upper_bound (i + 26) N ltac:(lia)).
+  rewrite Hia, Hih, !Hhat by lia. unfold litv. cbn [fst snd]. rewrite F_kap, F_in by lia. rewrite Hx by lia.
+  destruct (Bool.eqb kk idlep) eqn:Ek.
+  - apply Bool.eqb_prop in Ek. subst idlep. rewrite ?eqb_reflx, ?andb_true_r.
+    replace (Bool.eqb kk (negb kk)) with false by (destruct kk; reflexivity). cbn [andb orb].
+    destruct advA; cbn [andb orb negb]; rewrite ?orb_false_r.
+    + rewrite nth_rot1 by (unfold wrote; destruct (Nat.eqb aosem 2); rewrite ?wr0_length; lia).
+      unfold wrote at 2. destruct (Nat.eqb aosem 2); rewrite ?wr0_length, HT; reflexivity.
+    + reflexivity.
+  - replace (Bool.eqb kk (negb idlep)) with true
+      by (revert Ek; clear; generalize kk; intros b Ek; destruct b, idlep; cbn in Ek |- *; try reflexivity; discriminate).
+    cbn [andb orb]. rewrite ?orb_false_r, ?andb_false_r. cbn [orb]. rewrite ?orb_false_r.
+    rewrite nth_rotn by lia. rewrite HT. reflexivity.
+Qed.
+
+(* ---- blocks 24 to 27: the description tapes -------------------------------------- *)
+Definition wrotec (l : list bool) (here : bool) : list bool := if here then wr0 l vsem else l.
+
+Lemma F_desc : forall dh db idlep base T, (dh = 24 /\ db = 25 /\ idlep = true /\ base = od0 N /\ T = d0 s)
+                                        \/ (dh = 26 /\ db = 27 /\ idlep = false /\ base = od1 N L /\ T = d1 s) ->
+  forall i, i < L ->
+  F (SRef db i 2) =
+    if Bool.eqb kk idlep
+    then nth i (if advC then rot1 (wrotec (contents T) (Nat.eqb aosem 3)) else wrotec (contents T) (Nat.eqb aosem 3)) false
+    else nth i (if advR then rot1 (contents T) else contents T) false.
+Proof.
+  intros dh db idlep base T Hsel i Hi.
+  assert (HT : length (contents T) = L) by (destruct Hsel as [(_ & _ & _ & _ & ->)|(_ & _ & _ & _ & ->)]; assumption).
+  assert (Hx : forall m, m < L -> X (base + m) = nth m (contents T) false).
+  { intros m Hm. destruct (X_tape m) as (_ & _ & T2 & T3).
+    destruct Hsel as [(_ & _ & _ & -> & ->)|(_ & _ & _ & -> & ->)]; [apply T2|apply T3]; exact Hm. }
+  assert (Hb : base + L <= nst N L)
+    by (destruct Hsel as [(_ & _ & _ & -> & _)|(_ & _ & _ & -> & _)]; unfold nst, od0, od1; lia).
+  assert (Hh : forall r, r < 7 -> dh < 28 /\ 0 < bcount (nth dh (phys_blocks N L) blk0)
+                                   /\ r < bsize (nth dh (phys_blocks N L) blk0))
+    by (intros; destruct Hsel as [(-> & _)|(-> & _)]; blk_compute; lia).
+  assert (U : sunit (phys_blocks N L) dh 0 0 = sAND [(kap, negb idlep); (SRef 18 1 2, true)]
+              /\ sunit (phys_blocks N L) dh 0 1 = sAND [(kap, idlep); (SRef 18 3 2, true)]
+              /\ sunit (phys_blocks N L) dh 0 2 = sOR [(SRef dh 0 0, true); (SRef dh 0 1, true)]
+              /\ sunit (phys_blocks N L) dh 0 3 = sAND [(SRef 4 3 0, true); (kap, idlep)]
+              /\ sunit (phys_blocks N L) dh 0 4 = sAND [(SRef dh 0 3, true); (SRef 17 0 0, true)]
+              /\ sunit (phys_blocks N L) dh 0 5 = sAND [(SRef dh 0 3, false); (SIn base, true)]
+              /\ sunit (phys_blocks N L) dh 0 6 = sOR [(SRef dh 0 4, true); (SRef dh 0 5, true)])
+    by (destruct Hsel as [(-> & -> & -> & -> & _)|(-> & -> & -> & -> & _)]; repeat split; reflexivity).
+  destruct U as (U0 & U1 & U2 & U3 & U4 & U5 & U6).
+  destruct F_adv as (HR & _ & HC).
+  (* the rotation request and the head cell after the copy head's write *)
+  assert (Hrot : F (SRef dh 0 2) = if Bool.eqb kk idlep then advC else advR).
+  { destruct (Hh 2 ltac:(lia)) as (A1 & A2 & A3). rewrite (F_or dh 0 2 _ A1 A2 A3 U2). cbn [existsb].
+    destruct (Hh 0 ltac:(lia)) as (B1 & B2 & B3). destruct (Hh 1 ltac:(lia)) as (C1 & C2 & C3).
+    rewrite !litv_pos, (F_and dh 0 0 _ B1 B2 B3 U0), (F_and dh 0 1 _ C1 C2 C3 U1).
+    cbn [forallb]. unfold litv. cbn [fst snd]. rewrite F_kap, HR, HC.
+    destruct kk, idlep, advR, advC; reflexivity. }
+  assert (Hh0 : F (SRef dh 0 6) = if Nat.eqb aosem 3 && Bool.eqb kk idlep then vsem else nth 0 (contents T) false).
+  { destruct (Hh 6 ltac:(lia)) as (A1 & A2 & A3).
+    rewrite (F_mux dh 0 4 (SRef dh 0 3) (SRef 17 0 0) (SIn base) A1 A2 A3 U4 U5 U6).
+    destruct (Hh 3 ltac:(lia)) as (B1 & B2 & B3). rewrite (F_and dh 0 3 _ B1 B2 B3 U3).
+    cbn [forallb]. unfold litv. cbn [fst snd].
+    rewrite F_lo, F_kap, F_vsem, F_in by (lia || (pose proof (Hx 0 ltac:(lia)); lia)).
+    rewrite <- (Nat.add_0_r base), Hx by lia.
+    destruct (Nat.eqb aosem 3), kk, idlep; reflexivity. }
+  assert (Hhat : forall m, m < L -> F (hatd dh base m)
+                 = nth m (wrotec (contents T) (Nat.eqb aosem 3 && Bool.eqb kk idlep)) false).
+  { intros m Hm. unfold wrotec. destruct (contents T) as [|x t] eqn:Ec; [cbn [length] in HT; lia|].
+    unfold hatd. destruct (Nat.eqb_spec m 0) as [->|E].
+    - rewrite Hh0. destruct (Nat.eqb aosem 3 && Bool.eqb kk idlep); reflexivity.
+    - rewrite F_in by lia. rewrite Hx by exact Hm.
+      destruct (Nat.eqb aosem 3 && Bool.eqb kk idlep); [destruct m; [lia|]|]; reflexivity. }
+  assert (Hm3 : sunit (phys_blocks N L) db i 0 = sAND [(SRef dh 0 2, true); (hatd dh base ((i + 1) mod L), true)]
+                /\ sunit (phys_blocks N L) db i 1 = sAND [(SRef dh 0 2, false); (hatd dh base i, true)]
+                /\ sunit (phys_blocks N L) db i 2 = sOR [(SRef db i 0, true); (SRef db i 1, true)])
+    by (destruct Hsel as [(-> & -> & _ & -> & _)|(-> & -> & _ & -> & _)]; repeat split; reflexivity).
+  destruct Hm3 as (M0 & M1 & M2).
+  assert (Hc : db < 28 /\ i < bcount (nth db (phys_blocks N L) blk0) /\ 2 < bsize (nth db (phys_blocks N L) blk0))
+    by (destruct Hsel as [(_ & -> & _)|(_ & -> & _)]; blk_compute; lia).
+  destruct Hc as (C1 & C2 & C3).
+  rewrite (F_mux db i 0 (SRef dh 0 2) (hatd dh base ((i + 1) mod L)) (hatd dh base i) C1 C2 C3 M0 M1 M2).
+  pose proof (Nat.mod_upper_bound (i + 1) L ltac:(lia)).
+  rewrite Hrot, !Hhat by lia.
+  assert (Hlw : forall here, length (wrotec (contents T) here) = L)
+    by (intro here; unfold wrotec; destruct here; rewrite ?wr0_length; exact HT).
+  destruct (Bool.eqb kk idlep); rewrite ?andb_true_r, ?andb_false_r.
+  - destruct advC; [|reflexivity]. rewrite nth_rot1 by (rewrite Hlw; exact Hi). rewrite Hlw. reflexivity.
+  - destruct advR; [|reflexivity]. rewrite nth_rot1 by (rewrite HT; exact Hi). rewrite HT. reflexivity.
+Qed.
+
+(* ---- one step of the machine in the same terms ------------------------------------ *)
+Hypothesis Hw : length (win s) = 64.
+
+Lemma firstn_skipn_firstn : forall (l : list bool) a b c, a + b <= c ->
+  firstn b (skipn a (firstn c l)) = firstn b (skipn a l).
+Proof. intros l a b c H. rewrite skipn_firstn_comm, firstn_firstn. f_equal. lia. Qed.
+
+Lemma firstn4_skipn4 : forall (l : list bool), 8 <= length l ->
+  firstn 4 (skipn 4 l) = [nth 4 l false; nth 5 l false; nth 6 l false; nth 7 l false].
+Proof.
+  intros l H. destruct l as [|x0 [|x1 [|x2 [|x3 [|x4 [|x5 [|x6 [|x7 l]]]]]]]]; cbn [length] in H; try lia.
+  reflexivity.
+Qed.
+
+Lemma decode_qa : decode (firstn 26 qa) =
+  Rec (fa 8) (wcode (fb 0) (fb 1)) (fa 14) (wcode (fb 2) (fb 3)) (beta4 (fb 4) (fb 5) (fb 6) (fb 7)) (fa 20).
+Proof.
+  unfold decode. cbv zeta. unfold fa, field, fb, beta4.
+  rewrite !firstn_skipn_firstn by lia. rewrite !nth_firstn. cbn [Nat.ltb Nat.leb].
+  rewrite firstn4_skipn4 by (rewrite length_qa; lia). reflexivity.
+Qed.
+
+Lemma cellof_cellv : forall a, cellof s kk a = cellv a.
+Proof. intro a. unfold cellof, cellv, rdv, armv, cpyv. rewrite !hd_t_contents. reflexivity. Qed.
+
+Lemma step_eq : exists qa', contents qa' = rotn 26 qa /\ step s = stepres s kk qa' aosem vsem.
+Proof.
+  destruct (popn 26 (if kk then q1 s else q0 s)) as [bits qa'] eqn:Ep.
+  exists qa'. split.
+  - pose proof (popn_turns 26 (if kk then q1 s else q0 s)) as P. rewrite Ep in P. exact P.
+  - assert (Hbits : bits = firstn 26 qa).
+    { pose proof (popn_reads 26 (if kk then q1 s else q0 s)) as P. rewrite Ep in P. apply P.
+      fold qa. rewrite length_qa. lia. }
+    apply (step_char s kk bits qa' (fa 8) (wcode (fb 0) (fb 1)) (fa 14) (wcode (fb 2) (fb 3))
+             (beta4 (fb 4) (fb 5) (fb 6) (fb 7)) (fa 20) vsem eq_refl Ep).
+    + rewrite Hbits. apply decode_qa.
+    + unfold vsem. rewrite vnet_ok, !cellof_cellv. reflexivity.
+Qed.
+
+Lemma aosem_lt : aosem < 64.
+Proof. apply fa_lt. lia. Qed.
+
+Lemma wget_wn : forall a, a < 64 -> a <> 1 -> a <> 2 -> a <> 3 ->
+  wget (wnext (win s) aosem vsem) a = if Nat.eqb aosem a then vsem else wget (win s) a.
+Proof.
+  intros a Ha H1 H2 H3. unfold wnext.
+  destruct (Nat.eqb aosem RD || Nat.eqb aosem ARM || Nat.eqb aosem CPY) eqn:E.
+  - destruct (Nat.eqb_spec aosem a) as [E2|E2]; [|reflexivity].
+    exfalso. rewrite E2 in E. unfold RD, ARM, CPY in E.
+    apply orb_true_iff in E as [E|E]; [apply orb_true_iff in E as [E|E]|]; apply Nat.eqb_eq in E; lia.
+  - rewrite wget_upd, Hw. pose proof aosem_lt.
+    destruct (Nat.eqb_spec aosem a) as [E2|E2].
+    + rewrite E2, Nat.eqb_refl. replace (a <? 64) with true by (symmetry; apply Nat.ltb_lt; lia). reflexivity.
+    + replace (Nat.eqb a aosem) with false by (symmetry; apply Nat.eqb_neq; lia). reflexivity.
+Qed.
+
+Lemma adv_wn : wget (wnext (win s) aosem vsem) AA = advA /\ wget (wnext (win s) aosem vsem) AR = advR
+               /\ wget (wnext (win s) aosem vsem) AC = advC.
+Proof. unfold AA, AR, AC, advA, advR, advC. repeat split; apply wget_wn; lia. Qed.
+
+Lemma tapes_step : forall qa', contents qa' = rotn 26 qa ->
+  let t := stepres s kk qa' aosem vsem in
+  contents (q0 t) = (if kk then (if advA then rot1 (wrote (contents (q0 s)) (Nat.eqb aosem 2))
+                                 else wrote (contents (q0 s)) (Nat.eqb aosem 2))
+                     else rotn 26 (contents (q0 s)))
+  /\ contents (q1 t) = (if kk then rotn 26 (contents (q1 s))
+                        else (if advA then rot1 (wrote (contents (q1 s)) (Nat.eqb aosem 2))
+                              else wrote (contents (q1 s)) (Nat.eqb aosem 2)))
+  /\ contents (d0 t) = (if kk then (if advC then rot1 (wrotec (contents (d0 s)) (Nat.eqb aosem 3))
+                                   else wrotec (contents (d0 s)) (Nat.eqb aosem 3))
+                        else (if advR then rot1 (contents (d0 s)) else contents (d0 s)))
+  /\ contents (d1 t) = (if kk then (if advR then rot1 (contents (d1 s)) else contents (d1 s))
+                        else (if advC then rot1 (wrotec (contents (d1 s)) (Nat.eqb aosem 3))
+                              else wrotec (contents (d1 s)) (Nat.eqb aosem 3))).
+Proof.
+  intros qa' Hqa t. unfold t, stepres. cbv zeta.
+  destruct adv_wn as (EA & ER & EC). rewrite EA, ER, EC.
+  unfold qa in Hqa. unfold wrote, wrotec, ARM, CPY.
+  destruct kk; cbn [q0 q1 d0 d1];
+    repeat split;
+    repeat match goal with |- context [if ?b then _ else _] => destruct b end;
+    rewrite ?turn1_contents, ?wr_t_contents; try exact Hqa; reflexivity.
+Qed.
+
+End Sem.
+
+(* ---- the netlist computes the step -------------------------------------------------- *)
+Lemma nth_encode : forall s N L i,
+  length (contents (q0 s)) = N -> length (contents (q1 s)) = N ->
+  length (contents (d0 s)) = L -> length (contents (d1 s)) = L ->
+  nth i (encode s) false =
+    if i <? 61 then wget (win s) (realcell i)
+    else if i <? 61 + N then nth (i - 61) (contents (q0 s)) false
+    else if i <? 61 + 2 * N then nth (i - 61 - N) (contents (q1 s)) false
+    else if i <? 61 + 2 * N + L then nth (i - 61 - 2 * N) (contents (d0 s)) false
+    else nth (i - 61 - 2 * N - L) (contents (d1 s)) false.
+Proof.
+  intros s N L i H0 H1 H2 H3. unfold encode.
+  destruct (Nat.ltb_spec i 61).
+  { rewrite app_nth1 by (rewrite length_map, length_seq; lia).
+    exact (nth_map_seq _ (fun j => wget (win s) (realcell j)) 61 i false H). }
+  rewrite app_nth2 by (rewrite length_map, length_seq; lia). rewrite length_map, length_seq.
+  destruct (Nat.ltb_spec i (61 + N)).
+  { rewrite app_nth1 by lia. reflexivity. }
+  rewrite app_nth2 by lia. rewrite H0.
+  destruct (Nat.ltb_spec i (61 + 2 * N)).
+  { rewrite app_nth1 by lia. f_equal; lia. }
+  rewrite app_nth2 by lia. rewrite H1.
+  destruct (Nat.ltb_spec i (61 + 2 * N + L)).
+  { rewrite app_nth1 by lia. f_equal; lia. }
+  rewrite app_nth2 by lia. rewrite H2. f_equal; lia.
+Qed.
+

rocq/PhysWF.v

@@ -0,0 +1,64 @@
+(* The physics netlist reads, at every unit, only state bits and earlier units. *)
+From Stdlib Require Import List Bool Arith ZArith Lia.
+Import ListNotations.
+From TH Require Import TwoHead Net Gates Phys.
+
+Lemma phys_shaped : forall N L, Forall shaped (phys_blocks N L).
+Proof.
+  intros N L. unfold phys_blocks.
+  repeat apply Forall_cons; try apply Forall_nil; intros j Hj; reflexivity.
+Qed.
+
+Lemma phys_length : forall N L, length (phys_blocks N L) = 28.
+Proof. reflexivity. Qed.
+
+Ltac unfold_layout := unfold nst, oq0, oq1, od0, od1 in *.
+
+(* a reference to an earlier block, or to an earlier unit of the same member, or a state bit *)
+Ltac rb_solve :=
+  cbn [reads_back];
+  first
+  [ unfold_layout; lia
+  | right; split; [reflexivity|]; split; [reflexivity|]; lia
+  | left; split; [lia|];
+    cbn [nth phys_blocks bcount bsize blk_fld blk_head blk_dec blk_term blk_xs blk_pos blk_neg blk_mt
+         blk_nt blk_pge blk_b4 blk_bge blk_vand blk_v blk_xhat blk_zero blk_bankh blk_bank blk_desch blk_desc];
+    split; lia ].
+
+Ltac crush_in Hin :=
+  cbn [nth mux3 sin sAND sOR map lw fst snd seq app kap fld xsref vand_bge] in Hin;
+  repeat (destruct Hin as [Hin|Hin]; [injection Hin as <- <-|]); try destruct Hin.
+
+(* open the helpers that name signals, splitting on the cases they distinguish *)
+Ltac open_refs :=
+  unfold kap, hatq, hatd, cellref, xsref, realcell in *;
+  try match goal with |- context [vand_bge ?j] => destruct j as [|[|[|[|j]]]]; cbn [vand_bge] end;
+  try match goal with |- context [head_src _ _ ?j] => destruct j as [|[|j]]; cbn [head_src fst snd] end;
+  repeat match goal with |- context [if ?c then _ else _] => destruct c eqn:? end;
+  repeat match goal with
+         | H : (_ =? _) = true |- _ => apply Nat.eqb_eq in H
+         | H : (_ =? _) = false |- _ => apply Nat.eqb_neq in H
+         | H : (_ || _) = true |- _ => apply orb_true_iff in H as [H|H]
+         | H : (_ || _) = false |- _ => apply orb_false_iff in H as [? H]
+         end.
+
+Ltac split_blocks b :=
+  destruct b as [|b];
+  [ cbn [nth phys_blocks bcount bsize bshape blk_fld blk_head blk_dec blk_term blk_xs blk_pos blk_neg
+         blk_mt blk_nt blk_pge blk_b4 blk_bge blk_vand blk_v blk_xhat blk_zero blk_bankh blk_bank
+         blk_desch blk_desc] in *
+  | first [lia | split_blocks b] ].
+
+Lemma phys_wf : forall N L, 26 <= N -> 1 <= L -> wf (phys_blocks N L) (nst N L).
+Proof.
+  intros N L HN HL. split; [apply phys_shaped|].
+  intros b j r x w Hb Hj Hr Hin. unfold sunit in Hin. rewrite phys_length in Hb.
+  assert (M1 : forall i, (i + 26) mod N < N) by (intro i; apply Nat.mod_upper_bound; lia).
+  assert (M2 : forall i, (i + 1) mod N < N) by (intro i; apply Nat.mod_upper_bound; lia).
+  assert (M3 : forall i, (i + 1) mod L < L) by (intro i; apply Nat.mod_upper_bound; lia).
+  split_blocks b.
+  all: repeat (destruct r as [|r]; [crush_in Hin | try (exfalso; lia)]).
+  all: try lia.
+  all: try rb_solve.
+  all: try (pose proof (M1 j); pose proof (M2 j); pose proof (M3 j)); open_refs; try rb_solve.
+Qed.

rocq/Run.v

@@ -0,0 +1,93 @@
+(* The decoder's passes carried out by the two-head physics, and the theorems they give. *)
+From Stdlib Require Import List Bool Arith ZArith Lia.
+Import ListNotations.
+From TH Require Import TwoHead Tapes Iter Abstract Spec Organism PassCheck PassLemma Decoder.
+
+(* the physical state s carries the decoder state t, the tapes in the roles of the bank bit k0 *)
+Definition matches (k0 : bool) (t : dst) (s : st) : Prop :=
+  length (win s) = 64
+  /\ (forall i, relevant i = true -> wget (win s) i = wget (wcfg (dc t) (dk t)) i)
+  /\ contents (if k0 then d1 s else d0 s) = dR t
+  /\ contents (if k0 then q0 s else q1 s) = dA t
+  /\ contents (if k0 then d0 s else d1 s) = dK t
+  /\ contents (if k0 then q1 s else q0 s) = enc organism.
+
+Lemma reach_step : forall cf k r, reachable cf = true -> reachable (ncf (dpass cf k r)) = true.
+Proof.
+  intros [p n e3 e2 e1 e0 m] k r H. unfold reachable in H. cbn [ph Spec.z] in H.
+  unfold dpass. cbn [ph Spec.z Spec.c3 Spec.c2 Spec.c1 Spec.c0 mo].
+  destruct p; apply Nat.leb_le in H; destruct (Nat.eqb n 0) eqn:E;
+    repeat match goal with |- context [if ?b then _ else _] => destruct b end;
+    cbn [ncf reachable ph Spec.z]; apply Nat.leb_le; lia.
+Qed.
+
+Lemma dstep_ne : forall t, dR t <> [] -> dA t <> [] -> dK t <> [] ->
+  dR (dstep t) <> [] /\ dA (dstep t) <> [] /\ dK (dstep t) <> [].
+Proof.
+  intros [c k R A K] HR HA HK. cbn [dR dA dK] in *.
+  destruct R as [|r R]; [congruence|]. destruct A as [|a A]; [congruence|].
+  destruct K as [|y K]; [congruence|].
+  unfold dstep. cbn [dR dA dK dc dk hd tl].
+  repeat split;
+    match goal with |- (if ?b then _ else _) <> [] => destruct b end;
+    cbn [rot1]; try discriminate;
+    intro Hn; apply app_eq_nil in Hn as [_ Hn]; discriminate.
+Qed.
+
+Lemma pass_matches : forall k0 t s, matches k0 t s -> dk t = k0 -> reachable (dc t) = true ->
+  dR t <> [] -> dA t <> [] -> dK t <> [] ->
+  matches k0 (dstep t) (itern G s).
+Proof.
+  intros k0 [c k R A K] s (Hl & Hw & HR & HA & HK & HQ) Hk Hreach HRn HAn HKn.
+  cbn [dc dk dR dA dK] in *. subst k.
+  destruct R as [|r restR]; [congruence|]. destruct A as [|x restA]; [congruence|].
+  destruct K as [|y restK]; [congruence|].
+  destruct (machine_pass c k0 r x y restR restA restK s Hreach Hl Hw HR HA HK HQ
+              (dpass c k0 r) (itern G s) eq_refl eq_refl) as (Hw' & Hl' & HR' & HA' & HK' & HQ').
+  unfold matches, dstep. cbn [dc dk dR dA dK hd tl].
+  refine (conj Hl' (conj Hw' (conj _ (conj _ (conj _ HQ'))))).
+  - rewrite HR'. destruct (cons (dpass c k0 r)); reflexivity.
+  - rewrite HA'. destruct (emit (dpass c k0 r)); reflexivity.
+  - rewrite HK'. destruct (cw (dpass c k0 r)); reflexivity.
+Qed.
+
+Lemma stable_tail : forall k n t, stable k (S n) t -> stable k n (dstep t).
+Proof. intros k n t H j Hj. rewrite <- dsteps_S. apply H. lia. Qed.
+
+Lemma run_matches : forall n k0 t s, matches k0 t s -> stable k0 n t -> reachable (dc t) = true ->
+  dR t <> [] -> dA t <> [] -> dK t <> [] ->
+  matches k0 (dsteps n t) (itern (n * G) s).
+Proof.
+  induction n as [|n IH]; intros k0 t s Hm Hs Hr HR HA HK; [exact Hm|].
+  rewrite dsteps_S. change (S n * G) with (G + n * G). rewrite itern_add.
+  destruct (dstep_ne t HR HA HK) as (HR' & HA' & HK').
+  apply IH; auto.
+  - apply pass_matches; auto. apply (Hs 0). lia.
+  - apply stable_tail. exact Hs.
+  - unfold dstep. cbn [dc]. apply reach_step. exact Hr.
+Qed.
+
+(* ---- universal construction ----------------------------------------------------- *)
+(* Let the active bank hold the organism, the window a codon start in construct mode, the read
+   tape a description d of a nonempty record image X, the arm a tape as long as X and the copy
+   tape one as long as d. After 30 passes per record of X, 4 on the end codon and one per bit
+   of d, each pass G = 133 steps, the arm holds X, the copy tape and the read tape hold d, the
+   bank still holding the organism, and the bank bit has flipped, so that from the next step
+   on the physics executes the records of X. *)
+Theorem universal_construction : forall d X k A0 K0 s b3 b2 b1 b0,
+  translate d = Some X -> X <> [] -> length A0 = length X -> length K0 = length d ->
+  matches k (mkD (mkC PC 3 b3 b2 b1 b0 false) k d A0 K0) s ->
+  exists nrec, length X = 26 * nrec
+    /\ matches k (mkD (mkC PC 3 true true true true false) (negb k) d X d)
+               (itern ((30 * nrec + 4 + length d) * G) s).
+Proof.
+  intros d X k A0 K0 s b3 b2 b1 b0 Ht HX HA HK Hm.
+  destruct (generation d X k A0 K0 b3 b2 b1 b0 Ht HA HK) as (nrec & Hn & Hs & He).
+  exists nrec. split; [exact Hn|]. rewrite <- He.
+  apply run_matches; auto.
+  - cbn [dR]. unfold translate in Ht. pose proof (translate_aux_long _ _ _ Ht).
+    destruct d; [cbn [length] in *; lia | discriminate].
+  - cbn [dA]. destruct A0; [destruct X; [congruence | discriminate] | discriminate].
+  - cbn [dK]. unfold translate in Ht. pose proof (translate_aux_long _ _ _ Ht).
+    destruct K0; [cbn [length] in *; lia | discriminate].
+Qed.

rocq/SelfRep.v

@@ -0,0 +1,115 @@
+(* Exact self-reproduction of the translating organism on the two-head physics,
+   checked by evaluating the run in the kernel. *)
+From Stdlib Require Import List Bool Arith ZArith Lia.
+Import ListNotations.
+From TH Require Import TwoHead Organism Iter.
+
+Definition T1 : positive := 920892%positive.
+
+Definition holds_two_copies (s : st) : bool :=
+  lbeq (contents (q0 s)) rho && lbeq (contents (q1 s)) rho
+  && lbeq (contents (d0 s)) desc && lbeq (contents (d1 s)) desc.
+
+Definition same_state (s t : st) : bool :=
+  lbeq (win s) (win t)
+  && lbeq (contents (q0 s)) (contents (q0 t)) && lbeq (contents (q1 s)) (contents (q1 t))
+  && lbeq (contents (d0 s)) (contents (d0 t)) && lbeq (contents (d1 s)) (contents (d1 t)).
+
+(* the first hand-over: kappa is 0 before it, then 1, with both copies in place *)
+Definition judge (x : option st) : bool :=
+  match x with None => false | Some t => wget (win t) KAPPA && holds_two_copies t end.
+
+(* the second hand-over: kappa back at 0, with both copies in place *)
+Definition judge2 (t : st) : bool := negb (wget (win t) KAPPA) && holds_two_copies t.
+
+(* ---- what the run is checked to do, in the form the theorems consume ---- *)
+Lemma translate_desc : translate desc = Some rho.
+Proof. vm_compute. reflexivity. Qed.
+
+Lemma lengths : length rho = 3458 /\ length desc = 2930.
+Proof. split; vm_compute; reflexivity. Qed.
+
+Lemma first_generation_ok : judge (kfp T1 s0) = true.
+Proof. vm_compute. reflexivity. Qed.
+
+Lemma second_generation_ok : judge2 (iterp (2 * T1) s0) = true.
+Proof. vm_compute. reflexivity. Qed.
+
+Lemma period_ok : same_state (iterp (3 * T1) s0) (iterp T1 s0) = true.
+Proof. vm_compute. reflexivity. Qed.
+
+(* ---- what the checks mean, for any run ---------------------------------- *)
+Lemma judge_sound : forall p s, judge (kfp p s) = true ->
+  (forall n, n < Pos.to_nat p -> wget (win (itern n s)) KAPPA = false)
+  /\ wget (win (itern (Pos.to_nat p) s)) KAPPA = true
+  /\ contents (q0 (itern (Pos.to_nat p) s)) = rho
+  /\ contents (q1 (itern (Pos.to_nat p) s)) = rho
+  /\ contents (d0 (itern (Pos.to_nat p) s)) = desc
+  /\ contents (d1 (itern (Pos.to_nat p) s)) = desc.
+Proof.
+  intros p s H. unfold judge in H.
+  destruct (kfp p s) as [t|] eqn:E; [|discriminate].
+  destruct (kfp_sound _ _ _ E) as [Ht Hk]. subst t.
+  unfold holds_two_copies in H.
+  apply andb_prop in H as [Hkap H].
+  apply andb_prop in H as [H H4]. apply andb_prop in H as [H H3]. apply andb_prop in H as [H1 H2].
+  exact (conj Hk (conj Hkap (conj (lbeq_true _ _ H1) (conj (lbeq_true _ _ H2)
+           (conj (lbeq_true _ _ H3) (lbeq_true _ _ H4)))))).
+Qed.
+
+Lemma judge2_sound : forall p s, judge2 (iterp p s) = true ->
+  wget (win (itern (Pos.to_nat p) s)) KAPPA = false
+  /\ contents (q0 (itern (Pos.to_nat p) s)) = rho
+  /\ contents (q1 (itern (Pos.to_nat p) s)) = rho
+  /\ contents (d0 (itern (Pos.to_nat p) s)) = desc
+  /\ contents (d1 (itern (Pos.to_nat p) s)) = desc.
+Proof.
+  intros p s H. rewrite iterp_itern in H. unfold judge2, holds_two_copies in H.
+  apply andb_prop in H as [Hkap H].
+  apply andb_prop in H as [H H4]. apply andb_prop in H as [H H3]. apply andb_prop in H as [H1 H2].
+  exact (conj (proj1 (negb_true_iff _) Hkap) (conj (lbeq_true _ _ H1) (conj (lbeq_true _ _ H2)
+           (conj (lbeq_true _ _ H3) (lbeq_true _ _ H4))))).
+Qed.
+
+Lemma same_state_sound : forall p q s, same_state (iterp p s) (iterp q s) = true ->
+  win (itern (Pos.to_nat p) s) = win (itern (Pos.to_nat q) s)
+  /\ contents (q0 (itern (Pos.to_nat p) s)) = contents (q0 (itern (Pos.to_nat q) s))
+  /\ contents (q1 (itern (Pos.to_nat p) s)) = contents (q1 (itern (Pos.to_nat q) s))
+  /\ contents (d0 (itern (Pos.to_nat p) s)) = contents (d0 (itern (Pos.to_nat q) s))
+  /\ contents (d1 (itern (Pos.to_nat p) s)) = contents (d1 (itern (Pos.to_nat q) s)).
+Proof.
+  intros p q s H. rewrite !iterp_itern in H. unfold same_state in H.
+  apply andb_prop in H as [H H5]. apply andb_prop in H as [H H4].
+  apply andb_prop in H as [H H3]. apply andb_prop in H as [H1 H2].
+  exact (conj (lbeq_true _ _ H1) (conj (lbeq_true _ _ H2) (conj (lbeq_true _ _ H3)
+           (conj (lbeq_true _ _ H4) (lbeq_true _ _ H5))))).
+Qed.
+
+(* The bank bit stays 0 for the first 920,892 states and is 1 after them; both banks then
+   hold the organism and both tapes its description. *)
+Theorem self_reproduction :
+  (forall n, n < Pos.to_nat T1 -> wget (win (itern n s0)) KAPPA = false)
+  /\ wget (win (itern (Pos.to_nat T1) s0)) KAPPA = true
+  /\ contents (q0 (itern (Pos.to_nat T1) s0)) = rho
+  /\ contents (q1 (itern (Pos.to_nat T1) s0)) = rho
+  /\ contents (d0 (itern (Pos.to_nat T1) s0)) = desc
+  /\ contents (d1 (itern (Pos.to_nat T1) s0)) = desc.
+Proof. exact (judge_sound T1 s0 first_generation_ok). Qed.
+
+(* Two generations return every bank and tape to the organism and its description. *)
+Theorem second_generation :
+  wget (win (itern (Pos.to_nat (2 * T1)) s0)) KAPPA = false
+  /\ contents (q0 (itern (Pos.to_nat (2 * T1)) s0)) = rho
+  /\ contents (q1 (itern (Pos.to_nat (2 * T1)) s0)) = rho
+  /\ contents (d0 (itern (Pos.to_nat (2 * T1)) s0)) = desc
+  /\ contents (d1 (itern (Pos.to_nat (2 * T1)) s0)) = desc.
+Proof. exact (judge2_sound (2 * T1) s0 second_generation_ok). Qed.
+
+(* From the first hand-over on, the orbit is periodic with a period of two generations. *)
+Theorem periodic :
+  win (itern (Pos.to_nat (3 * T1)) s0) = win (itern (Pos.to_nat T1) s0)
+  /\ contents (q0 (itern (Pos.to_nat (3 * T1)) s0)) = contents (q0 (itern (Pos.to_nat T1) s0))
+  /\ contents (q1 (itern (Pos.to_nat (3 * T1)) s0)) = contents (q1 (itern (Pos.to_nat T1) s0))
+  /\ contents (d0 (itern (Pos.to_nat (3 * T1)) s0)) = contents (d0 (itern (Pos.to_nat T1) s0))
+  /\ contents (d1 (itern (Pos.to_nat (3 * T1)) s0)) = contents (d1 (itern (Pos.to_nat T1) s0)).
+Proof. exact (same_state_sound (3 * T1) T1 s0 period_ok). Qed.

rocq/Smoke.v

@@ -0,0 +1,27 @@
+(* The Rocq physics and organism against the Python transcription in src/twohead.py: the
+   organism, its description, and the full state from s0 after 1000 and 20000 steps. *)
+From Stdlib Require Import List Bool Arith ZArith.
+Import ListNotations.
+From TH Require Import TwoHead Organism SmokeData.
+
+Definition same_at (s : st) (w a b c d : list bool) : bool :=
+  lbeq (win s) w && lbeq (contents (q0 s)) a && lbeq (contents (q1 s)) b
+  && lbeq (contents (d0 s)) c && lbeq (contents (d1 s)) d.
+
+Lemma rho_matches_python : lbeq rho py_rho = true.
+Proof. vm_compute. reflexivity. Qed.
+
+Lemma desc_matches_python : lbeq desc py_desc = true.
+Proof. vm_compute. reflexivity. Qed.
+
+Lemma decode_encode : forallb (fun r => match r, decode (enc_rec r) with
+  | Rec a b c d e f, Rec a' b' c' d' e' f' =>
+      Nat.eqb a a' && Z.eqb b b' && Nat.eqb c c' && Z.eqb d d' && Z.eqb e e' && Nat.eqb f f' end)
+  organism = true.
+Proof. vm_compute. reflexivity. Qed.
+
+Lemma run_1000 : same_at (iterp 1000 s0) py_win_1000 py_q0_1000 py_q1_1000 py_d0_1000 py_d1_1000 = true.
+Proof. vm_compute. reflexivity. Qed.
+
+Lemma run_20000 : same_at (iterp 20000 s0) py_win_20000 py_q0_20000 py_q1_20000 py_d0_20000 py_d1_20000 = true.
+Proof. vm_compute. reflexivity. Qed.

rocq/Spec.v

@@ -0,0 +1,78 @@
+(* What one pass of the organism is meant to do, written without reference to its records. *)
+From Stdlib Require Import List Bool Arith ZArith Lia.
+Import ListNotations.
+From TH Require Import TwoHead.
+
+Inductive phase := PC | PG | PA.
+
+(* the codon register holds c3 c2 c1 c0, c3 the first bit read; z counts down *)
+Record cfg := mkC { ph : phase; z : nat; c3 : bool; c2 : bool; c1 : bool; c0 : bool; mo : bool }.
+
+(* the gate bit at position 7 - z of a gate codon *)
+Definition table (a3 a2 s0 s1 : bool) (k : nat) : bool :=
+  let cpy := a3 && negb a2 in
+  let sign := if a3 then s0 else if a2 then s0 && s1 else s0 || s1 in
+  let odd := if a3 then s0 else xorb a2 (xorb s0 s1) in
+  match k with
+  | 7 => negb s0
+  | 6 => s0
+  | 5 => negb cpy && negb s1
+  | 4 => negb cpy && s1
+  | 3 | 2 | 1 => sign
+  | 0 => odd
+  | _ => false
+  end.
+
+Definition is_esc (a3 a2 a1 a0 : bool) : bool := a3 && a2 && negb (a1 && a0).
+Definition is_end (a3 a2 a1 a0 : bool) : bool := a3 && a2 && a1 && a0.
+
+(* one pass, from the bit r under the read head: the next configuration and bank bit, whether
+   the read head moves, whether the arm writes (and what), whether the copy head writes r *)
+Record out := mkO { ncf : cfg; nk : bool; cons : bool; emit : bool; av : bool; cw : bool }.
+
+Definition dpass (cf : cfg) (k r : bool) : out :=
+  let m := mo cf in
+  let zero := Nat.eqb (z cf) 0 in
+  match ph cf with
+  | PC =>
+      let n3 := c2 cf in let n2 := c1 cf in let n1 := c0 cf in let n0 := r in
+      if zero then
+        if is_end n3 n2 n1 n0 then mkO (mkC PC 3 n3 n2 n1 n0 (negb m)) (xorb k m) true false false m
+        else if negb m || is_esc n3 n2 n1 n0 then mkO (mkC PG 7 n3 n2 n1 n0 m) k true false false m
+        else mkO (mkC PA 17 n3 n2 n1 n0 m) k true false false m
+      else mkO (mkC PC (z cf - 1) n3 n2 n1 n0 m) k true false false m
+  | PG =>
+      let e := is_esc (c3 cf) (c2 cf) (c1 cf) (c0 cf) in
+      let a := if e then r else table (c3 cf) (c2 cf) (c1 cf) (c0 cf) (z cf) in
+      let nx := if zero then mkC PA 17 (c3 cf) (c2 cf) (c1 cf) (c0 cf) m
+                else mkC PG (z cf - 1) (c3 cf) (c2 cf) (c1 cf) (c0 cf) m in
+      mkO nx k e (negb m) a (m && e)
+  | PA =>
+      let nx := if zero then mkC PC 3 (c3 cf) (c2 cf) (c1 cf) (c0 cf) m
+                else mkC PA (z cf - 1) (c3 cf) (c2 cf) (c1 cf) (c0 cf) m in
+      mkO nx k true (negb m) r m
+  end.
+
+(* the configurations a run visits *)
+Definition reachable (cf : cfg) : bool :=
+  match ph cf with PC => Nat.leb (z cf) 3 | PG => Nat.leb (z cf) 7 | PA => Nat.leb (z cf) 17 end.
+
+(* the window cells that hold the configuration: m 8, C 9, G 10, Ad 11, c0..c3 12..15, z 16..20 *)
+Definition cell_of_cfg (cf : cfg) (k : bool) (i : nat) : bool :=
+  match i with
+  | 0 => k
+  | 8 => mo cf
+  | 9 => match ph cf with PC => true | _ => false end
+  | 10 => match ph cf with PG => true | _ => false end
+  | 11 => match ph cf with PA => true | _ => false end
+  | 12 => c0 cf | 13 => c1 cf | 14 => c2 cf | 15 => c3 cf
+  | 16 => Nat.testbit (z cf) 0 | 17 => Nat.testbit (z cf) 1 | 18 => Nat.testbit (z cf) 2
+  | 19 => Nat.testbit (z cf) 3 | 20 => Nat.testbit (z cf) 4
+  | _ => false
+  end.
+
+Definition wcfg (cf : cfg) (k : bool) : list bool := map (cell_of_cfg cf k) (seq 0 64).
+
+(* the cells a pass carries over: the bank bit, the requests and the configuration *)
+Definition relevant (i : nat) : bool := Nat.eqb i 0 || (Nat.leb 4 i && Nat.leb i 6) || (Nat.leb 8 i && Nat.leb i 20).
+Definition istmp (i : nat) : bool := negb (relevant i || (Nat.leb 1 i && Nat.leb i 3)).

rocq/Tapes.v

@@ -0,0 +1,152 @@
+(* The tape operations, read as operations on contents. *)
+From Stdlib Require Import List Bool Arith Lia.
+Import ListNotations.
+From TH Require Import TwoHead.
+
+Definition rot1 (l : list bool) : list bool :=
+  match l with [] => [] | x :: t => t ++ [x] end.
+
+Definition hd0 (l : list bool) : bool := match l with [] => false | x :: _ => x end.
+
+Definition wr0 (l : list bool) (v : bool) : list bool :=
+  match l with [] => [] | _ :: t => v :: t end.
+
+Lemma contents_norm : forall t, contents (norm t) = contents t.
+Proof.
+  intros [f b]; unfold norm, contents; simpl.
+  destruct f as [|x f]; simpl; [rewrite rev_append_rev, !app_nil_r|]; reflexivity.
+Qed.
+
+Lemma norm_cases : forall t,
+  (fr (norm t) = [] /\ contents t = [])
+  \/ (exists x f, fr (norm t) = x :: f /\ contents t = x :: f ++ rev (bk (norm t))).
+Proof.
+  intros [f b]; unfold norm, contents; simpl.
+  destruct f as [|x f]; simpl.
+  - rewrite rev_append_rev, app_nil_r.
+    destruct (rev b) as [|y r] eqn:E.
+    + left; split; reflexivity.
+    + right; exists y, r; split; [reflexivity|]. simpl. rewrite app_nil_r. reflexivity.
+  - right; exists x, f; split; reflexivity.
+Qed.
+
+Lemma hd_t_contents : forall t, hd_t t = hd0 (contents t).
+Proof.
+  intro t; unfold hd_t.
+  destruct (norm_cases t) as [[H1 H2] | (x & f & H1 & H2)]; rewrite H1, H2; reflexivity.
+Qed.
+
+Lemma turn1_contents : forall t, contents (turn1 t) = rot1 (contents t).
+Proof.
+  intro t; unfold turn1; cbv zeta.
+  destruct (norm_cases t) as [[H1 H2] | (x & f & H1 & H2)]; rewrite H1.
+  - rewrite contents_norm, H2. reflexivity.
+  - rewrite H2. unfold contents; simpl. rewrite app_assoc. reflexivity.
+Qed.
+
+Lemma wr_t_contents : forall t v, contents (wr_t t v) = wr0 (contents t) v.
+Proof.
+  intros t v; unfold wr_t; cbv zeta.
+  destruct (norm_cases t) as [[H1 H2] | (x & f & H1 & H2)]; rewrite H1.
+  - rewrite contents_norm, H2. reflexivity.
+  - rewrite H2. unfold contents; simpl. reflexivity.
+Qed.
+
+Lemma rot1_length : forall l, length (rot1 l) = length l.
+Proof. intros [|x t]; simpl; auto. rewrite length_app; simpl; lia. Qed.
+
+Lemma wr0_length : forall l v, length (wr0 l v) = length l.
+Proof. intros [|x t] v; simpl; auto. Qed.
+
+Fixpoint rotn (n : nat) (l : list bool) : list bool :=
+  match n with O => l | S m => rotn m (rot1 l) end.
+
+Lemma rotn_app : forall a b, rotn (length a) (a ++ b) = b ++ a.
+Proof.
+  induction a as [|x a IH]; intro b; simpl.
+  - rewrite app_nil_r; reflexivity.
+  - rewrite <- app_assoc, IH, <- app_assoc. reflexivity.
+Qed.
+
+Lemma rotn_full : forall l, rotn (length l) l = l.
+Proof. intro l. pose proof (rotn_app l []) as H. rewrite !app_nil_r in H. exact H. Qed.
+
+(* popn reads the first n cells and turns the tape by n *)
+Lemma popn_turns : forall n t, contents (snd (popn n t)) = rotn n (contents t).
+Proof.
+  induction n as [|n IH]; intro t; simpl; auto.
+  destruct (popn n (turn1 t)) as [xs t'] eqn:E. simpl.
+  specialize (IH (turn1 t)). rewrite E in IH. simpl in IH.
+  rewrite IH, turn1_contents. reflexivity.
+Qed.
+
+Lemma popn_reads : forall n t, n <= length (contents t) ->
+  fst (popn n t) = firstn n (contents t).
+Proof.
+  induction n as [|n IH]; intros t Hn; simpl; auto.
+  destruct (popn n (turn1 t)) as [xs t'] eqn:E. simpl.
+  assert (Hx : xs = firstn n (rot1 (contents t))).
+  { specialize (IH (turn1 t)). rewrite E, turn1_contents in IH. simpl in IH. apply IH.
+    rewrite rot1_length. lia. }
+  rewrite Hx, hd_t_contents.
+  destruct (contents t) as [|x c] eqn:Ec; simpl in Hn; [lia|]. simpl.
+  rewrite firstn_app. replace (n - length c) with 0 by lia. simpl. rewrite app_nil_r. reflexivity.
+Qed.
+
+(* rotating a prefix-split list, and reading or writing at the head inside the prefix *)
+Lemma rotn_rot1 : forall n l, rotn n (rot1 l) = rot1 (rotn n l).
+Proof. induction n as [|n IH]; intro l; simpl; auto. Qed.
+
+Lemma rotn_S : forall n l, rot1 (rotn n l) = rotn (S n) l.
+Proof. intros n l. simpl. rewrite rotn_rot1. reflexivity. Qed.
+
+Lemma rotn_split : forall k a b, k <= length a ->
+  rotn k (a ++ b) = skipn k a ++ b ++ firstn k a.
+Proof.
+  induction k as [|k IH]; intros a b Hk; simpl.
+  - rewrite app_nil_r. reflexivity.
+  - destruct a as [|x a]; simpl in Hk; [lia|].
+    simpl. rewrite <- app_assoc. rewrite IH by lia.
+    rewrite <- !app_assoc. reflexivity.
+Qed.
+
+Lemma hd_skipn : forall k a t, k < length a -> hd0 (skipn k a ++ t) = nth k a false.
+Proof. induction k as [|k IH]; intros [|x a] t Hk; simpl in *; try lia; auto. apply IH; lia. Qed.
+
+Lemma hd_rotn_prefix : forall k a b, k < length a ->
+  hd0 (rotn k (a ++ b)) = nth k a false.
+Proof. intros k a b Hk. rewrite rotn_split by lia. apply hd_skipn; lia. Qed.
+
+Lemma upd_length : forall l i v, length (upd l i v) = length l.
+Proof. induction l as [|x l IH]; intros [|i] v; simpl; auto. Qed.
+
+Lemma firstn_upd : forall k l v, firstn k (upd l k v) = firstn k l.
+Proof. induction k as [|k IH]; intros [|x l] v; simpl; auto. f_equal; apply IH. Qed.
+
+Lemma skipn_upd : forall k l v, k < length l ->
+  skipn k (upd l k v) = wr0 (skipn k l) v.
+Proof.
+  induction k as [|k IH]; intros [|x l] v Hk; simpl in *; try lia; auto.
+  apply IH; lia.
+Qed.
+
+Lemma wr_rotn_prefix : forall k a b v, k < length a ->
+  wr0 (rotn k (a ++ b)) v = rotn k (upd a k v ++ b).
+Proof.
+  intros k a b v Hk.
+  rewrite !rotn_split by (try rewrite upd_length; lia).
+  rewrite skipn_upd, firstn_upd by lia.
+  destruct (skipn k a) as [|y s] eqn:E.
+  - exfalso. apply (f_equal (@length bool)) in E. rewrite length_skipn in E. simpl in E. lia.
+  - reflexivity.
+Qed.
+
+Lemma nth_upd_same : forall l i v, i < length l -> nth i (upd l i v) false = v.
+Proof. induction l as [|x l IH]; intros [|i] v Hi; simpl in *; try lia; auto. apply IH; lia. Qed.
+
+Lemma nth_upd_other : forall l i j v, i <> j -> nth j (upd l i v) false = nth j l false.
+Proof.
+  induction l as [|x l IH]; intros i j v Hij; [reflexivity|].
+  destruct i as [|i], j as [|j]; simpl; try reflexivity; [lia|].
+  apply IH. lia.
+Qed.

rocq/TwoHead.v

@@ -0,0 +1,178 @@
+(* The two-head physics, its record format, the code of descriptions. *)
+From Stdlib Require Import List Bool Arith ZArith Lia.
+Import ListNotations.
+
+(* ---- window cells ---------------------------------------------------- *)
+Definition KAPPA := 0%nat.
+Definition RD := 1%nat.
+Definition ARM := 2%nat.
+Definition CPY := 3%nat.
+Definition AR := 4%nat.
+Definition AA := 5%nat.
+Definition AC := 6%nat.
+Definition SINK := 7%nat.
+
+Fixpoint upd (l : list bool) (i : nat) (v : bool) : list bool :=
+  match l with
+  | [] => []
+  | x :: t => match i with O => v :: t | S j => x :: upd t j v end
+  end.
+
+Definition wget (l : list bool) (i : nat) : bool := nth i l false.
+
+Fixpoint lbeq (a b : list bool) : bool :=
+  match a, b with
+  | [], [] => true
+  | x :: s, y :: t => Bool.eqb x y && lbeq s t
+  | _, _ => false
+  end.
+
+Lemma lbeq_true : forall a b, lbeq a b = true -> a = b.
+Proof.
+  induction a as [|x s IH]; intros [|y t] H; simpl in H; try discriminate; auto.
+  apply andb_prop in H as [Hxy Hst].
+  apply Bool.eqb_prop in Hxy; subst; f_equal; auto.
+Qed.
+
+(* ---- circular tapes: the contents read from the head are fr ++ rev bk -- *)
+Record tape := mkT { fr : list bool; bk : list bool }.
+
+Definition contents (t : tape) : list bool := fr t ++ rev (bk t).
+Definition norm (t : tape) : tape :=
+  match fr t with [] => mkT (rev_append (bk t) []) [] | _ => t end.
+Definition hd_t (t : tape) : bool :=
+  match fr (norm t) with x :: _ => x | [] => false end.
+Definition wr_t (t : tape) (v : bool) : tape :=
+  let n := norm t in match fr n with _ :: f => mkT (v :: f) (bk n) | [] => n end.
+Definition turn1 (t : tape) : tape :=
+  let n := norm t in match fr n with x :: f => mkT f (x :: bk n) | [] => n end.
+Fixpoint popn (n : nat) (t : tape) : list bool * tape :=
+  match n with
+  | O => ([], t)
+  | S m => let x := hd_t t in let '(xs, t') := popn m (turn1 t) in (x :: xs, t')
+  end.
+Definition tape_of (l : list bool) : tape := mkT l [].
+
+(* ---- records, gate first: w0 code, w1 code, beta, a0, a1, ao ----------- *)
+Inductive rec := Rec (a0 : nat) (w0 : Z) (a1 : nat) (w1 : Z) (beta : Z) (ao : nat).
+
+Fixpoint bits2nat_acc (acc : nat) (l : list bool) : nat :=
+  match l with [] => acc | b :: t => bits2nat_acc (2 * acc + (if b then 1 else 0)) t end.
+Definition bits2nat (l : list bool) : nat := bits2nat_acc 0 l.
+
+Fixpoint nat2bits (w v : nat) : list bool :=
+  match w with O => [] | S w' => Nat.testbit v w' :: nat2bits w' v end.
+
+Definition wcode (h l : bool) : Z :=
+  match h, l with false, true => 1%Z | true, false => (-1)%Z | _, _ => 0%Z end.
+Definition enc_w (w : Z) : list bool :=
+  if Z.eqb w 1 then [false; true] else if Z.eqb w (-1) then [true; false] else [false; false].
+
+Definition decode (bs : list bool) : rec :=
+  let g i := nth i bs false in
+  let braw := Z.of_nat (bits2nat (firstn 4 (skipn 4 bs))) in
+  Rec (bits2nat (firstn 6 (skipn 8 bs))) (wcode (g 0%nat) (g 1%nat))
+      (bits2nat (firstn 6 (skipn 14 bs))) (wcode (g 2%nat) (g 3%nat))
+      (if Z.leb 8 braw then braw - 16 else braw)%Z
+      (bits2nat (firstn 6 (skipn 20 bs))).
+
+Definition enc_rec (r : rec) : list bool :=
+  match r with
+  | Rec a0 w0 a1 w1 beta ao =>
+      enc_w w0 ++ enc_w w1 ++ nat2bits 4 (Z.to_nat (Z.modulo beta 16))
+        ++ nat2bits 6 a0 ++ nat2bits 6 a1 ++ nat2bits 6 ao
+  end.
+
+(* ---- one step of the physics ------------------------------------------ *)
+Record st := mkS { win : list bool; q0 : tape; q1 : tape; d0 : tape; d1 : tape }.
+
+Definition b2z (b : bool) : Z := if b then 1%Z else 0%Z.
+
+Definition step (s : st) : st :=
+  let k := wget (win s) KAPPA in
+  let qa := if k then q1 s else q0 s in
+  let qi := if k then q0 s else q1 s in
+  let da := if k then d1 s else d0 s in
+  let di := if k then d0 s else d1 s in
+  let (bits, qa') := popn 26 qa in
+  match decode bits with
+  | Rec a0 w0 a1 w1 beta ao =>
+      let cell a :=
+        if Nat.eqb a RD then hd_t da
+        else if Nat.eqb a ARM then hd_t qi
+        else if Nat.eqb a CPY then hd_t di
+        else wget (win s) a in
+      let v := Z.leb 0 (w0 * b2z (cell a0) + w1 * b2z (cell a1) + beta)%Z in
+      let wn := if Nat.eqb ao RD || Nat.eqb ao ARM || Nat.eqb ao CPY then win s
+                else upd (win s) ao v in
+      let qi1 := if Nat.eqb ao ARM then wr_t qi v else qi in
+      let di1 := if Nat.eqb ao CPY then wr_t di v else di in
+      let qi2 := if wget wn AA then turn1 qi1 else qi1 in
+      let da2 := if wget wn AR then turn1 da else da in
+      let di2 := if wget wn AC then turn1 di1 else di1 in
+      let w2 := upd (upd (upd wn AA false) AR false) AC false in
+      if k then mkS w2 qi2 qa' di2 da2 else mkS w2 qa' qi2 da2 di2
+  end.
+
+Fixpoint iterp (p : positive) (s : st) : st :=
+  match p with
+  | xH => step s
+  | xO q => iterp q (iterp q s)
+  | xI q => step (iterp q (iterp q s))
+  end.
+
+(* ---- the code of descriptions ----------------------------------------- *)
+(* kind 0 AND, 1 OR, 2 COPY; s0, s1 the polarities of the two literals. *)
+Definition gate_bits (kind : nat) (s0 s1 : bool) : list bool :=
+  let sgn := match kind with 0 => s0 || s1 | 1 => s0 && s1 | _ => s0 end in
+  let odd := match kind with 0 => xorb s0 s1 | 1 => negb (xorb s0 s1) | _ => s0 end in
+  let w1 := match kind with 2 => [false; false] | _ => [negb s1; s1] end in
+  [negb s0; s0] ++ w1 ++ [sgn; sgn; sgn; odd].
+
+Definition codon_bits (kind : nat) (s0 s1 : bool) : list bool :=
+  [Nat.eqb kind 2 || Nat.eqb kind 3; Nat.eqb kind 1 || Nat.eqb kind 3; s0; s1].
+
+Definition candidates : list (nat * bool * bool) :=
+  [(0, false, false); (0, false, true); (0, true, false); (0, true, true);
+   (1, false, false); (1, false, true); (1, true, false); (1, true, true);
+   (2, false, false); (2, true, false)]%nat.
+
+Fixpoint find_codon (cs : list (nat * bool * bool)) (gb : list bool) : option (list bool) :=
+  match cs with
+  | [] => None
+  | (k, a, b) :: t => if lbeq (gate_bits k a b) gb then Some (codon_bits k a b) else find_codon t gb
+  end.
+
+Definition ESC : list bool := [true; true; false; false].
+Definition ENDC : list bool := [true; true; true; true].
+
+Fixpoint chunks (fuel : nat) (l : list bool) : list (list bool) :=
+  match fuel with
+  | O => []
+  | S f => match l with [] => [] | _ => firstn 26 l :: chunks f (skipn 26 l) end
+  end.
+
+Definition describe (img : list bool) : list bool :=
+  concat (map (fun r => match find_codon candidates (firstn 8 r) with
+                        | Some c => c ++ skipn 8 r
+                        | None => ESC ++ r
+                        end) (chunks (length img) img)) ++ ENDC.
+
+(* The decoding the organism is meant to carry out. *)
+Fixpoint translate_aux (fuel : nat) (d : list bool) : option (list bool) :=
+  match fuel with
+  | O => None
+  | S f =>
+      match d with
+      | c3 :: c2 :: s0 :: s1 :: rest =>
+          if c3 && c2 then
+            if s0 && s1 then match rest with [] => Some [] | _ => None end
+            else if Nat.eqb (length rest) 0 then None
+            else option_map (fun t => firstn 26 rest ++ t) (translate_aux f (skipn 26 rest))
+          else
+            option_map (fun t => gate_bits (if c3 then 2 else if c2 then 1 else 0) s0 s1 ++ firstn 18 rest ++ t)
+                       (translate_aux f (skipn 18 rest))
+      | _ => None
+      end
+  end.
+Definition translate (d : list bool) : option (list bool) := translate_aux (length d) d.

rocq/_CoqProject

@@ -0,0 +1,26 @@
+-R . TH
+TwoHead.v
+Organism.v
+Iter.v
+Tapes.v
+Abstract.v
+Indep.v
+Spec.v
+PassCheck.v
+PassLemma.v
+Decoder.v
+Run.v
+Complete.v
+Main.v
+SelfRep.v
+SmokeData.v
+Smoke.v
+Net.v
+Gates.v
+Phys.v
+PhysWF.v
+PhysSem.v
+PhysMain.v
+PhysFacts.v
+NetMain.v
+Extract.v