packages feed

phino 0.0.155 → 0.0.156

raw patch · 42 files changed

+2428/−814 lines, 42 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Lambdas: [_defer] :: Lambda -> Bool
+ Deps: EvUnreminted :: Int -> Text -> Expression -> Evaluation
+ Deps: EvUpcast :: Int -> Int -> Expression -> [(Int, [Attribute])] -> Evaluation
+ Deps: EvWorld :: Expression -> Evaluation
+ Deps: [_opaque] :: Nesting -> Int
+ Deps: [_shapes] :: Nesting -> Map [Maybe Attribute] [(Expression, [Binding])]
+ Deps: [_world] :: Nesting -> Map Attribute Expression
+ Deps: type Naming = StateT (Nesting, [String]) IO
+ Lambdas: Unfolded :: Meta -> Meta -> Bool -> Line
+ Lambdas: Upcasted :: Meta -> Meta -> Meta -> Meta -> Line
+ Lambdas: upcasted :: Expression -> Expression -> Int -> Maybe (Int, Expression, [(Int, [Attribute])], Int)
+ Morph: Unreminted :: Text -> ReduceException
- Deps: Nesting :: Int -> [(Int, Int)] -> [(Int, String)] -> Named Expression -> Map Int Int -> Map Int Int -> Maybe (Bytes, String) -> [(Int, String)] -> [(Int, String, String)] -> [(Int, Expression, String)] -> Nesting
+ Deps: Nesting :: Int -> [(Int, Int)] -> [(Int, String)] -> Named Expression -> Map Int Int -> Map Int Int -> Maybe (Bytes, String) -> [(Int, (Judgment, Expression))] -> [(Int, Judgment, Expression)] -> [(Int, Expression, String)] -> Map Attribute Expression -> Map [Maybe Attribute] [(Expression, [Binding])] -> Int -> Nesting
- Deps: [_heads] :: Nesting -> [(Int, String)]
+ Deps: [_heads] :: Nesting -> [(Int, (Judgment, Expression))]
- Deps: [_pending] :: Nesting -> [(Int, String, String)]
+ Deps: [_pending] :: Nesting -> [(Int, Judgment, Expression)]
- Lambdas: Lambda :: Text -> [(Meta, Expression)] -> [(Meta, Expression)] -> [Line] -> Bool -> Bool -> [Text] -> Expression -> Lambda
+ Lambdas: Lambda :: Text -> [(Meta, Expression)] -> [(Meta, Expression)] -> [Line] -> Bool -> [Text] -> Expression -> Lambda

Files

README.md view
@@ -34,7 +34,7 @@  ```bash cabal update-cabal install --overwrite-policy=always phino-0.0.154+cabal install --overwrite-policy=always phino-0.0.155 phino --version ``` @@ -59,7 +59,7 @@ for the runner and puts it on the `PATH`:  ```yaml-- uses: objectionary/phino@0.0.154+- uses: objectionary/phino@0.0.155   with:     version-file: phino-version.txt - run: phino --version@@ -152,6 +152,12 @@ `--max-steps` work on it unchanged. It may name any meta the entry bound, those of the two blocks below among them. +An entry reads no key but `λ`, `dataize`, `morph`, `evaluate`, `unfold`,+`rewrite`, `stay`, `symbolize`, `upcast`, `join`, `lenient`, `terminators` and+`𝑛`, and any other key, such as a misspelled `lenent` or a `defer` that now+belongs to a line of `unfold`, refuses the whole file, so a typo never drops a+block or an option without a word.+ ### Firing what an operand came to  𝕄 fires a λ function only where a dispatch reads the formation carrying it, so@@ -190,9 +196,92 @@ the meta it fired, `𝔼(L_second):  # 𝔼(𝑛2)`, and the line binding the answer the same way, `𝑛3·1 := 𝑛·3·2  # 𝔼(𝑛2)`. +### Unfolding an ordinary object++A branch may be an ordinary object, such as+`⟦ φ ↦ ξ.eq, eq ↦ ⟦ λ ⤍ L_eq ⟧ ⟧`: a formation with no `λ`, whose `φ` reads+an attribute of the object itself. Morphing stops at a formation, so the value+of such a branch stays one call away, and it joins with nothing. There is a+fourth block, `unfold`, and each line of it morphs the `φ` of such a term,+fires what that comes to, the way an `evaluate` line does, and binds an+expression meta of its own to the answer:++```yaml+- λ: L_fork+  morph:+    𝑛1: $.left+    𝑛2: $.right+  unfold:+    𝑛3: 𝑛1+  join:+    𝑛4: [𝑛3, 𝑛2]+  𝑛: 𝑛4+```++The right-hand side of a line names a meta bound by `morph` or by another line+of the entry, and nothing else. A term whose `φ` reads nothing of its own+object, such as `⟦ φ ↦ Φ.bool( … ) ⟧`, is bound as it stands, since morphing+it only expands the call, and so is a term that is no such formation at all.+The step is written to the protocol like any operand. Its firing counts+against `--max-steps`, as one of an `evaluate` line does, and `--acyclic`+cuts it when it fires again what it fired before.++That step gets stuck on a term that is a copy, such as+`Φ.step( tup ↦ Φ.items.tail )`, one of whose arguments reads to a bare+symbol `⟦ λ ⤍ 𝜎1 ⟧`: morphing its `φ`, `tup.next`, asks `𝜎1` for an+attribute nobody knows. A line that says `defer: true` does not enter such a+copy. It binds its meta to a fresh symbol instead and writes what the symbol+stands for:++```yaml+  unfold:+    𝑛3: {of: 𝑛2, defer: true}+```++```text+deferred(𝜎3) := Φ.step( tup ↦ 𝜎1:λ )  # 𝕄(𝑛2.φ)+```++The markup writes it as `<deferred symbol="𝜎3" … of="Φ.step">`, holding a+`<with>` element with an `<attr name="tup">𝜎1</attr>` per argument. When the+world declares no object the copy was made of, `of` names the `<formed>`+element that spells the copy out, and there is no `<with>`. A copy whose+arguments read to no bare symbol is entered as before. The short `𝑛3: 𝑛2`+stands for `𝑛3: {of: 𝑛2, defer: false}`.++An argument that is no bare symbol, such as `w ↦ Φ.inc( ⟦ Δ ⤍ 2A- ⟧ )`, is+worked out before the line is written. The entry morphs it in the copy, fires+what that comes to, the way an `evaluate` line does, and writes every step to+the protocol under `𝕄(𝑛2.w):`. The line then names the object the firing+answered, `Φ.box( x ↦ 𝜎1:λ, w ↦ 𝑛·2·2 )`, and so does the markup,+`<attr name="w">𝑛·2·3</attr>`, with a meta of its own count. A reader follows+the meta to the application that made the object. An argument whose morph gets+stuck, is cut or runs out of steps is written as the code spells it, and in the+markup by the meta of the element that named it earlier, such as the+`<applied>` of the call, or by an expression meta, such as `𝑒1`, when none+did.++A deferring line also answers a copy it did enter when `--acyclic` cuts the+firing its `φ` comes to. With+`rec(n) ↦ ⟦ φ ↦ Φ.fork( ⟦ λ ⤍ 𝜎1 ⟧, Φ.rec( ξ.n ) ) ⟧`, the copy+`Φ.rec( ⟦ φ ↦ ⟦ λ ⤍ 𝜎2 ⟧ ⟧ )` reads to no bare symbol, so the line enters it,+comes to the same fork, and fires it again, and the cut refuses that firing.+A line that does not defer loses the whole firing to the cut. A deferring one+binds its meta to a fresh symbol and writes it on the `looped` line:++```text+looped(𝑛·1·3) := 𝜎3  # 𝔼(𝑛2), proven+```++The markup writes it as `<looped symbol="𝜎3" … of="Φ.rec">` with the same+`<with>` element a `deferred` record holds. An argument whose `φ` holds a bare+symbol counts as that symbol, unless an element named it earlier: here+`<attr name="n">𝑛·0·1</attr>` names the `<formed>` element written for+`⟦ φ ↦ ⟦ λ ⤍ 𝜎2 ⟧ ⟧` earlier in the run, and that element holds `𝜎2`.+ ### Rewriting a term into another shape -There is a fourth block, `rewrite`, and it reduces nothing. Each line of it+There is a fifth block, `rewrite`, and it reduces nothing. Each line of it takes a term another meta of the entry is already bound to, named under `of`, applies a list of ordinary rules to it, spelled with the very `pattern`, `result`, `when` and meta variables a rule file uses, and binds an expression@@ -232,6 +321,46 @@ pattern never binds, is refused where the file is read. +A rule may still turn a large term into a small one made of symbols, through+`remint` in its `where` block. The function takes one expression and answers+the bare `⟦ λ ⤍ 𝜎k ⟧` the expression stands for:++```yaml+- λ: L_fork+  morph:+    𝑛1: $.left+  rewrite:+    𝑛2:+      of: 𝑛1+      rules:+        - name: small-tuple+          pattern: Φ.tuple( tail ↦ 𝑒1, head ↦ 𝑒2 )+          result: Φ.tuple( tail ↦ 𝑒3, head ↦ 𝑒4 )+          where:+            - meta: 𝑒3+              function: remint+              args: [𝑒1]+            - meta: 𝑒4+              function: remint+              args: [𝑒2]+  𝑛: 𝑛2+```++The result still writes no `𝜎`, and every symbol `remint` answers is one a+reader of the protocol builds without parsing a term. The function first works+the term out: it morphs the term in the formation it sits in, fires what that+comes to, follows the φ of a decorator such as `as-number`, and writes every+step to the protocol. Then it answers by what the term came to. A term whose+φ chain ends in a bare symbol is that symbol, and nothing is minted. A datum+is a fresh known symbol, `𝔻(𝜎4:λ) == 00-`, the way `symbolize` writes one. A+copy of an object of the world is a fresh deferred symbol, such as+`deferred(𝜎5) := Φ.l/.throw( message ↦ 𝜎4:λ )`, once every argument of the+copy came to a symbol the same way. Any other term has no symbol a reader+could build, so the step writes `unreminted(L_fork)` with the term, and the+firing gets stuck the way a fork whose branches do not join does.+`remint` is known only to the rules of a `rewrite` block, since nowhere else is+there a firing to mint for.+ This is how a program brings two branches of a fork to one shape before they are compared. In EO a `Φ.false` is written `φ ↦ ξ.right` while a bool a firing answered carries a symbol, and the two are one value in two spellings that@@ -242,7 +371,7 @@  ### Dropping the ρ of a dispatch -There is a fifth block, `stay`, and it reduces nothing either. Each line of it+There is a sixth block, `stay`, and it reduces nothing either. Each line of it takes a term another meta of the entry is already bound to and binds an expression meta of its own to that term with every `( ρ ↦ … )` dropped that is applied to a dispatch:@@ -285,7 +414,7 @@  ### Standing data into unknowns -There is a sixth block, `symbolize`, and it reduces nothing. It takes a term+There is a seventh block, `symbolize`, and it reduces nothing. It takes a term another meta of the entry is already bound to and binds an expression meta of its own to that same term with every datum in it standing for an unknown: @@ -326,12 +455,84 @@ `⟦ λ ⤍ 𝜎 ⟧`. A `Δ` against a `λ` is a difference in kind and not in value, and after the stage both branches carry `⟦ λ ⤍ 𝜎 ⟧` where they differ. +### Casting a bare symbol into a shape++A bare symbol, `⟦ λ ⤍ 𝜎1 ⟧`, says nothing of the object it stands for, while+the other branch of a fork may be a copy of `Φ.tuple` with a symbol in `tail`,+in `head` and in `length`, as one in `bytes.array` is. There is an eighth+block, `upcast`, and it holds exactly two lines, each reading a meta the way+a line of any other block does. The block takes the two terms as one pair,+casts the smaller of them into the shape of the larger, and binds the metas+of its two lines to the two results, in the order the lines are written:++```yaml+- λ: L_fork+  morph:+    𝑛1: $.left+    𝑛2: $.right+  rewrite:+    𝑛3:+      of: 𝑛2+      rules:+        - name: called+          pattern: ⟦ tail ↦ 𝑒1, head ↦ 𝑒2, length ↦ 𝑒3, !B ⟧+          result: Φ.tuple( tail ↦ 𝑒1, head ↦ 𝑒2, length ↦ 𝑒3 )+  upcast:+    𝑛4: 𝑛1+    𝑛5: 𝑛3+  join:+    𝑛6: [𝑛4, 𝑛5]+  𝑛: 𝑛6+```++Today the smaller term is a bare symbol, and the larger one is a term it can+be cast into: every symbol of it is reached by a path, and the cast is a copy+of it where every symbol is a fresh one, read off the bare symbol by the path+to its place. The line that read the bare symbol binds the cast, here `𝑛4`,+and the other line binds its term as it is. The author of the entry does not+say which of the two is cast, since the terms tell. The block runs once both+metas it reads are bound, and a line reading either meta it binds runs after+it. A block with one line, or with more than two, is refused when the file is+read.++The `rewrite` line spells the tuple 𝕄 made as the call it was made of, for the+reason the end of this section gives. The `join` line then pairs the two+calls symbol by symbol, minting a symbol for every pair the usual way:++```text+upcast(𝜎1) := Φ.tuple( tail ↦ 𝜎5:λ, head ↦ 𝜎6:λ, length ↦ 𝜎7:λ )+  𝜎5 := 𝜎1.tail+  𝜎6 := 𝜎1.head+  𝜎7 := 𝜎1.length+𝔻(𝜎8:λ) ∈ { 𝔻(𝜎5:λ), 𝔻(𝜎2:λ) }+𝔻(𝜎9:λ) ∈ { 𝔻(𝜎6:λ), 𝔻(𝜎3:λ) }+𝔻(𝜎10:λ) ∈ { 𝔻(𝜎7:λ), 𝔻(𝜎4:λ) }+```++A program reading `length` off the answer gets `𝜎10`, which stands for either+length, and does not get stuck. A path walks through the attributes of a+formation and the arguments of a copy of an object of the world, such as+`Φ.tuple( … )`. A `φ` is an attribute like any other, so the symbol of+`Φ.number( φ ↦ Φ.bytes( φ ↦ ⟦ λ ⤍ 𝜎2 ⟧ ) )` is read as `𝜎1.φ.φ`. When both+terms are bare symbols, when neither is, or when the other term holds no+symbol, or one no path reaches, such as one in an argument of a call+`x.slice( start ↦ 𝜎2 )`, both lines bind their terms as they are and nothing+is written for the cast. The protocol writes the two bindings the way it+writes any other line, `𝑛4·1 := …  # 𝑛1`. The term alone does not prove+that both branches are objects of one kind. The record is what lets a reader+check that against what it knows about the program.++A `join` compares only the `φ` chain of two formations, so a cast into a+formation, which is what 𝕄 makes of a copy, pairs nothing but that chain.+An entry that needs the arguments paired spells the copy as the call it was+made of first, with a `rewrite` line such as the one above.+ ### Joining the branches of a fork  A branching λ function answers neither of its branches. Which one the program takes is decided by a value nobody worked out, so handing one of them through would drop the branch point from the program altogether and a reader would see-the condition computed and thrown away. `join` is the seventh block, and it+the condition computed and thrown away. `join` is the ninth block, and it reduces nothing either: it takes two metas the entry has bound already and binds one of its own to the two terms joined into one. @@ -401,7 +602,7 @@ `if. (value.gte 0) (0.plus value) value.neg` the first branch comes to a number `X`, while `value.neg` is a method, `times -1 > @`, and comes to `⟦ φ ↦ X ⟧`, with the number one level down. The two differ in shape, so the-join is refused. An entry that says `lenient: true` beside its `join` block+join is refused. An entry that says `lenient: []` beside its `join` block lets it through:  ```yaml@@ -411,7 +612,7 @@     𝑛2: $.right   join:     𝑛3: [𝑛1, 𝑛2]-  lenient: true+  lenient: []   𝑛: 𝑛3 ``` @@ -421,8 +622,10 @@ chain is taken for the decorator. The answer drops the `ρ` and the other attributes of the decorator, so it is not exactly the object either branch made, which is why an entry is strict unless it says otherwise. Dataization-still reaches the same data through it. An entry that says `lenient: true` and-has no `join` line is refused when the file is read.+still reaches the same data through it. The list takes no option and stays+empty. A name in it is refused when the file is read, `defer` and `upcast`+among them, since an `unfold` line and an `upcast` block now do their work, and+so is a lenient entry with no `join` line.  A lenient entry also joins a bare symbol with a term that holds exactly one symbol anywhere inside. In `bool.and` one branch comes to a bare@@ -433,52 +636,10 @@ stands for either `𝜎1` or `𝜎2`. The copy keeps every binding of the term, `ρ` included. A term with no symbol, or with two, is still refused. -A lenient entry takes one more step before it gives up. A branch may be an-ordinary object, such as `⟦ φ ↦ ξ.eq, eq ↦ ⟦ λ ⤍ L_eq ⟧ ⟧`: a formation with-no `λ`, whose `φ` reads an attribute of the object itself. Morphing stops at a-formation, so the value of such a branch stays one call away and it joins with-nothing. When a join fails, a lenient entry morphs the `φ` of every such-branch, fires what it comes to, the way an `evaluate` line does, and joins-once more. The step is taken once and is written to the protocol like any-operand. Its firing counts against `--max-steps`, as one of an `evaluate`-line does, and `--acyclic` cuts it when it fires again what it fired before.-A branch whose `φ` reads nothing of its own object, such as-`⟦ φ ↦ Φ.bool( … ) ⟧`, is left as it is, since morphing it only expands the-call.--That step gets stuck on a branch that is a copy, such as-`Φ.step( tup ↦ Φ.items.tail )`, one of whose arguments reads to a bare-symbol `⟦ λ ⤍ 𝜎1 ⟧`: morphing its `φ`, `tup.next`, asks `𝜎1` for an-attribute nobody knows. An entry that says `defer: true` beside-`lenient: true` does not enter such a copy. It answers the copy with a fresh-symbol, joins that symbol instead, and writes what it stands for:--```text-deferred(𝜎3) := Φ.step( tup ↦ 𝜎1:λ )  # 𝕄(𝑛2.φ)-```--The markup writes it as `<deferred symbol="𝜎3" … of="Φ.step">`, holding a-`<with>` element with an `<attr name="tup">𝜎1</attr>` per argument, a `?` for-an argument that is no bare symbol, and the copy itself in `<e>`. The `of` is-left out when the world declares no object the copy was made of. A copy whose-arguments read to no bare symbol is entered as before. An entry that says-`defer: true` and is not lenient is refused when the file is read.--The same entry answers a copy it did enter when `--acyclic` cuts the firing-its `φ` comes to. With `rec(n) ↦ ⟦ φ ↦ Φ.fork( ⟦ λ ⤍ 𝜎1 ⟧, Φ.rec( ξ.n ) ) ⟧`,-the copy `Φ.rec( ⟦ φ ↦ ⟦ λ ⤍ 𝜎2 ⟧ ⟧ )` reads to no bare symbol, so the step-enters it, comes to the same fork, and fires it again, and the cut refuses-that firing. A lenient entry without `defer: true` loses the whole firing to-the cut. A deferring one answers the copy with a fresh symbol, joins that-symbol, and writes it on the `looped` line:--```text-looped(𝑛·1·3) := 𝜎3  # 𝔼(𝑛2), proven-```--The markup writes it as `<looped symbol="𝜎3" … of="Φ.rec">` with the same-`<with>` element a `deferred` record holds, here `<attr name="n">𝜎2</attr>`,-since an argument whose `φ` holds a bare symbol counts as that symbol.+A bare symbol meeting a term with more symbols than one is no join, lenient+or not. The entry casts it into the shape of that term first, with an+`upcast` block, and a branch one call away from its value is fired first with+an `unfold` line.  One term being `⊥` is the exception, since `if. cond value ⊥` is how EO spells "raise unless `cond`": the program raises on that side of the condition and@@ -512,8 +673,9 @@ reaches the join as `morph` left it. The record names the `message` of that term as its last argument, as written, as `terminate(𝔻(𝜎2:λ), right, 7.plus( 8 ))  # 𝑛4` in the text format and-`<terminate symbol="𝜎2" branch="right" message="7.plus( 8 )"/>` in the-markup, so the error path can be lowered as well as the other branch. A raising+`<terminate symbol="𝜎2" branch="right" message="𝑛·1·6"/>` in the markup,+where `message` names the `<applied meta="𝑛·1·6" of="𝑛·1·3.plus">` written for+`7.plus( 8 )`, so the error path can be lowered as well as the other branch. A raising term with no `message` names none. A name under `terminators` that a key of the file matches is refused when the file is read, since that function fires rather than raises.@@ -524,10 +686,10 @@  ### The order of the lines -The lines of `evaluate`, `rewrite`, `stay`, `symbolize` and `join` run in the-order of the metas they read, not in the order of their blocks. A line runs-once every meta it reads is bound, so this entry fires what its `rewrite` line-unwrapped:+The lines of `evaluate`, `unfold`, `rewrite`, `stay`, `symbolize`, `upcast`+and `join` run in the order of the metas they read, not in the order of their+blocks. A line runs once every meta it reads is bound, so this entry fires+what its `rewrite` line unwrapped:  ```yaml - λ: L_pick@@ -829,7 +991,7 @@ residue instead of failing: what `phino` could not decide is a property of the program and not of the option that decides what to do about it. -Four more lines say why a firing gave no answer.+Five more lines say why a firing gave no answer. `stuck(L_outer)` is the last line of a firing that got stuck, naming the λ function it got stuck on, which is seldom the one `unanswered(…)` names: that one is written where it was asked for, and this one closes every firing the@@ -839,6 +1001,8 @@ `unjoined(L_fork)  # 𝜎1:λ:l vs ⟦ l ↦ 𝜎2:λ, x ↦ ⟦⟧ ⟧`, so a fork the program left in two shapes never reads as an operand that ran out of steps; the firings around it still close with `stuck(L_fork)`.+`unreminted(L_fork)` takes its place in the firing whose `remint` step found+no symbol for a term, and carries the term, `unreminted(L_fork)  # 𝜎2:λ:k`. `stall(L_outer)` stands under a firing that `--acyclic=plausible` answered with the stall an earlier firing of the same formation kept, so a told stall never reads as a fresh firing that wrote nothing.@@ -862,8 +1026,11 @@ ```  The markup spells them `<stuck λ="L_outer"/>`,-`<unjoined λ="L_fork"><e>𝜎1:λ:l</e><e>⟦ l ↦ 𝜎2:λ, x ↦ ⟦⟧ ⟧</e></unjoined>`,-`<stall λ="L_outer"/>` and `<starved limit="3" by="dataize" at="Φ.a🌵2"/>`.+`<unjoined λ="L_fork">𝑛·1·1 𝑛·1·3</unjoined>`,+`<unreminted λ="L_fork">𝑛·1·2</unreminted>`,+`<stall λ="L_outer"/>` and `<starved limit="3" by="dataize" at="Φ.a🌵2"/>`,+where `<unjoined>` names its two terms and `<unreminted>` its one by meta, the+way every other element names a term.  `timeout(5)` is where `--max-seconds=5` ran out, placed and commented the same way and written at the first step the deadline refused.@@ -1068,32 +1235,36 @@ <protocol>   <dataize at="Φ">     <morph at="Φ">-      <applied meta="𝑛·0·1" by="morph" at="Φ" of="Φ.number"><attr name="φ">Φ.bytes( φ ↦ 40-14-00-00-00-00-00-00:Δ )</attr></applied>-      <applied meta="𝑛·0·2" by="morph" at="Φ" of="𝑛·0·1.plus"><attr name="x">6</attr></applied>+      <applied meta="𝑛·0·1" of="Φ.bytes"><attr name="φ">40-14-00-00-00-00-00-00</attr></applied>+      <applied meta="𝑛·0·2" by="morph" at="Φ" of="Φ.number"><attr name="φ">𝑛·0·1</attr></applied>+      <applied meta="𝑛·0·3" of="Φ.bytes"><attr name="φ">40-18-00-00-00-00-00-00</attr></applied>+      <applied meta="𝑛·0·4" of="Φ.number"><attr name="φ">𝑛·0·3</attr></applied>+      <applied meta="𝑛·0·5" by="morph" at="Φ" of="𝑛·0·2.plus"><attr name="x">𝑛·0·4</attr></applied>     </morph>     <evaluate λ="L_number_plus" by="dataize" at="Φ">       <dataize at="Φ.a🌵0">         <morph at="Φ.a🌵0">-          <applied meta="𝑛·1·1" by="morph" at="Φ.a🌵0" of="Φ.number"><attr name="φ">Φ.bytes( φ ↦ 40-14-00-00-00-00-00-00:Δ )</attr></applied>-          <applied meta="𝑛·1·2" by="morph" at="Φ.a🌵0" of="Φ.bytes"><attr name="φ">40-14-00-00-00-00-00-00:Δ</attr></applied>+          <applied meta="𝑛·1·1" by="morph" at="Φ.a🌵0" of="Φ.number"><attr name="φ">𝑛·0·1</attr></applied>+          <applied meta="𝑛·1·2" by="morph" at="Φ.a🌵0" of="Φ.bytes"><attr name="φ">40-14-00-00-00-00-00-00</attr></applied>         </morph>         <delta meta="𝛿·1·1" number="5.0">40-14-00-00-00-00-00-00</delta>       </dataize>       <bind meta="𝛿1·1">𝛿·1·1</bind>       <dataize at="Φ.a🌵1">         <morph at="Φ.a🌵1">-          <applied meta="𝑛·1·3" by="morph" at="Φ.a🌵1" of="Φ.number"><attr name="φ">Φ.bytes( φ ↦ 40-18-00-00-00-00-00-00:Δ )</attr></applied>-          <applied meta="𝑛·1·4" by="morph" at="Φ.a🌵1" of="Φ.bytes"><attr name="φ">40-18-00-00-00-00-00-00:Δ</attr></applied>+          <applied meta="𝑛·1·3" by="morph" at="Φ.a🌵1" of="Φ.number"><attr name="φ">𝑛·0·3</attr></applied>+          <applied meta="𝑛·1·4" by="morph" at="Φ.a🌵1" of="Φ.bytes"><attr name="φ">40-18-00-00-00-00-00-00</attr></applied>         </morph>         <delta meta="𝛿·1·2" number="6.0">40-18-00-00-00-00-00-00</delta>       </dataize>       <bind meta="𝛿2·1">𝛿·1·2</bind>       <minted symbol="𝜎1">40-14-00-00-00-00-00-00 40-18-00-00-00-00-00-00</minted>-      <built meta="𝑛·1·5">Φ.number( φ ↦ 𝜎1:λ )</built>-      <morph at="𝑛·1·5">-        <applied meta="𝑛·1·6" by="morph" at="𝑛·1·5" of="Φ.number"><attr name="φ">𝜎1</attr></applied>+      <applied meta="𝑛·1·5" of="Φ.number"><attr name="φ">𝜎1</attr></applied>+      <built meta="𝑛·1·6">𝑛·1·5</built>+      <morph at="𝑛·1·6">+        <applied meta="𝑛·1·7" by="morph" at="𝑛·1·6" of="Φ.number"><attr name="φ">𝜎1</attr></applied>       </morph>-      <answer meta="𝑛·1·7">𝑛·1·6</answer>+      <answer meta="𝑛·1·8">𝑛·1·7</answer>     </evaluate>   </dataize> </protocol>@@ -1124,35 +1295,58 @@ of the data. A datum of eight bytes also carries `number`, the double the text format writes as the comment of its line. `<bind>` is one meta the firing bound, `meta` naming it the same way the text-format names it, counter and all, and the element holding the value it took: a-term where the operand was reduced with 𝕄, the datum itself where a `dataize`-operand came down to data. `<dataize>` inside a firing is the other thing a-`dataize` operand may come to, the datum manufactured for an unknown, and holds-the formation that unknown names rather than the 42 standing for it: a `𝜎` is-the name of a λ function and no term of its own, so what 𝔻 was applied to is-`𝜎2:λ` and never `𝜎2` alone. It carries `meta` where the run carries-`at`, the same difference the text format draws between `𝔻(Φ)` at the top-and `𝛿1·2 := 𝔻(…)` in a block. The name of the element is what tells a-manufactured datum from data, the way `𝔻(…)` does in the text format, so-nothing has to be read off the presence of an attribute. `<answer>` holds the-term the firing answered with, named the same way by its own `meta`, and-`<built>` before it holds the term the entry wrote, the one 𝕄 made that answer-of: two elements rather than two attributes of one, for the same reason-`<dataize>` is no `<bind>`.+format names it, counter and all, and the element holding the value it took:+the name of the term where the operand was reduced with 𝕄, the datum itself+where a `dataize` operand came down to data. `<dataize>` inside a firing is the+other thing a `dataize` operand may come to, the datum manufactured for an+unknown, and holds the symbol of that unknown rather than the 42 standing for+it, `𝜎2` where the text format writes the formation `𝜎2:λ`. It carries `meta`+where the run carries `at`, the same difference the text format draws between+`𝔻(Φ)` at the top and `𝛿1·2 := 𝔻(…)` in a block. The name of the element is+what tells a manufactured datum from data, the way `𝔻(…)` does in the text+format, so nothing has to be read off the presence of an attribute. `<answer>`+holds the name of the term the firing answered with, named the same way by its+own `meta`, and `<built>` before it holds the name of the term the entry wrote,+the one 𝕄 made that answer of: two elements rather than two attributes of one,+for the same reason `<dataize>` is no `<bind>`. -`<applied meta="𝑛·1·6" by="morph" at="𝑛·1·5" of="Φ.number">` is an object an+`<applied meta="𝑛·1·7" by="morph" at="𝑛·1·6" of="Φ.number">` is an object an application made, which the text format writes as `𝑛·1·6 := …` in the block-`𝕄(𝑛·1·5):`: `meta` names the object the way the text format-does, counted with the `<built>` and the `<answer>` of the firing it stands in,-`by` and `at` name the judgment that normalized and the site it stood at, and-`of` names the object applied.-The argument stands in an `<attr>`, `name` naming the attribute it fills and-the text holding the name of the object or the application it is, the symbol,-such as `𝜎1`, where it is a bare one, and the term itself otherwise. A later-element holding that object holds its name instead, in its text or in its-`term`, so `<answer meta="𝑛·1·7">𝑛·1·6</answer>` says the firing answered with-it and `<dataize at="Φ">` that 𝔻 got into it.+`𝕄(𝑛·1·5):`: `meta` names the object, counted with the `<built>` and the+`<answer>` of the firing it stands in, `by` and `at` name the judgment that+normalized and the site it stood at, and `of` names the object applied. The+argument stands in an `<attr>`, `name` naming the attribute it fills and the+text holding the name of the argument. An application nothing reduced gets an+`<applied>` too, with no `by` and no `at`, right before the element that holds+it: `<applied meta="𝑛·0·1" of="Φ.bytes">` is `Φ.bytes( 40-14-… )`, the argument+of the `Φ.number` that `𝑛·0·2` applies. A later element holding an object holds+its name instead, so `<answer meta="𝑛·1·8">𝑛·1·7</answer>` says the firing+answered with it and `<morph at="𝑛·1·6">` that 𝕄 got into what the entry+built. +The markup is for a program, which never has to parse a term of 𝜑-calculus to+read it. Every value the markup holds, in an attribute or as the text of an+element, is one of a few kinds: a symbol such as `𝜎1`, a datum such as+`40-14-00-00-00-00-00-00`, a meta such as `𝑛·0·2` or `𝛿·1·1`, a path of+attribute names off `Φ`, `ξ`, `ρ` or a meta, such as `𝑛·0·2.plus`, a name such+as `tail` or `L_fork`, or `⊥`. A term of any other kind is named by an element+of its own, written before the first element that holds it, and is its meta+from then on: an application by an `<applied>`, and a formation by a+`<formed>`. A formation that copies an object of the world, binding its `φ` to+`𝜎196`, is `<formed meta="𝑛·3·9" of="Φ.string"><attr name="φ">𝜎196</attr>`:+`of` names the object by its path, and every `<attr>` is an attribute the copy+binds to a value other than the one the object has. A copy that binds nothing+new is named by its path alone. A formation that copies no object of the world+has no `of` and holds all its bindings: an `<attr>` for each bound attribute, a+`<void name="x"/>` for each void one, and its `λ` or `Δ`, if it has one, as an+attribute of the element, such as `<formed meta="𝑛·1·1" λ="L_fork">`. A term+the markup can name in none of these ways, such as an argument of a deferred+call that nothing worked out, is an expression meta, `𝑒1`: the same term gets+the same `𝑒` throughout the file and another term gets another, so a reader can+tell two holes apart, while what the term is stays in the text format alone.+Since the markup names terms the text format writes out, the two count their+metas each on their own: `𝑛·1·7` of the markup above is `𝑛·1·6` of the text.+ `<known symbol="𝜎44">3F-F0-00-00-00-00-00-00</known>` is the fact a `symbolize` line writes about a symbol it minted, which the text format writes as `𝔻(𝜎44:λ) == …`: the symbol stands in the attribute a reader joins@@ -1179,7 +1373,7 @@ lists its pair. With the `λ` of the block the element reads as the fact `𝔻(𝜎1:λ) == L_number_plus(40-14-…, 40-18-…)`, and a firing of an entry with no `dataize` line writes `<minted symbol="𝜎1"/>`. The symbol is also the edge-a reader joins on: a later `<dataize meta="𝛿1·5">𝜎2:λ</dataize>` names the+a reader joins on: a later `<dataize meta="𝛿1·5">𝜎2</dataize>` names the symbol the firing that wrote `<minted symbol="𝜎2">` handed out. A firing minting two symbols writes two elements and one minting none writes none, which no attribute on the answer could say: a term may carry several symbols,@@ -1189,12 +1383,20 @@ since the symbol it answers with comes from a `join` line and stands in a `<joined>` of its own. +`<upcast symbol="𝜎1" of="𝑛·1·2"><path symbol="𝜎5">tail</path>…</upcast>` is a+bare symbol an `upcast` block cast into a copy of another term, which the+text format writes as `upcast(𝜎1) := …` with a line `𝜎5 := 𝜎1.tail` per fresh+symbol. The bare symbol stands in `symbol` and `of` names the copy. Every+`<path>` holds a fresh symbol of the copy in `symbol` and, as its text, the+attributes that read it off the bare one, joined by dots.+ A λ name no entry answers is `<unanswered λ="…">`, standing where its-`<evaluate>` would have stood with the formation 𝔼 was fired against as its text-and the judgment that asked in its `by` attribute, where the text format writes-the letter of it. A firing that happened while an operand of another was being-reduced is an `<evaluate>` inside the one that asked, which is what the deeper-indentation means in the text. Elements are written as the run goes and+`<evaluate>` would have stood with the name of the formation 𝔼 was fired+against as its text, such as `𝑛·1·7.nope` below, and the judgment that asked+in its `by` attribute, where the text format writes the letter of it. A firing+that happened while an operand of another was being reduced is an `<evaluate>`+inside the one that asked, which is what the deeper indentation means in the+text. Elements are written as the run goes and the open ones are closed when it ends, so a run that fails still leaves a well-formed document behind: @@ -1209,34 +1411,38 @@ <protocol>   <dataize at="Φ">     <morph at="Φ">-      <applied meta="𝑛·0·1" by="morph" at="Φ" of="Φ.number"><attr name="φ">Φ.bytes( φ ↦ 40-14-00-00-00-00-00-00:Δ )</attr></applied>-      <applied meta="𝑛·0·2" by="morph" at="Φ" of="𝑛·0·1.plus"><attr name="x">6</attr></applied>+      <applied meta="𝑛·0·1" of="Φ.bytes"><attr name="φ">40-14-00-00-00-00-00-00</attr></applied>+      <applied meta="𝑛·0·2" by="morph" at="Φ" of="Φ.number"><attr name="φ">𝑛·0·1</attr></applied>+      <applied meta="𝑛·0·3" of="Φ.bytes"><attr name="φ">40-18-00-00-00-00-00-00</attr></applied>+      <applied meta="𝑛·0·4" of="Φ.number"><attr name="φ">𝑛·0·3</attr></applied>+      <applied meta="𝑛·0·5" by="morph" at="Φ" of="𝑛·0·2.plus"><attr name="x">𝑛·0·4</attr></applied>       <evaluate λ="L_number_plus" by="morph" at="Φ">         <dataize at="Φ.a🌵0">           <morph at="Φ.a🌵0">-            <applied meta="𝑛·1·1" by="morph" at="Φ.a🌵0" of="Φ.number"><attr name="φ">Φ.bytes( φ ↦ 40-14-00-00-00-00-00-00:Δ )</attr></applied>-            <applied meta="𝑛·1·2" by="morph" at="Φ.a🌵0" of="Φ.bytes"><attr name="φ">40-14-00-00-00-00-00-00:Δ</attr></applied>+            <applied meta="𝑛·1·1" by="morph" at="Φ.a🌵0" of="Φ.number"><attr name="φ">𝑛·0·1</attr></applied>+            <applied meta="𝑛·1·2" by="morph" at="Φ.a🌵0" of="Φ.bytes"><attr name="φ">40-14-00-00-00-00-00-00</attr></applied>           </morph>           <delta meta="𝛿·1·1" number="5.0">40-14-00-00-00-00-00-00</delta>         </dataize>         <bind meta="𝛿1·1">𝛿·1·1</bind>         <dataize at="Φ.a🌵1">           <morph at="Φ.a🌵1">-            <applied meta="𝑛·1·3" by="morph" at="Φ.a🌵1" of="Φ.number"><attr name="φ">Φ.bytes( φ ↦ 40-18-00-00-00-00-00-00:Δ )</attr></applied>-            <applied meta="𝑛·1·4" by="morph" at="Φ.a🌵1" of="Φ.bytes"><attr name="φ">40-18-00-00-00-00-00-00:Δ</attr></applied>+            <applied meta="𝑛·1·3" by="morph" at="Φ.a🌵1" of="Φ.number"><attr name="φ">𝑛·0·3</attr></applied>+            <applied meta="𝑛·1·4" by="morph" at="Φ.a🌵1" of="Φ.bytes"><attr name="φ">40-18-00-00-00-00-00-00</attr></applied>           </morph>           <delta meta="𝛿·1·2" number="6.0">40-18-00-00-00-00-00-00</delta>         </dataize>         <bind meta="𝛿2·1">𝛿·1·2</bind>         <minted symbol="𝜎1">40-14-00-00-00-00-00-00 40-18-00-00-00-00-00-00</minted>-        <built meta="𝑛·1·5">Φ.number( φ ↦ 𝜎1:λ )</built>-        <morph at="𝑛·1·5">-          <applied meta="𝑛·1·6" by="morph" at="𝑛·1·5" of="Φ.number"><attr name="φ">𝜎1</attr></applied>+        <applied meta="𝑛·1·5" of="Φ.number"><attr name="φ">𝜎1</attr></applied>+        <built meta="𝑛·1·6">𝑛·1·5</built>+        <morph at="𝑛·1·6">+          <applied meta="𝑛·1·7" by="morph" at="𝑛·1·6" of="Φ.number"><attr name="φ">𝜎1</attr></applied>         </morph>-        <answer meta="𝑛·1·7">𝑛·1·6</answer>+        <answer meta="𝑛·1·8">𝑛·1·7</answer>       </evaluate>     </morph>-    <unanswered λ="L_number_nope" by="dataize">L_number_nope:λ</unanswered>+    <unanswered λ="L_number_nope" by="dataize">𝑛·1·7.nope</unanswered>   </dataize> </protocol> ```@@ -1247,11 +1453,12 @@  A formation carrying a whole object is written flat on one line, so a real run fills the protocol with lines tens of thousands of characters long. The-`--abridged` option shortens every term the protocol writes, in the text and-the XML alike: a formation longer than sixty-four characters keeps its `φ`,-`Δ` and `λ` bindings and folds the rest into a count. The width is a value of-the option, `--abridged=120`, for a run that can read longer lines. The result-the run prints stays whole, and the option is refused without `--protocol`.+`--abridged` option shortens every term the text protocol writes: a formation+longer than sixty-four characters keeps its `φ`, `Δ` and `λ` bindings and folds+the rest into a count. The markup writes no terms, only their names, so the+option leaves it as it is. The width is a value of the option,+`--abridged=120`, for a run that can read longer lines. The result the run+prints stays whole, and the option is refused without `--protocol`. Every byte string the protocol writes stays whole too, since a reader may need the data a firing came down to: @@ -1624,8 +1831,8 @@ line that made it, `𝑛·0·1`, so the two are paired by their terms and no reader has to rename symbols by eye or find the cut in the residue. Nothing runs under a cut, so no block opens under the line. In the XML protocol it is-`<looped by="morph" match="proven" at="Φ.y"><e>𝑛·0·1</e></looped>`, with the-site and the mode as attributes and the formation in `<e>`. Without the option+`<looped by="morph" match="proven" at="Φ.y" of="𝑛·0·1"/>`, with the site, the+mode and the name of the formation as attributes. Without the option the same run nests one round inside another until `--max-steps` runs out.  What a frame remembers is the branch from the run down to it, never everything@@ -2183,6 +2390,11 @@ * `join` - accepts list of bindings and returns list of joined bindings. Duplicated   `ρ`, `Δ` and `λ` attributes are ignored, all other duplicated attributes are replaced   with unique attributes using `random-tau` function.+* `remint` - accepts one expression and answers the symbol it stands for: the+  bare symbol its φ chain ends in, a known symbol for a datum, or a deferred+  symbol for a copy of an object of the world.+  It works only in a `rewrite` block of the `--symbolic` file, see+  [above](#rewriting-a-term-into-another-shape).  ## Meta variables @@ -2279,119 +2491,119 @@ === parse/phi ===   warmup:     3 iterations   batches:    10 x 1-  total:      1797890.573 μs-  avg:        179789.057 μs-  min:        162091.874 μs-  max:        210027.085 μs-  std dev:    16246.548 μs+  total:      1449859.357 μs+  avg:        144985.936 μs+  min:        127788.624 μs+  max:        180748.736 μs+  std dev:    18594.498 μs === parse/xmir ===   warmup:     3 iterations   batches:    10 x 1-  total:      7935401.706 μs-  avg:        793540.171 μs-  min:        737257.079 μs-  max:        864759.805 μs-  std dev:    46225.278 μs+  total:      6946940.912 μs+  avg:        694694.091 μs+  min:        628516.654 μs+  max:        800858.894 μs+  std dev:    55991.977 μs === rewrite/normalize ===   warmup:     3 iterations   batches:    10 x 1-  total:      17.396 μs-  avg:        1.740 μs-  min:        1.603 μs-  max:        2.082 μs-  std dev:    0.127 μs+  total:      11.436 μs+  avg:        1.144 μs+  min:        0.932 μs+  max:        1.542 μs+  std dev:    0.197 μs === print/sweet/multiline ===   warmup:     3 iterations   batches:    10 x 1-  total:      5454056.634 μs-  avg:        545405.663 μs-  min:        515758.348 μs-  max:        582503.512 μs-  std dev:    22764.961 μs+  total:      4445986.898 μs+  avg:        444598.690 μs+  min:        398258.495 μs+  max:        481107.673 μs+  std dev:    23991.734 μs === print/sweet/flat ===   warmup:     3 iterations   batches:    10 x 1-  total:      552072.467 μs-  avg:        55207.247 μs-  min:        49412.521 μs-  max:        67399.308 μs-  std dev:    7769.298 μs+  total:      487593.672 μs+  avg:        48759.367 μs+  min:        43188.190 μs+  max:        64565.233 μs+  std dev:    7856.020 μs === print/salty/multiline ===   warmup:     3 iterations   batches:    10 x 1-  total:      17341236.442 μs-  avg:        1734123.644 μs-  min:        1695951.065 μs-  max:        1783518.134 μs-  std dev:    22630.032 μs+  total:      13090120.822 μs+  avg:        1309012.082 μs+  min:        1242004.615 μs+  max:        1396091.419 μs+  std dev:    42788.620 μs === morph/symbolic/demo/e1 ===   warmup:     3 iterations-  batches:    10 x 11-  total:      10945.365 μs-  avg:        99.503 μs-  min:        97.173 μs-  max:        103.887 μs-  std dev:    1.985 μs+  batches:    10 x 13+  total:      7326.444 μs+  avg:        56.357 μs+  min:        54.948 μs+  max:        59.799 μs+  std dev:    1.305 μs === morph/symbolic/demo/e2 ===   warmup:     3 iterations-  batches:    10 x 174-  total:      174504.049 μs-  avg:        100.290 μs-  min:        99.832 μs-  max:        101.139 μs-  std dev:    0.345 μs+  batches:    10 x 256+  total:      150484.172 μs+  avg:        58.783 μs+  min:        58.107 μs+  max:        59.962 μs+  std dev:    0.638 μs === morph/symbolic/demo/e3 ===   warmup:     3 iterations-  batches:    10 x 171-  total:      173859.715 μs-  avg:        101.672 μs-  min:        101.424 μs-  max:        102.096 μs-  std dev:    0.212 μs+  batches:    10 x 251+  total:      155622.704 μs+  avg:        62.001 μs+  min:        61.318 μs+  max:        63.528 μs+  std dev:    0.583 μs === morph/symbolic/demo/e4 ===   warmup:     3 iterations-  batches:    10 x 152-  total:      155114.153 μs-  avg:        102.049 μs-  min:        101.576 μs-  max:        103.791 μs-  std dev:    0.632 μs+  batches:    10 x 250+  total:      157486.792 μs+  avg:        62.995 μs+  min:        62.575 μs+  max:        63.718 μs+  std dev:    0.372 μs === morph/symbolic/demo/e5 ===   warmup:     3 iterations-  batches:    10 x 160-  total:      164432.368 μs-  avg:        102.770 μs-  min:        101.849 μs-  max:        105.495 μs-  std dev:    1.045 μs+  batches:    10 x 239+  total:      152736.856 μs+  avg:        63.907 μs+  min:        62.083 μs+  max:        75.524 μs+  std dev:    3.890 μs === morph/symbolic/native/e5 ===   warmup:     3 iterations-  batches:    10 x 165-  total:      171308.171 μs-  avg:        103.823 μs-  min:        102.973 μs-  max:        106.133 μs-  std dev:    0.997 μs+  batches:    10 x 224+  total:      143868.258 μs+  avg:        64.227 μs+  min:        63.912 μs+  max:        64.886 μs+  std dev:    0.255 μs === morph/symbolic/accum/0 ===   warmup:     3 iterations-  batches:    10 x 121-  total:      105704.677 μs-  avg:        87.359 μs-  min:        87.144 μs-  max:        87.909 μs-  std dev:    0.218 μs+  batches:    10 x 99+  total:      52382.352 μs+  avg:        52.911 μs+  min:        51.267 μs+  max:        55.604 μs+  std dev:    1.318 μs === morph/symbolic/accum/400 ===   warmup:     3 iterations-  batches:    10 x 79-  total:      70197.862 μs-  avg:        88.858 μs-  min:        88.372 μs-  max:        89.549 μs-  std dev:    0.357 μs+  batches:    10 x 126+  total:      67542.276 μs+  avg:        53.605 μs+  min:        52.701 μs+  max:        54.352 μs+  std dev:    0.516 μs ```  The results were calculated in [this GHA job][benchmark-gha]-on 2026-10-13 at 15:50,+on 2026-10-14 at 19:08, on Linux with 4 CPUs.  <!-- benchmark_end -->@@ -2442,4 +2654,4 @@ [jna-native]: https://github.com/java-native-access/jna/blob/master/src/com/sun/jna/Native.java [jeo]: https://github.com/objectionary/jeo-maven-plugin [issue-1291]: https://github.com/objectionary/phino/issues/1291-[benchmark-gha]: https://github.com/objectionary/phino/actions/runs/38425077680+[benchmark-gha]: https://github.com/objectionary/phino/actions/runs/38620470424
phino.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: phino-version: 0.0.155+version: 0.0.156 license: MIT synopsis: Command-Line Manipulator of 𝜑-Calculus Expressions description: Please see the README on GitHub at <https://github.com/objectionary/phino#readme>
src/CLI/Parsers.hs view
@@ -258,12 +258,15 @@               "Path to the YAML file of λ functions this run may fire, each entry keyed by a regular expression \               \over λ names under \"λ\", naming the operands it brings down to data under \"dataize\", the ones \               \it reduces to a normal form under \"morph\", the terms it rewrites by rules of its own under \-              \\"rewrite\", the terms of those it stands the data of into unknowns under \"symbolize\" and the \-              \pairs of branches it joins into one term under \"join\", whether a join takes a term and a \-              \formation whose φ is that term for one under \"lenient\", whether a lenient join answers a fresh \-              \symbol for a copy one of whose arguments reads to a bare symbol instead of entering it, or for \-              \a copy whose firing a cut refuses, under \"defer\", the λ functions whose objects a join takes for a branch that raises under \-              \\"terminators\", and answering with the term under \"𝑛\""+              \\"rewrite\", the terms whose φ it fires the way \"evaluate\" does under \"unfold\", where \+              \\"defer: true\" has a copy one of whose arguments reads to a bare symbol, or a copy whose firing \+              \a cut refuses, answer a fresh symbol instead, the terms of those it stands the data of into \+              \unknowns under \"symbolize\", the pair of terms whose smaller it casts into the shape of the \+              \larger under \"upcast\", in two lines binding the two results, the pairs of branches it joins \+              \into one term under \"join\", whether a join takes a term and a formation whose φ is that term for one under \+              \\"lenient\", an empty list, the λ functions whose objects \+              \a join takes for a branch that raises under \"terminators\", and answering with the term under \+              \\"𝑛\""         )     ) 
src/Deps.hs view
@@ -10,18 +10,21 @@  import AST import Bytes (btsSize, btsToNum)-import Control.Monad (unless, when)-import Data.Bifunctor (bimap, first)+import Control.Monad (foldM, guard, unless, when, zipWithM, (>=>))+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.State.Strict (StateT, get, modify, put, runStateT)+import Data.Bifunctor (bimap, first, second)+import Data.Either (lefts, rights) import Data.IORef (IORef, readIORef, writeIORef)-import Data.List (intercalate)+import Data.List (intercalate, sortOn) import qualified Data.Map.Strict as Map-import Data.Maybe (fromMaybe, listToMaybe)+import Data.Maybe (fromMaybe, listToMaybe, mapMaybe) import qualified Data.Text as T import Files (overwrite) import GHC.Clock (getMonotonicTime) import Logger (logDebug, logInfo) import Matcher-import Printer (printAttribute, printFunction)+import Printer (printAlpha, printAttribute, printFunction) import System.Directory (createDirectoryIfMissing) import System.FilePath import System.IO (Handle, hPutStrLn)@@ -106,6 +109,7 @@   | EvStall Int T.Text   | EvStuckOn Int T.Text   | EvUnjoined Int T.Text Expression Expression+  | EvUnreminted Int T.Text Expression   | EvStarved Int Int Judgment Expression   | EvTimeout Int Int Judgment Expression   | EvSpent Int Int Judgment Expression@@ -118,9 +122,11 @@   | EvTerminate Int (Maybe (Either Int Bytes)) T.Text T.Text (Maybe Expression)   | EvMinted Int Int [Either Int Bytes]   | EvDeferred Int Int Judgment Expression (Maybe Expression) Expression+  | EvUpcast Int Int Expression [(Int, [Attribute])]   | EvApplied Int Judgment Expression Expression Expression   | EvBuilt Int Expression   | EvAnswer Int Expression+  | EvWorld Expression  type SaveEvalFunc = Evaluation -> IO () @@ -157,6 +163,7 @@ tier (EvStall depth _) = depth tier (EvStuckOn depth _) = depth tier (EvUnjoined depth _ _ _) = depth+tier (EvUnreminted depth _ _) = depth tier (EvStarved depth _ _ _) = depth tier (EvTimeout depth _ _ _) = depth tier (EvSpent depth _ _ _) = depth@@ -169,9 +176,11 @@ tier (EvTerminate depth _ _ _ _) = depth tier (EvMinted depth _ _) = depth tier (EvDeferred depth _ _ _ _ _) = depth+tier (EvUpcast depth _ _ _) = depth tier (EvApplied depth _ _ _ _) = depth tier (EvBuilt depth _) = depth tier (EvAnswer depth _) = depth+tier EvWorld{} = maxBound  type Named a = Map.Map Int [(Expression, a)] @@ -225,13 +234,18 @@   , _numbered :: Map.Map Int Int   , _datums :: Map.Map Int Int   , _held :: Maybe (Bytes, String)-  , _heads :: [(Int, String)]-  , _pending :: [(Int, String, String)]+  , _heads :: [(Int, (Judgment, Expression))]+  , _pending :: [(Int, Judgment, Expression)]   , _sources :: [(Int, Expression, String)]+  , _world :: Map.Map Attribute Expression+  , _shapes :: Map.Map [Maybe Attribute] [(Expression, [Binding])]+  , _opaque :: Int   } +type Naming = StateT (Nesting, [String]) IO+ emptyNesting :: Nesting-emptyNesting = Nesting 0 [] [] Map.empty Map.empty Map.empty Nothing [] [] []+emptyNesting = Nesting 0 [] [] Map.empty Map.empty Map.empty Nothing [] [] [] Map.empty Map.empty 0  saveEval :: Handle -> IORef Protocol -> (Expression -> IO String) -> (Expression -> IO String) -> SaveEvalFunc saveEval handle cursor printed printed' report = do@@ -240,6 +254,7 @@   where     forgotten :: Evaluation -> Protocol -> Protocol     forgotten EvDelta{} protocol = protocol+    forgotten EvWorld{} protocol = protocol     forgotten _ protocol = protocol{_found = Nothing}     beside :: Evaluation -> Protocol -> Protocol     beside EvStarted{} protocol = protocol@@ -249,7 +264,7 @@     headed (protocol, Nothing) = (protocol, [])     headed (protocol, Just line) =       ( protocol{_blocks = [(level, heading, True) | (level, heading, _) <- protocol._blocks]}-      , [indented level (heading ++ ":") | (level, Just heading, False) <- reverse protocol._blocks] ++ [line]+      , [indented level (heading ++ ":") | (level, Just heading, False) <- reverse protocol._blocks] ++ lines line       )     render :: Expression -> IO String     render term = do@@ -329,6 +344,9 @@       left <- render one       right <- render two       pure (protocol, Just (indented depth (printf "unjoined(%s)  # %s vs %s" (T.unpack key) left right)))+    written (EvUnreminted depth key term) protocol = do+      form <- render term+      pure (protocol, Just (indented depth (printf "unreminted(%s)  # %s" (T.unpack key) form)))     written (EvStarved depth limit judgment site) protocol = do       remarks <- context protocol judgment site       pure (protocol, Just (indented depth (remarked (printf "starved(%d)" limit) remarks)))@@ -382,6 +400,12 @@       form <- maybe (render copy) (printed . abbreviatedInside protocol._made) call       remarks <- context protocol judgment site       pure (protocol, Just (indented depth (remarked (printf "deferred(%s) := %s" (printFunction (FnSymbol symbol)) form) remarks)))+    written (EvUpcast depth bare cast paths) protocol = do+      form <- render cast+      pure (protocol, Just (intercalate "\n" (indented depth (printf "upcast(%s) := %s" (printFunction (FnSymbol bare)) form) : map path paths)))+      where+        path :: (Int, [Attribute]) -> String+        path (fresh, attrs) = indented (depth + 1) (printf "%s := %s" (printFunction (FnSymbol fresh)) (intercalate "." (printFunction (FnSymbol bare) : map printAttribute attrs)))     written (EvApplied depth judgment call object site) protocol = do       let (index, counted) = numbered protocol           aliased :: Expression@@ -402,6 +426,7 @@           naming = printf "%s·%d" stem index       (protocol', value) <- valued counted naming term       pure (protocol', Just (indented depth (printf "%s := %s  # 𝕄(%s·%d)" naming value stem (Map.findWithDefault 1 (opener protocol) protocol._built))))+    written EvWorld{} protocol = pure (protocol, Nothing)     valued :: Protocol -> String -> Expression -> IO (Protocol, String)     valued protocol naming term = case denoted term of       Nothing -> (,) protocol <$> render term@@ -446,33 +471,39 @@  saveEvalXml :: Handle -> IORef Nesting -> (Expression -> IO String) -> SaveEvalFunc saveEvalXml handle cursor printed report = do-  written <- atomicModify cursor (opened' . flushed . beside report . outer (tier report))+  written <- atomicModify cursor (flushed . beside report . outer (tier report) >=> opened')   mapM_ (hPutStrLn handle) written   logDebug (printf "Saved %d line(s) of the XML protocol" (length written))   where-    render :: Expression -> IO String-    render term = do-      nesting <- readIORef cursor-      printed (abbreviated nesting._objects term)-    located :: Nesting -> Expression -> IO String-    located nesting site = case [naming | (_, built, naming) <- nesting._sources, built == site] of-      naming : _ -> pure naming-      [] -> render site     opened' :: (Nesting, [String]) -> IO (Nesting, [String])     opened' (nesting, openings) = bimap (forgotten report) (openings ++) <$> elements report nesting     beside :: Evaluation -> Nesting -> Nesting     beside EvStarted{} nesting = nesting     beside report' nesting = nesting{_heads = dropWhile ((>= tier report') . fst) nesting._heads, _pending = dropWhile (\(level, _, _) -> level >= tier report') nesting._pending}-    flushed :: Nesting -> (Nesting, [String])+    flushed :: Nesting -> IO (Nesting, [String])     flushed nesting-      | silent report = (nesting, [])-      | otherwise = (nesting{_pending = [], _closing = [(level, element) | (level, element, _) <- nesting._pending] ++ nesting._closing}, [opening | (_, _, opening) <- reverse nesting._pending])+      | silent report = pure (nesting, [])+      | otherwise = foldM pended (nesting{_pending = []}, []) (reverse nesting._pending)+    pended :: (Nesting, [String]) -> (Int, Judgment, Expression) -> IO (Nesting, [String])+    pended (nesting, openings) (level, judgment, site) = do+      (nesting', lines') <- staged level nesting (printf "<%s at=\"%s\">" (opened judgment) . escapeXML <$> located level site)+      pure (nesting'{_closing = (level, opened judgment) : nesting'._closing}, openings ++ lines')     silent :: Evaluation -> Bool     silent EvStarted{} = True+    silent EvWorld{} = True     silent _ = False     forgotten :: Evaluation -> Nesting -> Nesting     forgotten EvDelta{} nesting = nesting+    forgotten EvWorld{} nesting = nesting     forgotten _ nesting = nesting{_held = Nothing}+    staged :: Int -> Nesting -> Naming String -> IO (Nesting, [String])+    staged depth nesting naming = do+      (element, (nesting', records)) <- runStateT naming (nesting, [])+      pure (nesting', map (indentedXml depth) (reverse (element : records)))+    placed :: Int -> Nesting -> Naming String -> IO (Nesting, [String])+    placed depth nesting naming = second (closers ++) <$> staged depth nesting{_closing = kept} naming+      where+        (kept, closers) = closed depth nesting._closing     elements :: Evaluation -> Nesting -> IO (Nesting, [String])     elements (EvRun judgment locator) nesting =       pure@@ -484,158 +515,115 @@           ]         )     elements (EvFiring depth key judgment site) nesting = do-      locator <- located nesting site-      pure-        ( nesting-            { _fires = fires-            , _openedAt = (depth, fires) : nesting._openedAt-            , _closing = (depth, "evaluate") : kept-            }-        , closers ++ [indentedXml depth (printf "<evaluate λ=\"%s\" by=\"%s\" at=\"%s\">" (quoted key) (opened judgment) (escapeXML locator))]-        )+      (fired, lines') <- placed depth nesting (printf "<evaluate λ=\"%s\" by=\"%s\" at=\"%s\">" (quoted key) (opened judgment) . escapeXML <$> located depth site)+      pure (fired{_fires = fired._fires + 1, _openedAt = (depth, fired._fires + 1) : fired._openedAt, _closing = (depth, "evaluate") : fired._closing}, lines')+    elements (EvStarted depth judgment site) nesting =+      pure $ case inner of+        (level, opening) : _ | level == depth && opening == (judgment, site) -> (nesting{_heads = inner, _pending = pending}, [])+        _ -> (nesting{_heads = (depth, (judgment, site)) : dropWhile ((>= depth) . fst) inner, _pending = (depth, judgment, site) : dropWhile (\(level, _, _) -> level >= depth) pending, _closing = kept}, closers)       where+        inner :: [(Int, (Judgment, Expression))]+        inner = dropWhile ((> depth) . fst) nesting._heads+        pending :: [(Int, Judgment, Expression)]+        pending = dropWhile (\(level, _, _) -> level > depth) nesting._pending         (kept, closers) = closed depth nesting._closing-        fires :: Int-        fires = nesting._fires + 1-    elements (EvStarted depth judgment site) nesting = do-      locator <- located nesting site-      let opening = indentedXml depth (printf "<%s at=\"%s\">" (opened judgment) (escapeXML locator))-          inner = dropWhile ((> depth) . fst) nesting._heads-          pending = dropWhile (\(level, _, _) -> level > depth) nesting._pending-          (kept, closers) = closed depth nesting._closing-      pure $ case inner of-        (level, opening') : _ | level == depth && opening' == opening -> (nesting{_heads = inner, _pending = pending}, [])-        _ -> (nesting{_heads = (depth, opening) : dropWhile ((>= depth) . fst) inner, _pending = (depth, opened judgment, opening) : dropWhile (\(level, _, _) -> level >= depth) pending, _closing = kept}, closers)-    elements (EvLooped depth judgment mode self site answered) nesting = do-      form <- render self-      locator <- located nesting site-      (origin, given) <- maybe (pure ("", "")) called (answered >>= snd)-      let (kept, closers) = closed depth nesting._closing-      pure (nesting{_closing = kept}, closers ++ [indentedXml depth (printf "<looped%s by=\"%s\" match=\"%s\" at=\"%s\"%s>%s<e>%s</e></looped>" (maybe "" symbolized answered) (opened judgment) (certainty mode) (escapeXML locator) origin given (escapeXMLText form))])+    elements (EvLooped depth judgment mode self site answered) nesting =+      placed depth nesting $ do+        locator <- located depth site+        origin <- maybe (sole depth self) (called depth) (answered >>= snd)+        pure (enclosed "looped" (printf "<looped%s by=\"%s\" match=\"%s\" at=\"%s\"" (maybe "" symbolized answered) (opened judgment) (certainty mode) (escapeXML locator)) origin)       where         symbolized :: (Int, Maybe Expression) -> String         symbolized (symbol, _) = printf " symbol=\"%s\"" (sigma symbol)-    elements (EvStuck depth key judgment self) nesting = do-      form <- render self-      let (kept, closers) = closed depth nesting._closing-      pure (nesting{_closing = kept}, closers ++ [indentedXml depth (printf "<unanswered λ=\"%s\" by=\"%s\">%s</unanswered>" (quoted key) (opened judgment) (escapeXMLText form))])-    elements (EvStall depth key) nesting = do-      let (kept, closers) = closed depth nesting._closing-      pure (nesting{_closing = kept}, closers ++ [indentedXml depth (printf "<stall λ=\"%s\"/>" (quoted key))])-    elements (EvStuckOn depth key) nesting = do-      let (kept, closers) = closed depth nesting._closing-      pure (nesting{_closing = kept}, closers ++ [indentedXml depth (printf "<stuck λ=\"%s\"/>" (quoted key))])-    elements (EvUnjoined depth key one two) nesting = do-      left <- render one-      right <- render two-      let (kept, closers) = closed depth nesting._closing-      pure (nesting{_closing = kept}, closers ++ [indentedXml depth (printf "<unjoined λ=\"%s\"><e>%s</e><e>%s</e></unjoined>" (quoted key) (escapeXMLText left) (escapeXMLText right))])-    elements (EvStarved depth limit judgment site) nesting = do-      locator <- located nesting site-      let (kept, closers) = closed depth nesting._closing-      pure (nesting{_closing = kept}, closers ++ [indentedXml depth (printf "<starved limit=\"%d\" by=\"%s\" at=\"%s\"/>" limit (opened judgment) (escapeXML locator))])-    elements (EvTimeout depth limit judgment site) nesting = do-      locator <- located nesting site-      let (kept, closers) = closed depth nesting._closing-      pure (nesting{_closing = kept}, closers ++ [indentedXml depth (printf "<timeout limit=\"%d\" by=\"%s\" at=\"%s\"/>" limit (opened judgment) (escapeXML locator))])-    elements (EvSpent depth limit judgment site) nesting = do-      locator <- located nesting site-      let (kept, closers) = closed depth nesting._closing-      pure (nesting{_closing = kept}, closers ++ [indentedXml depth (printf "<spent limit=\"%d\" by=\"%s\" at=\"%s\"/>" limit (opened judgment) (escapeXML locator))])+    elements (EvStuck depth key judgment self) nesting =+      placed depth nesting (printf "<unanswered λ=\"%s\" by=\"%s\">%s</unanswered>" (quoted key) (opened judgment) . escapeXMLText <$> leaf depth self)+    elements (EvStall depth key) nesting =+      placed depth nesting (pure (printf "<stall λ=\"%s\"/>" (quoted key)))+    elements (EvStuckOn depth key) nesting =+      placed depth nesting (pure (printf "<stuck λ=\"%s\"/>" (quoted key)))+    elements (EvUnjoined depth key one two) nesting =+      placed depth nesting $ do+        left <- leaf depth one+        right <- leaf depth two+        pure (printf "<unjoined λ=\"%s\">%s %s</unjoined>" (quoted key) (escapeXMLText left) (escapeXMLText right))+    elements (EvUnreminted depth key term) nesting =+      placed depth nesting (printf "<unreminted λ=\"%s\">%s</unreminted>" (quoted key) . escapeXMLText <$> leaf depth term)+    elements (EvStarved depth limit judgment site) nesting =+      placed depth nesting (printf "<starved limit=\"%d\" by=\"%s\" at=\"%s\"/>" limit (opened judgment) . escapeXML <$> located depth site)+    elements (EvTimeout depth limit judgment site) nesting =+      placed depth nesting (printf "<timeout limit=\"%d\" by=\"%s\" at=\"%s\"/>" limit (opened judgment) . escapeXML <$> located depth site)+    elements (EvSpent depth limit judgment site) nesting =+      placed depth nesting (printf "<spent limit=\"%d\" by=\"%s\" at=\"%s\"/>" limit (opened judgment) . escapeXML <$> located depth site)     elements (EvDelta depth bytes) nesting = do-      datum <- render (ExBytes bytes)+      datum <- printed (ExBytes bytes)       let index = maybe 1 (+ 1) (Map.lookup (opener nesting) nesting._datums)           naming :: String           naming = printf "%s·%d" (labelled nesting sigil) index-          (kept, closers) = closed depth nesting._closing-      pure (nesting{_closing = kept, _datums = Map.insert (opener nesting) index nesting._datums, _held = Just (bytes, naming)}, closers ++ [indentedXml depth (printf "<delta meta=\"%s\"%s>%s</delta>" (escapeXML naming) (maybe "" (printf " number=\"%s\"" . escapeXML) (ieee bytes) :: String) (escapeXMLText datum))])-    elements (EvData depth spelling _ value) nesting = do-      record <- maybe (stood value) (pure . printf "<bind meta=\"%s\">%s</bind>" (escapeXML (labelled nesting spelling)) . escapeXMLText) (found value nesting._held)-      pure (nesting{_closing = kept}, closers ++ [indentedXml depth record])+      placed depth nesting{_datums = Map.insert (opener nesting) index nesting._datums, _held = Just (bytes, naming)} (pure (printf "<delta meta=\"%s\"%s>%s</delta>" (escapeXML naming) (maybe "" (printf " number=\"%s\"" . escapeXML) (ieee bytes) :: String) (escapeXMLText datum)))+    elements (EvData depth spelling _ value) nesting =+      placed depth nesting $ case (found value nesting._held, value) of+        (Just naming, _) -> pure (bound (escapeXMLText naming))+        (Nothing, Left symbol) -> pure (printf "<dataize meta=\"%s\">%s</dataize>" (escapeXML (labelled nesting spelling)) (sigma symbol))+        (Nothing, Right bytes) -> bound . escapeXMLText <$> lift (printed (ExBytes bytes))       where-        (kept, closers) = closed depth nesting._closing-        stood :: Either Int Bytes -> IO String-        stood (Left symbol) = do-          form <- render (standing symbol)-          pure (printf "<dataize meta=\"%s\">%s</dataize>" (escapeXML (labelled nesting spelling)) (escapeXMLText form))-        stood (Right bytes) = do-          form <- render (ExBytes bytes)-          pure (printf "<bind meta=\"%s\">%s</bind>" (escapeXML (labelled nesting spelling)) (escapeXMLText form))-    elements (EvTerm depth spelling _ _ term) nesting = do-      body <- render term-      let (kept, closers) = closed depth nesting._closing-      pure (nesting{_closing = kept}, closers ++ [indentedXml depth (printf "<bind meta=\"%s\">%s</bind>" (escapeXML (labelled nesting spelling)) (escapeXMLText body))])-    elements (EvSymbolize depth spelling _ term) nesting = do-      body <- render term-      let (kept, closers) = closed depth nesting._closing-      pure (nesting{_closing = kept}, closers ++ [indentedXml depth (printf "<bind meta=\"%s\">%s</bind>" (escapeXML (labelled nesting spelling)) (escapeXMLText body))])+        bound :: String -> String+        bound = printf "<bind meta=\"%s\">%s</bind>" (escapeXML (labelled nesting spelling))+    elements (EvTerm depth spelling _ _ term) nesting = placed depth nesting (bind depth nesting spelling term)+    elements (EvSymbolize depth spelling _ term) nesting = placed depth nesting (bind depth nesting spelling term)     elements (EvKnown depth symbol bytes) nesting = do-      value <- render (ExBytes bytes)-      let (kept, closers) = closed depth nesting._closing-      pure (nesting{_closing = kept}, closers ++ [indentedXml depth (printf "<known symbol=\"%s\">%s</known>" (sigma symbol) (escapeXMLText value))])-    elements (EvJoin depth spelling _ term) nesting = do-      body <- render term-      let (kept, closers) = closed depth nesting._closing-      pure (nesting{_closing = kept}, closers ++ [indentedXml depth (printf "<bind meta=\"%s\">%s</bind>" (escapeXML (labelled nesting spelling)) (escapeXMLText body))])+      value <- printed (ExBytes bytes)+      placed depth nesting (pure (printf "<known symbol=\"%s\">%s</known>" (sigma symbol) (escapeXMLText value)))+    elements (EvJoin depth spelling _ term) nesting = placed depth nesting (bind depth nesting spelling term)     elements (EvJoined depth fresh (one, two)) nesting =-      pure (nesting{_closing = kept}, closers ++ [indentedXml depth joint])-      where-        (kept, closers) = closed depth nesting._closing-        joint :: String-        joint = printf "<joined symbol=\"%s\">%s %s</joined>" (sigma fresh) (sigma one) (sigma two)-    elements (EvTerminate depth condition side _ message) nesting = do-      said <- maybe (pure "") attributed message-      terminal <- case condition of-        Just (Left symbol) -> pure (printf "<terminate symbol=\"%s\" branch=\"%s\"%s/>" (sigma symbol) (quoted side) said)-        Just (Right bytes) -> printf "<terminate branch=\"%s\"%s>%s</terminate>" (quoted side) said . escapeXMLText <$> render (ExBytes bytes)-        Nothing -> pure (printf "<terminate branch=\"%s\"%s/>" (quoted side) said)-      let (kept, closers) = closed depth nesting._closing-      pure (nesting{_closing = kept}, closers ++ [indentedXml depth terminal])-      where-        attributed :: Expression -> IO String-        attributed term = printf " message=\"%s\"" . escapeXML <$> render term+      placed depth nesting (pure (printf "<joined symbol=\"%s\">%s %s</joined>" (sigma fresh) (sigma one) (sigma two)))+    elements (EvTerminate depth condition side _ message) nesting =+      placed depth nesting $ do+        said <- maybe (pure "") (fmap (printf " message=\"%s\"" . escapeXML) . leaf depth) message :: Naming String+        case condition of+          Just (Left symbol) -> pure (printf "<terminate symbol=\"%s\" branch=\"%s\"%s/>" (sigma symbol) (quoted side) said)+          Just (Right bytes) -> printf "<terminate branch=\"%s\"%s>%s</terminate>" (quoted side) said . escapeXMLText <$> lift (printed (ExBytes bytes))+          Nothing -> pure (printf "<terminate branch=\"%s\"%s/>" (quoted side) said)     elements (EvMinted depth symbol operands) nesting = do-      spelledOperands <- mapM spelled operands-      let (kept, closers) = closed depth nesting._closing-          mint :: String-          mint-            | null operands = printf "<minted symbol=\"%s\"/>" (sigma symbol)-            | otherwise = printf "<minted symbol=\"%s\">%s</minted>" (sigma symbol) (escapeXMLText (unwords spelledOperands))-      pure (nesting{_closing = kept}, closers ++ [indentedXml depth mint])+      spelledOperands <- mapM spelled' operands+      placed depth nesting (pure (minted spelledOperands))       where-        spelled :: Either Int Bytes -> IO String-        spelled (Left fresh) = pure (sigma fresh)-        spelled (Right bytes) = render (ExBytes bytes)-    elements (EvDeferred depth symbol judgment copy call site) nesting = do-      form <- render copy-      locator <- located nesting site-      (origin, given) <- maybe (pure ("", "")) called call-      let (kept, closers) = closed depth nesting._closing-      pure (nesting{_closing = kept}, closers ++ [indentedXml depth (printf "<deferred symbol=\"%s\" by=\"%s\" at=\"%s\"%s>%s<e>%s</e></deferred>" (sigma symbol) (opened judgment) (escapeXML locator) origin given (escapeXMLText form))])-    elements (EvApplied depth judgment call object site) nesting = do-      (origin, given) <- parted (abbreviatedInside nesting._objects call)-      locator <- located nesting site-      let (index, counted) = numbered nesting-          (kept, closers) = closed depth nesting._closing-          naming :: String-          naming = printf "%s·%d" (labelled nesting answer) index-          aliased :: Expression-          aliased = alias (opener nesting) index-      pure (counted{_closing = kept, _objects = namedInsert call aliased (namedInsert object aliased counted._objects)}, closers ++ [indentedXml depth (printf "<applied meta=\"%s\" by=\"%s\" at=\"%s\" of=\"%s\">%s</applied>" (escapeXML naming) (opened judgment) (escapeXML locator) (escapeXML origin) given)])-    elements (EvBuilt depth term) nesting = do-      body <- render term-      let (index, counted) = numbered nesting-          (kept, closers) = closed depth nesting._closing-          naming :: String-          naming = printf "%s·%d" (labelled nesting answer) index-      pure (counted{_closing = kept, _sources = (depth, term, naming) : counted._sources}, closers ++ [indentedXml depth (printf "<built meta=\"%s\">%s</built>" (escapeXML naming) (escapeXMLText body))])-    elements (EvAnswer depth term) nesting = do-      body <- render term-      let (index, counted) = numbered nesting-          (kept, closers) = closed depth nesting._closing-          naming :: String-          naming = printf "%s·%d" (labelled nesting answer) index-      pure (counted{_closing = kept}, closers ++ [indentedXml depth (printf "<answer meta=\"%s\">%s</answer>" (escapeXML naming) (escapeXMLText body))])+        spelled' :: Either Int Bytes -> IO String+        spelled' (Left fresh') = pure (sigma fresh')+        spelled' (Right bytes) = printed (ExBytes bytes)+        minted :: [String] -> String+        minted [] = printf "<minted symbol=\"%s\"/>" (sigma symbol)+        minted spelt = printf "<minted symbol=\"%s\">%s</minted>" (sigma symbol) (escapeXMLText (unwords spelt))+    elements (EvDeferred depth symbol judgment copy call site) nesting =+      placed depth nesting $ do+        locator <- located depth site+        origin <- maybe (sole depth copy) (called depth) call+        pure (enclosed "deferred" (printf "<deferred symbol=\"%s\" by=\"%s\" at=\"%s\"" (sigma symbol) (opened judgment) (escapeXML locator)) origin)+    elements (EvUpcast depth bare cast paths) nesting =+      placed depth nesting $ do+        origin <- leaf depth cast+        pure (printf "<upcast symbol=\"%s\" of=\"%s\">%s</upcast>" (sigma bare) (escapeXML origin) (concatMap path paths))+      where+        path :: (Int, [Attribute]) -> String+        path (fresh', attrs) = printf "<path symbol=\"%s\">%s</path>" (sigma fresh') (escapeXMLText (intercalate "." (map printAttribute attrs)))+    elements (EvApplied depth judgment call object site) nesting =+      placed depth nesting $ do+        locator <- located depth site+        (origin, given) <- parted depth call+        (naming, aliased) <- counted+        modify (first (\nesting' -> nesting'{_objects = namedInsert call aliased (namedInsert object aliased nesting'._objects)}))+        pure (printf "<applied meta=\"%s\" by=\"%s\" at=\"%s\" of=\"%s\">%s</applied>" (escapeXML naming) (opened judgment) (escapeXML locator) (escapeXML origin) given)+    elements (EvBuilt depth term) nesting =+      placed depth nesting $ do+        body <- leaf depth term+        (naming, _) <- counted+        modify (first (\nesting' -> nesting'{_sources = (depth, term, naming) : nesting'._sources}))+        pure (printf "<built meta=\"%s\">%s</built>" (escapeXML naming) (escapeXMLText body))+    elements (EvAnswer depth term) nesting =+      placed depth nesting $ do+        body <- leaf depth term+        (naming, _) <- counted+        pure (printf "<answer meta=\"%s\">%s</answer>" (escapeXML naming) (escapeXMLText body))+    elements (EvWorld world) nesting = pure (known world nesting, [])     outer :: Int -> Nesting -> Nesting     outer depth nesting = nesting{_openedAt = dropWhile ((>= depth) . fst) nesting._openedAt, _sources = dropWhile (\(level, _, _) -> level > depth) nesting._sources}     labelled :: Nesting -> T.Text -> String@@ -647,30 +635,194 @@       where         index :: Int         index = maybe 1 (+ 1) (Map.lookup (opener nesting) nesting._numbered)-    called :: Expression -> IO (String, String)-    called term = do-      let (object, arguments) = invoked term-      path <- render object-      pure (printf " of=\"%s\"" (escapeXML path), printf "<with>%s</with>" (concat arguments))-    invoked :: Expression -> (Expression, [String])-    invoked (ExApplication term (ArTau attr value)) =-      let (object, arguments) = invoked term-       in (object, arguments ++ [printf "<attr name=\"%s\">%s</attr>" (escapeXML (printAttribute attr)) (escapeXMLText (valued value))])+    counted :: Naming (String, Expression)+    counted = do+      (nesting, records) <- get+      let (index, nesting') = numbered nesting+      put (nesting', records)+      pure (printf "%s·%d" (labelled nesting answer) index, alias (opener nesting) index)+    recorded :: Expression -> (String -> String) -> Naming Expression+    recorded term element = do+      (naming, aliased) <- counted+      modify (bimap (\nesting -> nesting{_objects = namedInsert term aliased nesting._objects}) (element (escapeXML naming) :))+      pure aliased+    opaque :: Expression -> Naming Expression+    opaque term = do+      (nesting, records) <- get+      let meta = ExMeta (T.pack (printf "e%d" (nesting._opaque + 1)))+      put (nesting{_opaque = nesting._opaque + 1, _objects = namedInsert term meta nesting._objects}, records)+      pure meta+    located :: Int -> Expression -> Naming String+    located depth site = do+      (nesting, _) <- get+      maybe (leaf depth site) pure (listToMaybe [naming | (_, built, naming) <- nesting._sources, built == site])+    bind :: Int -> Nesting -> T.Text -> Expression -> Naming String+    bind depth nesting spelling term = printf "<bind meta=\"%s\">%s</bind>" (escapeXML (labelled nesting spelling)) . escapeXMLText <$> leaf depth term+    leaf :: Int -> Expression -> Naming String+    leaf depth term = titled depth term >>= lift . spelled+    titled :: Int -> Expression -> Naming Expression+    titled depth term = do+      (nesting, _) <- get+      maybe (coined depth term) pure (namedLookup term nesting._objects)+    coined :: Int -> Expression -> Naming Expression+    coined _ term@(ExFormation [BiLambda (FnSymbol _)]) = pure term+    coined _ term@(ExFormation [BiDelta _]) = pure term+    coined depth term@(ExFormation bds) = do+      (nesting, _) <- get+      maybe (anonymous depth term bds) (cloned depth term) (copied nesting bds)+    coined depth term@(ExDispatch inner attr) = do+      head' <- titled depth inner+      if pathed head' then pure (ExDispatch head' attr) else opaque term+    coined depth term@(ExApplication _ _) = do+      (nesting, _) <- get+      let (head', arguments) = chained nesting._objects term+      origin <- leaf depth head'+      given <- mapM (argument depth) arguments+      recorded term (\naming -> printf "<applied meta=\"%s\" of=\"%s\">%s</applied>" naming (escapeXML origin) (concat given))+    coined _ term+      | plain term = pure term+      | otherwise = opaque term+    cloned :: Int -> Expression -> (Expression, [(Attribute, Expression)]) -> Naming Expression+    cloned depth term (origin, []) = do+      path <- titled depth origin+      modify (first (\nesting -> nesting{_objects = namedInsert term path nesting._objects}))+      pure path+    cloned depth term (origin, bound) = do+      path <- leaf depth origin+      given <- mapM (\(attr, value) -> attributed (printAttribute attr) <$> leaf depth value) bound+      recorded term (\naming -> printf "<formed meta=\"%s\" of=\"%s\">%s</formed>" naming (escapeXML path) (concat given))+    anonymous :: Int -> Expression -> [Binding] -> Naming Expression+    anonymous depth term bds = do+      parts <- mapM (part depth) bds+      let marks = concat (lefts parts)+          inner = concat (rights parts)+      recorded term (\naming -> if null inner then printf "<formed meta=\"%s\"%s/>" naming marks else printf "<formed meta=\"%s\"%s>%s</formed>" naming marks inner)+    part :: Int -> Binding -> Naming (Either String String)+    part depth (BiTau attr value) = Right . attributed (printAttribute attr) <$> leaf depth value+    part _ (BiVoid attr) = pure (Right (printf "<void name=\"%s\"/>" (escapeXML (printAttribute attr))))+    part _ (BiLambda func) = pure (Left (printf " λ=\"%s\"" (escapeXML (printFunction func))))+    part _ (BiDelta bytes) = Left . printf " Δ=\"%s\"" . escapeXML <$> lift (printed (ExBytes bytes))+    part _ _ = pure (Right "")+    argument :: Int -> Argument -> Naming String+    argument depth (ArTau attr value) = attributed (printAttribute attr) <$> leaf depth value+    argument depth (ArAlpha alpha value) = attributed (printAlpha alpha) <$> leaf depth value+    attributed :: String -> String -> String+    attributed name value = printf "<attr name=\"%s\">%s</attr>" (escapeXML name) (escapeXMLText value)+    chained :: Named Expression -> Expression -> (Expression, [Argument])+    chained objects (ExApplication inner arg) = case inner of+      ExApplication _ _ | Nothing <- namedLookup inner objects -> second (++ [arg]) (chained objects inner)+      _ -> (inner, [arg])+    chained _ term = (term, [])+    parted :: Int -> Expression -> Naming (String, String)+    parted depth (ExApplication term arg) = (,) <$> leaf depth term <*> argument depth arg+    parted depth term = (,"") <$> leaf depth term+    called :: Int -> Expression -> Naming (String, String)+    called depth term = do+      path <- leaf depth object+      given <- mapM passed arguments+      pure (path, printf "<with>%s</with>" (concat given))+      where+        object :: Expression+        arguments :: [(Attribute, Expression)]+        (object, arguments) = invoked term+    sole :: Int -> Expression -> Naming (String, String)+    sole depth term = (,"") <$> leaf depth term+    enclosed :: String -> String -> (String, String) -> String+    enclosed _ opening (origin, "") = printf "%s of=\"%s\"/>" opening (escapeXML origin)+    enclosed tag opening (origin, inner) = printf "%s of=\"%s\">%s</%s>" opening (escapeXML origin) inner tag+    invoked :: Expression -> (Expression, [(Attribute, Expression)])+    invoked (ExApplication term (ArTau attr value)) = second (++ [(attr, value)]) (invoked term)     invoked term = (term, [])-    valued :: Expression -> String-    valued (ExFormation [BiLambda (FnSymbol idx)]) = sigma idx-    valued (ExFormation bds) = maybe "?" valued (listToMaybe [body | BiTau AtPhi body <- bds])-    valued (ExApplication _ (ArTau AtPhi body)) = valued body-    valued _ = "?"-    parted :: Expression -> IO (String, String)-    parted (ExApplication term (ArTau attr value)) = do-      origin <- printed term-      given <- argued value-      pure (origin, printf "<attr name=\"%s\">%s</attr>" (escapeXML (printAttribute attr)) (escapeXMLText given))-    parted term = (,"") <$> printed term-    argued :: Expression -> IO String-    argued (ExFormation [BiLambda (FnSymbol idx)]) = pure (sigma idx)-    argued term = printed term+    passed :: (Attribute, Expression) -> Naming String+    passed (attr, value) = attributed (printAttribute attr) <$> valued value+    valued :: Expression -> Naming String+    valued value = do+      (nesting, _) <- get+      case (namedLookup value nesting._objects, symbolic value) of+        (Just aliased, _) -> lift (spelled aliased)+        (Nothing, Just symbol) -> pure (sigma symbol)+        (Nothing, Nothing) -> opaque value >>= lift . spelled+    symbolic :: Expression -> Maybe Int+    symbolic (ExFormation [BiLambda (FnSymbol idx)]) = Just idx+    symbolic (ExFormation bds) = listToMaybe [body | BiTau AtPhi body <- bds] >>= symbolic+    symbolic (ExApplication _ (ArTau AtPhi body)) = symbolic body+    symbolic _ = Nothing+    spelled :: Expression -> IO String+    spelled (ExFormation [BiLambda (FnSymbol idx)]) = pure (sigma idx)+    spelled (ExFormation [BiDelta bytes]) = printed (ExBytes bytes)+    spelled (ExDispatch inner attr)+      | sigmatic inner = printf "%s.%s" <$> spelled inner <*> pure (printAttribute attr)+    spelled term = printed term+    sigmatic :: Expression -> Bool+    sigmatic (ExFormation [BiLambda (FnSymbol _)]) = True+    sigmatic (ExDispatch inner _) = sigmatic inner+    sigmatic _ = False+    known :: Expression -> Nesting -> Nesting+    known world@(ExFormation bds) nesting = nesting{_world = world', _shapes = Map.fromListWith (flip (++)) [(shape kept, [(path, kept)]) | (path, kept) <- breadth [(ExDispatch ExRoot attr, inner) | (attr, ExFormation inner) <- Map.toList world']], _objects = namedInsert world ExRoot nesting._objects}+      where+        world' :: Map.Map Attribute Expression+        world' = Map.union (Map.fromList [(attr, value) | BiTau attr value <- bds]) nesting._world+        breadth :: [(Expression, [Binding])] -> [(Expression, [Binding])]+        breadth [] = []+        breadth level = [(path, filter (not . rho) inner) | (path, inner) <- level] ++ breadth [(ExDispatch path attr, inner') | (path, inner) <- level, BiTau attr (ExFormation inner') <- inner, attr /= AtRho]+    known _ nesting = nesting+    shape :: [Binding] -> [Maybe Attribute]+    shape = map label+      where+        label :: Binding -> Maybe Attribute+        label (BiTau attr _) = Just attr+        label (BiVoid attr) = Just attr+        label _ = Nothing+    rho :: Binding -> Bool+    rho (BiTau AtRho _) = True+    rho (BiVoid AtRho) = True+    rho _ = False+    copied :: Nesting -> [Binding] -> Maybe (Expression, [(Attribute, Expression)])+    copied nesting bds = snd <$> listToMaybe (sortOn fst (mapMaybe matched candidates))+      where+        own :: [Binding]+        own = filter (not . rho) bds+        parents :: [Expression]+        parents = [value | BiTau AtRho value <- bds]+        candidates :: [(Expression, [Binding])]+        candidates = case parents of+          [] -> Map.findWithDefault [] (shape own) nesting._shapes+          value : _ -> [(ExDispatch value attr, filter (not . rho) origin) | BiTau attr (ExFormation origin) <- fromMaybe [] (declared value), attr /= AtRho]+        matched :: (Expression, [Binding]) -> Maybe (Int, (Expression, [(Attribute, Expression)]))+        matched (path, kept) = do+          guard (length kept == length own)+          given <- concat <$> zipWithM bound kept own+          guard (or (zipWith (==) kept own) || not (null parents) && length given == length [() | BiVoid _ <- kept])+          pure (length given, (path, given))+        declared :: Expression -> Maybe [Binding]+        declared ExRoot = Just [BiTau attr value | (attr, value) <- Map.toList nesting._world]+        declared (ExFormation inner) = Just inner+        declared (ExApplication target _) = declared target+        declared (ExDispatch target attr) = do+          outer' <- declared target+          listToMaybe [inner | BiTau attr' (ExFormation inner) <- outer', attr' == attr]+        declared _ = Nothing+        bound :: Binding -> Binding -> Maybe [(Attribute, Expression)]+        bound (BiVoid attr) (BiTau attr' value)+          | attr == attr' = Just [(attr, value)]+        bound (BiTau attr origin) (BiTau attr' value)+          | attr == attr' = Just [(attr, value) | origin /= value]+        bound origin binding+          | origin == binding = Just []+          | otherwise = Nothing+    pathed :: Expression -> Bool+    pathed ExRoot = True+    pathed ExXi = True+    pathed (ExMeta _) = True+    pathed (ExDispatch inner _) = pathed inner+    pathed term = sigmatic term+    plain :: Expression -> Bool+    plain ExRoot = True+    plain ExXi = True+    plain ExTermination = True+    plain (ExMeta _) = True+    plain (ExBytes _) = True+    plain _ = False     sigma :: Int -> String     sigma = printFunction . FnSymbol     quoted :: T.Text -> String
src/Evaluate.hs view
@@ -17,9 +17,9 @@ import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (fromMaybe, listToMaybe) import qualified Data.Text as T-import Deps (Acyclic, Evaluation (..), Judgment (Evaluation, Morphing), State (..), dontSaveEval, dontSaveStep, resited)+import Deps (Acyclic, BuildTermFunc, BuildTermMethod, Evaluation (..), Judgment (Evaluation, Morphing), State (..), Term (TeExpression), dontSaveEval, dontSaveStep, resited) import Engine (Engine (..))-import Lambdas (Lambda (..), Line (..), Meta (..), emptyLambdas, joined, matched, message, minted, stayed, symbolized, thrown)+import Lambdas (Lambda (..), Line (..), Meta (..), emptyLambdas, joined, matched, message, minted, stayed, symbolized, thrown, upcasted) import Matcher (MetaValue (..), Subst, combine, substEmpty, substSingle, substSlot) import Morph (Answer, Firing (..), Kept (..), ReduceContext (..), ReduceException (..), Steps (..), admitting, boxed, charged, counted, deeper, expired, isLambda, lambda, morphing, normalized, opening, recalled, refused, remember, remembered, retained, settled, starved, unparked) import Printer (printFunction)@@ -92,9 +92,11 @@       pure (answer, state''')     line :: ReduceContext -> Lambda -> Maybe (Either Int Bytes) -> (Subst, State) -> Line -> IO (Subst, State)     line ctx entry _ held (Evaluated meta source) = evaluated ctx entry held meta source-    line ctx _ _ (bound, state') (Rewritten meta source rules) = (,state') <$> reshaped ctx bound meta source rules+    line ctx entry _ held (Unfolded meta source deferring) = unfolded ctx entry held meta source deferring+    line ctx entry _ (bound, state') (Rewritten meta source rules) = (,state') <$> reshaped ctx entry state' bound meta source rules     line ctx _ _ (bound, state') (Stayed meta source) = (,state') <$> trimmed ctx bound meta source     line ctx _ _ (bound, state') (Symbolized meta source) = (,state') <$> masked ctx bound meta source+    line ctx _ _ (bound, state') (Upcasted one first two second) = (,state') <$> cast ctx bound (one, first) (two, second)     line ctx entry condition held (Paired meta left right) = paired ctx entry condition held meta left right     shown :: Int -> Answer -> IO ()     shown depth (built, normal) = do@@ -115,6 +117,7 @@     stranded _ = Nothing     escaped :: ReduceException -> ReduceException     escaped (Unjoined name) = Stuck name+    escaped (Unreminted name) = Stuck name     escaped failure = failure     told :: Kept -> IO (Expression, State)     told (Answered answer) = do@@ -150,15 +153,15 @@     evaluated :: ReduceContext -> Lambda -> (Subst, State) -> Meta -> Meta -> IO (Subst, State)     evaluated ctx entry (bound, state') meta source = do       term <- buildExpressionThrows (ExMeta source._name) bound-      (answer, state'') <- fire refused ctx entry source state' term+      (answer, state'') <- fire refused ctx entry (ExMeta source._name) state' term       ctx._saveEval (EvTerm ctx._nesting meta._spelling Evaluation (ExMeta source._name) answer)       bound' <- bind meta (MvExpression answer) bound       pure (bound', state'')-    fire :: (Expression -> ReduceContext -> (Acyclic, Expression) -> IO Expression) -> ReduceContext -> Lambda -> Meta -> State -> Expression -> IO (Expression, State)+    fire :: (Expression -> ReduceContext -> (Acyclic, Expression) -> IO Expression) -> ReduceContext -> Lambda -> Expression -> State -> Expression -> IO (Expression, State)     fire _ _ entry _ state' term       | raising entry term = pure (term, state')-    fire cut ctx _ source state' term@(ExFormation _) = do-      let firing = ctx{_judgment = Evaluation, _site = ExMeta source._name}+    fire cut ctx _ site state' term@(ExFormation _) = do+      let firing = ctx{_judgment = Evaluation, _site = site}       admission <- admitting term firing       case admission of         Left refusal -> do@@ -168,12 +171,121 @@           entered <- deeper admitted           evaluation entered state' term univ     fire _ _ _ _ _ _ = throwIO (Stuck func)-    reshaped :: ReduceContext -> Subst -> Meta -> Meta -> [Y.Rule] -> IO Subst-    reshaped ctx bound meta source rules = do+    reshaped :: ReduceContext -> Lambda -> State -> Subst -> Meta -> Meta -> [Y.Rule] -> IO Subst+    reshaped ctx entry state' bound meta source rules = do       term <- buildExpressionThrows (ExMeta source._name) bound-      shaped <- rewritten rules (RuleContext ctx._buildTerm Nothing ctx._engine._normal) term+      shaped <- rewritten rules (\around -> RuleContext (reminting around) Nothing ctx._engine._normal) term       ctx._saveEval (EvSymbolize ctx._nesting meta._spelling (ExMeta source._name) shaped)       bind meta (MvExpression shaped) bound+      where+        reminting :: Maybe Expression -> BuildTermFunc+        reminting around "remint" = reminted around+        reminting _ func = ctx._buildTerm func+        reminted :: Maybe Expression -> BuildTermMethod+        reminted around [Y.ArgExpression expr] subst = do+          term <- buildExpressionThrows expr subst+          TeExpression <$> (stood ctx around term term >>= maybe (unreminted term) pure)+        reminted _ _ _ = throwIO (userError "Function remint() requires exactly 1 argument as expression")+        stood :: ReduceContext -> Maybe Expression -> Expression -> Expression -> IO (Maybe Expression)+        stood deep around site term = case ended term of+          Just found -> Just <$> pinned found+          Nothing -> do+            placed <- if xiFree term then pure term else maybe (pure term) (ctx._engine._contextualize term) around+            figured deep entry state' site placed >>= maybe (pure Nothing) (became deep site term)+        became :: ReduceContext -> Expression -> Expression -> Expression -> IO (Maybe Expression)+        became deep site term answer = case (ended answer, answer) of+          (Just found, _) -> Just <$> pinned found+          (_, ExFormation bds)+            | hollow bds -> deeper deep >>= \further -> stood further Nothing (ExDispatch site AtPhi) (ExDispatch answer AtPhi)+            | otherwise -> maybe (pure Nothing) (deferral deep site bds) (spelled term bds)+          _ -> pure Nothing+        spelled :: Expression -> [Binding] -> Maybe Expression+        spelled term bds = case located (stripped term) (fromMaybe univ caller._universe) of+          Just (ExFormation declared) -> Just (applied bds (stripped term) declared)+          _ -> called bds+          where+            stripped :: Expression -> Expression+            stripped (ExApplication target _) = stripped target+            stripped other = other+        hollow :: [Binding] -> Bool+        hollow bds = not (any isLambda bds) && or [True | BiTau AtPhi _ <- bds]+        deferral :: ReduceContext -> Expression -> [Binding] -> Expression -> IO (Maybe Expression)+        deferral deep site bds call = argued deep site bds call >>= traverse postponed+          where+            postponed :: Expression -> IO Expression+            postponed made = do+              fresh <- coined+              ctx._saveEval (EvDeferred ctx._nesting fresh Morphing (ExFormation bds) (Just made) site)+              pure (ExFormation [BiLambda (FnSymbol fresh)])+        argued :: ReduceContext -> Expression -> [Binding] -> Expression -> IO (Maybe Expression)+        argued deep site bds (ExApplication target (ArTau attr body)) = do+          target' <- argued deep site bds target+          case target' of+            Nothing -> pure Nothing+            Just made -> fmap (ExApplication made . ArTau attr) <$> stood deep (Just (ExFormation (filter (not . named attr) bds))) (ExDispatch site attr) body+        argued _ _ _ call = pure (Just call)+        pinned :: Either Int Bytes -> IO Expression+        pinned (Left idx) = pure (ExFormation [BiLambda (FnSymbol idx)])+        pinned (Right bytes) = do+          fresh <- coined+          ctx._saveEval (EvKnown ctx._nesting fresh bytes)+          pure (ExFormation [BiLambda (FnSymbol fresh)])+        unreminted :: Expression -> IO a+        unreminted term = do+          ctx._saveEval (EvUnreminted ctx._nesting func term)+          throwIO (Unreminted func)+    ended :: Expression -> Maybe (Either Int Bytes)+    ended (ExFormation [BiLambda (FnSymbol idx)]) = Just (Left idx)+    ended (ExFormation bds) = case [bytes | BiDelta bytes <- bds] of+      [bytes] -> Just (Right bytes)+      _ -> listToMaybe [body | BiTau AtPhi body <- bds] >>= ended+    ended (ExApplication _ (ArTau AtPhi body)) = ended body+    ended _ = Nothing+    figured :: ReduceContext -> Lambda -> State -> Expression -> Expression -> IO (Maybe Expression)+    figured ctx entry state' site placed = do+      outcome <- try $ do+        (normal, morphed) <- settled placed univ state' =<< opening Morphing ctx{_site = site}+        fst <$> fire refused ctx entry site morphed normal+      case outcome of+        Right answer -> pure (Just answer)+        Left (OutOfTime cap) -> throwIO (OutOfTime cap)+        Left _ -> pure Nothing+    named :: Attribute -> Binding -> Bool+    named attr (BiTau attr' _) = attr == attr'+    named _ _ = False+    called :: [Binding] -> Maybe Expression+    called known = uncurry (applied known) <$> origin known+    applied :: [Binding] -> Expression -> [Binding] -> Expression+    applied known path declared = foldl ExApplication path [ArTau attr value | BiTau attr value <- known, attr /= AtRho, BiVoid attr `elem` declared]+    origin :: [Binding] -> Maybe (Expression, [Binding])+    origin known = do+      parent <- case filter ((== Just AtRho) . attributeFromBinding) known of+        [] -> Just ExRoot+        [BiTau AtRho (ExFormation outer)] -> fst <$> origin outer+        [BiTau AtRho path] -> Just (erased path)+        _ -> Nothing+      ExFormation siblings <- located parent (fromMaybe univ caller._universe)+      chosen [(ExDispatch parent attr, declared) | BiTau attr (ExFormation declared) <- siblings, attr /= AtRho, fits declared]+      where+        fits :: [Binding] -> Bool+        fits declared = all (`elem` map attributeFromBinding declared) [attributeFromBinding bd | bd <- known, attributeFromBinding bd /= Just AtRho]+        chosen :: [(Expression, [Binding])] -> Maybe (Expression, [Binding])+        chosen [] = Nothing+        chosen candidates = case [candidate | candidate <- candidates, agreed candidate == maximum (map agreed candidates)] of+          [one] -> Just one+          _ -> Nothing+        agreed :: (Expression, [Binding]) -> (Int, Int)+        agreed (_, declared) = (length [attr | BiTau attr _ <- known, BiVoid attr `elem` declared], length (filter (`elem` declared) known))+    located :: Expression -> Expression -> Maybe Expression+    located ExRoot whole = Just whole+    located (ExDispatch path attr) whole = case located path whole of+      Just (ExFormation siblings) -> listToMaybe [body | BiTau attr' body <- siblings, attr' == attr]+      _ -> Nothing+    located _ _ = Nothing+    erased :: Expression -> Expression+    erased (ExApplication target _) = erased target+    erased (ExDispatch target attr) = ExDispatch (erased target) attr+    erased other = other     trimmed :: ReduceContext -> Subst -> Meta -> Meta -> IO Subst     trimmed ctx bound meta source = do       term <- stayed <$> buildExpressionThrows (ExMeta source._name) bound@@ -190,6 +302,26 @@       where         fact :: (Int, Bytes) -> Evaluation         fact (fresh, bytes) = EvKnown ctx._nesting fresh bytes+    cast :: ReduceContext -> Subst -> (Meta, Meta) -> (Meta, Meta) -> IO Subst+    cast ctx bound (one, first) (two, second) = do+      left <- buildExpressionThrows (ExMeta first._name) bound+      right <- buildExpressionThrows (ExMeta second._name) bound+      spent <- readIORef ctx._minted+      (left', right') <- case (upcasted left right spent, upcasted right left spent) of+        (Just outcome, _) -> (,right) <$> recorded outcome+        (_, Just outcome) -> (left,) <$> recorded outcome+        _ -> pure (left, right)+      written one first left' bound >>= written two second right'+      where+        recorded :: (Int, Expression, [(Int, [Attribute])], Int) -> IO Expression+        recorded (bare, made, paths, spent) = do+          writeIORef ctx._minted spent+          ctx._saveEval (EvUpcast ctx._nesting bare made paths)+          pure made+        written :: Meta -> Meta -> Expression -> Subst -> IO Subst+        written meta source term subst = do+          ctx._saveEval (EvSymbolize ctx._nesting meta._spelling (ExMeta source._name) term)+          bind meta (MvExpression term) subst     paired :: ReduceContext -> Lambda -> Maybe (Either Int Bytes) -> (Subst, State) -> Meta -> Meta -> Meta -> IO (Subst, State)     paired ctx entry condition (bound, state') meta left right = do       one <- branch left@@ -200,41 +332,49 @@         _ -> both one two       where         both :: Expression -> Expression -> IO (Subst, State)-        both one two = do-          outcome <- joined entry._lenient one two <$> readIORef ctx._minted-          case outcome of-            Just made -> written state' made-            Nothing-              | entry._lenient && (hanging one || hanging two) -> do-                  (one', reducing) <- reduced left one state'-                  (two', state'') <- reduced right two reducing-                  outcome' <- joined entry._lenient one' two' <$> readIORef ctx._minted-                  maybe (unjoined one' two') (written state'') outcome'-              | otherwise -> unjoined one two+        both one two = readIORef ctx._minted >>= maybe (unjoined one two) written . joined entry._lenient one two         unjoined :: Expression -> Expression -> IO a         unjoined one two = do           ctx._saveEval (EvUnjoined ctx._nesting func one two)           throwIO (Unjoined func)-        written :: State -> (Expression, [(Int, (Int, Int))], Int) -> IO (Subst, State)-        written state'' (term, made, spent) = do+        written :: (Expression, [(Int, (Int, Int))], Int) -> IO (Subst, State)+        written (term, made, spent) = do           writeIORef ctx._minted spent           mapM_ (ctx._saveEval . fact) made           ctx._saveEval (EvJoin ctx._nesting meta._spelling (left._spelling, right._spelling) term)           bound' <- bind meta (MvExpression term) bound-          pure (bound', state'')-        reduced :: Meta -> Expression -> State -> IO (Expression, State)-        reduced side term@(ExFormation bds) state''-          | hanging term && entry._defer && copied bds = deferred side bds state'' >>= maybe (entered (severed bds) side term state'') (\answer -> pure (answer, state''))-        reduced side term state''-          | hanging term = entered refused side term state''-          | otherwise = pure (term, state'')-        entered :: (Expression -> ReduceContext -> (Acyclic, Expression) -> IO Expression) -> Meta -> Expression -> State -> IO (Expression, State)-        entered cut side term state'' = do-          (normal, morphed) <- morphing univ ctx (ExDispatch term AtPhi) state''-          ctx._saveEval (EvTerm ctx._nesting side._spelling Morphing (ExDispatch (ExMeta side._name) AtPhi) normal)-          (answer, state''') <- fire cut ctx entry side morphed normal-          ctx._saveEval (EvTerm ctx._nesting side._spelling Evaluation (ExMeta side._name) answer)-          pure (answer, state''')+          pure (bound', state')+        terminating :: T.Text -> Meta -> Expression -> Expression -> IO (Subst, State)+        terminating side raised fault term = do+          ctx._saveEval (EvTerminate ctx._nesting condition side raised._spelling (message fault))+          ctx._saveEval (EvJoin ctx._nesting meta._spelling (left._spelling, right._spelling) term)+          bound' <- bind meta (MvExpression term) bound+          pure (bound', state')+        branch :: Meta -> IO Expression+        branch named = buildExpressionThrows (ExMeta named._name) bound+        fact :: (Int, (Int, Int)) -> Evaluation+        fact (fresh, pair) = EvJoined ctx._nesting fresh pair+    unfolded :: ReduceContext -> Lambda -> (Subst, State) -> Meta -> Meta -> Bool -> IO (Subst, State)+    unfolded ctx entry (bound, state') meta source deferring = do+      term <- buildExpressionThrows (ExMeta source._name) bound+      (answer, state'') <- reduced term+      bound' <- bind meta (MvExpression answer) bound+      pure (bound', state'')+      where+        reduced :: Expression -> IO (Expression, State)+        reduced term@(ExFormation bds)+          | hanging term && deferring && copied bds = deferred bds >>= maybe (entered (severed bds) term) (\answer -> pure (answer, state'))+          | hanging term = entered refused term+        reduced term = do+          ctx._saveEval (EvSymbolize ctx._nesting meta._spelling (ExMeta source._name) term)+          pure (term, state')+        entered :: (Expression -> ReduceContext -> (Acyclic, Expression) -> IO Expression) -> Expression -> IO (Expression, State)+        entered cut term = do+          (normal, morphed) <- morphing univ ctx (ExDispatch term AtPhi) state'+          ctx._saveEval (EvTerm ctx._nesting meta._spelling Morphing (ExDispatch (ExMeta source._name) AtPhi) normal)+          (answer, state'') <- fire cut ctx entry (ExMeta source._name) morphed normal+          ctx._saveEval (EvTerm ctx._nesting meta._spelling Evaluation (ExMeta source._name) answer)+          pure (answer, state'')         hanging :: Expression -> Bool         hanging (ExFormation bds) = not (any isLambda bds) && or [not (xiFree body) | BiTau AtPhi body <- bds]         hanging _ = False@@ -247,8 +387,8 @@             formed :: Expression -> Bool             formed (ExFormation _) = True             formed _ = False-        deferred :: Meta -> [Binding] -> State -> IO (Maybe Expression)-        deferred side bds state'' = do+        deferred :: [Binding] -> IO (Maybe Expression)+        deferred bds = do           known <- mapM resolved bds           if any bare known then Just <$> postponed known else pure Nothing           where@@ -259,7 +399,7 @@             resolved bd@(BiTau attr body)               | attr /= AtPhi && attr /= AtRho && reducible body = do                   placed <- ctx._engine._contextualize body (ExFormation (filter (not . named attr) bds))-                  outcome <- try (settled placed univ state'' reading)+                  outcome <- try (settled placed univ state' reading)                   case outcome of                     Right (sole@(ExFormation [BiLambda (FnSymbol _)]), _) -> pure (BiTau attr sole)                     Left (OutOfTime cap) -> expired ctx cap@@ -269,66 +409,32 @@             reducible (ExDispatch _ _) = True             reducible (ExApplication _ _) = True             reducible _ = False-            named :: Attribute -> Binding -> Bool-            named attr (BiTau attr' _) = attr == attr'-            named _ _ = False             reading :: ReduceContext             reading = ctx{_symbolic = emptyLambdas, _memo = Nothing, _tally = Nothing, _acyclic = Nothing, _saveStep = dontSaveStep, _saveEval = dontSaveEval}             postponed :: [Binding] -> IO Expression             postponed known = do+              call <- traverse (argued known) (called known)               fresh <- coined-              ctx._saveEval (EvDeferred ctx._nesting fresh Morphing (ExFormation known) (called known) (ExDispatch (ExMeta side._name) AtPhi))+              ctx._saveEval (EvDeferred ctx._nesting fresh Morphing (ExFormation known) call (ExDispatch (ExMeta source._name) AtPhi))               pure (ExFormation [BiLambda (FnSymbol fresh)])         severed :: [Binding] -> Expression -> ReduceContext -> (Acyclic, Expression) -> IO Expression         severed bds _ firing (mode, before) = do+          call <- traverse (argued bds) (called bds)           fresh <- coined-          firing._saveEval (EvLooped firing._nesting firing._judgment mode before firing._site (Just (fresh, called bds)))+          firing._saveEval (EvLooped firing._nesting firing._judgment mode before firing._site (Just (fresh, call)))           pure (ExFormation [BiLambda (FnSymbol fresh)])-        coined :: IO Int-        coined = atomicModifyIORef' ctx._minted (\count -> (succ count, succ count))-        called :: [Binding] -> Maybe Expression-        called known = do-          (path, declared) <- origin known-          pure (foldl ExApplication path [ArTau attr value | BiTau attr value <- known, attr /= AtRho, BiVoid attr `elem` declared])-        origin :: [Binding] -> Maybe (Expression, [Binding])-        origin known = do-          parent <- case filter ((== Just AtRho) . attributeFromBinding) known of-            [] -> Just ExRoot-            [BiTau AtRho (ExFormation outer)] -> fst <$> origin outer-            [BiTau AtRho path] -> Just (erased path)-            _ -> Nothing-          ExFormation siblings <- located parent (fromMaybe univ ctx._universe)-          chosen [(ExDispatch parent attr, declared) | BiTau attr (ExFormation declared) <- siblings, attr /= AtRho, fits declared]-          where-            fits :: [Binding] -> Bool-            fits declared = all (`elem` map attributeFromBinding declared) [attributeFromBinding bd | bd <- known, attributeFromBinding bd /= Just AtRho]-            chosen :: [(Expression, [Binding])] -> Maybe (Expression, [Binding])-            chosen [] = Nothing-            chosen candidates = case [candidate | candidate <- candidates, agreed candidate == maximum (map agreed candidates)] of-              [one] -> Just one-              _ -> Nothing-            agreed :: (Expression, [Binding]) -> (Int, Int)-            agreed (_, declared) = (length [attr | BiTau attr _ <- known, BiVoid attr `elem` declared], length (filter (`elem` declared) known))-        located :: Expression -> Expression -> Maybe Expression-        located ExRoot whole = Just whole-        located (ExDispatch path attr) whole = case located path whole of-          Just (ExFormation siblings) -> listToMaybe [body | BiTau attr' body <- siblings, attr' == attr]-          _ -> Nothing-        located _ _ = Nothing-        erased :: Expression -> Expression-        erased (ExApplication target _) = erased target-        erased (ExDispatch target attr) = ExDispatch (erased target) attr-        erased other = other-        terminating :: T.Text -> Meta -> Expression -> Expression -> IO (Subst, State)-        terminating side raised fault term = do-          ctx._saveEval (EvTerminate ctx._nesting condition side raised._spelling (message fault))-          ctx._saveEval (EvJoin ctx._nesting meta._spelling (left._spelling, right._spelling) term)-          bound' <- bind meta (MvExpression term) bound-          pure (bound', state')-        branch :: Meta -> IO Expression-        branch named = buildExpressionThrows (ExMeta named._name) bound-        fact :: (Int, (Int, Int)) -> Evaluation-        fact (fresh, pair) = EvJoined ctx._nesting fresh pair+        argued :: [Binding] -> Expression -> IO Expression+        argued bds (ExApplication target (ArTau attr body)) = do+          target' <- argued bds target+          ExApplication target' . ArTau attr <$> reckoned bds attr body+        argued _ call = pure call+        reckoned :: [Binding] -> Attribute -> Expression -> IO Expression+        reckoned _ _ body@(ExFormation [BiLambda (FnSymbol _)]) = pure body+        reckoned bds attr body = do+          placed <- ctx._engine._contextualize body (ExFormation (filter (not . named attr) bds))+          fromMaybe body <$> figured ctx entry state' (ExDispatch (ExMeta source._name) attr) placed+    coined :: IO Int+    coined = atomicModifyIORef' caller._minted (\count -> (succ count, succ count))     raising :: Lambda -> Expression -> Bool     raising _ ExTermination = True     raising entry term = thrown entry._terminators term@@ -356,29 +462,32 @@         throwIO           (userError (printf "The meta '%s' of λ function '%s' clashes with an existing binding" (T.unpack meta._spelling) (T.unpack func))) -rewritten :: [Y.Rule] -> RuleContext -> Expression -> IO Expression-rewritten rules ctx = goExpr+rewritten :: [Y.Rule] -> (Maybe Expression -> RuleContext) -> Expression -> IO Expression+rewritten rules ctx = goExpr Nothing   where-    goExpr :: Expression -> IO Expression-    goExpr expr = goRules rules+    goExpr :: Maybe Expression -> Expression -> IO Expression+    goExpr around expr = goRules rules       where         goRules :: [Y.Rule] -> IO Expression-        goRules [] = inside expr+        goRules [] = inside around expr         goRules (rule : rest) = do-          substs <- matchExpressionWithRule' [substEmpty] expr rule ctx+          substs <- matchExpressionWithRule' [substEmpty] expr rule (ctx (enclosing expr))           case substs of             subst : _ -> buildExpressionThrows rule.result subst             [] -> goRules rest-    inside :: Expression -> IO Expression-    inside (ExFormation bds) = ExFormation <$> mapM goBinding bds-    inside (ExApplication expr arg) = ExApplication <$> goExpr expr <*> goArgument arg-    inside (ExDispatch expr attr) = (`ExDispatch` attr) <$> goExpr expr-    inside (ExPhiMeet prefix idx expr) = ExPhiMeet prefix idx <$> goExpr expr-    inside (ExPhiAgain prefix idx expr) = ExPhiAgain prefix idx <$> goExpr expr-    inside expr = pure expr-    goBinding :: Binding -> IO Binding-    goBinding (BiTau attr expr) = BiTau attr <$> goExpr expr-    goBinding bd = pure bd-    goArgument :: Argument -> IO Argument-    goArgument (ArTau attr expr) = ArTau attr <$> goExpr expr-    goArgument (ArAlpha alpha expr) = ArAlpha alpha <$> goExpr expr+        enclosing :: Expression -> Maybe Expression+        enclosing form@(ExFormation _) = Just form+        enclosing _ = around+    inside :: Maybe Expression -> Expression -> IO Expression+    inside _ form@(ExFormation bds) = ExFormation <$> mapM (goBinding (Just form)) bds+    inside around (ExApplication expr arg) = ExApplication <$> goExpr around expr <*> goArgument around arg+    inside around (ExDispatch expr attr) = (`ExDispatch` attr) <$> goExpr around expr+    inside around (ExPhiMeet prefix idx expr) = ExPhiMeet prefix idx <$> goExpr around expr+    inside around (ExPhiAgain prefix idx expr) = ExPhiAgain prefix idx <$> goExpr around expr+    inside _ expr = pure expr+    goBinding :: Maybe Expression -> Binding -> IO Binding+    goBinding around (BiTau attr expr) = BiTau attr <$> goExpr around expr+    goBinding _ bd = pure bd+    goArgument :: Maybe Expression -> Argument -> IO Argument+    goArgument around (ArTau attr expr) = ArTau attr <$> goExpr around expr+    goArgument around (ArAlpha alpha expr) = ArAlpha alpha <$> goExpr around expr
src/Lambdas.hs view
@@ -22,13 +22,16 @@   , symbolized   , taken   , thrown+  , upcasted   ) where  import AST import Control.Applicative ((<|>)) import Control.Exception (Exception, throwIO)-import Data.Aeson (FromJSON (parseJSON), Key, Object, Value (Object), withObject, (.!=), (.:), (.:?))+import Data.Aeson (FromJSON (parseJSON), Key, Object, Value (Object, String), withObject, (.!=), (.:), (.:?))+import qualified Data.Aeson.Key as Key+import qualified Data.Aeson.KeyMap as KeyMap import Data.Char (isDigit) import Data.List (find, nub, sortOn) import Data.Map.Strict (Map)@@ -56,9 +59,11 @@  data Line   = Evaluated Meta Meta+  | Unfolded Meta Meta Bool   | Rewritten Meta Meta [Y.Rule]   | Stayed Meta Meta   | Symbolized Meta Meta+  | Upcasted Meta Meta Meta Meta   | Paired Meta Meta Meta  data Lambda = Lambda@@ -67,7 +72,6 @@   , _morphed :: [(Meta, Expression)]   , _lines :: [Line]   , _lenient :: Bool-  , _defer :: Bool   , _terminators :: [Text]   , _answer :: Expression   }@@ -86,13 +90,13 @@   parseJSON = withObject "Lambda" $ \entry -> do     key <- entry .:? "λ" >>= maybe (fail "The entry has no 'λ' key") pure     answer <- entry .:? "𝑛" >>= maybe (fail "The entry has no '𝑛' key") pure+    unknown (T.unpack key) entry     dataized <- operands key bytesMeta entry "dataize"     morphed <- operands key expressionMeta entry "morph"     lambda <-       Lambda key dataized morphed         <$> (written (T.unpack key) entry >>= ordered (T.unpack key) (map (_name . fst) morphed))-        <*> entry .:? "lenient" .!= False-        <*> entry .:? "defer" .!= False+        <*> lenient (T.unpack key) entry         <*> entry .:? "terminators" .!= []         <*> pure answer     sigmas (T.unpack key) lambda._answer@@ -104,6 +108,13 @@     lonely (T.unpack key) lambda     pure lambda     where+      unknown :: String -> Object -> Yaml.Parser ()+      unknown key entry = case filter (`notElem` known) (map Key.toText (KeyMap.keys entry)) of+        [] -> pure ()+        name : _ -> fail (printf "The key '%s' of λ function '%s' is none of the keys an entry reads: %s" (T.unpack name) key (T.unpack (T.intercalate ", " known)))+        where+          known :: [Text]+          known = ["λ", "dataize", "morph", "evaluate", "unfold", "rewrite", "stay", "symbolize", "upcast", "join", "lenient", "terminators", "𝑛"]       operands :: Text -> (Text -> Yaml.Parser Meta) -> Object -> Key -> Yaml.Parser [(Meta, Expression)]       operands key kind entry name = do         mapping <- entry .:? name .!= (Map.empty :: Map Text Expression)@@ -121,20 +132,67 @@       bytesMeta meta = case parseBytes (T.unpack meta) of         Right (BtMeta name) -> pure (Meta meta name)         _ -> fail (printf "The operand '%s' is not a bytes meta, such as '𝛿1'" (T.unpack meta))+      lenient :: String -> Object -> Yaml.Parser Bool+      lenient key entry = entry .:? "lenient" >>= maybe (pure False) (\names -> True <$ mapM_ (option key) (names :: [Text]))+      option :: String -> Text -> Yaml.Parser ()+      option key "defer" = fail (printf "The option 'defer' of 'lenient' of λ function '%s' is gone, while an 'unfold' line saying 'defer: true' does its work" key)+      option key "upcast" = fail (printf "The option 'upcast' of 'lenient' of λ function '%s' is gone, while an 'upcast' block does its work" key)+      option key name = fail (printf "The option '%s' of 'lenient' of λ function '%s' is unknown, while the list takes no option" (T.unpack name) key)       written :: String -> Object -> Yaml.Parser [Line]       written key entry =         concat           <$> sequence             [ links Evaluated entry "evaluate"+            , unfolds key entry             , rewrites key entry             , links Stayed entry "stay"             , links Symbolized entry "symbolize"+            , casts key entry             , pairs key entry             ]       links :: (Meta -> Meta -> Line) -> Object -> Key -> Yaml.Parser [Line]       links kind entry name = do         mapping <- entry .:? name .!= (Map.empty :: Map Text Text)         mapM (\(meta, source) -> kind <$> expressionMeta meta <*> expressionMeta source) (numbered mapping)+      unfolds :: String -> Object -> Yaml.Parser [Line]+      unfolds key entry = do+        mapping <- entry .:? "unfold" .!= (Map.empty :: Map Text Value)+        mapM line (numbered mapping)+        where+          line :: (Text, Value) -> Yaml.Parser Line+          line (meta, String source) = Unfolded <$> expressionMeta meta <*> expressionMeta source <*> pure False+          line (meta, Object body) = Unfolded <$> expressionMeta meta <*> (body .: "of" >>= expressionMeta) <*> body .:? "defer" .!= False+          line (meta, _) =+            fail+              ( printf+                  "The line '%s' of 'unfold' of λ function '%s' names neither a meta nor a mapping with 'of', such as '𝑛2: 𝑛1' or '𝑛2: {of: 𝑛1, defer: true}'"+                  (T.unpack meta)+                  key+              )+      casts :: String -> Object -> Yaml.Parser [Line]+      casts key entry = do+        mapping <- entry .:? "upcast" .!= (Map.empty :: Map Text Value)+        case numbered mapping of+          [] -> pure []+          [(one, first), (two, second)] -> (: []) <$> (Upcasted <$> expressionMeta one <*> plain one first <*> expressionMeta two <*> plain two second)+          lines' ->+            fail+              ( printf+                  "The 'upcast' block of λ function '%s' holds %d %s, while it casts one pair and takes exactly two"+                  key+                  (length lines')+                  (if length lines' == 1 then "line" else "lines" :: String)+              )+        where+          plain :: Text -> Value -> Yaml.Parser Meta+          plain _ (String source) = expressionMeta source+          plain meta _ =+            fail+              ( printf+                  "The line '%s' of 'upcast' of λ function '%s' names no meta, such as '𝑛3: 𝑛1', while the block itself finds which of its two terms to cast"+                  (T.unpack meta)+                  key+              )       pairs :: String -> Object -> Yaml.Parser [Line]       pairs key entry = do         mapping <- entry .:? "join" .!= (Map.empty :: Map Text [Text])@@ -190,7 +248,7 @@         where           bound :: Meta -> Yaml.Parser ()           bound meta-            | meta._name `elem` reduced ++ map (_name . binding) waiting = pure ()+            | meta._name `elem` reduced ++ map _name (concatMap bindings waiting) = pure ()             | otherwise =                 fail                   ( printf@@ -201,7 +259,7 @@           go :: [Text] -> [Line] -> Yaml.Parser [Line]           go _ [] = pure []           go known pending@(first : _) = case break (all ((`elem` known) . _name) . sources) pending of-            (before, line : after) -> (line :) <$> go ((binding line)._name : known) (before ++ after)+            (before, line : after) -> (line :) <$> go (map _name (bindings line) ++ known) (before ++ after)             (_, []) ->               fail                 ( printf@@ -215,19 +273,26 @@                 | meta._name `elem` seen = meta                 | otherwise = goCircle (meta._name : seen) (fromMaybe meta (listToMaybe (feeding meta)))               feeding :: Meta -> [Meta]-              feeding meta = [source | line <- pending, (binding line)._name == meta._name, source <- sources line, source._name `notElem` known]+              feeding meta = [source | line <- pending, meta._name `elem` map _name (bindings line), source <- sources line, source._name `notElem` known]           sources :: Line -> [Meta]           sources (Evaluated _ source) = [source]+          sources (Unfolded _ source _) = [source]           sources (Rewritten _ source _) = [source]           sources (Stayed _ source) = [source]           sources (Symbolized _ source) = [source]+          sources (Upcasted _ first _ second) = [first, second]           sources (Paired _ left right) = [left, right]       binding :: Line -> Meta       binding (Evaluated meta _) = meta+      binding (Unfolded meta _ _) = meta       binding (Rewritten meta _ _) = meta       binding (Stayed meta _) = meta       binding (Symbolized meta _) = meta+      binding (Upcasted meta _ _ _) = meta       binding (Paired meta _ _) = meta+      bindings :: Line -> [Meta]+      bindings (Upcasted one _ two _) = [one, two]+      bindings line = [binding line]       sigmas :: String -> Expression -> Yaml.Parser ()       sigmas key answer = case ([kind | Slot kind _ <- slots answer, kind /= "S"], symbols answer) of         ([], []) -> pure ()@@ -240,7 +305,7 @@         where           bound :: [Text]           bound =-            map (_spelling . fst) lambda._morphed ++ map (_spelling . binding) lambda._lines+            map (_spelling . fst) lambda._morphed ++ map _spelling (concatMap bindings lambda._lines)           twice :: [Text] -> [Text] -> Maybe Text           twice _ [] = Nothing           twice seen (meta : rest)@@ -271,7 +336,6 @@       lonely :: String -> Lambda -> Yaml.Parser ()       lonely key lambda         | lambda._lenient && null [meta | Paired meta _ _ <- lambda._lines] = fail (printf "The λ function '%s' is lenient but has no 'join' line to be lenient in" key)-        | lambda._defer && not lambda._lenient = fail (printf "The λ function '%s' defers but is not lenient, while only a lenient join may enter a copy" key)         | otherwise = pure ()       dataless :: String -> Expression -> Yaml.Parser ()       dataless key answer@@ -567,6 +631,64 @@       where         fresh :: Int         fresh = spent' + 1++upcasted :: Expression -> Expression -> Int -> Maybe (Int, Expression, [(Int, [Attribute])], Int)+upcasted (ExFormation [BiLambda (FnSymbol _)]) (ExFormation [BiLambda (FnSymbol _)]) _ = Nothing+upcasted (ExFormation [BiLambda (FnSymbol bare)]) shape spent = do+  paths@(_ : _) <- goReached [] shape+  let fresh = [spent + 1 .. spent + length paths]+  pure (bare, swapped fresh shape, zip fresh (map snd paths), spent + length paths)+  where+    goReached :: [Attribute] -> Expression -> Maybe [(Int, [Attribute])]+    goReached _ term+      | null (symbols term) = Just []+    goReached path (ExFormation bds) = concat <$> mapM goReachedBinding bds+      where+        goReachedBinding :: Binding -> Maybe [(Int, [Attribute])]+        goReachedBinding (BiLambda (FnSymbol idx)) = Just [(idx, path)]+        goReachedBinding (BiTau attr expr) = goReached (path ++ [attr]) expr+        goReachedBinding _ = Just []+    goReached path (ExApplication expr (ArTau attr arg))+      | copied expr = (++) <$> goReached path expr <*> goReached (path ++ [attr]) arg+      where+        copied :: Expression -> Bool+        copied (ExApplication target _) = copied target+        copied target = global target+        global :: Expression -> Bool+        global ExRoot = True+        global (ExDispatch target _) = global target+        global _ = False+    goReached _ _ = Nothing+    swapped :: [Int] -> Expression -> Expression+    swapped fresh term = fst (goSwapped term fresh)+      where+        goSwapped :: Expression -> [Int] -> (Expression, [Int])+        goSwapped (ExFormation bds) rest =+          let (bds', rest') = goSwappedBindings bds rest+           in (ExFormation bds', rest')+        goSwapped (ExApplication expr arg) rest =+          let (expr', rest') = goSwapped expr rest+              (arg', rest'') = goSwappedArgument arg rest'+           in (ExApplication expr' arg', rest'')+        goSwapped expr rest = (expr, rest)+        goSwappedBindings :: [Binding] -> [Int] -> ([Binding], [Int])+        goSwappedBindings [] rest = ([], rest)+        goSwappedBindings (bd : bds) rest =+          let (bd', rest') = goSwappedBinding bd rest+              (bds', rest'') = goSwappedBindings bds rest'+           in (bd' : bds', rest'')+        goSwappedBinding :: Binding -> [Int] -> (Binding, [Int])+        goSwappedBinding (BiLambda (FnSymbol _)) (idx : rest) = (BiLambda (FnSymbol idx), rest)+        goSwappedBinding (BiTau attr expr) rest =+          let (expr', rest') = goSwapped expr rest+           in (BiTau attr expr', rest')+        goSwappedBinding bd rest = (bd, rest)+        goSwappedArgument :: Argument -> [Int] -> (Argument, [Int])+        goSwappedArgument (ArTau attr expr) rest =+          let (expr', rest') = goSwapped expr rest+           in (ArTau attr expr', rest')+        goSwappedArgument arg rest = (arg, rest)+upcasted _ _ _ = Nothing  taken :: Expression -> Int taken program = maximum (0 : symbols program)
src/Morph.hs view
@@ -119,6 +119,7 @@   | Stuck T.Text   | StuckAt T.Text (NonEmpty Rewritten) State   | Unjoined T.Text+  | Unreminted T.Text   | OutOfStepsAt Budget (NonEmpty Rewritten) State   | Looping Expression   | LoopingAt Expression (NonEmpty Rewritten) State@@ -139,6 +140,7 @@   show (Stuck func) = printf "No entry of --symbolic answers the λ function '%s'" (T.unpack func)   show (StuckAt func _ _) = show (Stuck func)   show (Unjoined func) = printf "The λ function '%s' could not join its two branches" (T.unpack func)+  show (Unreminted func) = printf "The λ function '%s' could not remint a term as a symbol" (T.unpack func)   show (Looping term) = printf "Reduction entered a formation it is already inside: %s" (printExpression term)   show (LoopingAt term _ _) = show (Looping term)   show (Undataizable ExTermination _) = "dataization reached the terminator ⊥, which signals an error and cannot be dataized"@@ -404,6 +406,7 @@ universed _ ctx@ReduceContext{_universe = Just _} = pure ctx universed univ ctx = do   (normal, _) <- normalized univ ((univ, Nothing) :| []) ctx{_locator = ExRoot, _saveStep = dontSaveStep}+  ctx._saveEval (EvWorld normal)   pure ctx{_universe = Just normal}  insideUniverse :: Expression -> Expression -> ReduceContext -> IO (Expression, ReduceContext)
test-resources/evaluate-packs/answers-a-copy-a-cut-stops-with-a-fresh-symbol-when-deferring.yaml view
@@ -4,21 +4,22 @@ # yamllint disable rule:line-length # The cut of #1735 without the walk of --deep: the branch 'b' of the fork is # the copy 'rec( n ↦ ⟦ φ ↦ 𝜎2 ⟧ )', whose argument reads to no bare symbol, so-# a lenient join enters it, morphs its φ to the same fork and fires it.+# an 'unfold' line enters it, morphs its φ to the same fork and fires it. # '--acyclic=proven' refuses that firing, since the run is already inside the-# fork. An entry that says 'defer: true' answers the copy with a fresh symbol-# there, writes it on the 'looped' line, and joins it with the symbol the-# other branch holds, instead of losing the whole entry (#1895).+# fork. A line that says 'defer: true' answers the copy with a fresh symbol+# there and writes it on the 'looped' line, and the 'join' line pairs it with+# the symbol the other branch holds, instead of losing the whole entry (#1895,+# #1921). symbolic: |   - λ: L_fork     morph:       𝑛1: $.a       𝑛2: $.b+    unfold:+      𝑛3: {of: 𝑛2, defer: true}     join:-      𝑛3: [𝑛1, 𝑛2]-    lenient: true-    defer: true-    𝑛: ⟦ φ ↦ 𝑛3 ⟧+      𝑛4: [𝑛1, 𝑛3]+    𝑛: ⟦ φ ↦ 𝑛4 ⟧ location: 'Q.y' acyclic: proven input: '⟦ fork(a, b) ↦ ⟦ λ ⤍ L_fork ⟧, rec(n) ↦ ⟦ φ ↦ Φ.fork( ⟦ λ ⤍ 𝜎1 ⟧, Φ.rec( ξ.n ) ) ⟧, y ↦ Φ.rec( ⟦ φ ↦ ⟦ λ ⤍ 𝜎2 ⟧ ⟧ ).φ.φ ⟧'@@ -36,10 +37,10 @@       𝕄(Φ.a🌵2):         𝑛·1·2 := Φ.fork( a ↦ 𝜎1:λ )         𝑛·1·3 := 𝑛·1·2( b ↦ Φ.rec( 𝜎2:λ:φ ) )-      𝑛2·1 := 𝑛·1·3  # 𝕄(𝑛2.φ)+      𝑛3·1 := 𝑛·1·3  # 𝕄(𝑛2.φ)       looped(𝑛·1·3) := 𝜎3  # 𝔼(𝑛2), proven-      𝑛2·1 := 𝜎3:λ  # 𝔼(𝑛2)+      𝑛3·1 := 𝜎3:λ  # 𝔼(𝑛2)       𝔻(𝜎4:λ) ∈ { 𝔻(𝜎1:λ), 𝔻(𝜎3:λ) }-      𝑛3·1 := 𝜎4:λ  # [𝑛1, 𝑛2]+      𝑛4·1 := 𝜎4:λ  # [𝑛1, 𝑛3]       𝑛·1·4 := 𝜎4:λ:φ  # 𝑛       𝑛·1·5 := 𝜎4:λ:φ  # 𝕄(𝑛·1·4)
test-resources/evaluate-packs/cuts-a-branch-whose-phi-leads-back-to-it.yaml view
@@ -2,23 +2,23 @@ # SPDX-License-Identifier: MIT --- # yamllint disable rule:line-length-# The step a lenient join takes into a branch of #1885, under-# '--acyclic=proven', over a branch whose φ fires the same fork again: 'z'-# decorates a call of 'L_fork' whose branch 'a' is 'z' itself. The join morphs-# the φ of 'z' and fires the fork it comes to, which meets 'z' again, morphs-# its φ again and comes to the same fork. The step fires the way an 'evaluate'-# line does, entering the formation it fires (#1882), so the second firing is-# cut and writes a 'looped' line where it would have opened, and the run parks-# the first fork.+# The step of an 'unfold' line (#1885, #1921), under '--acyclic=proven', over+# a branch whose φ fires the same fork again: 'z' decorates a call of 'L_fork'+# whose branch 'a' is 'z' itself. The line morphs the φ of 'z' and fires the+# fork it comes to, which meets 'z' again, morphs its φ again and comes to the+# same fork. The step fires the way an 'evaluate' line does, entering the+# formation it fires (#1882), so the second firing is cut and writes a+# 'looped' line where it would have opened, and the run parks the first fork. symbolic: |   - λ: L_fork     morph:       𝑛1: $.a       𝑛2: $.b+    unfold:+      𝑛3: 𝑛1     join:-      𝑛3: [𝑛1, 𝑛2]-    lenient: true-    𝑛: 𝑛3+      𝑛4: [𝑛3, 𝑛2]+    𝑛: 𝑛4 location: 'Q.y' acyclic: proven input: '⟦ z ↦ ⟦ φ ↦ ξ.f, f ↦ ⟦ λ ⤍ L_fork, a ↦ Φ.z, b ↦ ⟦ φ ↦ ⟦ λ ⤍ 𝜎1 ⟧ ⟧ ⟧ ⟧, y ↦ ⟦ a ↦ Φ.z, b ↦ ⟦ φ ↦ ⟦ λ ⤍ 𝜎2 ⟧ ⟧, λ ⤍ L_fork ⟧.φ ⟧'@@ -28,9 +28,9 @@     𝔼(L_fork):       𝑛1·1 := ⟦ φ ↦ f, f ↦ ⟦ λ ⤍ L_fork, a ↦ Φ.z, b ↦ 𝜎1:λ:φ ⟧ ⟧  # 𝕄(ξ.a)       𝑛2·1 := 𝜎2:λ:φ  # 𝕄(ξ.b)-      𝑛1·1 := ⟦ λ ⤍ L_fork, a ↦ Φ.z, b ↦ 𝜎1:λ:φ ⟧  # 𝕄(𝑛1.φ)+      𝑛3·1 := ⟦ λ ⤍ L_fork, a ↦ Φ.z, b ↦ 𝜎1:λ:φ ⟧  # 𝕄(𝑛1.φ)       𝔼(L_fork):  # 𝔼(𝑛1)         𝑛1·2 := ⟦ φ ↦ f, f ↦ ⟦ λ ⤍ L_fork, a ↦ Φ.z, b ↦ 𝜎1:λ:φ ⟧ ⟧  # 𝕄(ξ.a)         𝑛2·2 := 𝜎1:λ:φ  # 𝕄(ξ.b)-        𝑛1·2 := ⟦ λ ⤍ L_fork, a ↦ Φ.z, b ↦ 𝜎1:λ:φ ⟧  # 𝕄(𝑛1.φ)+        𝑛3·2 := ⟦ λ ⤍ L_fork, a ↦ Φ.z, b ↦ 𝜎1:λ:φ ⟧  # 𝕄(𝑛1.φ)         looped(⟦ λ ⤍ L_fork, a ↦ Φ.z, b ↦ 𝜎1:λ:φ ⟧)  # 𝔼(𝑛1), proven
test-resources/evaluate-packs/defers-a-copy-whose-argument-reads-to-a-bare-symbol.yaml view
@@ -4,21 +4,22 @@ # yamllint disable rule:line-length # The loop of #1729 without the walk of --deep: the branch 'b' of the fork is # the copy 'step( tup ↦ Φ.items.tail )', and 'Φ.items.tail' reads to the bare-# symbol '𝜎1', an object nobody knows. A lenient join fails on the copy and-# morphs its φ, which asks '𝜎1' for 'next' and gets stuck. An entry that says-# 'defer: true' does not enter such a copy: it answers it with a fresh symbol,-# writes a 'deferred' line naming the call the copy stands for, and joins that-# symbol with the one the other branch holds (#1892).+# symbol '𝜎1', an object nobody knows. Unfolding the copy would morph its φ,+# which asks '𝜎1' for 'next' and gets stuck. An 'unfold' line that says+# 'defer: true' does not enter such a copy: it answers it with a fresh+# symbol, writes a 'deferred' line naming the call the copy stands for, and+# the 'join' line pairs that symbol with the one the other branch holds+# (#1892, #1921). symbolic: |   - λ: L_fork     morph:       𝑛1: $.a       𝑛2: $.b+    unfold:+      𝑛3: {of: 𝑛2, defer: true}     join:-      𝑛3: [𝑛1, 𝑛2]-    lenient: true-    defer: true-    𝑛: ⟦ φ ↦ 𝑛3 ⟧+      𝑛4: [𝑛1, 𝑛3]+    𝑛: ⟦ φ ↦ 𝑛4 ⟧ location: 'Q.y' input: '⟦ step(tup) ↦ ⟦ φ ↦ tup.next ⟧, items ↦ ⟦ tail ↦ ⟦ λ ⤍ 𝜎1 ⟧ ⟧, y ↦ ⟦ a ↦ ⟦ λ ⤍ 𝜎2 ⟧, b ↦ Φ.step( tup ↦ Φ.items.tail ), λ ⤍ L_fork ⟧.φ ⟧' result: '𝜎4:λ'@@ -31,6 +32,6 @@       𝑛2·1 := 𝑛·1·1  # 𝕄(ξ.b)       deferred(𝜎3) := Φ.step( tup ↦ 𝜎1:λ )  # 𝕄(𝑛2.φ)       𝔻(𝜎4:λ) ∈ { 𝔻(𝜎2:λ), 𝔻(𝜎3:λ) }-      𝑛3·1 := 𝜎4:λ  # [𝑛1, 𝑛2]+      𝑛4·1 := 𝜎4:λ  # [𝑛1, 𝑛3]       𝑛·1·2 := 𝜎4:λ:φ  # 𝑛       𝑛·1·3 := 𝜎4:λ:φ  # 𝕄(𝑛·1·2)
test-resources/evaluate-packs/enters-a-copy-whose-argument-reads-to-no-bare-symbol-when-deferring.yaml view
@@ -2,21 +2,21 @@ # SPDX-License-Identifier: MIT --- # yamllint disable rule:line-length-# An entry that says 'defer: true' defers only a copy one of whose arguments-# reads to a bare symbol (#1892). Here 'Φ.items.tail' reads to an object that-# knows its 'next', so the lenient join enters the copy as it did before-# (#1885): it morphs its φ, fires what it comes to, and joins two symbols. No-# 'deferred' line is written and no symbol is minted for the copy.+# An 'unfold' line that says 'defer: true' defers only a copy one of whose+# arguments reads to a bare symbol (#1892, #1921). Here 'Φ.items.tail' reads+# to an object that knows its 'next', so the line enters the copy (#1885): it+# morphs its φ and fires what it comes to, and the 'join' line pairs two+# symbols. No 'deferred' line is written and no symbol is minted for the copy. symbolic: |   - λ: L_fork     morph:       𝑛1: $.a       𝑛2: $.b+    unfold:+      𝑛3: {of: 𝑛2, defer: true}     join:-      𝑛3: [𝑛1, 𝑛2]-    lenient: true-    defer: true-    𝑛: ⟦ φ ↦ 𝑛3 ⟧+      𝑛4: [𝑛1, 𝑛3]+    𝑛: ⟦ φ ↦ 𝑛4 ⟧ location: 'Q.y' input: '⟦ step(tup) ↦ ⟦ φ ↦ tup.next ⟧, items ↦ ⟦ tail ↦ ⟦ next ↦ ⟦ φ ↦ ⟦ λ ⤍ 𝜎1 ⟧ ⟧ ⟧ ⟧, y ↦ ⟦ a ↦ ⟦ λ ⤍ 𝜎2 ⟧, b ↦ Φ.step( tup ↦ Φ.items.tail ), λ ⤍ L_fork ⟧.φ ⟧' result: '𝜎3:λ'@@ -27,9 +27,9 @@       𝕄(Φ.a🌵1):         𝑛·1·1 := Φ.step( tup ↦ Φ.items.tail )       𝑛2·1 := 𝑛·1·1  # 𝕄(ξ.b)-      𝑛2·1 := 𝜎1:λ:φ  # 𝕄(𝑛2.φ)-      𝑛2·1 := 𝑛2·1  # 𝔼(𝑛2)+      𝑛3·1 := 𝜎1:λ:φ  # 𝕄(𝑛2.φ)+      𝑛3·1 := 𝑛3·1  # 𝔼(𝑛2)       𝔻(𝜎3:λ) ∈ { 𝔻(𝜎2:λ), 𝔻(𝜎1:λ) }-      𝑛3·1 := 𝜎3:λ  # [𝑛1, 𝑛2]+      𝑛4·1 := 𝜎3:λ  # [𝑛1, 𝑛3]       𝑛·1·2 := 𝜎3:λ:φ  # 𝑛       𝑛·1·3 := 𝜎3:λ:φ  # 𝕄(𝑛·1·2)
test-resources/evaluate-packs/fails-on-a-bare-symbol-and-a-branch-holding-one-symbol-when-strict.yaml view
@@ -2,10 +2,10 @@ # SPDX-License-Identifier: MIT --- # yamllint disable rule:line-length-# The fork of 'bool.and' from #1817 under an entry that does not say-# 'lenient: true'. A strict join pairs a bare symbol only with the symbol a φ-# chain ends in, and the chain of the second branch stops at the call of-# 'Φ.bool', so there is no symbol to pair it with and the firing gets stuck.+# The fork of 'bool.and' from #1817 under an entry with no 'lenient' key. A+# strict join pairs a bare symbol only with the symbol a φ chain ends in, and+# the chain of the second branch stops at the call of 'Φ.bool', so there is+# no symbol to pair it with and the firing gets stuck. symbolic: |   - λ: L_fork     morph:
test-resources/evaluate-packs/fails-on-a-bare-symbol-and-a-branch-holding-two-symbols-when-lenient.yaml view
@@ -13,7 +13,7 @@       𝑛2: $.b     join:       𝑛3: [𝑛1, 𝑛2]-    lenient: true+    lenient: []     𝑛: 𝑛3 location: 'Q.y' input: |
test-resources/evaluate-packs/fails-on-a-branch-and-a-decorator-of-it-when-strict.yaml view
@@ -2,10 +2,10 @@ # SPDX-License-Identifier: MIT --- # yamllint disable rule:line-length-# The fork the lenient join of #1815 brings together, under an entry that-# does not say 'lenient: true'. A copy and a decorator of it differ in shape,-# so the strict join refuses them and the firing gets stuck, as an entry is-# strict unless it says otherwise.+# The fork the lenient join of #1815 brings together, under an entry with no+# 'lenient' key. A copy and a decorator of it differ in shape, so the strict+# join refuses them and the firing gets stuck, as an entry is strict unless it+# says otherwise. symbolic: |   - λ: L_fork     morph:
test-resources/evaluate-packs/fails-on-a-branch-whose-phi-reads-its-own-object-when-strict.yaml view
@@ -2,10 +2,10 @@ # SPDX-License-Identifier: MIT --- # yamllint disable rule:line-length-# The fork the lenient join of #1885 gets through, under an entry that does-# not say 'lenient: true'. The branch that is an ordinary object stays as 𝕄-# left it, a formation whose φ reads its own attribute, so the strict join-# refuses it beside a bare symbol and the firing gets stuck.+# The fork an 'unfold' line gets through (#1885, #1921), under an entry with+# no such line. The branch that is an ordinary object stays as 𝕄 left it, a+# formation whose φ reads its own attribute, so the join refuses it beside a+# bare symbol and the firing gets stuck. symbolic: |   - λ: L_eq     𝑛: ⟦ φ ↦ ⟦ λ ⤍ 𝜎 ⟧ ⟧
test-resources/evaluate-packs/fails-on-a-copy-whose-argument-reads-to-a-bare-symbol-when-not-deferring.yaml view
@@ -2,8 +2,8 @@ # SPDX-License-Identifier: MIT --- # yamllint disable rule:line-length-# The fork the deferral of #1892 gets through, under a lenient entry that does-# not say 'defer: true'. The lenient join morphs the φ of the copy+# The fork the deferral of #1892 gets through, under an 'unfold' line that+# does not say 'defer: true' (#1921). The line morphs the φ of the copy # 'step( tup ↦ Φ.items.tail )', which asks the bare symbol '𝜎1' for 'next', # and the firing gets stuck on that symbol, as it did since '--deep' was gone. symbolic: |@@ -11,10 +11,11 @@     morph:       𝑛1: $.a       𝑛2: $.b+    unfold:+      𝑛3: 𝑛2     join:-      𝑛3: [𝑛1, 𝑛2]-    lenient: true-    𝑛: ⟦ φ ↦ 𝑛3 ⟧+      𝑛4: [𝑛1, 𝑛3]+    𝑛: ⟦ φ ↦ 𝑛4 ⟧ location: 'Q.y' input: '⟦ step(tup) ↦ ⟦ φ ↦ tup.next ⟧, items ↦ ⟦ tail ↦ ⟦ λ ⤍ 𝜎1 ⟧ ⟧, y ↦ ⟦ a ↦ ⟦ λ ⤍ 𝜎2 ⟧, b ↦ Φ.step( tup ↦ Φ.items.tail ), λ ⤍ L_fork ⟧.φ ⟧' fails: "No entry of --symbolic answers the λ function '𝜎1'"
+ test-resources/evaluate-packs/fails-on-a-remint-of-a-term-that-comes-to-no-symbol.yaml view
@@ -0,0 +1,36 @@+# SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+# SPDX-License-Identifier: MIT+---+# yamllint disable rule:line-length+# The tail of the pair below comes to a formation that is no copy of an object+# of the world and whose φ chain ends in nothing, so a 'remint' step has no+# symbol to answer for it. It writes an 'unreminted' line naming the term+# instead of minting a symbol nobody can build, and the firing gets stuck the+# way one whose 'join' line could not pair its branches does (#1923).+symbolic: |+  - λ: L_shrink+    morph:+      𝑛1: $.x+    rewrite:+      𝑛2:+        of: 𝑛1+        rules:+          - name: small-pair+            pattern: ⟦ !B1, head ↦ 𝑒1, tail ↦ 𝑒2, !B2 ⟧+            result: ⟦ !B1, head ↦ 𝑒3, tail ↦ 𝑒4, !B2 ⟧+            where:+              - meta: 𝑒3+                function: remint+                args: [𝑒1]+              - meta: 𝑒4+                function: remint+                args: [𝑒2]+    𝑛: 𝑛2+location: 'Q.y'+input: '⟦ y ↦ ⟦ x ↦ ⟦ head ↦ ⟦ λ ⤍ 𝜎1 ⟧, tail ↦ ⟦ k ↦ ⟦ λ ⤍ 𝜎2 ⟧ ⟧ ⟧, λ ⤍ L_shrink ⟧.tail ⟧'+fails: "No entry of --symbolic answers the λ function 'L_shrink'"+protocol: |+  𝕄(Φ.y):+    𝔼(L_shrink):+      𝑛1·1 := ⟦ head ↦ 𝜎1:λ, tail ↦ 𝜎2:λ:k ⟧  # 𝕄(ξ.x)+      unreminted(L_shrink)  # 𝜎2:λ:k
+ test-resources/evaluate-packs/fails-on-a-remint-step-given-two-terms.yaml view
@@ -0,0 +1,29 @@+# SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+# SPDX-License-Identifier: MIT+---+# yamllint disable rule:line-length+# A 'remint' step mints one symbol for one term, so a step handing it two terms+# is refused the moment the rule matches, instead of minting for either (#1909).+symbolic: |+  - λ: L_shrink+    morph:+      𝑛1: $.x+    rewrite:+      𝑛2:+        of: 𝑛1+        rules:+          - name: small-pair+            pattern: ⟦ !B1, head ↦ 𝑒1, tail ↦ 𝑒2, !B2 ⟧+            result: ⟦ !B1, head ↦ 𝑒3, !B2 ⟧+            where:+              - meta: 𝑒3+                function: remint+                args: [𝑒1, 𝑒2]+    𝑛: 𝑛2+location: 'Q.y'+input: '⟦ y ↦ ⟦ x ↦ ⟦ head ↦ ⟦ λ ⤍ 𝜎1 ⟧, tail ↦ ⟦ λ ⤍ 𝜎2 ⟧ ⟧, λ ⤍ L_shrink ⟧.head ⟧'+fails: 'Function remint() requires exactly 1 argument as expression'+protocol: |+  𝕄(Φ.y):+    𝔼(L_shrink):+      𝑛1·1 := ⟦ head ↦ 𝜎1:λ, tail ↦ 𝜎2:λ ⟧  # 𝕄(ξ.x)
+ test-resources/evaluate-packs/fires-the-arguments-of-a-copy-a-cut-stops-when-deferring.yaml view
@@ -0,0 +1,57 @@+# SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+# SPDX-License-Identifier: MIT+---+# yamllint disable rule:line-length+# The cut of #1895 over a recursion whose argument changes every round: the+# copy 'rec( n ↦ Φ.inc( … ) )' is cut by '--acyclic=plausible', and its+# argument is a call of 'L_inc' nothing has fired yet. Before it writes the+# 'looped' line, an 'unfold' line that says 'defer: true' morphs that argument+# at '𝑛2.n' and fires what it comes to, so the protocol shows the object+# 'Φ.num' the argument stands for, and the markup names it in the call of the+# cut (#1916, #1921).+symbolic: |+  - λ: L_fork+    morph:+      𝑛1: $.a+      𝑛2: $.b+    unfold:+      𝑛3: {of: 𝑛2, defer: true}+    join:+      𝑛4: [𝑛1, 𝑛3]+    𝑛: ⟦ φ ↦ 𝑛4 ⟧+  - λ: L_inc+    dataize:+      𝛿1: $.x+    𝑛: Φ.num( φ ↦ ⟦ λ ⤍ 𝜎 ⟧ )+location: 'Q.y'+acyclic: plausible+input: '⟦ fork(a, b) ↦ ⟦ λ ⤍ L_fork ⟧, num(φ) ↦ ⟦⟧, inc(x) ↦ ⟦ λ ⤍ L_inc ⟧, rec(n) ↦ ⟦ φ ↦ Φ.fork( ⟦ λ ⤍ 𝜎1 ⟧, Φ.rec( Φ.inc( ξ.n ) ) ) ⟧, y ↦ Φ.rec( ⟦ φ ↦ ⟦ λ ⤍ 𝜎2 ⟧ ⟧ ).φ.φ ⟧'+result: '𝜎5:λ'+protocol: |+  𝕄(Φ.y):+    𝑛·0·1 := Φ.rec( n ↦ 𝜎2:λ:φ )+    𝑛·0·2 := Φ.fork( a ↦ 𝜎1:λ )+    𝑛·0·3 := 𝑛·0·2( b ↦ Φ.rec( Φ.inc( 𝜎2:λ:φ ) ) )+    𝔼(L_fork):+      𝑛1·1 := 𝜎1:λ  # 𝕄(ξ.a)+      𝕄(Φ.a🌵1):+        𝑛·1·1 := Φ.rec( n ↦ Φ.inc( 𝜎2:λ:φ ) )+      𝑛2·1 := 𝑛·1·1  # 𝕄(ξ.b)+      𝕄(Φ.a🌵2):+        𝑛·1·2 := Φ.fork( a ↦ 𝜎1:λ )+        𝑛·1·3 := 𝑛·1·2( b ↦ Φ.rec( Φ.inc( Φ.inc( 𝜎2:λ:φ ) ) ) )+      𝑛3·1 := 𝑛·1·3  # 𝕄(𝑛2.φ)+      𝕄(𝑛2.n):+        𝑛·1·4 := Φ.inc( x ↦ 𝜎2:λ:φ )+      𝔼(L_inc):  # 𝔼(𝑛2.n)+        𝛿1·2 := 𝔻(𝜎2:λ)  # 𝔻(ξ.x)+        𝑛·2·1 := Φ.num( φ ↦ 𝜎3:λ )  # 𝑛+        𝕄(𝑛·2·1):+          𝑛·2·2 := Φ.num( φ ↦ 𝜎3:λ )+        𝑛·2·3 := 𝑛·2·2  # 𝕄(𝑛·2·1)+      looped(𝑛·0·3) := 𝜎4  # 𝔼(𝑛2), plausible+      𝑛3·1 := 𝜎4:λ  # 𝔼(𝑛2)+      𝔻(𝜎5:λ) ∈ { 𝔻(𝜎1:λ), 𝔻(𝜎4:λ) }+      𝑛4·1 := 𝜎5:λ  # [𝑛1, 𝑛3]+      𝑛·1·5 := 𝜎5:λ:φ  # 𝑛+      𝑛·1·6 := 𝜎5:λ:φ  # 𝕄(𝑛·1·5)
+ test-resources/evaluate-packs/fires-the-arguments-of-a-copy-it-defers.yaml view
@@ -0,0 +1,49 @@+# SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+# SPDX-License-Identifier: MIT+---+# yamllint disable rule:line-length+# The deferral of #1892 over a copy with two arguments: 'x' reads to the bare+# symbol '𝜎1', so the copy is deferred, and 'w' is a call of 'L_inc'. Before it+# writes the 'deferred' line, the 'unfold' line morphs 'w' at '𝑛2.w' and fires+# what it comes to, so the line names the object 'Φ.num' the argument stands+# for, instead of the call as the code spells it (#1916, #1921).+symbolic: |+  - λ: L_fork+    morph:+      𝑛1: $.a+      𝑛2: $.b+    unfold:+      𝑛3: {of: 𝑛2, defer: true}+    join:+      𝑛4: [𝑛1, 𝑛3]+    𝑛: ⟦ φ ↦ 𝑛4 ⟧+  - λ: L_inc+    dataize:+      𝛿1: $.x+    𝑛: Φ.num( φ ↦ ⟦ λ ⤍ 𝜎 ⟧ )+location: 'Q.y'+input: '⟦ box(x, w) ↦ ⟦ φ ↦ x.next ⟧, num(φ) ↦ ⟦⟧, inc(x) ↦ ⟦ λ ⤍ L_inc ⟧, items ↦ ⟦ tail ↦ ⟦ λ ⤍ 𝜎1 ⟧ ⟧, y ↦ ⟦ a ↦ ⟦ λ ⤍ 𝜎2 ⟧, b ↦ Φ.box( x ↦ Φ.items.tail, w ↦ Φ.inc( ⟦ Δ ⤍ 2A- ⟧ ) ), λ ⤍ L_fork ⟧.φ ⟧'+result: '𝜎5:λ'+protocol: |+  𝕄(Φ.y):+    𝔼(L_fork):+      𝑛1·1 := 𝜎2:λ  # 𝕄(ξ.a)+      𝕄(Φ.a🌵1):+        𝑛·1·1 := Φ.box( x ↦ Φ.items.tail )+        𝑛·1·2 := 𝑛·1·1( w ↦ Φ.inc( 2A-:Δ ) )+      𝑛2·1 := 𝑛·1·2  # 𝕄(ξ.b)+      𝕄(𝑛2.w):+        𝑛·1·3 := Φ.inc( x ↦ 2A-:Δ )+      𝔼(L_inc):  # 𝔼(𝑛2.w)+        𝔻(Φ.a🌵2):+          𝛿·2·1 := 2A-+        𝛿1·2 := 𝛿·2·1  # 𝔻(ξ.x)+        𝑛·2·1 := Φ.num( φ ↦ 𝜎3:λ )  # 𝑛+        𝕄(𝑛·2·1):+          𝑛·2·2 := Φ.num( φ ↦ 𝜎3:λ )+        𝑛·2·3 := 𝑛·2·2  # 𝕄(𝑛·2·1)+      deferred(𝜎4) := Φ.box( x ↦ 𝜎1:λ, w ↦ 𝑛·2·2 )  # 𝕄(𝑛2.φ)+      𝔻(𝜎5:λ) ∈ { 𝔻(𝜎2:λ), 𝔻(𝜎4:λ) }+      𝑛4·1 := 𝜎5:λ  # [𝑛1, 𝑛3]+      𝑛·1·4 := 𝜎5:λ:φ  # 𝑛+      𝑛·1·5 := 𝜎5:λ:φ  # 𝕄(𝑛·1·4)
test-resources/evaluate-packs/joins-a-bare-symbol-with-a-branch-holding-one-symbol-when-lenient.yaml view
@@ -14,7 +14,7 @@       𝑛2: $.b     join:       𝑛3: [𝑛1, 𝑛2]-    lenient: true+    lenient: []     𝑛: 𝑛3 location: 'Q.y' input: |
+ test-resources/evaluate-packs/joins-a-branch-it-unfolded-whose-phi-reads-its-own-object.yaml view
@@ -0,0 +1,40 @@+# SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+# SPDX-License-Identifier: MIT+---+# yamllint disable rule:line-length+# A fork whose one branch is an ordinary object: a formation with no λ, whose+# value sits in a φ that reads an attribute of the object itself. 𝕄 stops at+# that formation, so the branch and a bare symbol differ in shape and depth,+# and the join alone cannot pair them. An 'unfold' line takes the step the+# join used to hide (#1921): it morphs the φ of that branch, fires what it+# comes to through 𝔼, the way an 'evaluate' line does, and binds the answer,+# so the 'join' line pairs two bare symbols (#1885).+symbolic: |+  - λ: L_eq+    𝑛: ⟦ φ ↦ ⟦ λ ⤍ 𝜎 ⟧ ⟧+  - λ: L_fork+    morph:+      𝑛1: $.a+      𝑛2: $.b+    unfold:+      𝑛3: 𝑛1+    join:+      𝑛4: [𝑛3, 𝑛2]+    𝑛: 𝑛4+location: 'Q.y'+input: '⟦ y ↦ ⟦ a ↦ ⟦ φ ↦ ξ.eq, eq ↦ ⟦ λ ⤍ L_eq ⟧ ⟧, b ↦ ⟦ φ ↦ ⟦ λ ⤍ 𝜎1 ⟧ ⟧, λ ⤍ L_fork ⟧.φ ⟧'+result: '𝜎3:λ'+protocol: |+  𝕄(Φ.y):+    𝔼(L_fork):+      𝑛1·1 := ⟦ φ ↦ eq, eq ↦ L_eq:λ ⟧  # 𝕄(ξ.a)+      𝑛2·1 := 𝜎1:λ:φ  # 𝕄(ξ.b)+      𝑛3·1 := L_eq:λ  # 𝕄(𝑛1.φ)+      𝔼(L_eq):  # 𝔼(𝑛1)+        𝑛·2·1 := 𝜎2:λ:φ  # 𝑛+        𝑛·2·2 := 𝜎2:λ:φ  # 𝕄(𝑛·2·1)+      𝑛3·1 := 𝑛·2·2  # 𝔼(𝑛1)+      𝔻(𝜎3:λ) ∈ { 𝔻(𝜎2:λ), 𝔻(𝜎1:λ) }+      𝑛4·1 := 𝜎3:λ:φ  # [𝑛3, 𝑛2]+      𝑛·1·1 := 𝑛4·1  # 𝑛+      𝑛·1·2 := 𝑛4·1  # 𝕄(𝑛·1·1)
− test-resources/evaluate-packs/joins-a-branch-whose-phi-reads-its-own-object-when-lenient.yaml
@@ -1,39 +0,0 @@-# SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com-# SPDX-License-Identifier: MIT-----# yamllint disable rule:line-length-# A fork whose one branch is an ordinary object: a formation with no λ, whose-# value sits in a φ that reads an attribute of the object itself. 𝕄 stops at-# that formation, so the branch and a bare symbol differ in shape and depth,-# and the join alone cannot pair them. An entry that says 'lenient: true'-# takes one more step before it gets stuck: it morphs the φ of that branch,-# fires what it comes to through 𝔼, the way 'morph' and 'evaluate' lines do,-# and joins once more, now two bare symbols (#1885).-symbolic: |-  - λ: L_eq-    𝑛: ⟦ φ ↦ ⟦ λ ⤍ 𝜎 ⟧ ⟧-  - λ: L_fork-    morph:-      𝑛1: $.a-      𝑛2: $.b-    join:-      𝑛3: [𝑛1, 𝑛2]-    lenient: true-    𝑛: 𝑛3-location: 'Q.y'-input: '⟦ y ↦ ⟦ a ↦ ⟦ φ ↦ ξ.eq, eq ↦ ⟦ λ ⤍ L_eq ⟧ ⟧, b ↦ ⟦ φ ↦ ⟦ λ ⤍ 𝜎1 ⟧ ⟧, λ ⤍ L_fork ⟧.φ ⟧'-result: '𝜎3:λ'-protocol: |-  𝕄(Φ.y):-    𝔼(L_fork):-      𝑛1·1 := ⟦ φ ↦ eq, eq ↦ L_eq:λ ⟧  # 𝕄(ξ.a)-      𝑛2·1 := 𝜎1:λ:φ  # 𝕄(ξ.b)-      𝑛1·1 := L_eq:λ  # 𝕄(𝑛1.φ)-      𝔼(L_eq):  # 𝔼(𝑛1)-        𝑛·2·1 := 𝜎2:λ:φ  # 𝑛-        𝑛·2·2 := 𝜎2:λ:φ  # 𝕄(𝑛·2·1)-      𝑛1·1 := 𝑛·2·2  # 𝔼(𝑛1)-      𝔻(𝜎3:λ) ∈ { 𝔻(𝜎2:λ), 𝔻(𝜎1:λ) }-      𝑛3·1 := 𝜎3:λ:φ  # [𝑛1, 𝑛2]-      𝑛·1·1 := 𝑛3·1  # 𝑛-      𝑛·1·2 := 𝑛3·1  # 𝕄(𝑛·1·1)
test-resources/evaluate-packs/joins-a-branch-with-a-decorator-of-it-when-lenient.yaml view
@@ -5,7 +5,7 @@ # A fork whose one branch calls a method often meets a decorator: one branch # comes to a copy, the other to a formation whose φ is that copy. The two # differ in shape, so a strict join refuses them. An entry that says-# 'lenient: true' joins them into the decorator, with a fresh symbol minted+# 'lenient: []' joins them into the decorator, with a fresh symbol minted # inside it the usual way (#1815). symbolic: |   - λ: L_fork@@ -14,7 +14,7 @@       𝑛2: $.b     join:       𝑛3: [𝑛1, 𝑛2]-    lenient: true+    lenient: []     𝑛: 𝑛3 location: 'Q.y' input: '⟦ y ↦ ⟦ a ↦ ⟦ φ ↦ ⟦ λ ⤍ 𝜎1 ⟧, neg ↦ ⟦⟧ ⟧, b ↦ ⟦ φ ↦ ⟦ φ ↦ ⟦ λ ⤍ 𝜎2 ⟧, neg ↦ ⟦⟧ ⟧ ⟧, λ ⤍ L_fork ⟧.φ ⟧'
test-resources/evaluate-packs/joins-a-decorator-with-the-branch-it-decorates-standing-second-when-lenient.yaml view
@@ -13,7 +13,7 @@       𝑛2: $.b     join:       𝑛3: [𝑛1, 𝑛2]-    lenient: true+    lenient: []     𝑛: 𝑛3 location: 'Q.y' input: '⟦ y ↦ ⟦ a ↦ ⟦ φ ↦ ⟦ φ ↦ ⟦ λ ⤍ 𝜎1 ⟧, neg ↦ ⟦⟧ ⟧ ⟧, b ↦ ⟦ φ ↦ ⟦ λ ⤍ 𝜎2 ⟧, neg ↦ ⟦⟧ ⟧, λ ⤍ L_fork ⟧.φ ⟧'
+ test-resources/evaluate-packs/keeps-a-bare-symbol-no-path-casts-for-a-lenient-join.yaml view
@@ -0,0 +1,45 @@+# SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+# SPDX-License-Identifier: MIT+---+# yamllint disable rule:line-length+# An 'upcast' block casts the bare symbol of its pair only when a path reaches+# every symbol of the other term (#1921). The one symbol of the branch 'b' sits+# under the dispatch '.not', which no path walks into, so both lines bind their+# terms as they are and nothing is written for the cast. The 'join' line of the+# lenient entry then pairs the bare symbol with that one symbol, the way a+# lenient join always did (#1817).+symbolic: |+  - λ: L_fork+    morph:+      𝑛1: $.a+      𝑛2: $.b+    upcast:+      𝑛3: 𝑛1+      𝑛4: 𝑛2+    join:+      𝑛5: [𝑛3, 𝑛4]+    lenient: []+    𝑛: 𝑛5+location: 'Q.y'+input: |+  ⟦+    bool(if) ↦ ⟦ φ ↦ ξ.if( α0 ↦ ⟦ Δ ⤍ FF- ⟧, α1 ↦ ⟦ Δ ⤍ 00- ⟧ ) ⟧,+    y ↦ ⟦+      a ↦ ⟦ λ ⤍ 𝜎1 ⟧,+      b ↦ ⟦ φ ↦ Φ.bool( if ↦ ⟦ λ ⤍ L_fork, left ↦ ∅, right ↦ ∅, φ ↦ ⟦ λ ⤍ 𝜎2 ⟧.not ⟧ ) ⟧,+      λ ⤍ L_fork+    ⟧.φ+  ⟧+result: '⟦ if(left, right) ↦ ⟦ λ ⤍ L_fork, φ ↦ 𝜎3:λ.not ⟧, φ ↦ if( FF-:Δ, 00-:Δ ) ⟧'+protocol: |+  𝕄(Φ.y):+    𝔼(L_fork):+      𝑛1·1 := 𝜎1:λ  # 𝕄(ξ.a)+      𝑛2·1 := Φ.bool( if(left, right) ↦ ⟦ λ ⤍ L_fork, φ ↦ 𝜎2:λ.not ⟧ ):φ  # 𝕄(ξ.b)+      𝑛3·1 := 𝑛1·1  # 𝑛1+      𝑛4·1 := Φ.bool( if(left, right) ↦ ⟦ λ ⤍ L_fork, φ ↦ 𝜎2:λ.not ⟧ ):φ  # 𝑛2+      𝔻(𝜎3:λ) ∈ { 𝔻(𝜎1:λ), 𝔻(𝜎2:λ) }+      𝑛5·1 := Φ.bool( if(left, right) ↦ ⟦ λ ⤍ L_fork, φ ↦ 𝜎3:λ.not ⟧ ):φ  # [𝑛3, 𝑛4]+      𝑛·1·1 := Φ.bool( if(left, right) ↦ ⟦ λ ⤍ L_fork, φ ↦ 𝜎3:λ.not ⟧ ):φ  # 𝑛+      𝑛·1·2 := Φ.bool( if(left, right) ↦ ⟦ λ ⤍ L_fork, φ ↦ 𝜎3:λ.not ⟧ ):φ  # 𝕄(𝑛·1·1)+    𝑛·0·1 := Φ.bool( if(left, right) ↦ ⟦ λ ⤍ L_fork, φ ↦ 𝜎3:λ.not ⟧ )
+ test-resources/evaluate-packs/parks-a-firing-whose-remint-comes-to-no-symbol.yaml view
@@ -0,0 +1,35 @@+# SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+# SPDX-License-Identifier: MIT+---+# yamllint disable rule:line-length+# The very firing that fails without '--partial', with it: a 'remint' step+# with no symbol to answer gets the firing stuck, so '--partial' parks the+# site, as it parks a fork whose branches do not join (#1923).+symbolic: |+  - λ: L_shrink+    morph:+      𝑛1: $.x+    rewrite:+      𝑛2:+        of: 𝑛1+        rules:+          - name: small-pair+            pattern: ⟦ !B1, head ↦ 𝑒1, tail ↦ 𝑒2, !B2 ⟧+            result: ⟦ !B1, head ↦ 𝑒3, tail ↦ 𝑒4, !B2 ⟧+            where:+              - meta: 𝑒3+                function: remint+                args: [𝑒1]+              - meta: 𝑒4+                function: remint+                args: [𝑒2]+    𝑛: 𝑛2+location: 'Q.y'+partial: true+input: '⟦ y ↦ ⟦ x ↦ ⟦ head ↦ ⟦ λ ⤍ 𝜎1 ⟧, tail ↦ ⟦ k ↦ ⟦ λ ⤍ 𝜎2 ⟧ ⟧ ⟧, λ ⤍ L_shrink ⟧.tail ⟧'+result: '⟦ x ↦ ⟦ head ↦ 𝜎1:λ, tail ↦ 𝜎2:λ:k ⟧, λ ⤍ L_shrink ⟧.tail'+protocol: |+  𝕄(Φ.y):+    𝔼(L_shrink):+      𝑛1·1 := ⟦ head ↦ 𝜎1:λ, tail ↦ 𝜎2:λ:k ⟧  # 𝕄(ξ.x)+      unreminted(L_shrink)  # 𝜎2:λ:k
+ test-resources/evaluate-packs/remints-a-call-as-the-symbol-its-firing-answers.yaml view
@@ -0,0 +1,53 @@+# SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+# SPDX-License-Identifier: MIT+---+# yamllint disable rule:line-length+# Morphing is lazy, so the tail of the pair below is still the call of 'L_inc'+# as the code spells it. A 'remint' step works such a term out the way an+# argument of a deferred copy is worked out since #1916: it morphs the term,+# fires what it comes to and writes every step, and the answer of 'L_inc' is+# a copy of 'Φ.num' whose φ is the fresh symbol '𝜎2', so the tail is '𝜎2'+# (#1923).+symbolic: |+  - λ: L_shrink+    morph:+      𝑛1: $.x+    rewrite:+      𝑛2:+        of: 𝑛1+        rules:+          - name: small-pair+            pattern: ⟦ !B1, head ↦ 𝑒1, tail ↦ 𝑒2, !B2 ⟧+            result: ⟦ !B1, head ↦ 𝑒3, tail ↦ 𝑒4, !B2 ⟧+            where:+              - meta: 𝑒3+                function: remint+                args: [𝑒1]+              - meta: 𝑒4+                function: remint+                args: [𝑒2]+    𝑛: 𝑛2+  - λ: L_inc+    dataize:+      𝛿1: $.x+    𝑛: Φ.num( φ ↦ ⟦ λ ⤍ 𝜎 ⟧ )+location: 'Q.y'+input: '⟦ num(φ) ↦ ⟦⟧, inc(x) ↦ ⟦ λ ⤍ L_inc ⟧, y ↦ ⟦ x ↦ ⟦ head ↦ ⟦ λ ⤍ 𝜎1 ⟧, tail ↦ Φ.inc( ⟦ Δ ⤍ 2A- ⟧ ) ⟧, λ ⤍ L_shrink ⟧.tail ⟧'+result: '𝜎2:λ'+protocol: |+  𝕄(Φ.y):+    𝔼(L_shrink):+      𝑛1·1 := ⟦ head ↦ 𝜎1:λ, tail ↦ Φ.inc( 2A-:Δ ) ⟧  # 𝕄(ξ.x)+      𝕄(Φ.inc( 2A-:Δ )):+        𝑛·1·1 := Φ.inc( x ↦ 2A-:Δ )+      𝔼(L_inc):  # 𝔼(Φ.inc( 2A-:Δ ))+        𝔻(Φ.a🌵1):+          𝛿·2·1 := 2A-+        𝛿1·2 := 𝛿·2·1  # 𝔻(ξ.x)+        𝑛·2·1 := Φ.num( φ ↦ 𝜎2:λ )  # 𝑛+        𝕄(𝑛·2·1):+          𝑛·2·2 := Φ.num( φ ↦ 𝜎2:λ )+        𝑛·2·3 := 𝑛·2·2  # 𝕄(𝑛·2·1)+      𝑛2·1 := ⟦ head ↦ 𝜎1:λ, tail ↦ 𝜎2:λ ⟧  # 𝑛1+      𝑛·1·2 := ⟦ head ↦ 𝜎1:λ, tail ↦ 𝜎2:λ ⟧  # 𝑛+      𝑛·1·3 := ⟦ head ↦ 𝜎1:λ, tail ↦ 𝜎2:λ ⟧  # 𝕄(𝑛·1·2)
+ test-resources/evaluate-packs/remints-a-copy-of-an-object-of-the-world-as-a-deferred-symbol.yaml view
@@ -0,0 +1,43 @@+# SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+# SPDX-License-Identifier: MIT+---+# yamllint disable rule:line-length+# The tail of the pair below is a copy of 'Φ.l/.throw', which raises, so firing+# it answers the copy as it is. A 'remint' step answers such a copy of an+# object of the world with a fresh symbol and writes it as a deferred copy,+# naming the object by the term as written and every argument by the symbol it+# comes to: here '𝜎2', the known symbol of the message '01-' (#1923).+symbolic: |+  - λ: L_shrink+    morph:+      𝑛1: $.x+    rewrite:+      𝑛2:+        of: 𝑛1+        rules:+          - name: small-pair+            pattern: ⟦ !B1, head ↦ 𝑒1, tail ↦ 𝑒2, !B2 ⟧+            result: ⟦ !B1, head ↦ 𝑒3, tail ↦ 𝑒4, !B2 ⟧+            where:+              - meta: 𝑒3+                function: remint+                args: [𝑒1]+              - meta: 𝑒4+                function: remint+                args: [𝑒2]+    terminators: [L_throw]+    𝑛: 𝑛2+location: 'Q.y'+input: '⟦ l/ ↦ ⟦ throw(message) ↦ ⟦ λ ⤍ L_throw ⟧ ⟧, y ↦ ⟦ x ↦ ⟦ head ↦ ⟦ λ ⤍ 𝜎1 ⟧, tail ↦ Φ.l/.throw( message ↦ ⟦ Δ ⤍ 01- ⟧ ) ⟧, λ ⤍ L_shrink ⟧.tail ⟧'+result: '𝜎3:λ'+protocol: |+  𝕄(Φ.y):+    𝔼(L_shrink):+      𝑛1·1 := ⟦ head ↦ 𝜎1:λ, tail ↦ Φ.l/.throw( message ↦ 01-:Δ ) ⟧  # 𝕄(ξ.x)+      𝕄(Φ.l/.throw( message ↦ 01-:Δ )):+        𝑛·1·1 := ⟦ message ↦ ∅, λ ⤍ L_throw ⟧( message ↦ 01-:Δ )+      𝔻(𝜎2:λ) == 01-+      deferred(𝜎3) := Φ.l/.throw( message ↦ 𝜎2:λ )  # 𝕄(Φ.l/.throw( message ↦ 01-:Δ ))+      𝑛2·1 := ⟦ head ↦ 𝜎1:λ, tail ↦ 𝜎3:λ ⟧  # 𝑛1+      𝑛·1·2 := ⟦ head ↦ 𝜎1:λ, tail ↦ 𝜎3:λ ⟧  # 𝑛+      𝑛·1·3 := ⟦ head ↦ 𝜎1:λ, tail ↦ 𝜎3:λ ⟧  # 𝕄(𝑛·1·2)
+ test-resources/evaluate-packs/remints-a-copy-whose-argument-is-a-copy-as-two-deferred-symbols.yaml view
@@ -0,0 +1,47 @@+# SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+# SPDX-License-Identifier: MIT+---+# yamllint disable rule:line-length+# The tail of the pair below is a copy of 'Φ.pair' whose own tail is a copy of+# 'Φ.l/.throw', the way the tail of a tuple of EO ends in the empty tuple,+# whose tail throws. A 'remint' step works every argument of a copy out as it+# works out the term itself, so the inner copy is deferred first, as '𝜎4', and+# the outer one names it as its argument, as '𝜎5' (#1923).+symbolic: |+  - λ: L_shrink+    morph:+      𝑛1: $.x+    rewrite:+      𝑛2:+        of: 𝑛1+        rules:+          - name: small-pair+            pattern: ⟦ !B1, head ↦ 𝑒1, tail ↦ 𝑒2, !B2 ⟧+            result: ⟦ !B1, head ↦ 𝑒3, tail ↦ 𝑒4, !B2 ⟧+            where:+              - meta: 𝑒3+                function: remint+                args: [𝑒1]+              - meta: 𝑒4+                function: remint+                args: [𝑒2]+    terminators: [L_throw]+    𝑛: 𝑛2+location: 'Q.y'+input: '⟦ l/ ↦ ⟦ throw(message) ↦ ⟦ λ ⤍ L_throw ⟧ ⟧, pair(tail, head) ↦ ⟦⟧, y ↦ ⟦ x ↦ ⟦ head ↦ ⟦ λ ⤍ 𝜎1 ⟧, tail ↦ Φ.pair( tail ↦ Φ.l/.throw( message ↦ ⟦ Δ ⤍ 01- ⟧ ), head ↦ ⟦ φ ↦ ⟦ λ ⤍ 𝜎2 ⟧ ⟧ ) ⟧, λ ⤍ L_shrink ⟧.tail ⟧'+result: '𝜎5:λ'+protocol: |+  𝕄(Φ.y):+    𝔼(L_shrink):+      𝑛1·1 := ⟦ head ↦ 𝜎1:λ, tail ↦ Φ.pair( tail ↦ Φ.l/.throw( message ↦ 01-:Δ ), head ↦ 𝜎2:λ:φ ) ⟧  # 𝕄(ξ.x)+      𝕄(Φ.pair( tail ↦ Φ.l/.throw( message ↦ 01-:Δ ), head ↦ 𝜎2:λ:φ )):+        𝑛·1·1 := Φ.pair( tail ↦ Φ.l/.throw( message ↦ 01-:Δ ) )+        𝑛·1·2 := 𝑛·1·1( head ↦ 𝜎2:λ:φ )  # 𝕄(𝑛·1·1( head ↦ 𝜎2:λ:φ ))+      𝕄(𝑛·1·2.tail):+        𝑛·1·3 := ⟦ message ↦ ∅, λ ⤍ L_throw ⟧( message ↦ 01-:Δ )+      𝔻(𝜎3:λ) == 01-+      deferred(𝜎4) := Φ.l/.throw( message ↦ 𝜎3:λ )  # 𝕄(𝑛·1·2.tail)+      deferred(𝜎5) := Φ.pair( tail ↦ 𝜎4:λ, head ↦ 𝜎2:λ )  # 𝕄(𝑛·1·2)+      𝑛2·1 := ⟦ head ↦ 𝜎1:λ, tail ↦ 𝜎5:λ ⟧  # 𝑛1+      𝑛·1·4 := ⟦ head ↦ 𝜎1:λ, tail ↦ 𝜎5:λ ⟧  # 𝑛+      𝑛·1·5 := ⟦ head ↦ 𝜎1:λ, tail ↦ 𝜎5:λ ⟧  # 𝕄(𝑛·1·4)
+ test-resources/evaluate-packs/remints-a-datum-as-a-known-symbol.yaml view
@@ -0,0 +1,39 @@+# SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+# SPDX-License-Identifier: MIT+---+# yamllint disable rule:line-length+# A 'remint' step given a term whose φ chain ends in data answers a fresh+# symbol and writes it as a known one, the way 'symbolize' does, so the head+# of the pair below becomes '𝜎1' standing for '01-' and the tail '𝜎2' standing+# for '02-' (#1923).+symbolic: |+  - λ: L_shrink+    morph:+      𝑛1: $.x+    rewrite:+      𝑛2:+        of: 𝑛1+        rules:+          - name: small-pair+            pattern: ⟦ !B1, head ↦ 𝑒1, tail ↦ 𝑒2, !B2 ⟧+            result: ⟦ !B1, head ↦ 𝑒3, tail ↦ 𝑒4, !B2 ⟧+            where:+              - meta: 𝑒3+                function: remint+                args: [𝑒1]+              - meta: 𝑒4+                function: remint+                args: [𝑒2]+    𝑛: 𝑛2+location: 'Q.y'+input: '⟦ y ↦ ⟦ x ↦ ⟦ head ↦ ⟦ Δ ⤍ 01- ⟧, tail ↦ ⟦ φ ↦ ⟦ Δ ⤍ 02- ⟧ ⟧ ⟧, λ ⤍ L_shrink ⟧.tail ⟧'+result: '𝜎2:λ'+protocol: |+  𝕄(Φ.y):+    𝔼(L_shrink):+      𝑛1·1 := ⟦ head ↦ 01-:Δ, tail ↦ 02-:Δ:φ ⟧  # 𝕄(ξ.x)+      𝔻(𝜎1:λ) == 01-+      𝔻(𝜎2:λ) == 02-+      𝑛2·1 := ⟦ head ↦ 𝜎1:λ, tail ↦ 𝜎2:λ ⟧  # 𝑛1+      𝑛·1·1 := ⟦ head ↦ 𝜎1:λ, tail ↦ 𝜎2:λ ⟧  # 𝑛+      𝑛·1·2 := ⟦ head ↦ 𝜎1:λ, tail ↦ 𝜎2:λ ⟧  # 𝕄(𝑛·1·1)
+ test-resources/evaluate-packs/remints-a-decorator-as-the-symbol-its-phi-comes-to.yaml view
@@ -0,0 +1,44 @@+# SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+# SPDX-License-Identifier: MIT+---+# yamllint disable rule:line-length+# Morphing stops at a formation, so the tail of the pair below, a call of+# 'as-number' the way EO's 'length.plus( 1 ).as-number' is one, comes to the+# object 'as-number' and not to the number it decorates. A 'remint' step then+# morphs the φ of what the term came to, once per decorator, until a φ chain+# ends in the bare symbol '𝜎2', and answers that symbol (#1923).+symbolic: |+  - λ: L_shrink+    morph:+      𝑛1: $.x+    rewrite:+      𝑛2:+        of: 𝑛1+        rules:+          - name: small-pair+            pattern: ⟦ !B1, head ↦ 𝑒1, tail ↦ 𝑒2, !B2 ⟧+            result: ⟦ !B1, head ↦ 𝑒3, tail ↦ 𝑒4, !B2 ⟧+            where:+              - meta: 𝑒3+                function: remint+                args: [𝑒1]+              - meta: 𝑒4+                function: remint+                args: [𝑒2]+    𝑛: 𝑛2+location: 'Q.y'+input: '⟦ number(φ) ↦ ⟦⟧, bytes(φ) ↦ ⟦ as-number ↦ ⟦ ρ ↦ ∅, φ ↦ Φ.number( φ ↦ ξ.ρ ) ⟧ ⟧, y ↦ ⟦ x ↦ ⟦ head ↦ ⟦ λ ⤍ 𝜎1 ⟧, tail ↦ Φ.bytes( φ ↦ ⟦ λ ⤍ 𝜎2 ⟧ ).as-number ⟧, λ ⤍ L_shrink ⟧.tail ⟧'+result: '𝜎2:λ'+protocol: |+  𝕄(Φ.y):+    𝔼(L_shrink):+      𝑛1·1 := ⟦ head ↦ 𝜎1:λ, tail ↦ Φ.bytes( φ ↦ 𝜎2:λ ).as-number ⟧  # 𝕄(ξ.x)+      𝕄(Φ.bytes( φ ↦ 𝜎2:λ ).as-number):+        𝑛·1·1 := Φ.bytes( φ ↦ 𝜎2:λ )+      𝕄(𝑛·1·1.as-number.φ):+        𝑛·1·2 := Φ.number( φ ↦ 𝑛·1·1 )+      𝕄(𝑛·1·1.as-number.φ.φ):+        𝑛·1·3 := Φ.bytes( φ ↦ 𝜎2:λ )+      𝑛2·1 := ⟦ head ↦ 𝜎1:λ, tail ↦ 𝜎2:λ ⟧  # 𝑛1+      𝑛·1·4 := ⟦ head ↦ 𝜎1:λ, tail ↦ 𝜎2:λ ⟧  # 𝑛+      𝑛·1·5 := ⟦ head ↦ 𝜎1:λ, tail ↦ 𝜎2:λ ⟧  # 𝕄(𝑛·1·4)
+ test-resources/evaluate-packs/remints-a-term-as-the-symbol-its-phi-chain-ends-in.yaml view
@@ -0,0 +1,38 @@+# SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+# SPDX-License-Identifier: MIT+---+# yamllint disable rule:line-length+# A rule of a 'rewrite' block may not write a 𝜎 into its result, but a 'where'+# step may call 'remint', which answers the symbol the term it is given stands+# for. A term whose φ chain ends in a bare symbol is that symbol, so nothing is+# minted and no line is written: the head of the pair below is '𝜎1' and its+# tail '𝜎2', whatever else the tail holds (#1923).+symbolic: |+  - λ: L_shrink+    morph:+      𝑛1: $.x+    rewrite:+      𝑛2:+        of: 𝑛1+        rules:+          - name: small-pair+            pattern: ⟦ !B1, head ↦ 𝑒1, tail ↦ 𝑒2, !B2 ⟧+            result: ⟦ !B1, head ↦ 𝑒3, tail ↦ 𝑒4, !B2 ⟧+            where:+              - meta: 𝑒3+                function: remint+                args: [𝑒1]+              - meta: 𝑒4+                function: remint+                args: [𝑒2]+    𝑛: 𝑛2+location: 'Q.y'+input: '⟦ y ↦ ⟦ x ↦ ⟦ head ↦ ⟦ φ ↦ ⟦ λ ⤍ 𝜎1 ⟧ ⟧, tail ↦ ⟦ φ ↦ ⟦ λ ⤍ 𝜎2 ⟧, k ↦ ⟦ λ ⤍ 𝜎3 ⟧ ⟧ ⟧, λ ⤍ L_shrink ⟧.tail ⟧'+result: '𝜎2:λ'+protocol: |+  𝕄(Φ.y):+    𝔼(L_shrink):+      𝑛1·1 := ⟦ head ↦ 𝜎1:λ:φ, tail ↦ ⟦ φ ↦ 𝜎2:λ, k ↦ 𝜎3:λ ⟧ ⟧  # 𝕄(ξ.x)+      𝑛2·1 := ⟦ head ↦ 𝜎1:λ, tail ↦ 𝜎2:λ ⟧  # 𝑛1+      𝑛·1·1 := ⟦ head ↦ 𝜎1:λ, tail ↦ 𝜎2:λ ⟧  # 𝑛+      𝑛·1·2 := ⟦ head ↦ 𝜎1:λ, tail ↦ 𝜎2:λ ⟧  # 𝕄(𝑛·1·1)
test-resources/evaluate-packs/spends-the-step-budget-on-a-branch-whose-phi-leads-back-to-it.yaml view
@@ -3,19 +3,20 @@ --- # yamllint disable rule:line-length # The branch whose φ fires the same fork again, with no '--acyclic' to cut it.-# The step a lenient join takes into a branch of #1885 fires the way an-# 'evaluate' line does, spending a step on every firing (#1882), so the step-# limit ends the run instead of letting the join fire the fork forever. This-# is the control the pack asking for the guard stands against.+# The step of an 'unfold' line (#1885, #1921) fires the way an 'evaluate'+# line does, spending a step on every firing (#1882), so the step limit ends+# the run instead of letting the line fire the fork forever. This is the+# control the pack asking for the guard stands against. symbolic: |   - λ: L_fork     morph:       𝑛1: $.a       𝑛2: $.b+    unfold:+      𝑛3: 𝑛1     join:-      𝑛3: [𝑛1, 𝑛2]-    lenient: true-    𝑛: 𝑛3+      𝑛4: [𝑛3, 𝑛2]+    𝑛: 𝑛4 location: 'Q.y' steps: 6 input: '⟦ z ↦ ⟦ φ ↦ ξ.f, f ↦ ⟦ λ ⤍ L_fork, a ↦ Φ.z, b ↦ ⟦ φ ↦ ⟦ λ ⤍ 𝜎1 ⟧ ⟧ ⟧ ⟧, y ↦ ⟦ a ↦ Φ.z, b ↦ ⟦ φ ↦ ⟦ λ ⤍ 𝜎2 ⟧ ⟧, λ ⤍ L_fork ⟧.φ ⟧'@@ -25,11 +26,11 @@     𝔼(L_fork):       𝑛1·1 := ⟦ φ ↦ f, f ↦ ⟦ λ ⤍ L_fork, a ↦ Φ.z, b ↦ 𝜎1:λ:φ ⟧ ⟧  # 𝕄(ξ.a)       𝑛2·1 := 𝜎2:λ:φ  # 𝕄(ξ.b)-      𝑛1·1 := ⟦ λ ⤍ L_fork, a ↦ Φ.z, b ↦ 𝜎1:λ:φ ⟧  # 𝕄(𝑛1.φ)+      𝑛3·1 := ⟦ λ ⤍ L_fork, a ↦ Φ.z, b ↦ 𝜎1:λ:φ ⟧  # 𝕄(𝑛1.φ)       𝔼(L_fork):  # 𝔼(𝑛1)         𝑛1·2 := ⟦ φ ↦ f, f ↦ ⟦ λ ⤍ L_fork, a ↦ Φ.z, b ↦ 𝜎1:λ:φ ⟧ ⟧  # 𝕄(ξ.a)         𝑛2·2 := 𝜎1:λ:φ  # 𝕄(ξ.b)-        𝑛1·2 := ⟦ λ ⤍ L_fork, a ↦ Φ.z, b ↦ 𝜎1:λ:φ ⟧  # 𝕄(𝑛1.φ)+        𝑛3·2 := ⟦ λ ⤍ L_fork, a ↦ Φ.z, b ↦ 𝜎1:λ:φ ⟧  # 𝕄(𝑛1.φ)         𝔼(L_fork):  # 𝔼(𝑛1)           𝕄(Φ.a🌵6):             starved(6)
+ test-resources/evaluate-packs/upcasts-a-bare-symbol-to-the-tuple-of-the-other-branch.yaml view
@@ -0,0 +1,68 @@+# SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+# SPDX-License-Identifier: MIT+---+# yamllint disable rule:line-length+# The fork of 'bytes.array' from #1914: one branch is a bare symbol, the other+# a tuple holding three symbols, so a lenient join cannot tell which of them+# the bare one pairs with. A 'rewrite' line spells the tuple as the call+# 'Φ.tuple( … )' it was made of, and the 'upcast' block takes '𝜎1' and that+# call as one pair. It casts the smaller of the two, the bare '𝜎1', into a+# copy of the call whose every symbol is read off '𝜎1' by a path, and passes+# the call through as it is (#1921). The 'join' line then pairs the two metas+# the block wrote symbol by symbol, through their arguments. The program reads 'length' off the answer and gets the symbol+# standing for either length.+symbolic: |+  - λ: L_fork+    morph:+      𝑛1: $.a+      𝑛2: $.b+    rewrite:+      𝑛3:+        of: 𝑛2+        rules:+          - name: called+            pattern: ⟦ tail ↦ 𝑒1, head ↦ 𝑒2, length ↦ 𝑒3, !B ⟧+            result: Φ.tuple( tail ↦ 𝑒1, head ↦ 𝑒2, length ↦ 𝑒3 )+    upcast:+      𝑛4: 𝑛1+      𝑛5: 𝑛3+    join:+      𝑛6: [𝑛4, 𝑛5]+    𝑛: 𝑛6+location: 'Q.y'+input: |+  ⟦+    tuple(tail, head, length) ↦ ⟦ empty ↦ ⟦⟧ ⟧,+    y ↦ ⟦+      a ↦ ⟦ λ ⤍ 𝜎1 ⟧,+      b ↦ Φ.tuple( tail ↦ ⟦ λ ⤍ 𝜎2 ⟧, head ↦ ⟦ λ ⤍ 𝜎3 ⟧, length ↦ ⟦ λ ⤍ 𝜎4 ⟧ ),+      λ ⤍ L_fork+    ⟧.length+  ⟧+result: '𝜎10:λ'+protocol: |+  𝕄(Φ.y):+    𝔼(L_fork):+      𝑛1·1 := 𝜎1:λ  # 𝕄(ξ.a)+      𝕄(Φ.a🌵1):+        𝑛·1·1 := Φ.tuple( tail ↦ 𝜎2:λ )+        𝑛·1·2 := 𝑛·1·1( head ↦ 𝜎3:λ )+        𝑛·1·3 := 𝑛·1·2( length ↦ 𝜎4:λ )+      𝑛2·1 := 𝑛·1·3  # 𝕄(ξ.b)+      𝑛3·1 := 𝑛·1·3  # 𝑛2+      upcast(𝜎1) := Φ.tuple( tail ↦ 𝜎5:λ, head ↦ 𝜎6:λ, length ↦ 𝜎7:λ )+        𝜎5 := 𝜎1.tail+        𝜎6 := 𝜎1.head+        𝜎7 := 𝜎1.length+      𝑛4·1 := Φ.tuple( tail ↦ 𝜎5:λ, head ↦ 𝜎6:λ, length ↦ 𝜎7:λ )  # 𝑛1+      𝑛5·1 := 𝑛·1·3  # 𝑛3+      𝔻(𝜎8:λ) ∈ { 𝔻(𝜎5:λ), 𝔻(𝜎2:λ) }+      𝔻(𝜎9:λ) ∈ { 𝔻(𝜎6:λ), 𝔻(𝜎3:λ) }+      𝔻(𝜎10:λ) ∈ { 𝔻(𝜎7:λ), 𝔻(𝜎4:λ) }+      𝑛6·1 := Φ.tuple( tail ↦ 𝜎8:λ, head ↦ 𝜎9:λ, length ↦ 𝜎10:λ )  # [𝑛4, 𝑛5]+      𝑛·1·4 := Φ.tuple( tail ↦ 𝜎8:λ, head ↦ 𝜎9:λ, length ↦ 𝜎10:λ )  # 𝑛+      𝕄(𝑛·1·4):+        𝑛·1·5 := Φ.tuple( tail ↦ 𝜎8:λ )+        𝑛·1·6 := 𝑛·1·5( head ↦ 𝜎9:λ )+        𝑛·1·7 := 𝑛·1·6( length ↦ 𝜎10:λ )+      𝑛·1·8 := 𝑛·1·7  # 𝕄(𝑛·1·4)
+ test-resources/evaluate-packs/upcasts-a-cut-branch-to-the-tuple-an-unfolded-branch-was-reminted-into.yaml view
@@ -0,0 +1,129 @@+# SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+# SPDX-License-Identifier: MIT+---+# yamllint disable rule:line-length+# The fork of 'bytes.array' from #1921, spelled as a pipeline. The left branch+# 'Φ.rec( ξ.n )' leads back to the same fork, so its 'unfold' line, which says+# 'defer: true', has '--acyclic=proven' cut the firing and answers the copy+# with the looped bare symbol '𝜎3'. The right branch is the 'with' object of+# a tuple, whose φ builds a copy of 'Φ.tuple' with three arguments; its+# 'unfold' line morphs that φ into the real tuple. The 'rewrite' line then+# shrinks the tuple into a call of 'Φ.tuple' with every argument reminted:+# the tail 'Φ.items' as a deferred copy, the head as the symbol '𝜎2' it ends+# in and the length as the symbol the firing of 'L_plus' answers (#1923);+# 'stay' and 'symbolize' see the unfolded term, the two lines of the 'upcast'+# block take the two terms as one pair and cast the smaller, the bare symbol,+# into the shape of the larger by the paths 'tail', 'head' and 'length', and+# the 'join' line pairs the two metas the block wrote symbol by symbol. The+# program reads 'length' off the answer.+symbolic: |+  - λ: L_fork+    morph:+      𝑛1: $.a+      𝑛2: $.b+    unfold:+      𝑛3: {of: 𝑛1, defer: true}+      𝑛4: {of: 𝑛2, defer: true}+    rewrite:+      𝑛5:+        of: 𝑛3+        rules: &shape+          - name: shrunk+            pattern: ⟦ tail ↦ 𝑒1, head ↦ 𝑒2, length ↦ 𝑒3, !B ⟧+            result: Φ.tuple( tail ↦ 𝑒4, head ↦ 𝑒5, length ↦ 𝑒6 )+            where:+              - meta: 𝑒4+                function: remint+                args: [𝑒1]+              - meta: 𝑒5+                function: remint+                args: [𝑒2]+              - meta: 𝑒6+                function: remint+                args: [𝑒3]+      𝑛6:+        of: 𝑛4+        rules: *shape+    stay:+      𝑛7: 𝑛5+      𝑛8: 𝑛6+    symbolize:+      𝑛9: 𝑛7+      𝑛10: 𝑛8+    upcast:+      𝑛11: 𝑛9+      𝑛12: 𝑛10+    join:+      𝑛13: [𝑛11, 𝑛12]+    𝑛: ⟦ φ ↦ 𝑛13 ⟧+  - λ: L_plus+    𝑛: Φ.number( φ ↦ ⟦ λ ⤍ 𝜎 ⟧ )+location: 'Q.y'+acyclic: proven+input: |+  ⟦+    fork(a, b) ↦ ⟦ λ ⤍ L_fork ⟧,+    tuple(tail, head, length) ↦ ⟦⟧,+    number(φ) ↦ ⟦ plus(x) ↦ ⟦ λ ⤍ L_plus ⟧ ⟧,+    items ↦ ⟦+      length ↦ Φ.number( ⟦ λ ⤍ 𝜎1 ⟧ ),+      with(ρ, x) ↦ ⟦ φ ↦ Φ.tuple( tail ↦ ξ.ρ, head ↦ ξ.x, length ↦ ξ.ρ.length.plus( 1 ) ) ⟧+    ⟧,+    rec(n) ↦ ⟦ φ ↦ Φ.fork( Φ.rec( ξ.n ), Φ.items.with( ξ.n ) ) ⟧,+    y ↦ Φ.rec( ⟦ φ ↦ ⟦ λ ⤍ 𝜎2 ⟧ ⟧ ).φ.φ.length+  ⟧+result: '𝜎11:λ'+protocol: |+  𝕄(Φ.y):+    𝑛·0·1 := Φ.rec( n ↦ 𝜎2:λ:φ )+    𝑛·0·2 := Φ.fork( a ↦ Φ.rec( 𝜎2:λ:φ ) )+    𝑛·0·3 := 𝑛·0·2( b ↦ Φ.items.with( 𝜎2:λ:φ ) )+    𝔼(L_fork):+      𝕄(Φ.a🌵0):+        𝑛·1·1 := Φ.rec( n ↦ 𝜎2:λ:φ )+      𝑛1·1 := 𝑛·1·1  # 𝕄(ξ.a)+      𝕄(Φ.a🌵1):+        𝑛·1·2 := Φ.items.with( x ↦ 𝜎2:λ:φ )+      𝑛2·1 := 𝑛·1·2  # 𝕄(ξ.b)+      𝕄(Φ.a🌵2):+        𝑛·1·3 := Φ.fork( a ↦ Φ.rec( 𝜎2:λ:φ ) )+        𝑛·1·4 := 𝑛·1·3( b ↦ Φ.items.with( 𝜎2:λ:φ ) )+      𝑛3·1 := 𝑛·1·4  # 𝕄(𝑛1.φ)+      looped(𝑛·1·4) := 𝜎3  # 𝔼(𝑛1), proven+      𝑛3·1 := 𝜎3:λ  # 𝔼(𝑛1)+      𝕄(Φ.a🌵3):+        𝑛·1·5 := Φ.tuple( tail ↦ Φ.items )+        𝑛·1·6 := 𝑛·1·5( head ↦ 𝜎2:λ:φ )+        𝑛·1·7 := 𝑛·1·6( length ↦ Φ.items.length.plus( 1 ) )+      𝑛4·1 := 𝑛·1·7  # 𝕄(𝑛2.φ)+      𝑛4·1 := 𝑛·1·7  # 𝔼(𝑛2)+      𝑛5·1 := 𝑛3·1  # 𝑛3+      deferred(𝜎4) := Φ.items  # 𝕄(Φ.items)+      𝕄(Φ.items.length.plus( 1 )):+        𝑛·1·8 := Φ.number( φ ↦ 𝜎1:λ )+        𝑛·1·9 := ⟦ x ↦ ∅, λ ⤍ L_plus ⟧( x ↦ 1 )+      𝔼(L_plus):  # 𝔼(Φ.items.length.plus( 1 ))+        𝑛·2·1 := Φ.number( φ ↦ 𝜎5:λ )  # 𝑛+        𝕄(𝑛·2·1):+          𝑛·2·2 := Φ.number( φ ↦ 𝜎5:λ )+        𝑛·2·3 := 𝑛·2·2  # 𝕄(𝑛·2·1)+      𝑛6·1 := Φ.tuple( tail ↦ 𝜎4:λ, head ↦ 𝜎2:λ, length ↦ 𝜎5:λ )  # 𝑛4+      𝑛7·1 := 𝑛5·1  # 𝑛5+      𝑛8·1 := Φ.tuple( tail ↦ 𝜎4:λ, head ↦ 𝜎2:λ, length ↦ 𝜎5:λ )  # 𝑛6+      𝑛9·1 := 𝑛7·1  # 𝑛7+      𝑛10·1 := Φ.tuple( tail ↦ 𝜎4:λ, head ↦ 𝜎2:λ, length ↦ 𝜎5:λ )  # 𝑛8+      upcast(𝜎3) := Φ.tuple( tail ↦ 𝜎6:λ, head ↦ 𝜎7:λ, length ↦ 𝜎8:λ )+        𝜎6 := 𝜎3.tail+        𝜎7 := 𝜎3.head+        𝜎8 := 𝜎3.length+      𝑛11·1 := Φ.tuple( tail ↦ 𝜎6:λ, head ↦ 𝜎7:λ, length ↦ 𝜎8:λ )  # 𝑛9+      𝑛12·1 := Φ.tuple( tail ↦ 𝜎4:λ, head ↦ 𝜎2:λ, length ↦ 𝜎5:λ )  # 𝑛10+      𝔻(𝜎9:λ) ∈ { 𝔻(𝜎6:λ), 𝔻(𝜎4:λ) }+      𝔻(𝜎10:λ) ∈ { 𝔻(𝜎7:λ), 𝔻(𝜎2:λ) }+      𝔻(𝜎11:λ) ∈ { 𝔻(𝜎8:λ), 𝔻(𝜎5:λ) }+      𝑛13·1 := Φ.tuple( tail ↦ 𝜎9:λ, head ↦ 𝜎10:λ, length ↦ 𝜎11:λ )  # [𝑛11, 𝑛12]+      𝑛·1·10 := Φ.tuple( tail ↦ 𝜎9:λ, head ↦ 𝜎10:λ, length ↦ 𝜎11:λ ):φ  # 𝑛+      𝑛·1·11 := Φ.tuple( tail ↦ 𝜎9:λ, head ↦ 𝜎10:λ, length ↦ 𝜎11:λ ):φ  # 𝕄(𝑛·1·10)+    𝑛·0·4 := Φ.tuple( tail ↦ 𝜎9:λ )+    𝑛·0·5 := 𝑛·0·4( head ↦ 𝜎10:λ )+    𝑛·0·6 := 𝑛·0·5( length ↦ 𝜎11:λ )
− test-resources/evaluate-packs/writes-the-reduced-branches-a-lenient-join-could-not-pair.yaml
@@ -1,34 +0,0 @@-# SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com-# SPDX-License-Identifier: MIT-----# yamllint disable rule:line-length-# A lenient entry morphs the φ of the branch that reads its own object, fires-# what it comes to and joins once more, but a symbol never joins a datum, so-# the firing gets stuck all the same. The protocol says why: 'unjoined(…)'-# closes the firing in place of the generic 'stuck(…)', and it carries the two-# branches as the last join saw them, the reduced one included (#1900).-symbolic: |-  - λ: L_eq-    𝑛: ⟦ φ ↦ ⟦ λ ⤍ 𝜎 ⟧ ⟧-  - λ: L_fork-    morph:-      𝑛1: $.a-      𝑛2: $.b-    join:-      𝑛3: [𝑛1, 𝑛2]-    lenient: true-    𝑛: 𝑛3-location: 'Q.y'-input: '⟦ y ↦ ⟦ a ↦ ⟦ φ ↦ ξ.eq, eq ↦ ⟦ λ ⤍ L_eq ⟧ ⟧, b ↦ ⟦ φ ↦ ⟦ Δ ⤍ 01- ⟧ ⟧, λ ⤍ L_fork ⟧.φ ⟧'-fails: "No entry of --symbolic answers the λ function 'L_fork'"-protocol: |-  𝕄(Φ.y):-    𝔼(L_fork):-      𝑛1·1 := ⟦ φ ↦ eq, eq ↦ L_eq:λ ⟧  # 𝕄(ξ.a)-      𝑛2·1 := 01-:Δ:φ  # 𝕄(ξ.b)-      𝑛1·1 := L_eq:λ  # 𝕄(𝑛1.φ)-      𝔼(L_eq):  # 𝔼(𝑛1)-        𝑛·2·1 := 𝜎1:λ:φ  # 𝑛-        𝑛·2·2 := 𝜎1:λ:φ  # 𝕄(𝑛·2·1)-      𝑛1·1 := 𝑛·2·2  # 𝔼(𝑛1)-      unjoined(L_fork)  # 𝜎1:λ:φ vs 01-:Δ:φ
+ test-resources/evaluate-packs/writes-the-unfolded-branches-a-join-could-not-pair.yaml view
@@ -0,0 +1,36 @@+# SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+# SPDX-License-Identifier: MIT+---+# yamllint disable rule:line-length+# An 'unfold' line morphs the φ of the branch that reads its own object and+# fires what it comes to, but a symbol never joins a datum, so the 'join'+# line that reads the answer gets stuck all the same. The protocol says why:+# 'unjoined(…)' closes the firing in place of the generic 'stuck(…)', and it+# carries the two branches as the join saw them, the unfolded one included+# (#1900, #1921).+symbolic: |+  - λ: L_eq+    𝑛: ⟦ φ ↦ ⟦ λ ⤍ 𝜎 ⟧ ⟧+  - λ: L_fork+    morph:+      𝑛1: $.a+      𝑛2: $.b+    unfold:+      𝑛3: 𝑛1+    join:+      𝑛4: [𝑛3, 𝑛2]+    𝑛: 𝑛4+location: 'Q.y'+input: '⟦ y ↦ ⟦ a ↦ ⟦ φ ↦ ξ.eq, eq ↦ ⟦ λ ⤍ L_eq ⟧ ⟧, b ↦ ⟦ φ ↦ ⟦ Δ ⤍ 01- ⟧ ⟧, λ ⤍ L_fork ⟧.φ ⟧'+fails: "No entry of --symbolic answers the λ function 'L_fork'"+protocol: |+  𝕄(Φ.y):+    𝔼(L_fork):+      𝑛1·1 := ⟦ φ ↦ eq, eq ↦ L_eq:λ ⟧  # 𝕄(ξ.a)+      𝑛2·1 := 01-:Δ:φ  # 𝕄(ξ.b)+      𝑛3·1 := L_eq:λ  # 𝕄(𝑛1.φ)+      𝔼(L_eq):  # 𝔼(𝑛1)+        𝑛·2·1 := 𝜎1:λ:φ  # 𝑛+        𝑛·2·2 := 𝜎1:λ:φ  # 𝕄(𝑛·2·1)+      𝑛3·1 := 𝑛·2·2  # 𝔼(𝑛1)+      unjoined(L_fork)  # 𝜎1:λ:φ vs 01-:Δ:φ
test/CLISpec.hs view
@@ -1328,7 +1328,7 @@       testCLISucceeded ["dataize", "--help"] ["Dataize the 𝜑-expression"]      it "names every block of a --symbolic entry in its help" $-      testCLISucceeded ["dataize", "--help"] ["\"dataize\"", "\"morph\"", "\"rewrite\"", "\"symbolize\"", "\"join\"", "\"lenient\"", "\"defer\"", "\"terminators\""]+      testCLISucceeded ["dataize", "--help"] ["\"dataize\"", "\"morph\"", "\"rewrite\"", "\"symbolize\"", "\"join\"", "\"lenient\"", "\"unfold\"", "\"upcast\"", "\"terminators\""]      it "dataizes simple expression" $       withStdin "[[ D> 01- ]]" $@@ -1415,10 +1415,11 @@             `shouldBe` [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"                        , "<dataize at=\"Φ.t\">"                        , "  <morph at=\"Φ.t\">"-                       , "    <applied meta=\"𝑛·0·1\" by=\"morph\" at=\"Φ.t\" of=\"Φ.cyc\"><attr name=\"x\">⟦⟧</attr></applied>"-                       , "    <applied meta=\"𝑛·0·2\" by=\"morph\" at=\"Φ.t\" of=\"Φ.cyc\"><attr name=\"x\">⟦⟧</attr></applied>"+                       , "    <formed meta=\"𝑛·0·1\"/>"+                       , "    <applied meta=\"𝑛·0·2\" by=\"morph\" at=\"Φ.t\" of=\"Φ.cyc\"><attr name=\"x\">𝑛·0·1</attr></applied>"+                       , "    <applied meta=\"𝑛·0·3\" by=\"morph\" at=\"Φ.t\" of=\"Φ.cyc\"><attr name=\"x\">𝑛·0·1</attr></applied>"                        , "  </morph>"-                       , "  <looped by=\"dataize\" match=\"proven\" at=\"Φ.t\"><e>𝑛·0·2</e></looped>"+                       , "  <looped by=\"dataize\" match=\"proven\" at=\"Φ.t\" of=\"𝑛·0·3\"/>"                        , "</dataize>"                        ] @@ -1540,13 +1541,13 @@             testCLISucceeded ["dataize", "--locator=Q.t", "--partial", "--protocol=" ++ path, "--abridged", "--sweet", "--hide-rho", "--quiet"] []           records <- readProtocol path           lines records `shouldContain` ["  unanswered(L_weit)  # 𝔻(⟦ λ ⤍ L_weit, +4 ⟧)"]-      it "folds a long formation in the XML protocol" $+      it "names a long formation in the XML protocol by its path rather than folding it" $         withTempFile "protocolXXXXXX.xml" $ \(path, stream) -> do           hClose stream           withStdin stuck $             testCLISucceeded ["dataize", "--locator=Q.t", "--partial", "--protocol=" ++ path, "--abridged", "--sweet", "--hide-rho", "--quiet"] []           records <- readProtocol path-          lines records `shouldContain` ["  <unanswered λ=\"L_weit\" by=\"dataize\">⟦ λ ⤍ L_weit, +4 ⟧</unanswered>"]+          lines records `shouldContain` ["  <unanswered λ=\"L_weit\" by=\"dataize\">Φ.t</unanswered>"]       forM_         [ ("textXXXXXX.txt", "      𝛿·1·1 := 01-02-..(8b)..-0B-0C")         , ("XMLXXXXXX.xml", "      <delta meta=\"𝛿·1·1\">01-02-..(8b)..-0B-0C</delta>")@@ -1862,7 +1863,7 @@             withStdin "⟦ y ↦ ⟦ a ↦ ⟦ l ↦ ⟦ λ ⤍ 𝜎1 ⟧ ⟧, b ↦ ⟦ l ↦ ⟦ λ ⤍ 𝜎2 ⟧, x ↦ ⟦⟧ ⟧, λ ⤍ L_fork ⟧.l ⟧" $               testCLISucceeded ["morph", "--symbolic=" ++ forks, "--locator=Q.y", "--partial", "--protocol=" ++ path, "--quiet", "--sweet", "--hide-rho"] []           records <- readProtocol path-          lines records `shouldContain` ["    <unjoined λ=\"L_fork\"><e>𝜎1:λ:l</e><e>⟦ l ↦ 𝜎2:λ, x ↦ ⟦⟧ ⟧</e></unjoined>"]+          lines records `shouldContain` ["    <unjoined λ=\"L_fork\">𝑛·1·1 𝑛·1·3</unjoined>"]        it "writes a starved step budget to the XML protocol" $         withTempFile "protocolXXXXXX.xml" $ \(path, stream) -> do@@ -1945,32 +1946,36 @@               `shouldBe` [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"                          , "<dataize at=\"Φ\">"                          , "  <morph at=\"Φ\">"-                         , "    <applied meta=\"𝑛·0·1\" by=\"morph\" at=\"Φ\" of=\"Φ.number\"><attr name=\"φ\">Φ.bytes( φ ↦ 40-14-00-00-00-00-00-00:Δ )</attr></applied>"-                         , "    <applied meta=\"𝑛·0·2\" by=\"morph\" at=\"Φ\" of=\"𝑛·0·1.plus\"><attr name=\"x\">6</attr></applied>"+                         , "    <applied meta=\"𝑛·0·1\" of=\"Φ.bytes\"><attr name=\"φ\">40-14-00-00-00-00-00-00</attr></applied>"+                         , "    <applied meta=\"𝑛·0·2\" by=\"morph\" at=\"Φ\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·1</attr></applied>"+                         , "    <applied meta=\"𝑛·0·3\" of=\"Φ.bytes\"><attr name=\"φ\">40-18-00-00-00-00-00-00</attr></applied>"+                         , "    <applied meta=\"𝑛·0·4\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·3</attr></applied>"+                         , "    <applied meta=\"𝑛·0·5\" by=\"morph\" at=\"Φ\" of=\"𝑛·0·2.plus\"><attr name=\"x\">𝑛·0·4</attr></applied>"                          , "  </morph>"                          , "  <evaluate λ=\"L_number_plus\" by=\"dataize\" at=\"Φ\">"                          , "    <dataize at=\"Φ.a🌵0\">"                          , "      <morph at=\"Φ.a🌵0\">"-                         , "        <applied meta=\"𝑛·1·1\" by=\"morph\" at=\"Φ.a🌵0\" of=\"Φ.number\"><attr name=\"φ\">Φ.bytes( φ ↦ 40-14-00-00-00-00-00-00:Δ )</attr></applied>"-                         , "        <applied meta=\"𝑛·1·2\" by=\"morph\" at=\"Φ.a🌵0\" of=\"Φ.bytes\"><attr name=\"φ\">40-14-00-00-00-00-00-00:Δ</attr></applied>"+                         , "        <applied meta=\"𝑛·1·1\" by=\"morph\" at=\"Φ.a🌵0\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·1</attr></applied>"+                         , "        <applied meta=\"𝑛·1·2\" by=\"morph\" at=\"Φ.a🌵0\" of=\"Φ.bytes\"><attr name=\"φ\">40-14-00-00-00-00-00-00</attr></applied>"                          , "      </morph>"                          , "      <delta meta=\"𝛿·1·1\" number=\"5.0\">40-14-00-00-00-00-00-00</delta>"                          , "    </dataize>"                          , "    <bind meta=\"𝛿1·1\">𝛿·1·1</bind>"                          , "    <dataize at=\"Φ.a🌵1\">"                          , "      <morph at=\"Φ.a🌵1\">"-                         , "        <applied meta=\"𝑛·1·3\" by=\"morph\" at=\"Φ.a🌵1\" of=\"Φ.number\"><attr name=\"φ\">Φ.bytes( φ ↦ 40-18-00-00-00-00-00-00:Δ )</attr></applied>"-                         , "        <applied meta=\"𝑛·1·4\" by=\"morph\" at=\"Φ.a🌵1\" of=\"Φ.bytes\"><attr name=\"φ\">40-18-00-00-00-00-00-00:Δ</attr></applied>"+                         , "        <applied meta=\"𝑛·1·3\" by=\"morph\" at=\"Φ.a🌵1\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·3</attr></applied>"+                         , "        <applied meta=\"𝑛·1·4\" by=\"morph\" at=\"Φ.a🌵1\" of=\"Φ.bytes\"><attr name=\"φ\">40-18-00-00-00-00-00-00</attr></applied>"                          , "      </morph>"                          , "      <delta meta=\"𝛿·1·2\" number=\"6.0\">40-18-00-00-00-00-00-00</delta>"                          , "    </dataize>"                          , "    <bind meta=\"𝛿2·1\">𝛿·1·2</bind>"                          , "    <minted symbol=\"𝜎1\">40-14-00-00-00-00-00-00 40-18-00-00-00-00-00-00</minted>"-                         , "    <built meta=\"𝑛·1·5\">Φ.number( φ ↦ 𝜎1:λ )</built>"-                         , "    <morph at=\"𝑛·1·5\">"-                         , "      <applied meta=\"𝑛·1·6\" by=\"morph\" at=\"𝑛·1·5\" of=\"Φ.number\"><attr name=\"φ\">𝜎1</attr></applied>"+                         , "    <applied meta=\"𝑛·1·5\" of=\"Φ.number\"><attr name=\"φ\">𝜎1</attr></applied>"+                         , "    <built meta=\"𝑛·1·6\">𝑛·1·5</built>"+                         , "    <morph at=\"𝑛·1·6\">"+                         , "      <applied meta=\"𝑛·1·7\" by=\"morph\" at=\"𝑛·1·6\" of=\"Φ.number\"><attr name=\"φ\">𝜎1</attr></applied>"                          , "    </morph>"-                         , "    <answer meta=\"𝑛·1·7\">𝑛·1·6</answer>"+                         , "    <answer meta=\"𝑛·1·8\">𝑛·1·7</answer>"                          , "  </evaluate>"                          , "</dataize>"                          ]@@ -2047,33 +2052,39 @@               `shouldBe` [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"                          , "<dataize at=\"Φ\">"                          , "  <morph at=\"Φ\">"-                         , "    <applied meta=\"𝑛·0·1\" by=\"morph\" at=\"Φ\" of=\"Φ.number\"><attr name=\"φ\">Φ.bytes( φ ↦ 40-14-00-00-00-00-00-00:Δ )</attr></applied>"-                         , "    <applied meta=\"𝑛·0·2\" by=\"morph\" at=\"Φ\" of=\"𝑛·0·1.plus\"><attr name=\"x\">6</attr></applied>"+                         , "    <applied meta=\"𝑛·0·1\" of=\"Φ.bytes\"><attr name=\"φ\">40-14-00-00-00-00-00-00</attr></applied>"+                         , "    <applied meta=\"𝑛·0·2\" by=\"morph\" at=\"Φ\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·1</attr></applied>"+                         , "    <applied meta=\"𝑛·0·3\" of=\"Φ.bytes\"><attr name=\"φ\">40-18-00-00-00-00-00-00</attr></applied>"+                         , "    <applied meta=\"𝑛·0·4\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·3</attr></applied>"+                         , "    <applied meta=\"𝑛·0·5\" by=\"morph\" at=\"Φ\" of=\"𝑛·0·2.plus\"><attr name=\"x\">𝑛·0·4</attr></applied>"                          , "    <evaluate λ=\"L_number_plus\" by=\"morph\" at=\"Φ\">"                          , "      <dataize at=\"Φ.a🌵0\">"                          , "        <morph at=\"Φ.a🌵0\">"-                         , "          <applied meta=\"𝑛·1·1\" by=\"morph\" at=\"Φ.a🌵0\" of=\"Φ.number\"><attr name=\"φ\">Φ.bytes( φ ↦ 40-14-00-00-00-00-00-00:Δ )</attr></applied>"-                         , "          <applied meta=\"𝑛·1·2\" by=\"morph\" at=\"Φ.a🌵0\" of=\"Φ.bytes\"><attr name=\"φ\">40-14-00-00-00-00-00-00:Δ</attr></applied>"+                         , "          <applied meta=\"𝑛·1·1\" by=\"morph\" at=\"Φ.a🌵0\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·1</attr></applied>"+                         , "          <applied meta=\"𝑛·1·2\" by=\"morph\" at=\"Φ.a🌵0\" of=\"Φ.bytes\"><attr name=\"φ\">40-14-00-00-00-00-00-00</attr></applied>"                          , "        </morph>"                          , "        <delta meta=\"𝛿·1·1\" number=\"5.0\">40-14-00-00-00-00-00-00</delta>"                          , "      </dataize>"                          , "      <bind meta=\"𝛿1·1\">𝛿·1·1</bind>"                          , "      <dataize at=\"Φ.a🌵1\">"                          , "        <morph at=\"Φ.a🌵1\">"-                         , "          <applied meta=\"𝑛·1·3\" by=\"morph\" at=\"Φ.a🌵1\" of=\"Φ.number\"><attr name=\"φ\">Φ.bytes( φ ↦ 40-18-00-00-00-00-00-00:Δ )</attr></applied>"-                         , "          <applied meta=\"𝑛·1·4\" by=\"morph\" at=\"Φ.a🌵1\" of=\"Φ.bytes\"><attr name=\"φ\">40-18-00-00-00-00-00-00:Δ</attr></applied>"+                         , "          <applied meta=\"𝑛·1·3\" by=\"morph\" at=\"Φ.a🌵1\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·3</attr></applied>"+                         , "          <applied meta=\"𝑛·1·4\" by=\"morph\" at=\"Φ.a🌵1\" of=\"Φ.bytes\"><attr name=\"φ\">40-18-00-00-00-00-00-00</attr></applied>"                          , "        </morph>"                          , "        <delta meta=\"𝛿·1·2\" number=\"6.0\">40-18-00-00-00-00-00-00</delta>"                          , "      </dataize>"                          , "      <bind meta=\"𝛿2·1\">𝛿·1·2</bind>"                          , "      <minted symbol=\"𝜎1\">40-14-00-00-00-00-00-00 40-18-00-00-00-00-00-00</minted>"-                         , "      <built meta=\"𝑛·1·5\">Φ.number( φ ↦ 𝜎1:λ )</built>"-                         , "      <morph at=\"𝑛·1·5\">"-                         , "        <applied meta=\"𝑛·1·6\" by=\"morph\" at=\"𝑛·1·5\" of=\"Φ.number\"><attr name=\"φ\">𝜎1</attr></applied>"+                         , "      <applied meta=\"𝑛·1·5\" of=\"Φ.number\"><attr name=\"φ\">𝜎1</attr></applied>"+                         , "      <built meta=\"𝑛·1·6\">𝑛·1·5</built>"+                         , "      <morph at=\"𝑛·1·6\">"+                         , "        <applied meta=\"𝑛·1·7\" by=\"morph\" at=\"𝑛·1·6\" of=\"Φ.number\"><attr name=\"φ\">𝜎1</attr></applied>"                          , "      </morph>"-                         , "      <answer meta=\"𝑛·1·7\">𝑛·1·6</answer>"+                         , "      <answer meta=\"𝑛·1·8\">𝑛·1·7</answer>"                          , "    </evaluate>"-                         , "    <applied meta=\"𝑛·0·3\" by=\"morph\" at=\"Φ\" of=\"𝑛·1·6.plus\"><attr name=\"x\">7</attr></applied>"+                         , "    <applied meta=\"𝑛·0·6\" of=\"Φ.bytes\"><attr name=\"φ\">40-1C-00-00-00-00-00-00</attr></applied>"+                         , "    <applied meta=\"𝑛·0·7\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·6</attr></applied>"+                         , "    <applied meta=\"𝑛·0·8\" by=\"morph\" at=\"Φ\" of=\"𝑛·1·7.plus\"><attr name=\"x\">𝑛·0·7</attr></applied>"                          , "  </morph>"                          , "  <evaluate λ=\"L_number_plus\" by=\"dataize\" at=\"Φ\">"                          , "    <dataize at=\"Φ.a🌵2\">"@@ -2081,21 +2092,22 @@                          , "        <applied meta=\"𝑛·2·1\" by=\"morph\" at=\"Φ.a🌵2\" of=\"Φ.number\"><attr name=\"φ\">𝜎1</attr></applied>"                          , "      </morph>"                          , "    </dataize>"-                         , "    <dataize meta=\"𝛿1·2\">𝜎1:λ</dataize>"+                         , "    <dataize meta=\"𝛿1·2\">𝜎1</dataize>"                          , "    <dataize at=\"Φ.a🌵3\">"                          , "      <morph at=\"Φ.a🌵3\">"-                         , "        <applied meta=\"𝑛·2·2\" by=\"morph\" at=\"Φ.a🌵3\" of=\"Φ.number\"><attr name=\"φ\">Φ.bytes( φ ↦ 40-1C-00-00-00-00-00-00:Δ )</attr></applied>"-                         , "        <applied meta=\"𝑛·2·3\" by=\"morph\" at=\"Φ.a🌵3\" of=\"Φ.bytes\"><attr name=\"φ\">40-1C-00-00-00-00-00-00:Δ</attr></applied>"+                         , "        <applied meta=\"𝑛·2·2\" by=\"morph\" at=\"Φ.a🌵3\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·6</attr></applied>"+                         , "        <applied meta=\"𝑛·2·3\" by=\"morph\" at=\"Φ.a🌵3\" of=\"Φ.bytes\"><attr name=\"φ\">40-1C-00-00-00-00-00-00</attr></applied>"                          , "      </morph>"                          , "      <delta meta=\"𝛿·2·1\" number=\"7.0\">40-1C-00-00-00-00-00-00</delta>"                          , "    </dataize>"                          , "    <bind meta=\"𝛿2·2\">𝛿·2·1</bind>"                          , "    <minted symbol=\"𝜎2\">𝜎1 40-1C-00-00-00-00-00-00</minted>"-                         , "    <built meta=\"𝑛·2·4\">Φ.number( φ ↦ 𝜎2:λ )</built>"-                         , "    <morph at=\"𝑛·2·4\">"-                         , "      <applied meta=\"𝑛·2·5\" by=\"morph\" at=\"𝑛·2·4\" of=\"Φ.number\"><attr name=\"φ\">𝜎2</attr></applied>"+                         , "    <applied meta=\"𝑛·2·4\" of=\"Φ.number\"><attr name=\"φ\">𝜎2</attr></applied>"+                         , "    <built meta=\"𝑛·2·5\">𝑛·2·4</built>"+                         , "    <morph at=\"𝑛·2·5\">"+                         , "      <applied meta=\"𝑛·2·6\" by=\"morph\" at=\"𝑛·2·5\" of=\"Φ.number\"><attr name=\"φ\">𝜎2</attr></applied>"                          , "    </morph>"-                         , "    <answer meta=\"𝑛·2·6\">𝑛·2·5</answer>"+                         , "    <answer meta=\"𝑛·2·7\">𝑛·2·6</answer>"                          , "  </evaluate>"                          , "</dataize>"                          ]@@ -2111,11 +2123,12 @@               `shouldBe` [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"                          , "<morph at=\"Φ.y\">"                          , "  <evaluate λ=\"L_stand\" by=\"morph\" at=\"Φ.y\">"-                         , "    <bind meta=\"𝑛1·1\">01-:Δ</bind>"+                         , "    <bind meta=\"𝑛1·1\">01-</bind>"                          , "    <known symbol=\"𝜎1\">01-</known>"-                         , "    <bind meta=\"𝑛2·1\">𝜎1:λ</bind>"-                         , "    <built meta=\"𝑛·1·1\">𝜎1:λ:z</built>"-                         , "    <answer meta=\"𝑛·1·2\">𝜎1:λ:z</answer>"+                         , "    <bind meta=\"𝑛2·1\">𝜎1</bind>"+                         , "    <formed meta=\"𝑛·1·1\"><attr name=\"z\">𝜎1</attr></formed>"+                         , "    <built meta=\"𝑛·1·2\">𝑛·1·1</built>"+                         , "    <answer meta=\"𝑛·1·3\">𝑛·1·1</answer>"                          , "  </evaluate>"                          , "</morph>"                          ]@@ -2131,12 +2144,15 @@               `shouldBe` [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"                          , "<morph at=\"Φ.y\">"                          , "  <evaluate λ=\"L_fork\" by=\"morph\" at=\"Φ.y\">"-                         , "    <bind meta=\"𝑛1·1\">𝜎1:λ:φ</bind>"-                         , "    <bind meta=\"𝑛2·1\">𝜎2:λ:φ</bind>"+                         , "    <formed meta=\"𝑛·1·1\"><attr name=\"φ\">𝜎1</attr></formed>"+                         , "    <bind meta=\"𝑛1·1\">𝑛·1·1</bind>"+                         , "    <formed meta=\"𝑛·1·2\"><attr name=\"φ\">𝜎2</attr></formed>"+                         , "    <bind meta=\"𝑛2·1\">𝑛·1·2</bind>"                          , "    <joined symbol=\"𝜎3\">𝜎1 𝜎2</joined>"-                         , "    <bind meta=\"𝑛3·1\">𝜎3:λ:φ</bind>"-                         , "    <built meta=\"𝑛·1·1\">𝜎3:λ:φ</built>"-                         , "    <answer meta=\"𝑛·1·2\">𝜎3:λ:φ</answer>"+                         , "    <formed meta=\"𝑛·1·3\"><attr name=\"φ\">𝜎3</attr></formed>"+                         , "    <bind meta=\"𝑛3·1\">𝑛·1·3</bind>"+                         , "    <built meta=\"𝑛·1·4\">𝑛·1·3</built>"+                         , "    <answer meta=\"𝑛·1·5\">𝑛·1·3</answer>"                          , "  </evaluate>"                          , "</morph>"                          ]@@ -2152,13 +2168,14 @@               `shouldBe` [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"                          , "<morph at=\"Φ.y\">"                          , "  <evaluate λ=\"L_fork\" by=\"morph\" at=\"Φ.y\">"-                         , "    <dataize meta=\"𝛿1·1\">𝜎1:λ</dataize>"-                         , "    <bind meta=\"𝑛1·1\">𝜎2:λ:φ</bind>"+                         , "    <dataize meta=\"𝛿1·1\">𝜎1</dataize>"+                         , "    <formed meta=\"𝑛·1·1\"><attr name=\"φ\">𝜎2</attr></formed>"+                         , "    <bind meta=\"𝑛1·1\">𝑛·1·1</bind>"                          , "    <bind meta=\"𝑛2·1\">⊥</bind>"                          , "    <terminate symbol=\"𝜎1\" branch=\"right\"/>"-                         , "    <bind meta=\"𝑛3·1\">𝜎2:λ:φ</bind>"-                         , "    <built meta=\"𝑛·1·1\">𝜎2:λ:φ</built>"-                         , "    <answer meta=\"𝑛·1·2\">𝜎2:λ:φ</answer>"+                         , "    <bind meta=\"𝑛3·1\">𝑛·1·1</bind>"+                         , "    <built meta=\"𝑛·1·2\">𝑛·1·1</built>"+                         , "    <answer meta=\"𝑛·1·3\">𝑛·1·1</answer>"                          , "  </evaluate>"                          , "</morph>"                          ]@@ -2174,11 +2191,12 @@               `shouldBe` [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"                          , "<morph at=\"Φ.y\">"                          , "  <evaluate λ=\"L_pair\" by=\"morph\" at=\"Φ.y\">"-                         , "    <bind meta=\"𝑛1·1\">01-:Δ</bind>"+                         , "    <bind meta=\"𝑛1·1\">01-</bind>"                          , "    <minted symbol=\"𝜎1\"/>"                          , "    <minted symbol=\"𝜎2\"/>"-                         , "    <built meta=\"𝑛·1·1\">⟦ left ↦ 𝜎1:λ, right ↦ 𝜎2:λ ⟧</built>"-                         , "    <answer meta=\"𝑛·1·2\">⟦ left ↦ 𝜎1:λ, right ↦ 𝜎2:λ ⟧</answer>"+                         , "    <formed meta=\"𝑛·1·1\"><attr name=\"left\">𝜎1</attr><attr name=\"right\">𝜎2</attr></formed>"+                         , "    <built meta=\"𝑛·1·2\">𝑛·1·1</built>"+                         , "    <answer meta=\"𝑛·1·3\">𝑛·1·1</answer>"                          , "  </evaluate>"                          , "</morph>"                          ]@@ -2194,13 +2212,41 @@               `shouldBe` [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"                          , "<morph at=\"Φ.y\">"                          , "  <evaluate λ=\"L_keep\" by=\"morph\" at=\"Φ.y\">"-                         , "    <bind meta=\"𝑛1·1\">01-:Δ</bind>"-                         , "    <built meta=\"𝑛·1·1\">01-:Δ:z</built>"-                         , "    <answer meta=\"𝑛·1·2\">01-:Δ:z</answer>"+                         , "    <bind meta=\"𝑛1·1\">01-</bind>"+                         , "    <formed meta=\"𝑛·1·1\"><attr name=\"z\">01-</attr></formed>"+                         , "    <built meta=\"𝑛·1·2\">𝑛·1·1</built>"+                         , "    <answer meta=\"𝑛·1·3\">𝑛·1·1</answer>"                          , "  </evaluate>"                          , "</morph>"                          ] +        it "writes the copy of an object of the world a 'remint' step deferred, naming every argument by a symbol" $+          withTempFile "protocolXXXXXX.xml" $ \(path, stream) -> do+            hClose stream+            withLambdasOf (T.pack "- λ: L_shrink\n  morph:\n    𝑛1: $.x\n  rewrite:\n    𝑛2:\n      of: 𝑛1\n      rules:\n        - name: small\n          pattern: ⟦ !B1, tail ↦ 𝑒1, !B2 ⟧\n          result: ⟦ !B1, tail ↦ 𝑒2, !B2 ⟧\n          where:\n            - meta: 𝑒2\n              function: remint\n              args: [𝑒1]\n  terminators: [L_throw]\n  𝑛: 𝑛2\n") $ \shrinks ->+              withStdin "⟦ l/ ↦ ⟦ throw(message) ↦ ⟦ λ ⤍ L_throw ⟧ ⟧, y ↦ ⟦ x ↦ ⟦ tail ↦ Φ.l/.throw( message ↦ ⟦ Δ ⤍ 4B- ⟧ ) ⟧, λ ⤍ L_shrink ⟧.tail ⟧" $+                testCLISucceeded ["morph", "--symbolic=" ++ shrinks, "--locator=Q.y", "--protocol=" ++ path, "--quiet", "--sweet", "--hide-rho"] []+            records <- readProtocol path+            lines records `shouldContain` ["    <deferred symbol=\"𝜎2\" by=\"morph\" at=\"𝑛·1·1\" of=\"Φ.l/.throw\"><with><attr name=\"message\">𝜎1</attr></with></deferred>"]++        it "writes the path of every symbol an upcast block cast a bare symbol into" $+          withTempFile "protocolXXXXXX.xml" $ \(path, stream) -> do+            hClose stream+            withLambdasOf (T.pack "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  upcast:\n    𝑛3: 𝑛2\n    𝑛4: 𝑛1\n  join:\n    𝑛5: [𝑛3, 𝑛4]\n  𝑛: 𝑛5\n") $ \forks ->+              withStdin "⟦ y ↦ ⟦ a ↦ ⟦ λ ⤍ 𝜎1 ⟧, b ↦ ⟦ sh ↦ ⟦ λ ⤍ 𝜎2 ⟧, zj ↦ ⟦ λ ⤍ 𝜎3 ⟧ ⟧, λ ⤍ L_fork ⟧.φ ⟧" $+                testCLISucceeded ["morph", "--symbolic=" ++ forks, "--locator=Q.y", "--protocol=" ++ path, "--quiet", "--sweet", "--hide-rho"] []+            records <- readProtocol path+            lines records `shouldContain` ["    <upcast symbol=\"𝜎1\" of=\"𝑛·1·2\"><path symbol=\"𝜎4\">sh</path><path symbol=\"𝜎5\">zj</path></upcast>"]++        it "binds both metas of an upcast block, the cast under the line that read the bare symbol" $+          withTempFile "protocolXXXXXX.xml" $ \(path, stream) -> do+            hClose stream+            withLambdasOf (T.pack "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  upcast:\n    𝑛3: 𝑛2\n    𝑛4: 𝑛1\n  join:\n    𝑛5: [𝑛3, 𝑛4]\n  𝑛: 𝑛5\n") $ \forks ->+              withStdin "⟦ y ↦ ⟦ a ↦ ⟦ λ ⤍ 𝜎1 ⟧, b ↦ ⟦ sh ↦ ⟦ λ ⤍ 𝜎2 ⟧, zj ↦ ⟦ λ ⤍ 𝜎3 ⟧ ⟧, λ ⤍ L_fork ⟧.φ ⟧" $+                testCLISucceeded ["morph", "--symbolic=" ++ forks, "--locator=Q.y", "--protocol=" ++ path, "--quiet", "--sweet", "--hide-rho"] []+            records <- readProtocol path+            filter (isInfixOf "<bind meta=\"𝑛3·1\"") (lines records) ++ filter (isInfixOf "<bind meta=\"𝑛4·1\"") (lines records) `shouldBe` ["    <bind meta=\"𝑛3·1\">𝑛·1·1</bind>", "    <bind meta=\"𝑛4·1\">𝑛·1·2</bind>"]+         it "nests a firing an operand took inside the firing that asked" $           withTempFile "protocolXXXXXX.xml" $ \(path, stream) -> do             hClose stream@@ -2211,55 +2257,63 @@               `shouldBe` [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"                          , "<dataize at=\"Φ\">"                          , "  <morph at=\"Φ\">"-                         , "    <applied meta=\"𝑛·0·1\" by=\"morph\" at=\"Φ\" of=\"Φ.number\"><attr name=\"φ\">Φ.bytes( φ ↦ 40-14-00-00-00-00-00-00:Δ )</attr></applied>"-                         , "    <applied meta=\"𝑛·0·2\" by=\"morph\" at=\"Φ\" of=\"𝑛·0·1.plus\"><attr name=\"x\">6.plus( 7 )</attr></applied>"+                         , "    <applied meta=\"𝑛·0·1\" of=\"Φ.bytes\"><attr name=\"φ\">40-14-00-00-00-00-00-00</attr></applied>"+                         , "    <applied meta=\"𝑛·0·2\" by=\"morph\" at=\"Φ\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·1</attr></applied>"+                         , "    <applied meta=\"𝑛·0·3\" of=\"Φ.bytes\"><attr name=\"φ\">40-18-00-00-00-00-00-00</attr></applied>"+                         , "    <applied meta=\"𝑛·0·4\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·3</attr></applied>"+                         , "    <applied meta=\"𝑛·0·5\" of=\"Φ.bytes\"><attr name=\"φ\">40-1C-00-00-00-00-00-00</attr></applied>"+                         , "    <applied meta=\"𝑛·0·6\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·5</attr></applied>"+                         , "    <applied meta=\"𝑛·0·7\" of=\"𝑛·0·4.plus\"><attr name=\"α0\">𝑛·0·6</attr></applied>"+                         , "    <applied meta=\"𝑛·0·8\" by=\"morph\" at=\"Φ\" of=\"𝑛·0·2.plus\"><attr name=\"x\">𝑛·0·7</attr></applied>"                          , "  </morph>"                          , "  <evaluate λ=\"L_number_plus\" by=\"dataize\" at=\"Φ\">"                          , "    <dataize at=\"Φ.a🌵0\">"                          , "      <morph at=\"Φ.a🌵0\">"-                         , "        <applied meta=\"𝑛·1·1\" by=\"morph\" at=\"Φ.a🌵0\" of=\"Φ.number\"><attr name=\"φ\">Φ.bytes( φ ↦ 40-14-00-00-00-00-00-00:Δ )</attr></applied>"-                         , "        <applied meta=\"𝑛·1·2\" by=\"morph\" at=\"Φ.a🌵0\" of=\"Φ.bytes\"><attr name=\"φ\">40-14-00-00-00-00-00-00:Δ</attr></applied>"+                         , "        <applied meta=\"𝑛·1·1\" by=\"morph\" at=\"Φ.a🌵0\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·1</attr></applied>"+                         , "        <applied meta=\"𝑛·1·2\" by=\"morph\" at=\"Φ.a🌵0\" of=\"Φ.bytes\"><attr name=\"φ\">40-14-00-00-00-00-00-00</attr></applied>"                          , "      </morph>"                          , "      <delta meta=\"𝛿·1·1\" number=\"5.0\">40-14-00-00-00-00-00-00</delta>"                          , "    </dataize>"                          , "    <bind meta=\"𝛿1·1\">𝛿·1·1</bind>"                          , "    <dataize at=\"Φ.a🌵1\">"                          , "      <morph at=\"Φ.a🌵1\">"-                         , "        <applied meta=\"𝑛·1·3\" by=\"morph\" at=\"Φ.a🌵1\" of=\"Φ.number\"><attr name=\"φ\">Φ.bytes( φ ↦ 40-18-00-00-00-00-00-00:Δ )</attr></applied>"-                         , "        <applied meta=\"𝑛·1·4\" by=\"morph\" at=\"Φ.a🌵1\" of=\"𝑛·1·3.plus\"><attr name=\"x\">7</attr></applied>"+                         , "        <applied meta=\"𝑛·1·3\" by=\"morph\" at=\"Φ.a🌵1\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·3</attr></applied>"+                         , "        <applied meta=\"𝑛·1·4\" by=\"morph\" at=\"Φ.a🌵1\" of=\"𝑛·1·3.plus\"><attr name=\"x\">𝑛·0·6</attr></applied>"                          , "      </morph>"                          , "      <evaluate λ=\"L_number_plus\" by=\"dataize\" at=\"Φ.a🌵1\">"                          , "        <dataize at=\"Φ.a🌵2\">"                          , "          <morph at=\"Φ.a🌵2\">"-                         , "            <applied meta=\"𝑛·2·1\" by=\"morph\" at=\"Φ.a🌵2\" of=\"Φ.number\"><attr name=\"φ\">Φ.bytes( φ ↦ 40-18-00-00-00-00-00-00:Δ )</attr></applied>"-                         , "            <applied meta=\"𝑛·2·2\" by=\"morph\" at=\"Φ.a🌵2\" of=\"Φ.bytes\"><attr name=\"φ\">40-18-00-00-00-00-00-00:Δ</attr></applied>"+                         , "            <applied meta=\"𝑛·2·1\" by=\"morph\" at=\"Φ.a🌵2\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·3</attr></applied>"+                         , "            <applied meta=\"𝑛·2·2\" by=\"morph\" at=\"Φ.a🌵2\" of=\"Φ.bytes\"><attr name=\"φ\">40-18-00-00-00-00-00-00</attr></applied>"                          , "          </morph>"                          , "          <delta meta=\"𝛿·2·1\" number=\"6.0\">40-18-00-00-00-00-00-00</delta>"                          , "        </dataize>"                          , "        <bind meta=\"𝛿1·2\">𝛿·2·1</bind>"                          , "        <dataize at=\"Φ.a🌵3\">"                          , "          <morph at=\"Φ.a🌵3\">"-                         , "            <applied meta=\"𝑛·2·3\" by=\"morph\" at=\"Φ.a🌵3\" of=\"Φ.number\"><attr name=\"φ\">Φ.bytes( φ ↦ 40-1C-00-00-00-00-00-00:Δ )</attr></applied>"-                         , "            <applied meta=\"𝑛·2·4\" by=\"morph\" at=\"Φ.a🌵3\" of=\"Φ.bytes\"><attr name=\"φ\">40-1C-00-00-00-00-00-00:Δ</attr></applied>"+                         , "            <applied meta=\"𝑛·2·3\" by=\"morph\" at=\"Φ.a🌵3\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·5</attr></applied>"+                         , "            <applied meta=\"𝑛·2·4\" by=\"morph\" at=\"Φ.a🌵3\" of=\"Φ.bytes\"><attr name=\"φ\">40-1C-00-00-00-00-00-00</attr></applied>"                          , "          </morph>"                          , "          <delta meta=\"𝛿·2·2\" number=\"7.0\">40-1C-00-00-00-00-00-00</delta>"                          , "        </dataize>"                          , "        <bind meta=\"𝛿2·2\">𝛿·2·2</bind>"                          , "        <minted symbol=\"𝜎1\">40-18-00-00-00-00-00-00 40-1C-00-00-00-00-00-00</minted>"-                         , "        <built meta=\"𝑛·2·5\">Φ.number( φ ↦ 𝜎1:λ )</built>"-                         , "        <morph at=\"𝑛·2·5\">"-                         , "          <applied meta=\"𝑛·2·6\" by=\"morph\" at=\"𝑛·2·5\" of=\"Φ.number\"><attr name=\"φ\">𝜎1</attr></applied>"+                         , "        <applied meta=\"𝑛·2·5\" of=\"Φ.number\"><attr name=\"φ\">𝜎1</attr></applied>"+                         , "        <built meta=\"𝑛·2·6\">𝑛·2·5</built>"+                         , "        <morph at=\"𝑛·2·6\">"+                         , "          <applied meta=\"𝑛·2·7\" by=\"morph\" at=\"𝑛·2·6\" of=\"Φ.number\"><attr name=\"φ\">𝜎1</attr></applied>"                          , "        </morph>"-                         , "        <answer meta=\"𝑛·2·7\">𝑛·2·6</answer>"+                         , "        <answer meta=\"𝑛·2·8\">𝑛·2·7</answer>"                          , "      </evaluate>"                          , "    </dataize>"-                         , "    <dataize meta=\"𝛿2·1\">𝜎1:λ</dataize>"+                         , "    <dataize meta=\"𝛿2·1\">𝜎1</dataize>"                          , "    <minted symbol=\"𝜎2\">40-14-00-00-00-00-00-00 𝜎1</minted>"-                         , "    <built meta=\"𝑛·1·5\">Φ.number( φ ↦ 𝜎2:λ )</built>"-                         , "    <morph at=\"𝑛·1·5\">"-                         , "      <applied meta=\"𝑛·1·6\" by=\"morph\" at=\"𝑛·1·5\" of=\"Φ.number\"><attr name=\"φ\">𝜎2</attr></applied>"+                         , "    <applied meta=\"𝑛·1·5\" of=\"Φ.number\"><attr name=\"φ\">𝜎2</attr></applied>"+                         , "    <built meta=\"𝑛·1·6\">𝑛·1·5</built>"+                         , "    <morph at=\"𝑛·1·6\">"+                         , "      <applied meta=\"𝑛·1·7\" by=\"morph\" at=\"𝑛·1·6\" of=\"Φ.number\"><attr name=\"φ\">𝜎2</attr></applied>"                          , "    </morph>"-                         , "    <answer meta=\"𝑛·1·7\">𝑛·1·6</answer>"+                         , "    <answer meta=\"𝑛·1·8\">𝑛·1·7</answer>"                          , "  </evaluate>"                          , "</dataize>"                          ]@@ -2274,34 +2328,38 @@               `shouldBe` [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"                          , "<dataize at=\"Φ\">"                          , "  <morph at=\"Φ\">"-                         , "    <applied meta=\"𝑛·0·1\" by=\"morph\" at=\"Φ\" of=\"Φ.number\"><attr name=\"φ\">Φ.bytes( φ ↦ 40-00-00-00-00-00-00-00:Δ )</attr></applied>"-                         , "    <applied meta=\"𝑛·0·2\" by=\"morph\" at=\"Φ\" of=\"𝑛·0·1.times\"><attr name=\"x\">3</attr></applied>"+                         , "    <applied meta=\"𝑛·0·1\" of=\"Φ.bytes\"><attr name=\"φ\">40-00-00-00-00-00-00-00</attr></applied>"+                         , "    <applied meta=\"𝑛·0·2\" by=\"morph\" at=\"Φ\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·1</attr></applied>"+                         , "    <applied meta=\"𝑛·0·3\" of=\"Φ.bytes\"><attr name=\"φ\">40-08-00-00-00-00-00-00</attr></applied>"+                         , "    <applied meta=\"𝑛·0·4\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·3</attr></applied>"+                         , "    <applied meta=\"𝑛·0·5\" by=\"morph\" at=\"Φ\" of=\"𝑛·0·2.times\"><attr name=\"x\">𝑛·0·4</attr></applied>"                          , "    <evaluate λ=\"L_number_times\" by=\"morph\" at=\"Φ\">"                          , "      <dataize at=\"Φ.a🌵0\">"                          , "        <morph at=\"Φ.a🌵0\">"-                         , "          <applied meta=\"𝑛·1·1\" by=\"morph\" at=\"Φ.a🌵0\" of=\"Φ.number\"><attr name=\"φ\">Φ.bytes( φ ↦ 40-00-00-00-00-00-00-00:Δ )</attr></applied>"-                         , "          <applied meta=\"𝑛·1·2\" by=\"morph\" at=\"Φ.a🌵0\" of=\"Φ.bytes\"><attr name=\"φ\">40-00-00-00-00-00-00-00:Δ</attr></applied>"+                         , "          <applied meta=\"𝑛·1·1\" by=\"morph\" at=\"Φ.a🌵0\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·1</attr></applied>"+                         , "          <applied meta=\"𝑛·1·2\" by=\"morph\" at=\"Φ.a🌵0\" of=\"Φ.bytes\"><attr name=\"φ\">40-00-00-00-00-00-00-00</attr></applied>"                          , "        </morph>"                          , "        <delta meta=\"𝛿·1·1\" number=\"2.0\">40-00-00-00-00-00-00-00</delta>"                          , "      </dataize>"                          , "      <bind meta=\"𝛿1·1\">𝛿·1·1</bind>"                          , "      <dataize at=\"Φ.a🌵1\">"                          , "        <morph at=\"Φ.a🌵1\">"-                         , "          <applied meta=\"𝑛·1·3\" by=\"morph\" at=\"Φ.a🌵1\" of=\"Φ.number\"><attr name=\"φ\">Φ.bytes( φ ↦ 40-08-00-00-00-00-00-00:Δ )</attr></applied>"-                         , "          <applied meta=\"𝑛·1·4\" by=\"morph\" at=\"Φ.a🌵1\" of=\"Φ.bytes\"><attr name=\"φ\">40-08-00-00-00-00-00-00:Δ</attr></applied>"+                         , "          <applied meta=\"𝑛·1·3\" by=\"morph\" at=\"Φ.a🌵1\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·3</attr></applied>"+                         , "          <applied meta=\"𝑛·1·4\" by=\"morph\" at=\"Φ.a🌵1\" of=\"Φ.bytes\"><attr name=\"φ\">40-08-00-00-00-00-00-00</attr></applied>"                          , "        </morph>"                          , "        <delta meta=\"𝛿·1·2\" number=\"3.0\">40-08-00-00-00-00-00-00</delta>"                          , "      </dataize>"                          , "      <bind meta=\"𝛿2·1\">𝛿·1·2</bind>"                          , "      <minted symbol=\"𝜎1\">40-00-00-00-00-00-00-00 40-08-00-00-00-00-00-00</minted>"-                         , "      <built meta=\"𝑛·1·5\">Φ.number( φ ↦ 𝜎1:λ )</built>"-                         , "      <morph at=\"𝑛·1·5\">"-                         , "        <applied meta=\"𝑛·1·6\" by=\"morph\" at=\"𝑛·1·5\" of=\"Φ.number\"><attr name=\"φ\">𝜎1</attr></applied>"+                         , "      <applied meta=\"𝑛·1·5\" of=\"Φ.number\"><attr name=\"φ\">𝜎1</attr></applied>"+                         , "      <built meta=\"𝑛·1·6\">𝑛·1·5</built>"+                         , "      <morph at=\"𝑛·1·6\">"+                         , "        <applied meta=\"𝑛·1·7\" by=\"morph\" at=\"𝑛·1·6\" of=\"Φ.number\"><attr name=\"φ\">𝜎1</attr></applied>"                          , "      </morph>"-                         , "      <answer meta=\"𝑛·1·7\">𝑛·1·6</answer>"+                         , "      <answer meta=\"𝑛·1·8\">𝑛·1·7</answer>"                          , "    </evaluate>"                          , "  </morph>"-                         , "  <unanswered λ=\"L_number_nope\" by=\"dataize\">L_number_nope:λ</unanswered>"+                         , "  <unanswered λ=\"L_number_nope\" by=\"dataize\">𝑛·1·7.nope</unanswered>"                          , "</dataize>"                          ] @@ -2314,7 +2372,8 @@             lines records               `shouldBe` [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"                          , "<morph at=\"Φ.x\">"-                         , "  <unanswered λ=\"L_number_nope\" by=\"morph\">⟦ λ ⤍ L_number_nope ⟧</unanswered>"+                         , "  <formed meta=\"𝑛·0·1\" λ=\"L_number_nope\"/>"+                         , "  <unanswered λ=\"L_number_nope\" by=\"morph\">𝑛·0·1</unanswered>"                          , "</morph>"                          ] @@ -2328,34 +2387,38 @@               `shouldBe` [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"                          , "<dataize at=\"Φ\">"                          , "  <morph at=\"Φ\">"-                         , "    <applied meta=\"𝑛·0·1\" by=\"morph\" at=\"Φ\" of=\"Φ.number\"><attr name=\"φ\">Φ.bytes( φ ↦ ⟦ Δ ⤍ 40-00-00-00-00-00-00-00 ⟧ )</attr></applied>"-                         , "    <applied meta=\"𝑛·0·2\" by=\"morph\" at=\"Φ\" of=\"𝑛·0·1.times\"><attr name=\"x\">Φ.number( φ ↦ Φ.bytes( φ ↦ ⟦ Δ ⤍ 40-08-00-00-00-00-00-00 ⟧ ) )</attr></applied>"+                         , "    <applied meta=\"𝑛·0·1\" of=\"Φ.bytes\"><attr name=\"φ\">40-00-00-00-00-00-00-00</attr></applied>"+                         , "    <applied meta=\"𝑛·0·2\" by=\"morph\" at=\"Φ\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·1</attr></applied>"+                         , "    <applied meta=\"𝑛·0·3\" of=\"Φ.bytes\"><attr name=\"φ\">40-08-00-00-00-00-00-00</attr></applied>"+                         , "    <applied meta=\"𝑛·0·4\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·3</attr></applied>"+                         , "    <applied meta=\"𝑛·0·5\" by=\"morph\" at=\"Φ\" of=\"𝑛·0·2.times\"><attr name=\"x\">𝑛·0·4</attr></applied>"                          , "    <evaluate λ=\"L_number_times\" by=\"morph\" at=\"Φ\">"                          , "      <dataize at=\"Φ.a🌵0\">"                          , "        <morph at=\"Φ.a🌵0\">"-                         , "          <applied meta=\"𝑛·1·1\" by=\"morph\" at=\"Φ.a🌵0\" of=\"Φ.number\"><attr name=\"φ\">Φ.bytes( φ ↦ ⟦ Δ ⤍ 40-00-00-00-00-00-00-00 ⟧ )</attr></applied>"-                         , "          <applied meta=\"𝑛·1·2\" by=\"morph\" at=\"Φ.a🌵0\" of=\"Φ.bytes\"><attr name=\"φ\">⟦ Δ ⤍ 40-00-00-00-00-00-00-00 ⟧</attr></applied>"+                         , "          <applied meta=\"𝑛·1·1\" by=\"morph\" at=\"Φ.a🌵0\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·1</attr></applied>"+                         , "          <applied meta=\"𝑛·1·2\" by=\"morph\" at=\"Φ.a🌵0\" of=\"Φ.bytes\"><attr name=\"φ\">40-00-00-00-00-00-00-00</attr></applied>"                          , "        </morph>"                          , "        <delta meta=\"𝛿·1·1\" number=\"2.0\">40-00-00-00-00-00-00-00</delta>"                          , "      </dataize>"                          , "      <bind meta=\"𝛿1·1\">𝛿·1·1</bind>"                          , "      <dataize at=\"Φ.a🌵1\">"                          , "        <morph at=\"Φ.a🌵1\">"-                         , "          <applied meta=\"𝑛·1·3\" by=\"morph\" at=\"Φ.a🌵1\" of=\"Φ.number\"><attr name=\"φ\">Φ.bytes( φ ↦ ⟦ Δ ⤍ 40-08-00-00-00-00-00-00 ⟧ )</attr></applied>"-                         , "          <applied meta=\"𝑛·1·4\" by=\"morph\" at=\"Φ.a🌵1\" of=\"Φ.bytes\"><attr name=\"φ\">⟦ Δ ⤍ 40-08-00-00-00-00-00-00 ⟧</attr></applied>"+                         , "          <applied meta=\"𝑛·1·3\" by=\"morph\" at=\"Φ.a🌵1\" of=\"Φ.number\"><attr name=\"φ\">𝑛·0·3</attr></applied>"+                         , "          <applied meta=\"𝑛·1·4\" by=\"morph\" at=\"Φ.a🌵1\" of=\"Φ.bytes\"><attr name=\"φ\">40-08-00-00-00-00-00-00</attr></applied>"                          , "        </morph>"                          , "        <delta meta=\"𝛿·1·2\" number=\"3.0\">40-08-00-00-00-00-00-00</delta>"                          , "      </dataize>"                          , "      <bind meta=\"𝛿2·1\">𝛿·1·2</bind>"                          , "      <minted symbol=\"𝜎1\">40-00-00-00-00-00-00-00 40-08-00-00-00-00-00-00</minted>"-                         , "      <built meta=\"𝑛·1·5\">Φ.number( φ ↦ ⟦ λ ⤍ 𝜎1 ⟧ )</built>"-                         , "      <morph at=\"𝑛·1·5\">"-                         , "        <applied meta=\"𝑛·1·6\" by=\"morph\" at=\"𝑛·1·5\" of=\"Φ.number\"><attr name=\"φ\">𝜎1</attr></applied>"+                         , "      <applied meta=\"𝑛·1·5\" of=\"Φ.number\"><attr name=\"φ\">𝜎1</attr></applied>"+                         , "      <built meta=\"𝑛·1·6\">𝑛·1·5</built>"+                         , "      <morph at=\"𝑛·1·6\">"+                         , "        <applied meta=\"𝑛·1·7\" by=\"morph\" at=\"𝑛·1·6\" of=\"Φ.number\"><attr name=\"φ\">𝜎1</attr></applied>"                          , "      </morph>"-                         , "      <answer meta=\"𝑛·1·7\">𝑛·1·6</answer>"+                         , "      <answer meta=\"𝑛·1·8\">𝑛·1·7</answer>"                          , "    </evaluate>"                          , "  </morph>"-                         , "  <unanswered λ=\"L_number_nope\" by=\"dataize\">⟦ ρ ↦ 𝑛·1·6, λ ⤍ L_number_nope ⟧</unanswered>"+                         , "  <unanswered λ=\"L_number_nope\" by=\"dataize\">𝑛·1·7.nope</unanswered>"                          , "</dataize>"                          ] @@ -2372,10 +2435,10 @@                          , "  <evaluate λ=\"L_pick\" by=\"morph\" at=\"Φ.x\">"                          , "    <bind meta=\"𝑛1·1\">⊥</bind>"                          , "    <minted symbol=\"𝜎1\"/>"-                         , "    <built meta=\"𝑛·1·1\">⟦ λ ⤍ 𝜎1 ⟧</built>"-                         , "    <answer meta=\"𝑛·1·2\">⟦ λ ⤍ 𝜎1 ⟧</answer>"+                         , "    <built meta=\"𝑛·1·1\">𝜎1</built>"+                         , "    <answer meta=\"𝑛·1·2\">𝜎1</answer>"                          , "  </evaluate>"-                         , "  <unanswered λ=\"𝜎1\" by=\"morph\">⟦ λ ⤍ 𝜎1 ⟧</unanswered>"+                         , "  <unanswered λ=\"𝜎1\" by=\"morph\">𝜎1</unanswered>"                          , "</morph>"                          ] @@ -2496,7 +2559,7 @@      describe "a lenient join" $ do       let strict = T.pack "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  𝑛: 𝑛3\n"-          lenient = T.pack "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  lenient: true\n  𝑛: 𝑛3\n"+          lenient = T.pack "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  lenient: []\n  𝑛: 𝑛3\n"       it "gets stuck on a fork whose second branch decorates the first when the entry is strict" $         withLambdasOf strict $ \forks ->           withStdin "⟦ y ↦ ⟦ a ↦ ⟦ φ ↦ ⟦ λ ⤍ 𝜎1 ⟧, neg ↦ ⟦⟧ ⟧, b ↦ ⟦ φ ↦ ⟦ φ ↦ ⟦ λ ⤍ 𝜎2 ⟧, neg ↦ ⟦⟧ ⟧ ⟧, λ ⤍ L_fork ⟧ ⟧" $@@ -2874,7 +2937,7 @@      describe "a lenient join" $ do       let strict = T.pack "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  𝑛: 𝑛3\n"-          lenient = T.pack "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  lenient: true\n  𝑛: 𝑛3\n"+          lenient = T.pack "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  lenient: []\n  𝑛: 𝑛3\n"       it "gets stuck on a fork whose second branch decorates the first when the entry is strict" $         withLambdasOf strict $ \forks ->           withStdin "⟦ y ↦ ⟦ a ↦ ⟦ φ ↦ ⟦ λ ⤍ 𝜎1 ⟧, neg ↦ ⟦⟧ ⟧, b ↦ ⟦ φ ↦ ⟦ φ ↦ ⟦ λ ⤍ 𝜎2 ⟧, neg ↦ ⟦⟧ ⟧ ⟧, λ ⤍ L_fork ⟧.φ ⟧" $@@ -2915,51 +2978,71 @@               ["morph", "--symbolic=" ++ forks, "--locator=Q.y", "--sweet", "--hide-rho", "--flat"]               ["⟦ if(left, right) ↦ ⟦ λ ⤍ L_fork, φ ↦ 𝜎3:λ ⟧, φ ↦ if( FF-:Δ, 00-:Δ ) ⟧"] -    describe "a deferring join" $ do-      let deferring = T.pack "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  lenient: true\n  defer: true\n  𝑛: ⟦ φ ↦ 𝑛3 ⟧\n"-          deferred :: [String] -> String -> IO [String]-          deferred options program =+    describe "a deferring unfold" $ do+      let deferring = T.pack "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  unfold:\n    𝑛3: {of: 𝑛2, defer: true}\n  join:\n    𝑛4: [𝑛1, 𝑛3]\n  𝑛: ⟦ φ ↦ 𝑛4 ⟧\n"+          counting = deferring <> T.pack "- λ: L_inc\n  dataize:\n    𝛿1: $.x\n  𝑛: Φ.num( φ ↦ ⟦ λ ⤍ 𝜎 ⟧ )\n"+          recordedWith :: T.Text -> [String] -> String -> IO [String]+          recordedWith entries options program =             withTempFile "protocolXXXXXX.xml" $ \(path, stream) -> do               hClose stream-              withLambdasOf deferring $ \forks ->+              withLambdasOf entries $ \forks ->                 withStdin program $                   testCLISucceeded (["morph", "--symbolic=" ++ forks, "--locator=Q.y", "--protocol=" ++ path, "--quiet", "--sweet", "--hide-rho"] ++ options) []               lines <$> readProtocol path+          deferred :: [String] -> String -> IO [String]+          deferred = recordedWith deferring       it "writes the copy it deferred to the XML protocol as a call of the object it was made of" $ do         records <- deferred [] "⟦ step(tup) ↦ ⟦ φ ↦ tup.next ⟧, items ↦ ⟦ tail ↦ ⟦ λ ⤍ 𝜎1 ⟧ ⟧, y ↦ ⟦ a ↦ ⟦ λ ⤍ 𝜎2 ⟧, b ↦ Φ.step( tup ↦ Φ.items.tail ), λ ⤍ L_fork ⟧.φ ⟧"         records           `shouldBe` [ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"                      , "<morph at=\"Φ.y\">"                      , "  <evaluate λ=\"L_fork\" by=\"morph\" at=\"Φ.y\">"-                     , "    <bind meta=\"𝑛1·1\">𝜎2:λ</bind>"+                     , "    <bind meta=\"𝑛1·1\">𝜎2</bind>"                      , "    <morph at=\"Φ.a🌵1\">"                      , "      <applied meta=\"𝑛·1·1\" by=\"morph\" at=\"Φ.a🌵1\" of=\"Φ.step\"><attr name=\"tup\">Φ.items.tail</attr></applied>"                      , "    </morph>"                      , "    <bind meta=\"𝑛2·1\">𝑛·1·1</bind>"-                     , "    <deferred symbol=\"𝜎3\" by=\"morph\" at=\"𝑛2.φ\" of=\"Φ.step\"><with><attr name=\"tup\">𝜎1</attr></with><e>⟦ tup ↦ 𝜎1:λ, φ ↦ tup.next ⟧</e></deferred>"+                     , "    <deferred symbol=\"𝜎3\" by=\"morph\" at=\"𝑛2.φ\" of=\"Φ.step\"><with><attr name=\"tup\">𝜎1</attr></with></deferred>"                      , "    <joined symbol=\"𝜎4\">𝜎2 𝜎3</joined>"-                     , "    <bind meta=\"𝑛3·1\">𝜎4:λ</bind>"-                     , "    <built meta=\"𝑛·1·2\">𝜎4:λ:φ</built>"-                     , "    <answer meta=\"𝑛·1·3\">𝜎4:λ:φ</answer>"+                     , "    <bind meta=\"𝑛4·1\">𝜎4</bind>"+                     , "    <formed meta=\"𝑛·1·2\"><attr name=\"φ\">𝜎4</attr></formed>"+                     , "    <built meta=\"𝑛·1·3\">𝑛·1·2</built>"+                     , "    <answer meta=\"𝑛·1·4\">𝑛·1·2</answer>"                      , "  </evaluate>"                      , "</morph>"                      ]        it "names the object a deferred copy was made of through the formation its ρ holds" $ do         records <- deferred [] "⟦ joined(items) ↦ ⟦ φ ↦ step( tup ↦ items ), step(ρ, tup) ↦ ⟦ φ ↦ tup.next ⟧ ⟧, items ↦ ⟦ tail ↦ ⟦ λ ⤍ 𝜎1 ⟧ ⟧, y ↦ ⟦ a ↦ ⟦ λ ⤍ 𝜎2 ⟧, b ↦ Φ.joined( items ↦ Φ.items.tail ).φ, λ ⤍ L_fork ⟧.φ ⟧"-        records `shouldContain` ["    <deferred symbol=\"𝜎3\" by=\"morph\" at=\"𝑛2.φ\" of=\"Φ.joined.step\"><with><attr name=\"tup\">𝜎1</attr></with><e>⟦ tup ↦ 𝜎1:λ, φ ↦ tup.next ⟧</e></deferred>"]+        records `shouldContain` ["    <deferred symbol=\"𝜎3\" by=\"morph\" at=\"𝑛2.φ\" of=\"Φ.joined.step\"><with><attr name=\"tup\">𝜎1</attr></with></deferred>"] -      it "writes a question mark for an argument of a deferred copy that is no bare symbol" $ do+      it "names an argument of a deferred copy that is no bare symbol by the element that formed it" $ do         records <- deferred [] "⟦ box(x, w) ↦ ⟦ φ ↦ x.next ⟧, items ↦ ⟦ tail ↦ ⟦ λ ⤍ 𝜎1 ⟧ ⟧, y ↦ ⟦ a ↦ ⟦ λ ⤍ 𝜎2 ⟧, b ↦ Φ.box( x ↦ Φ.items.tail, w ↦ ⟦ z ↦ Φ ⟧ ), λ ⤍ L_fork ⟧.φ ⟧"-        records `shouldContain` ["    <deferred symbol=\"𝜎3\" by=\"morph\" at=\"𝑛2.φ\" of=\"Φ.box\"><with><attr name=\"x\">𝜎1</attr><attr name=\"w\">?</attr></with><e>⟦ x ↦ 𝜎1:λ, w ↦ Φ:z, φ ↦ x.next ⟧</e></deferred>"]+        records `shouldContain` ["    <deferred symbol=\"𝜎3\" by=\"morph\" at=\"𝑛2.φ\" of=\"Φ.box\"><with><attr name=\"x\">𝜎1</attr><attr name=\"w\">𝑛·1·2</attr></with></deferred>"] -      it "writes no object for a deferred copy of a formation the world does not declare" $ do+      it "names a deferred copy of a formation the world does not declare by the element that formed it" $ do         records <- deferred [] "⟦ wrap(v) ↦ ⟦⟧, items ↦ ⟦ tail ↦ ⟦ λ ⤍ 𝜎1 ⟧ ⟧, y ↦ ⟦ a ↦ ⟦ λ ⤍ 𝜎2 ⟧, b ↦ Φ.wrap( v ↦ ⟦ inner(x) ↦ ⟦ φ ↦ x.next ⟧ ⟧ ).v.inner( x ↦ Φ.items.tail ), λ ⤍ L_fork ⟧.φ ⟧"-        records `shouldContain` ["    <deferred symbol=\"𝜎3\" by=\"morph\" at=\"𝑛2.φ\"><e>⟦ x ↦ 𝜎1:λ, φ ↦ x.next ⟧</e></deferred>"]+        records `shouldContain` ["    <formed meta=\"𝑛·1·5\"><attr name=\"x\">𝜎1</attr><attr name=\"φ\">x.next</attr></formed>", "    <deferred symbol=\"𝜎3\" by=\"morph\" at=\"𝑛2.φ\" of=\"𝑛·1·5\"/>"]        it "writes the copy a cut stopped to the XML protocol with its symbol and the call of the object it was made of" $ do         records <- deferred ["--acyclic=proven"] "⟦ fork(a, b) ↦ ⟦ λ ⤍ L_fork ⟧, rec(n) ↦ ⟦ φ ↦ Φ.fork( ⟦ λ ⤍ 𝜎1 ⟧, Φ.rec( ξ.n ) ) ⟧, y ↦ Φ.rec( ⟦ φ ↦ ⟦ λ ⤍ 𝜎2 ⟧ ⟧ ).φ.φ ⟧"-        records `shouldContain` ["    <looped symbol=\"𝜎3\" by=\"evaluate\" match=\"proven\" at=\"𝑛2\" of=\"Φ.rec\"><with><attr name=\"n\">𝜎2</attr></with><e>𝑛·1·3</e></looped>"]+        records `shouldContain` ["    <looped symbol=\"𝜎3\" by=\"evaluate\" match=\"proven\" at=\"𝑛2\" of=\"Φ.rec\"><with><attr name=\"n\">𝑛·0·1</attr></with></looped>"]++      it "names an argument of a copy a cut stopped by the object its morph answered" $ do+        records <- recordedWith counting ["--acyclic=plausible"] "⟦ fork(a, b) ↦ ⟦ λ ⤍ L_fork ⟧, num(φ) ↦ ⟦⟧, inc(x) ↦ ⟦ λ ⤍ L_inc ⟧, rec(n) ↦ ⟦ φ ↦ Φ.fork( ⟦ λ ⤍ 𝜎1 ⟧, Φ.rec( Φ.inc( ξ.n ) ) ) ⟧, y ↦ Φ.rec( ⟦ φ ↦ ⟦ λ ⤍ 𝜎2 ⟧ ⟧ ).φ.φ ⟧"+        filter (isInfixOf "<looped") records `shouldBe` ["    <looped symbol=\"𝜎4\" by=\"evaluate\" match=\"plausible\" at=\"𝑛2\" of=\"Φ.rec\"><with><attr name=\"n\">𝑛·2·3</attr></with></looped>"]++      it "fires the argument of a copy a cut stopped before it writes the cut" $ do+        records <- recordedWith counting ["--acyclic=plausible"] "⟦ fork(a, b) ↦ ⟦ λ ⤍ L_fork ⟧, num(φ) ↦ ⟦⟧, inc(x) ↦ ⟦ λ ⤍ L_inc ⟧, rec(n) ↦ ⟦ φ ↦ Φ.fork( ⟦ λ ⤍ 𝜎1 ⟧, Φ.rec( Φ.inc( ξ.n ) ) ) ⟧, y ↦ Φ.rec( ⟦ φ ↦ ⟦ λ ⤍ 𝜎2 ⟧ ⟧ ).φ.φ ⟧"+        takeWhile (not . isInfixOf "<looped") records `shouldContain` ["    <evaluate λ=\"L_inc\" by=\"evaluate\" at=\"𝑛2.n\">"]++      it "names an argument of a copy a cut stopped whose firing gets stuck by the application it stands for" $ do+        records <- recordedWith deferring ["--acyclic=plausible"] "⟦ fork(a, b) ↦ ⟦ λ ⤍ L_fork ⟧, dec(x) ↦ ⟦ λ ⤍ L_dec ⟧, rec(n) ↦ ⟦ φ ↦ Φ.fork( ⟦ λ ⤍ 𝜎1 ⟧, Φ.rec( Φ.dec( ξ.n ) ) ) ⟧, y ↦ Φ.rec( ⟦ φ ↦ ⟦ λ ⤍ 𝜎2 ⟧ ⟧ ).φ.φ ⟧"+        filter (isInfixOf "<looped") records `shouldBe` ["    <looped symbol=\"𝜎3\" by=\"evaluate\" match=\"plausible\" at=\"𝑛2\" of=\"Φ.rec\"><with><attr name=\"n\">𝑛·0·4</attr></with></looped>"]++      it "names an argument of a deferred copy by the object its morph answered" $ do+        records <- recordedWith counting [] "⟦ box(x, w) ↦ ⟦ φ ↦ x.next ⟧, num(φ) ↦ ⟦⟧, inc(x) ↦ ⟦ λ ⤍ L_inc ⟧, items ↦ ⟦ tail ↦ ⟦ λ ⤍ 𝜎1 ⟧ ⟧, y ↦ ⟦ a ↦ ⟦ λ ⤍ 𝜎2 ⟧, b ↦ Φ.box( x ↦ Φ.items.tail, w ↦ Φ.inc( ⟦ Δ ⤍ 2A- ⟧ ) ), λ ⤍ L_fork ⟧.φ ⟧"+        filter (isInfixOf "<deferred") records `shouldBe` ["    <deferred symbol=\"𝜎4\" by=\"morph\" at=\"𝑛2.φ\" of=\"Φ.box\"><with><attr name=\"x\">𝜎1</attr><attr name=\"w\">𝑛·2·3</attr></with></deferred>"]      describe "--acyclic=plausible" $ do       let twins = "[[ bytes ↦ ⟦ φ ↦ ∅ ⟧, number(φ) -> [[ plus(^, x) -> [[ L> L_number_plus ]] ]], pair(a, b) -> [[ L> L_pair ]], t -> Φ.pair( 7.plus( 5.plus( 6 ) ), 7.plus( 5.plus( 6 ) ) ).φ ]]"
test/DepsSpec.hs view
@@ -5,13 +5,13 @@  module DepsSpec where -import AST (Argument (ArTau), Attribute (AtLabel, AtPhi), Binding (BiLambda, BiTau), Bytes (BtMany, BtOne), Expression (ExApplication, ExDispatch, ExFormation, ExRoot, ExXi), Function (FnSymbol))+import AST (Argument (ArTau), Attribute (AtLabel, AtPhi, AtRho), Binding (BiDelta, BiLambda, BiTau, BiVoid), Bytes (BtMany, BtOne), Expression (ExApplication, ExDispatch, ExFormation, ExRoot, ExXi), Function (FnSymbol, Function)) import Control.Exception (bracket) import Control.Monad (replicateM_, when) import Data.IORef (modifyIORef', newIORef, readIORef) import Data.List (isInfixOf, isPrefixOf) import Data.Time.Clock.POSIX (getPOSIXTime)-import Deps (Acyclic (Proven), Evaluation (EvAnswer, EvApplied, EvBuilt, EvData, EvDeferred, EvDelta, EvFiring, EvLooped, EvRun, EvStarted, EvStuckOn, EvTerm, EvTerminate, EvUnjoined), Judgment (Dataization, Morphing), Nesting (..), Protocol (..), dontSaveEval, dontSaveStep, emptyNesting, emptyProgress, emptyProtocol, endEval, endEvalXml, perSecond, progressed, resited, saveStep)+import Deps (Acyclic (Plausible, Proven), Evaluation (EvAnswer, EvApplied, EvBuilt, EvData, EvDeferred, EvDelta, EvFiring, EvLooped, EvRun, EvStarted, EvStuck, EvStuckOn, EvTerm, EvTerminate, EvUnjoined, EvUnreminted, EvUpcast, EvWorld), Judgment (Dataization, Morphing), Nesting (..), Protocol (..), dontSaveEval, dontSaveStep, emptyNesting, emptyProgress, emptyProtocol, endEval, endEvalXml, perSecond, progressed, resited, saveStep) import Fixtures (readUtf8, recorded, recordedXml) import GHC.Clock (getMonotonicTime) import Logger (LogLevel (DEBUG, ERROR, INFO), setLogConfig)@@ -127,6 +127,9 @@         _ -> expectationFailure "The record did not stay the record it was"    describe "saveEval" $ do+    it "writes nothing for the world it is told" $ do+      (_, written) <- recorded (\record -> mapM_ record [EvRun Morphing "Φ", EvWorld (ExFormation [BiTau (AtLabel "ёж") (ExFormation [])])])+      filter (isInfixOf "ёж") (lines written) `shouldBe` []     it "writes an application as a line binding what it made to a fresh 𝑛" $ do       (_, written) <- recorded (\record -> record (EvApplied 1 Morphing (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "q") (ExFormation []))) (ExFormation [BiTau (AtLabel "q") (ExFormation [])]) (ExDispatch ExRoot (AtLabel "w"))))       written `shouldBe` "  𝑛·0·1 := Φ.ёж( q ↦ ⟦⟧ )  # 𝕄(Φ.w)\n"@@ -205,20 +208,74 @@     it "writes a join that failed with the two branches it could not pair" $ do       (_, written) <- recorded (\record -> mapM_ record [EvRun Morphing "Φ", EvFiring 1 "L_щ" Morphing ExRoot, EvUnjoined 2 "L_щ" (ExFormation [BiLambda (FnSymbol 5)]) (ExFormation [BiTau (AtLabel "ю") (ExFormation [BiLambda (FnSymbol 8)]), BiTau (AtLabel "ц") ExRoot])])       last (lines written) `shouldBe` "    unjoined(L_щ)  # 𝜎5:λ vs ⟦ ю ↦ 𝜎8:λ, ц ↦ Φ ⟧"+    it "writes a remint that failed with the term it found no symbol for" $ do+      (_, written) <- recorded (\record -> mapM_ record [EvRun Morphing "Φ", EvFiring 1 "L_ёж" Morphing ExRoot, EvUnreminted 2 "L_ёж" (ExFormation [BiTau (AtLabel "жук") (ExFormation [BiLambda (FnSymbol 17)]), BiTau (AtLabel "ф") ExRoot])])+      last (lines written) `shouldBe` "    unreminted(L_ёж)  # ⟦ жук ↦ 𝜎17:λ, ф ↦ Φ ⟧"+    it "writes an upcast as the term a bare symbol was cast to" $ do+      (_, written) <- recorded (\record -> mapM_ record [EvRun Morphing "Φ", EvFiring 1 "L_щ" Morphing ExRoot, EvUpcast 2 41 (ExApplication (ExApplication (ExDispatch ExRoot (AtLabel "кортеж")) (ArTau (AtLabel "хвост") (ExFormation [BiLambda (FnSymbol 43)]))) (ArTau AtPhi (ExFormation [BiLambda (FnSymbol 44)]))) [(43, [AtLabel "хвост"]), (44, [AtPhi])]])+      lines written `shouldContain` ["    upcast(𝜎41) := Φ.кортеж( хвост ↦ 𝜎43:λ, φ ↦ 𝜎44:λ )"]+    it "writes every symbol of an upcast as the path that reads it off the bare symbol" $ do+      (_, written) <- recorded (\record -> mapM_ record [EvRun Morphing "Φ", EvFiring 1 "L_щ" Morphing ExRoot, EvUpcast 2 41 (ExApplication (ExApplication (ExDispatch ExRoot (AtLabel "кортеж")) (ArTau (AtLabel "хвост") (ExFormation [BiLambda (FnSymbol 43)]))) (ArTau AtPhi (ExFormation [BiTau AtRho (ExFormation [BiLambda (FnSymbol 44)])]))) [(43, [AtLabel "хвост"]), (44, [AtPhi, AtRho])]])+      drop 3 (lines written) `shouldBe` ["      𝜎43 := 𝜎41.хвост", "      𝜎44 := 𝜎41.φ.ρ"]    describe "saveEvalXml" $ do+    it "writes an upcast as an element naming the term a bare symbol was cast to" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvFiring 1 "L_щ" Morphing ExRoot, EvUpcast 2 41 (ExApplication (ExApplication (ExDispatch ExRoot (AtLabel "кортеж")) (ArTau (AtLabel "хвост") (ExFormation [BiLambda (FnSymbol 43)]))) (ArTau AtPhi (ExFormation [BiTau AtRho (ExFormation [BiLambda (FnSymbol 44)])]))) [(43, [AtLabel "хвост"]), (44, [AtPhi, AtRho])]])+      lines written `shouldContain` ["    <upcast symbol=\"𝜎41\" of=\"𝑛·1·2\"><path symbol=\"𝜎43\">хвост</path><path symbol=\"𝜎44\">φ.ρ</path></upcast>"]+    it "names the term an upcast was cast to by an element written before it" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvFiring 1 "L_щ" Morphing ExRoot, EvUpcast 2 41 (ExApplication (ExApplication (ExDispatch ExRoot (AtLabel "кортеж")) (ArTau (AtLabel "хвост") (ExFormation [BiLambda (FnSymbol 43)]))) (ArTau AtPhi (ExFormation [BiTau AtRho (ExFormation [BiLambda (FnSymbol 44)])]))) [(43, [AtLabel "хвост"]), (44, [AtPhi, AtRho])]])+      lines written `shouldContain` ["    <applied meta=\"𝑛·1·2\" of=\"Φ.кортеж\"><attr name=\"хвост\">𝜎43</attr><attr name=\"φ\">𝑛·1·1</attr></applied>"]     it "writes an application as an element naming its head and holding its argument" $ do-      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ.w", EvApplied 1 Morphing (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "q") (ExFormation []))) (ExFormation [BiTau (AtLabel "q") (ExFormation [])]) (ExDispatch ExRoot (AtLabel "w"))])-      lines written `shouldContain` ["  <applied meta=\"𝑛·0·1\" by=\"morph\" at=\"Φ.w\" of=\"Φ.ёж\"><attr name=\"q\">⟦⟧</attr></applied>"]+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ.w", EvApplied 1 Morphing (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "q") (ExDispatch ExRoot (AtLabel "ю")))) (ExFormation [BiTau (AtLabel "q") (ExDispatch ExRoot (AtLabel "ю"))]) (ExDispatch ExRoot (AtLabel "w"))])+      lines written `shouldContain` ["  <applied meta=\"𝑛·0·1\" by=\"morph\" at=\"Φ.w\" of=\"Φ.ёж\"><attr name=\"q\">Φ.ю</attr></applied>"]     it "spells an argument an earlier application made by its name" $ do-      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvApplied 1 Morphing (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "q") (ExFormation []))) (ExFormation [BiTau (AtLabel "q") (ExFormation [])]) ExRoot, EvApplied 1 Morphing (ExApplication (ExDispatch ExRoot (AtLabel "жук")) (ArTau (AtLabel "w") (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "q") (ExFormation []))))) (ExFormation [BiTau (AtLabel "w") (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "q") (ExFormation [])))]) ExRoot])+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvApplied 1 Morphing (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "q") (ExDispatch ExRoot (AtLabel "ю")))) (ExFormation [BiTau (AtLabel "q") (ExDispatch ExRoot (AtLabel "ю"))]) ExRoot, EvApplied 1 Morphing (ExApplication (ExDispatch ExRoot (AtLabel "жук")) (ArTau (AtLabel "w") (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "q") (ExDispatch ExRoot (AtLabel "ю")))))) (ExFormation [BiTau (AtLabel "w") (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "q") (ExDispatch ExRoot (AtLabel "ю"))))]) ExRoot])       lines written `shouldContain` ["  <applied meta=\"𝑛·0·2\" by=\"morph\" at=\"Φ\" of=\"Φ.жук\"><attr name=\"w\">𝑛·0·1</attr></applied>"]     it "spells an argument that is a bare symbol as that symbol" $ do       (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvApplied 1 Morphing (ExApplication (ExDispatch ExRoot (AtLabel "цапля")) (ArTau AtPhi (ExFormation [BiLambda (FnSymbol 7)]))) (ExFormation [BiTau AtPhi (ExFormation [BiLambda (FnSymbol 7)])]) ExRoot])       lines written `shouldContain` ["  <applied meta=\"𝑛·0·1\" by=\"morph\" at=\"Φ\" of=\"Φ.цапля\"><attr name=\"φ\">𝜎7</attr></applied>"]+    it "spells a datum an application holds with no tag" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvApplied 1 Morphing (ExApplication (ExDispatch ExRoot (AtLabel "байты")) (ArTau AtPhi (ExFormation [BiDelta (BtOne "0C")]))) (ExFormation [BiTau AtPhi (ExFormation [BiDelta (BtOne "0C")])]) ExRoot])+      lines written `shouldContain` ["  <applied meta=\"𝑛·0·1\" by=\"morph\" at=\"Φ\" of=\"Φ.байты\"><attr name=\"φ\">0C-</attr></applied>"]+    it "names an argument that is an application by an element of its own" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvApplied 1 Morphing (ExApplication (ExDispatch ExRoot (AtLabel "цапля")) (ArTau AtPhi (ExApplication (ExDispatch ExRoot (AtLabel "байты")) (ArTau AtPhi (ExFormation [BiDelta (BtOne "0C")]))))) (ExFormation [BiTau AtPhi (ExFormation [BiDelta (BtOne "0C")])]) ExRoot])+      lines written `shouldContain` ["  <applied meta=\"𝑛·0·1\" of=\"Φ.байты\"><attr name=\"φ\">0C-</attr></applied>"]+    it "writes an application of two arguments nothing reduced as one element" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvAnswer 1 (ExApplication (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "а") (ExFormation [BiLambda (FnSymbol 1)]))) (ArTau (AtLabel "б") (ExFormation [BiLambda (FnSymbol 2)])))])+      lines written `shouldContain` ["  <applied meta=\"𝑛·0·1\" of=\"Φ.ёж\"><attr name=\"а\">𝜎1</attr><attr name=\"б\">𝜎2</attr></applied>"]+    it "writes an answer as the name of the term it holds" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvAnswer 1 (ExApplication (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "а") (ExFormation [BiLambda (FnSymbol 1)]))) (ArTau (AtLabel "б") (ExFormation [BiLambda (FnSymbol 2)])))])+      lines written `shouldContain` ["  <answer meta=\"𝑛·0·2\">𝑛·0·1</answer>"]+    it "writes a term a firing built as the name of the term" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvBuilt 1 (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "а") (ExFormation [BiLambda (FnSymbol 1)])))])+      lines written `shouldContain` ["  <built meta=\"𝑛·0·2\">𝑛·0·1</built>"]     it "spells an object an application made by its name in a later element" $ do-      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvFiring 1 "L_ы" Morphing ExRoot, EvBuilt 2 (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "q") (ExFormation []))), EvApplied 2 Morphing (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "q") (ExFormation []))) (ExFormation [BiTau (AtLabel "q") (ExFormation [])]) ExRoot, EvAnswer 2 (ExFormation [BiTau (AtLabel "q") (ExFormation [])])])+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvFiring 1 "L_ы" Morphing ExRoot, EvBuilt 2 (ExDispatch ExRoot (AtLabel "ю")), EvApplied 2 Morphing (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "q") (ExDispatch ExRoot (AtLabel "ю")))) (ExFormation [BiTau (AtLabel "q") (ExDispatch ExRoot (AtLabel "ю"))]) ExRoot, EvAnswer 2 (ExFormation [BiTau (AtLabel "q") (ExDispatch ExRoot (AtLabel "ю"))])])       lines written `shouldContain` ["    <answer meta=\"𝑛·1·3\">𝑛·1·2</answer>"]+    it "writes a formation no object of the world made as an element holding its bindings" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvAnswer 1 (ExFormation [BiLambda (Function "L_вилка"), BiVoid (AtLabel "лево"), BiTau AtPhi (ExFormation [BiLambda (FnSymbol 5)])])])+      lines written `shouldContain` ["  <formed meta=\"𝑛·0·1\" λ=\"L_вилка\"><void name=\"лево\"/><attr name=\"φ\">𝜎5</attr></formed>"]+    it "names a formation that copies an object of the world by the object and the attributes it binds" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvWorld (ExFormation [BiTau (AtLabel "ёж") (ExFormation [BiVoid (AtLabel "q"), BiTau (AtLabel "w") ExRoot])]), EvAnswer 1 (ExFormation [BiTau (AtLabel "q") (ExFormation [BiLambda (FnSymbol 3)]), BiTau (AtLabel "w") ExRoot])])+      lines written `shouldContain` ["  <formed meta=\"𝑛·0·1\" of=\"Φ.ёж\"><attr name=\"q\">𝜎3</attr></formed>"]+    it "names a formation that replaced an attribute of an object of the world by the object and that attribute" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvWorld (ExFormation [BiTau (AtLabel "ёж") (ExFormation [BiVoid (AtLabel "q"), BiTau AtPhi (ExDispatch ExXi (AtLabel "q")), BiTau (AtLabel "w") ExRoot])]), EvAnswer 1 (ExFormation [BiTau (AtLabel "q") (ExFormation [BiLambda (FnSymbol 3)]), BiTau AtPhi (ExFormation [BiLambda (FnSymbol 5)]), BiTau (AtLabel "w") ExRoot])])+      lines written `shouldContain` ["  <formed meta=\"𝑛·0·1\" of=\"Φ.ёж\"><attr name=\"q\">𝜎3</attr><attr name=\"φ\">𝜎5</attr></formed>"]+    it "writes a formation that keeps no binding of an object of the world as a formation of its own" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvWorld (ExFormation [BiTau (AtLabel "ёж") (ExFormation [BiVoid AtPhi])]), EvAnswer 1 (ExFormation [BiTau AtPhi (ExFormation [BiLambda (FnSymbol 8)])])])+      lines written `shouldContain` ["  <formed meta=\"𝑛·0·1\"><attr name=\"φ\">𝜎8</attr></formed>"]+    it "spells a formation that is an object of the world by its path" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvWorld (ExFormation [BiTau (AtLabel "ёж") (ExFormation [BiVoid (AtLabel "q"), BiTau (AtLabel "w") ExRoot])]), EvAnswer 1 (ExFormation [BiVoid (AtLabel "q"), BiTau (AtLabel "w") ExRoot])])+      lines written `shouldContain` ["  <answer meta=\"𝑛·0·1\">Φ.ёж</answer>"]+    it "names a formation that copies an object nested in the world by its path" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvWorld (ExFormation [BiTau (AtLabel "лес") (ExFormation [BiTau (AtLabel "ёж") (ExFormation [BiVoid (AtLabel "q"), BiLambda (Function "L_ёж")])])]), EvAnswer 1 (ExFormation [BiTau (AtLabel "q") (ExFormation [BiLambda (FnSymbol 7)]), BiLambda (Function "L_ёж")])])+      lines written `shouldContain` ["  <formed meta=\"𝑛·0·1\" of=\"Φ.лес.ёж\"><attr name=\"q\">𝜎7</attr></formed>"]+    it "names a method of a copy by the copy it is dispatched from" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvWorld (ExFormation [BiTau (AtLabel "ёж") (ExFormation [BiVoid (AtLabel "q"), BiTau (AtLabel "м") (ExFormation [BiVoid AtRho, BiVoid (AtLabel "z")])])]), EvAnswer 1 (ExFormation [BiTau AtRho (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "q") (ExFormation [BiLambda (FnSymbol 3)]))), BiTau (AtLabel "z") (ExFormation [BiLambda (FnSymbol 4)])])])+      lines written `shouldContain` ["  <formed meta=\"𝑛·0·2\" of=\"𝑛·0·1.м\"><attr name=\"z\">𝜎4</attr></formed>"]+    it "writes nothing for the world it is told" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvWorld (ExFormation [BiTau (AtLabel "ёж") (ExFormation [])])])+      filter (isInfixOf "ёж") (lines written) `shouldBe` []     it "writes the datum the delta rule found as an element with its name" $ do       (_, written) <- recordedXml (\record -> mapM_ record [EvRun Dataization "Φ", EvDelta 1 (BtMany ["0C", "D4"])])       lines written `shouldContain` ["  <delta meta=\"𝛿·0·1\">0C-D4</delta>"]@@ -228,12 +285,24 @@     it "spells the datum of an operand by the name the delta rule just gave it in the markup" $ do       (_, written) <- recordedXml (\record -> mapM_ record [EvRun Dataization "Φ", EvFiring 1 "L_ж" Dataization ExRoot, EvDelta 3 (BtOne "7F"), EvData 2 "𝛿1" (ExDispatch ExXi (AtLabel "щ")) (Right (BtOne "7F"))])       lines written `shouldContain` ["    <bind meta=\"𝛿1·1\">𝛿·1·1</bind>"]+    it "spells the symbol a dataization stood on with no tag" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Dataization "Φ", EvFiring 1 "L_ж" Dataization ExRoot, EvData 2 "𝛿1" (ExDispatch ExXi (AtLabel "щ")) (Left 32)])+      lines written `shouldContain` ["    <dataize meta=\"𝛿1·1\">𝜎32</dataize>"]     it "writes a block as an element once an element stands in it" $ do       (_, written) <- recordedXml (\record -> mapM_ record [EvRun Dataization "Φ", EvStarted 1 Morphing (ExDispatch ExRoot (AtLabel "w")), EvApplied 2 Morphing (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "q") (ExFormation []))) (ExFormation [BiTau (AtLabel "q") (ExFormation [])]) (ExDispatch ExRoot (AtLabel "w"))])       lines written `shouldContain` ["  <morph at=\"Φ.w\">"]     it "writes no element for a block nothing stands in" $ do       (_, written) <- recordedXml (\record -> mapM_ record [EvRun Dataization "Φ", EvStarted 1 Morphing (ExDispatch ExRoot (AtLabel "w")), EvDelta 1 (BtOne "0C")])       filter (isInfixOf "morph") (lines written) `shouldBe` []+    it "names the site of a block that is an application by an element written before the block" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Dataization "Φ", EvStarted 1 Morphing (ExApplication (ExDispatch ExRoot (AtLabel "ж")) (ArTau (AtLabel "q") (ExFormation [BiLambda (FnSymbol 1)]))), EvDelta 2 (BtOne "0C")])+      lines written `shouldContain` ["  <applied meta=\"𝑛·0·1\" of=\"Φ.ж\"><attr name=\"q\">𝜎1</attr></applied>", "  <morph at=\"𝑛·0·1\">"]+    it "names nothing for the site of a block nothing stands in" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Dataization "Φ", EvStarted 1 Morphing (ExApplication (ExDispatch ExRoot (AtLabel "ж")) (ArTau (AtLabel "q") (ExFormation [BiLambda (FnSymbol 1)]))), EvDelta 1 (BtOne "0C")])+      filter (isInfixOf "applied") (lines written) `shouldBe` []+    it "names the site of a firing that is an application by an element written before the firing" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvFiring 1 "L_ж" Morphing (ExApplication (ExDispatch ExRoot (AtLabel "ж")) (ArTau (AtLabel "q") (ExFormation [BiLambda (FnSymbol 1)])))])+      lines written `shouldContain` ["  <applied meta=\"𝑛·0·1\" of=\"Φ.ж\"><attr name=\"q\">𝜎1</attr></applied>", "  <evaluate λ=\"L_ж\" by=\"morph\" at=\"𝑛·0·1\">"]     it "writes one element for two blocks of one judgment at one site in a row" $ do       (_, written) <- recordedXml (\record -> mapM_ record [EvRun Dataization "Φ", EvStarted 1 Morphing (ExDispatch ExRoot (AtLabel "w")), EvApplied 2 Morphing (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "q") (ExFormation []))) (ExFormation [BiTau (AtLabel "q") (ExFormation [])]) (ExDispatch ExRoot (AtLabel "w")), EvStarted 1 Morphing (ExDispatch ExRoot (AtLabel "w")), EvApplied 2 Morphing (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "q") (ExFormation []))) (ExFormation [BiTau (AtLabel "q") (ExFormation [])]) (ExDispatch ExRoot (AtLabel "w"))])       length (filter (isInfixOf "<morph") (lines written)) `shouldBe` 1@@ -244,20 +313,47 @@       (_, written) <- recordedXml (\record -> mapM_ record [EvRun Dataization "Φ", EvFiring 1 "L_ф" Dataization ExRoot, EvBuilt 2 (ExDispatch ExRoot (AtLabel "ю")), EvStarted 2 Morphing (ExDispatch ExRoot (AtLabel "ю")), EvApplied 3 Morphing (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "q") (ExFormation []))) (ExFormation [BiTau (AtLabel "q") (ExFormation [])]) (ExDispatch ExRoot (AtLabel "ю"))])       lines written `shouldContain` ["    <morph at=\"𝑛·1·1\">"]     it "names the message a fork raises with by the name its application gave it in the markup" $ do-      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvFiring 1 "L_ф" Morphing ExRoot, EvApplied 2 Morphing (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "q") (ExFormation []))) (ExFormation [BiTau (AtLabel "q") (ExFormation [])]) ExRoot, EvTerminate 2 (Just (Left 7)) "right" "𝑛4" (Just (ExFormation [BiTau (AtLabel "q") (ExFormation [])]))])+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvFiring 1 "L_ф" Morphing ExRoot, EvApplied 2 Morphing (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "q") (ExDispatch ExRoot (AtLabel "ю")))) (ExFormation [BiTau (AtLabel "q") (ExDispatch ExRoot (AtLabel "ю"))]) ExRoot, EvTerminate 2 (Just (Left 7)) "right" "𝑛4" (Just (ExFormation [BiTau (AtLabel "q") (ExDispatch ExRoot (AtLabel "ю"))]))])       lines written `shouldContain` ["    <terminate symbol=\"𝜎7\" branch=\"right\" message=\"𝑛·1·1\"/>"]     it "writes the message a fork raises with beside the datum of its condition" $ do       (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvTerminate 1 (Just (Right (BtOne "0D"))) "left" "𝑛3" (Just (ExDispatch ExRoot (AtLabel "щука")))])       lines written `shouldContain` ["  <terminate branch=\"left\" message=\"Φ.щука\">0D-</terminate>"]+    it "names the message a fork raises with that is an application by an element of its own" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvTerminate 1 (Just (Right (BtOne "0D"))) "left" "𝑛3" (Just (ExApplication (ExDispatch ExRoot (AtLabel "щука")) (ArTau (AtLabel "q") (ExFormation [BiLambda (FnSymbol 2)]))))])+      lines written `shouldContain` ["  <terminate branch=\"left\" message=\"𝑛·0·1\">0D-</terminate>"]     it "writes a deferred copy as an element naming its object and the symbols of its arguments" $ do       (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvDeferred 1 9 Morphing (ExFormation [BiTau (AtLabel "щ") (ExFormation [BiLambda (FnSymbol 4)]), BiTau AtPhi (ExDispatch (ExDispatch ExXi (AtLabel "щ")) (AtLabel "й"))]) (Just (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "щ") (ExFormation [BiLambda (FnSymbol 4)])))) ExRoot])-      lines written `shouldContain` ["  <deferred symbol=\"𝜎9\" by=\"morph\" at=\"Φ\" of=\"Φ.ёж\"><with><attr name=\"щ\">𝜎4</attr></with><e>⟦ щ ↦ 𝜎4:λ, φ ↦ щ.й ⟧</e></deferred>"]+      lines written `shouldContain` ["  <deferred symbol=\"𝜎9\" by=\"morph\" at=\"Φ\" of=\"Φ.ёж\"><with><attr name=\"щ\">𝜎4</attr></with></deferred>"]+    it "writes a deferred copy that names no call as an element naming the copy" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvDeferred 1 9 Morphing (ExFormation [BiTau (AtLabel "щ") (ExFormation [BiLambda (FnSymbol 4)])]) Nothing ExRoot])+      lines written `shouldContain` ["  <deferred symbol=\"𝜎9\" by=\"morph\" at=\"Φ\" of=\"𝑛·0·1\"/>"]+    it "names an argument of a copy nothing worked out by an expression meta" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvDeferred 1 9 Morphing (ExFormation []) (Just (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "щ") (ExApplication (ExDispatch ExRoot (AtLabel "ю")) (ArTau (AtLabel "ж") (ExFormation [BiLambda (FnSymbol 2)])))))) ExRoot])+      lines written `shouldSatisfy` any (isInfixOf "<attr name=\"щ\">𝑒1</attr>")+    it "names one argument nothing worked out by one expression meta in two elements" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvDeferred 1 9 Morphing (ExFormation []) (Just (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "щ") (ExApplication (ExDispatch ExRoot (AtLabel "ю")) (ArTau (AtLabel "ж") (ExFormation [BiLambda (FnSymbol 2)])))))) ExRoot, EvDeferred 1 10 Morphing (ExFormation []) (Just (ExApplication (ExDispatch ExRoot (AtLabel "ёрш")) (ArTau (AtLabel "ц") (ExApplication (ExDispatch ExRoot (AtLabel "ю")) (ArTau (AtLabel "ж") (ExFormation [BiLambda (FnSymbol 2)])))))) ExRoot])+      length (filter (isInfixOf ">𝑒1<") (lines written)) `shouldBe` 2     it "writes a cut that answered a copy as an element naming its symbol, its object and the symbols of its arguments" $ do       (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvLooped 1 Morphing Proven (ExFormation [BiTau (AtLabel "ъ") ExRoot]) ExRoot (Just (13, Just (ExApplication (ExDispatch ExRoot (AtLabel "ёрш")) (ArTau (AtLabel "ц") (ExFormation [BiLambda (FnSymbol 6)])))))])-      lines written `shouldContain` ["  <looped symbol=\"𝜎13\" by=\"morph\" match=\"proven\" at=\"Φ\" of=\"Φ.ёрш\"><with><attr name=\"ц\">𝜎6</attr></with><e>Φ:ъ</e></looped>"]-    it "writes a join that failed as an element holding the two branches it could not pair" $ do+      lines written `shouldContain` ["  <looped symbol=\"𝜎13\" by=\"morph\" match=\"proven\" at=\"Φ\" of=\"Φ.ёрш\"><with><attr name=\"ц\">𝜎6</attr></with></looped>"]+    it "writes a cut that answered no copy as an element naming the formation it entered" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvLooped 1 Morphing Proven (ExFormation [BiTau (AtLabel "ъ") ExRoot]) ExRoot Nothing])+      lines written `shouldContain` ["  <looped by=\"morph\" match=\"proven\" at=\"Φ\" of=\"𝑛·0·1\"/>"]+    it "names an argument of a copy a cut answered by the application that made it" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvApplied 1 Morphing (ExApplication (ExDispatch ExRoot (AtLabel "жаба")) (ArTau AtPhi (ExFormation [BiLambda (FnSymbol 17)]))) (ExFormation [BiTau AtPhi (ExFormation [BiLambda (FnSymbol 17)])]) ExRoot, EvLooped 1 Morphing Plausible (ExFormation [BiTau (AtLabel "ъ") ExRoot]) ExRoot (Just (23, Just (ExApplication (ExDispatch ExRoot (AtLabel "ёрш")) (ArTau (AtLabel "ц") (ExFormation [BiTau AtPhi (ExFormation [BiLambda (FnSymbol 17)])])))))])+      lines written `shouldContain` ["  <looped symbol=\"𝜎23\" by=\"morph\" match=\"plausible\" at=\"Φ\" of=\"Φ.ёрш\"><with><attr name=\"ц\">𝑛·0·1</attr></with></looped>"]+    it "names an argument of a deferred copy by the application that made it" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvApplied 1 Morphing (ExApplication (ExDispatch ExRoot (AtLabel "кулик")) (ArTau (AtLabel "ш") ExRoot)) (ExFormation [BiTau (AtLabel "ш") ExRoot]) ExRoot, EvDeferred 1 31 Morphing (ExFormation [BiTau (AtLabel "щ") (ExFormation [BiTau (AtLabel "ш") ExRoot]), BiTau AtPhi (ExDispatch ExXi (AtLabel "щ"))]) (Just (ExApplication (ExDispatch ExRoot (AtLabel "ёж")) (ArTau (AtLabel "щ") (ExFormation [BiTau (AtLabel "ш") ExRoot])))) ExRoot])+      lines written `shouldContain` ["  <deferred symbol=\"𝜎31\" by=\"morph\" at=\"Φ\" of=\"Φ.ёж\"><with><attr name=\"щ\">𝑛·0·1</attr></with></deferred>"]+    it "writes a join that failed as an element naming the two branches it could not pair" $ do       (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvFiring 1 "L_щ" Morphing ExRoot, EvUnjoined 2 "L_щ" (ExFormation [BiLambda (FnSymbol 5)]) (ExFormation [BiTau (AtLabel "ю") (ExFormation [BiLambda (FnSymbol 8)]), BiTau (AtLabel "ц") ExRoot])])-      lines written `shouldContain` ["    <unjoined λ=\"L_щ\"><e>𝜎5:λ</e><e>⟦ ю ↦ 𝜎8:λ, ц ↦ Φ ⟧</e></unjoined>"]+      lines written `shouldContain` ["    <unjoined λ=\"L_щ\">𝜎5 𝑛·1·1</unjoined>"]+    it "writes a remint that failed as an element naming the term it found no symbol for" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvFiring 1 "L_ёж" Morphing ExRoot, EvUnreminted 2 "L_ёж" (ExFormation [BiTau (AtLabel "жук") (ExFormation [BiLambda (FnSymbol 17)]), BiTau (AtLabel "ф") ExRoot])])+      lines written `shouldContain` ["    <unreminted λ=\"L_ёж\">𝑛·1·1</unreminted>"]+    it "writes a firing no entry answered as an element naming the term it got stuck on" $ do+      (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvFiring 1 "L_щ" Morphing ExRoot, EvStuck 2 "L_щ" Morphing (ExFormation [BiLambda (FnSymbol 120)])])+      lines written `shouldContain` ["    <unanswered λ=\"L_щ\" by=\"morph\">𝜎120</unanswered>"]     it "writes a stuck firing as an element of the word the text uses" $ do       (_, written) <- recordedXml (\record -> mapM_ record [EvRun Morphing "Φ", EvFiring 1 "L_щ" Morphing ExRoot, EvStuckOn 2 "L_жук"])       lines written `shouldContain` ["    <stuck λ=\"L_жук\"/>"]
test/LambdasSpec.hs view
@@ -12,7 +12,7 @@ import Data.List (isInfixOf) import Data.Text qualified as T import Fixtures (withLambdasOf)-import Lambdas (Lambda (..), Lambdas, Line (..), Meta (..), emptyLambdas, joined, matched, message, minted, readLambdas, stayed, symbolized, taken, thrown)+import Lambdas (Lambda (..), Lambdas, Line (..), Meta (..), emptyLambdas, joined, matched, message, minted, readLambdas, stayed, symbolized, taken, thrown, upcasted) import Parser (parseExpressionThrows) import Test.Hspec @@ -29,14 +29,16 @@ lined known func = maybe [] _lines (matched known func)  order :: Lambdas -> T.Text -> [T.Text]-order known func = map bound (lined known func)+order known func = concatMap bound (lined known func)   where-    bound :: Line -> T.Text-    bound (Evaluated meta _) = _spelling meta-    bound (Rewritten meta _ _) = _spelling meta-    bound (Stayed meta _) = _spelling meta-    bound (Symbolized meta _) = _spelling meta-    bound (Paired meta _ _) = _spelling meta+    bound :: Line -> [T.Text]+    bound (Evaluated meta _) = [_spelling meta]+    bound (Unfolded meta _ _) = [_spelling meta]+    bound (Rewritten meta _ _) = [_spelling meta]+    bound (Stayed meta _) = [_spelling meta]+    bound (Symbolized meta _) = [_spelling meta]+    bound (Upcasted one _ two _) = [_spelling one, _spelling two]+    bound (Paired meta _ _) = [_spelling meta]  joins :: Lambdas -> T.Text -> [(T.Text, (T.Text, T.Text))] joins known func = [(_spelling meta, (_spelling left, _spelling right)) | Paired meta left right <- lined known func]@@ -44,6 +46,12 @@ fired :: Lambdas -> T.Text -> [(T.Text, T.Text)] fired known func = [(_spelling meta, _spelling source) | Evaluated meta source <- lined known func] +unfolds :: Lambdas -> T.Text -> [(T.Text, T.Text, Bool)]+unfolds known func = [(_spelling meta, _spelling source, deferring) | Unfolded meta source deferring <- lined known func]++casts :: Lambdas -> T.Text -> [((T.Text, T.Text), (T.Text, T.Text))]+casts known func = [((_spelling one, _spelling first), (_spelling two, _spelling second)) | Upcasted one first two second <- lined known func]+ stays :: Lambdas -> T.Text -> [(T.Text, T.Text)] stays known func = [(_spelling meta, _spelling source) | Stayed meta source <- lined known func] @@ -140,22 +148,26 @@       known <- lambdasOf "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n    𝑛3: $.c\n  join:\n    𝑛4: [𝑛1, 𝑛2]\n    𝑛5: [𝑛4, 𝑛3]\n  𝑛: 𝑛5\n"       joins known "L_fork" `shouldBe` [("𝑛4", ("𝑛1", "𝑛2")), ("𝑛5", ("𝑛4", "𝑛3"))] -    it "reads an entry whose 'join' lines are lenient" $ do-      known <- lambdasOf "- λ: L_fork\n  morph:\n    𝑛1: $.then\n    𝑛2: $.else\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  lenient: true\n  𝑛: 𝑛3\n"+    it "reads an entry whose 'join' lines are lenient with no option" $ do+      known <- lambdasOf "- λ: L_fork\n  morph:\n    𝑛1: $.then\n    𝑛2: $.else\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  lenient: []\n  𝑛: 𝑛3\n"       fmap _lenient (matched known "L_fork") `shouldBe` Just True      it "reads an entry saying nothing of leniency as strict" $ do       known <- lambdasOf "- λ: L_fork\n  morph:\n    𝑛1: $.then\n    𝑛2: $.else\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  𝑛: 𝑛3\n"       fmap _lenient (matched known "L_fork") `shouldBe` Just False -    it "reads a lenient entry that defers a copy reading a bare symbol" $ do-      known <- lambdasOf "- λ: L_fork\n  morph:\n    𝑛1: $.then\n    𝑛2: $.else\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  lenient: true\n  defer: true\n  𝑛: 𝑛3\n"-      fmap _defer (matched known "L_fork") `shouldBe` Just True+    it "reads the lines of 'unfold' with the metas they read and whether they defer" $ do+      known <- lambdasOf "- λ: L_fork\n  morph:\n    𝑛1: $.a\n  unfold:\n    𝑛2: 𝑛1\n    𝑛3: {of: 𝑛2, defer: true}\n  𝑛: 𝑛3\n"+      unfolds known "L_fork" `shouldBe` [("𝑛2", "𝑛1", False), ("𝑛3", "𝑛2", True)] -    it "reads a lenient entry saying nothing of deferring as entering every copy" $ do-      known <- lambdasOf "- λ: L_fork\n  morph:\n    𝑛1: $.then\n    𝑛2: $.else\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  lenient: true\n  𝑛: 𝑛3\n"-      fmap _defer (matched known "L_fork") `shouldBe` Just False+    it "reads an 'unfold' line saying 'of' alone as one that does not defer" $ do+      known <- lambdasOf "- λ: L_fork\n  morph:\n    𝑛1: $.a\n  unfold:\n    𝑛2: {of: 𝑛1}\n  𝑛: 𝑛2\n"+      unfolds known "L_fork" `shouldBe` [("𝑛2", "𝑛1", False)] +    it "reads the two lines of an 'upcast' block as one pair" $ do+      known <- lambdasOf "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  upcast:\n    𝑛4: 𝑛2\n    𝑛3: 𝑛1\n  𝑛: 𝑛3\n"+      casts known "L_fork" `shouldBe` [(("𝑛3", "𝑛1"), ("𝑛4", "𝑛2"))]+     it "reads the terminators an entry names beside its 'join' block" $ do       known <- lambdasOf "- λ: L_fork\n  morph:\n    𝑛1: $.then\n    𝑛2: $.else\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  terminators: [L_throw, L_halt]\n  𝑛: 𝑛3\n"       fmap _terminators (matched known "L_fork") `shouldBe` Just ["L_throw", "L_halt"]@@ -220,9 +232,21 @@       known <- lambdasOf "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  symbolize:\n    𝑛4: 𝑛3\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  𝑛: 𝑛4\n"       order known "L_fork" `shouldBe` ["𝑛3", "𝑛4"] +    it "runs an 'upcast' block once the line binding either meta it reads has run" $ do+      known <- lambdasOf "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  upcast:\n    𝑛3: 𝑛1\n    𝑛5: 𝑛4\n  unfold:\n    𝑛4: 𝑛2\n  𝑛: 𝑛3\n"+      order known "L_fork" `shouldBe` ["𝑛4", "𝑛3", "𝑛5"]++    it "runs a line reading either meta an 'upcast' block binds after that block" $ do+      known <- lambdasOf "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  evaluate:\n    𝑛3: 𝑛5\n  upcast:\n    𝑛4: 𝑛1\n    𝑛5: 𝑛2\n  𝑛: 𝑛3\n"+      order known "L_fork" `shouldBe` ["𝑛4", "𝑛5", "𝑛3"]++    it "runs the lines of a fork in the order of the metas they read, whatever the order of their blocks" $ do+      known <- lambdasOf (T.concat ["- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  join:\n    𝑛15: [𝑛13, 𝑛14]\n  upcast:\n    𝑛13: 𝑛11\n    𝑛14: 𝑛12\n  symbolize:\n    𝑛11: 𝑛9\n    𝑛12: 𝑛10\n  stay:\n    𝑛9: 𝑛7\n    𝑛10: 𝑛8\n  rewrite:\n    𝑛7:\n      of: 𝑛5\n", rules, "    𝑛8:\n      of: 𝑛6\n", rules, "  unfold:\n    𝑛5: {of: 𝑛3, defer: true}\n    𝑛6: {of: 𝑛4, defer: true}\n  evaluate:\n    𝑛3: 𝑛1\n    𝑛4: 𝑛2\n  𝑛: 𝑛15\n"])+      order known "L_fork" `shouldBe` ["𝑛3", "𝑛4", "𝑛5", "𝑛6", "𝑛7", "𝑛8", "𝑛9", "𝑛10", "𝑛11", "𝑛12", "𝑛13", "𝑛14", "𝑛15"]+     it "runs the lines no meta orders in the order of their blocks" $ do-      known <- lambdasOf "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  symbolize:\n    𝑛4: 𝑛1\n  stay:\n    𝑛5: 𝑛2\n  evaluate:\n    𝑛6: 𝑛1\n  𝑛: 𝑛3\n"-      order known "L_fork" `shouldBe` ["𝑛6", "𝑛5", "𝑛4", "𝑛3"]+      known <- lambdasOf "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  upcast:\n    𝑛7: 𝑛1\n    𝑛9: 𝑛2\n  symbolize:\n    𝑛4: 𝑛1\n  stay:\n    𝑛5: 𝑛2\n  unfold:\n    𝑛8: 𝑛2\n  evaluate:\n    𝑛6: 𝑛1\n  𝑛: 𝑛3\n"+      order known "L_fork" `shouldBe` ["𝑛6", "𝑛8", "𝑛5", "𝑛4", "𝑛7", "𝑛9", "𝑛3"]      it "reads an entry naming no 'stay' block at all" $ do       known <- lambdasOf "- λ: L_fork\n  morph:\n    𝑛1: $.a\n  𝑛: 𝑛1\n"@@ -296,10 +320,24 @@       , ("an answer naming a meta no block binds", "- λ: L_pair\n  dataize:\n    𝛿1: $.ρ\n  𝑛: 𝑛7\n", "reads the meta 'n7' that no block binds")       , ("an operand of 'dataize' reading a meta", "- λ: L_pair\n  dataize:\n    𝛿1: 𝑛5\n  𝑛: ⟦ λ ⤍ 𝜎 ⟧\n", "of 'dataize' of λ function 'L_pair' reads the meta 'n5'")       , ("an operand of 'morph' reading a meta", "- λ: L_pair\n  morph:\n    𝑛1: $.x.𝜏1\n  𝑛: 𝑛1\n", "of 'morph' of λ function 'L_pair' reads the meta 't1'")-      , ("a lenient entry with no 'join' line to be lenient in", "- λ: L_pair\n  dataize:\n    𝛿1: $.ρ\n  lenient: true\n  𝑛: ⟦ λ ⤍ 𝜎 ⟧\n", "is lenient but has no 'join' line")-      , ("a 'lenient' key which is no boolean", "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  lenient: often\n  𝑛: 𝑛3\n", "lenient: expected Bool")-      , ("an entry that defers but is not lenient", "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  defer: true\n  𝑛: 𝑛3\n", "defers but is not lenient")-      , ("a 'defer' key which is no boolean", "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  lenient: true\n  defer: later\n  𝑛: 𝑛3\n", "defer: expected Bool")+      , ("a lenient entry with no 'join' line to be lenient in", "- λ: L_pair\n  dataize:\n    𝛿1: $.ρ\n  lenient: []\n  𝑛: ⟦ λ ⤍ 𝜎 ⟧\n", "is lenient but has no 'join' line")+      , ("a 'lenient' key which is no list", "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  lenient: true\n  𝑛: 𝑛3\n", "lenient: parsing [] failed, expected Array")+      , ("a 'lenient' key naming an option phino does not know", "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  lenient: [defr]\n  𝑛: 𝑛3\n", "The option 'defr' of 'lenient' of λ function 'L_fork' is unknown")+      , ("a 'lenient' key naming 'defer', which an 'unfold' line took over", "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  lenient: [defer]\n  𝑛: 𝑛3\n", "The option 'defer' of 'lenient' of λ function 'L_fork' is gone")+      , ("a 'lenient' key naming 'upcast', which an 'upcast' line took over", "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  lenient: [upcast, defer]\n  𝑛: 𝑛3\n", "The option 'upcast' of 'lenient' of λ function 'L_fork' is gone")+      , ("an 'unfold' line unfolding a meta the entry never bound", "- λ: L_fork\n  morph:\n    𝑛1: $.a\n  unfold:\n    𝑛3: 𝑛2\n  𝑛: 𝑛3\n", "names no meta bound by 'morph' or by any line")+      , ("an 'unfold' line naming a list", "- λ: L_fork\n  morph:\n    𝑛1: $.a\n  unfold:\n    𝑛2: [𝑛1]\n  𝑛: 𝑛2\n", "The line '𝑛2' of 'unfold' of λ function 'L_fork' names neither a meta nor a mapping with 'of'")+      , ("an 'unfold' line with no 'of'", "- λ: L_fork\n  morph:\n    𝑛1: $.a\n  unfold:\n    𝑛2: {defer: true}\n  𝑛: 𝑛2\n", "key \"of\" not found")+      , ("an 'unfold' line whose 'defer' is no flag", "- λ: L_fork\n  morph:\n    𝑛1: $.a\n  unfold:\n    𝑛2: {of: 𝑛1, defer: often}\n  𝑛: 𝑛2\n", "expected Bool")+      , ("an 'upcast' block holding one line", "- λ: L_fork\n  morph:\n    𝑛1: $.a\n  upcast:\n    𝑛2: 𝑛1\n  𝑛: 𝑛2\n", "The 'upcast' block of λ function 'L_fork' holds 1 line, while it casts one pair and takes exactly two")+      , ("an 'upcast' block holding three lines", "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n    𝑛3: $.c\n  upcast:\n    𝑛4: 𝑛1\n    𝑛5: 𝑛2\n    𝑛6: 𝑛3\n  𝑛: 𝑛4\n", "The 'upcast' block of λ function 'L_fork' holds 3 lines, while it casts one pair and takes exactly two")+      , ("an 'upcast' line written as the gone mapping with 'of' and 'to'", "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  upcast:\n    𝑛3: {of: 𝑛1, to: 𝑛2}\n    𝑛4: 𝑛2\n  𝑛: 𝑛3\n", "The line '𝑛3' of 'upcast' of λ function 'L_fork' names no meta")+      , ("an 'upcast' line reading a meta the entry never bound", "- λ: L_fork\n  morph:\n    𝑛1: $.a\n  upcast:\n    𝑛3: 𝑛1\n    𝑛4: 𝑛2\n  𝑛: 𝑛3\n", "names no meta bound by 'morph' or by any line")+      , ("a meta bound by 'unfold' and again by 'upcast'", "- λ: L_fork\n  morph:\n    𝑛1: $.a\n  unfold:\n    𝑛2: 𝑛1\n  upcast:\n    𝑛2: 𝑛1\n    𝑛3: 𝑛1\n  𝑛: 𝑛2\n", "The meta '𝑛2' of λ function 'L_fork' is bound by more than one line")+      , ("an 'upcast' block reading a meta it binds itself", "- λ: L_fork\n  morph:\n    𝑛1: $.a\n  upcast:\n    𝑛2: 𝑛1\n    𝑛3: 𝑛2\n  𝑛: 𝑛2\n", "reads the meta it binds")+      , ("a misspelled 'lenient' key", "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  lenent: []\n  𝑛: 𝑛3\n", "The key 'lenent' of λ function 'L_fork' is none of the keys an entry reads")+      , ("a 'defer' key beside 'lenient', which now lists it", "- λ: L_fork\n  morph:\n    𝑛1: $.a\n    𝑛2: $.b\n  join:\n    𝑛3: [𝑛1, 𝑛2]\n  lenient: []\n  defer: true\n  𝑛: 𝑛3\n", "The key 'defer' of λ function 'L_fork' is none of the keys an entry reads")+      , ("a misspelled 'dataize' block", "- λ: L_pair\n  datize:\n    𝛿1: $.ρ\n  𝑛: ⟦ λ ⤍ 𝜎 ⟧\n", "The key 'datize' of λ function 'L_pair' is none of the keys an entry reads")       , ("a 'terminators' key which is no list", "- λ: L_fork\n  morph:\n    𝑛1: $.a\n  terminators: L_throw\n  𝑛: 𝑛1\n", "expected Array")       ,         ( "a terminator an entry of the file answers"@@ -558,6 +596,14 @@       made <- joining True "⟦ λ ⤍ 𝜎3 ⟧" "⟦ φ ↦ ⟦ λ ⤍ 𝜎6 ⟧, neg ↦ ⟦⟧ ⟧" 7       made `shouldBe` Just (term, [(8, (3, 6))], 8) +    it "joins the cast of a bare symbol with the term it was cast to symbol by symbol" $ do+      made <- joining False "Φ.tuple( tail ↦ ⟦ λ ⤍ 𝜎5 ⟧, head ↦ ⟦ λ ⤍ 𝜎6 ⟧, length ↦ ⟦ λ ⤍ 𝜎7 ⟧ )" "Φ.tuple( tail ↦ ⟦ λ ⤍ 𝜎2 ⟧, head ↦ ⟦ λ ⤍ 𝜎3 ⟧, length ↦ ⟦ λ ⤍ 𝜎4 ⟧ )" 7+      fmap (\(_, facts, _) -> facts) made `shouldBe` Just [(8, (5, 2)), (9, (6, 3)), (10, (7, 4))]++    it "cannot join a bare symbol with a term holding three symbols even when lenient" $ do+      made <- joining True "⟦ λ ⤍ 𝜎1 ⟧" "Φ.tuple( tail ↦ ⟦ λ ⤍ 𝜎2 ⟧, head ↦ ⟦ λ ⤍ 𝜎3 ⟧, length ↦ ⟦ λ ⤍ 𝜎4 ⟧ )" 4+      made `shouldBe` Nothing+     forM_       [ ("a term with a formation carrying no φ" :: String, "Φ.number( φ ↦ ⟦ λ ⤍ 𝜎1 ⟧ )" :: String, "⟦ neg ↦ Φ.number( φ ↦ ⟦ λ ⤍ 𝜎2 ⟧ ) ⟧" :: String)       , ("a term with a decorator of a term of another forma", "Φ.number( φ ↦ ⟦ λ ⤍ 𝜎1 ⟧ )", "⟦ φ ↦ Φ.bool( φ ↦ ⟦ λ ⤍ 𝜎2 ⟧ ) ⟧")@@ -588,6 +634,67 @@           it ("cannot join " ++ desc) $ do             made <- joining False left right 4             fmap (\(joint, _, _) -> joint) made `shouldBe` Nothing+      )++  describe "upcasted" $ do+    let casting :: String -> String -> Int -> IO (Maybe (Int, Expression, [(Int, [Attribute])], Int))+        casting source shape spent = do+          one <- parseExpressionThrows source+          two <- parseExpressionThrows shape+          pure (upcasted one two spent)++    it "casts a bare symbol into a copy of the other term made of fresh symbols" $ do+      cast <- parseExpressionThrows "Φ.tuple( tail ↦ ⟦ λ ⤍ 𝜎5 ⟧, head ↦ ⟦ λ ⤍ 𝜎6 ⟧, length ↦ ⟦ λ ⤍ 𝜎7 ⟧ )"+      made <- casting "⟦ λ ⤍ 𝜎1 ⟧" "Φ.tuple( tail ↦ ⟦ λ ⤍ 𝜎2 ⟧, head ↦ ⟦ λ ⤍ 𝜎3 ⟧, length ↦ ⟦ λ ⤍ 𝜎4 ⟧ )" 4+      made `shouldBe` Just (1, cast, [(5, [AtLabel "tail"]), (6, [AtLabel "head"]), (7, [AtLabel "length"])], 7)++    it "counts the symbols of the cast into the state" $ do+      made <- casting "⟦ λ ⤍ 𝜎9 ⟧" "Φ.pair( left ↦ ⟦ λ ⤍ 𝜎2 ⟧, right ↦ ⟦ λ ⤍ 𝜎3 ⟧ )" 12+      fmap (\(_, _, _, spent) -> spent) made `shouldBe` Just 14++    it "reads a symbol in the φ chain of a data object by a path through every φ" $ do+      made <- casting "⟦ λ ⤍ 𝜎1 ⟧" "Φ.number( φ ↦ Φ.bytes( φ ↦ ⟦ λ ⤍ 𝜎2 ⟧ ) )" 6+      fmap (\(_, _, paths, _) -> paths) made `shouldBe` Just [(7, [AtPhi, AtPhi])]++    it "reads the one symbol of a decorated term by its path" $ do+      cast <- parseExpressionThrows "⟦ φ ↦ Φ.bool( if ↦ ⟦ λ ⤍ L_fork, φ ↦ ⟦ λ ⤍ 𝜎5 ⟧ ⟧ ) ⟧"+      made <- casting "⟦ λ ⤍ 𝜎1 ⟧" "⟦ φ ↦ Φ.bool( if ↦ ⟦ λ ⤍ L_fork, φ ↦ ⟦ λ ⤍ 𝜎2 ⟧ ⟧ ) ⟧" 4+      made `shouldBe` Just (1, cast, [(5, [AtPhi, AtLabel "if", AtPhi])], 5)++    it "casts every symbol of a formation carrying no φ" $ do+      cast <- parseExpressionThrows "⟦ kj ↦ ⟦ λ ⤍ 𝜎12 ⟧, vy ↦ ⟦ λ ⤍ 𝜎13 ⟧, ρ ↦ ⟦⟧ ⟧"+      made <- casting "⟦ λ ⤍ 𝜎9 ⟧" "⟦ kj ↦ ⟦ λ ⤍ 𝜎3 ⟧, vy ↦ ⟦ λ ⤍ 𝜎5 ⟧, ρ ↦ ⟦⟧ ⟧" 11+      fmap (\(_, term, _, _) -> term) made `shouldBe` Just cast++    it "reads the symbol a formation carries by the path of that formation" $ do+      made <- casting "⟦ λ ⤍ 𝜎1 ⟧" "⟦ x ↦ ⟦ λ ⤍ 𝜎2, q ↦ ⟦⟧ ⟧ ⟧" 4+      fmap (\(_, _, paths, _) -> paths) made `shouldBe` Just [(5, [AtLabel "x"])]++    it "mints a fresh symbol for every place a symbol of the other term stands at" $ do+      made <- casting "⟦ λ ⤍ 𝜎1 ⟧" "Φ.f( a ↦ ⟦ λ ⤍ 𝜎2 ⟧ )( b ↦ ⟦ λ ⤍ 𝜎2 ⟧ )" 4+      fmap (\(_, _, paths, _) -> paths) made `shouldBe` Just [(5, [AtLabel "a"]), (6, [AtLabel "b"])]++    it "casts a bare symbol into the φ chain of a formation ending in a symbol" $ do+      cast <- parseExpressionThrows "⟦ φ ↦ ⟦ λ ⤍ 𝜎8 ⟧, neg ↦ ⟦⟧ ⟧"+      made <- casting "⟦ λ ⤍ 𝜎3 ⟧" "⟦ φ ↦ ⟦ λ ⤍ 𝜎6 ⟧, neg ↦ ⟦⟧ ⟧" 7+      fmap (\(_, term, _, _) -> term) made `shouldBe` Just cast++    it "cannot cast a term that is no bare symbol" $ do+      made <- casting "Φ.pair( a ↦ ⟦ λ ⤍ 𝜎1 ⟧, b ↦ ⟦ λ ⤍ 𝜎2 ⟧ )" "Φ.pair( a ↦ Φ.t( x ↦ ⟦ λ ⤍ 𝜎3 ⟧ ), b ↦ ⟦ λ ⤍ 𝜎5 ⟧ )" 5+      made `shouldBe` Nothing++    forM_+      [ ("a call holding a symbol no path reaches" :: String, "⟦ k ↦ ⟦⟧ ⟧.slice( start ↦ ⟦ λ ⤍ 𝜎2 ⟧ )" :: String)+      , ("a call holding symbols in its arguments", "⟦ k ↦ ⟦⟧ ⟧.slice( start ↦ ⟦ λ ⤍ 𝜎2 ⟧, len ↦ ⟦ λ ⤍ 𝜎3 ⟧ )")+      , ("a term holding symbols in a dispatch", "Φ.f( a ↦ ⟦ λ ⤍ 𝜎2 ⟧.plus( x ↦ ⟦ λ ⤍ 𝜎3 ⟧ ) )")+      , ("a term holding symbols in positional arguments", "Φ.f( α0 ↦ ⟦ λ ⤍ 𝜎2 ⟧, α1 ↦ ⟦ λ ⤍ 𝜎3 ⟧ )")+      , ("a term holding no symbol", "Φ.tuple.empty")+      , ("another bare symbol", "⟦ λ ⤍ 𝜎2 ⟧")+      ]+      ( \(desc, shape) ->+          it ("cannot cast a bare symbol to " ++ desc) $ do+            made <- casting "⟦ λ ⤍ 𝜎1 ⟧" shape 4+            made `shouldBe` Nothing       )    describe "thrown" $ do
test/MorphSpec.hs view
@@ -20,7 +20,7 @@ import Data.Maybe (fromMaybe) import Data.Yaml qualified as Decode import Dataize (Outcome (..), dataize)-import Deps (Acyclic (..), Judgment (..), State, Term (TeExpression))+import Deps (Acyclic (..), Evaluation (EvWorld), Judgment (..), State, Term (TeExpression)) import Engine (Engine (_normal)) import Files (allPathsIn) import Fixtures (defaultReduceContext, fixtureLambdas, linked, overdue, primitives)@@ -102,6 +102,14 @@       ctx <- defaultReduceContext loc       _ <- morph expr emptyState ctx{_saveStep = const (modifyIORef' saved (+ 1))}       readIORef saved `shouldReturn` 2++    it "tells the protocol the world it has normalized" $ do+      expr <- parseExpressionThrows "[[ ezh -> [[ D> 0E- ]] ]]"+      told <- newIORef []+      ctx <- defaultReduceContext ExRoot+      _ <- morph expr emptyState ctx{_saveEval = \record -> modifyIORef' told (record :)}+      records <- readIORef told+      [world | EvWorld world <- records] `shouldBe` [expr]    describe "morph'" $     test'