phino 0.0.0.52 → 0.0.0.53

raw patch · 48 files changed

+4043/−1640 lines, 48 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +380/−0
• phino.cabal +8/−1
• src/AST.hs +7/−5
• src/Builder.hs +17/−17
• src/CLI.hs +123/−111
• src/CST.hs +13/−9
• src/Condition.hs +27/−27
• src/Dataize.hs +9/−9
• src/Deps.hs +1/−1
• src/Encoding.hs +33/−31
• src/Filter.hs +0/−0
• src/LaTeX.hs +133/−50
• src/Lining.hs +19/−17
• src/Logger.hs +8/−8
• src/Matcher.hs +10/−4
• src/Merge.hs +2/−2
• src/Misc.hs +26/−26
• src/Must.hs +5/−5
• src/Parser.hs +77/−77
• src/Printer.hs +12/−12
• src/Regexp.hs +1/−1
• src/Render.hs +60/−55
• src/Replacer.hs +57/−97
• src/Rewriter.hs +35/−33
• src/Rule.hs +16/−7
• src/Sugar.hs +35/−33
• src/XMIR.hs +46/−46
• src/Yaml.hs +33/−33
• test/ASTSpec.hs +269/−0
• test/BuilderSpec.hs +66/−57
• test/CLISpec.hs +144/−115
• test/CSTSpec.hs +6/−5
• test/ConditionSpec.hs +23/−23
• test/DataizeSpec.hs +108/−101
• test/FilterSpec.hs +202/−7
• test/LaTeXSpec.hs +303/−0
• test/MatcherSpec.hs +400/−321
• test/MergeSpec.hs +30/−23
• test/MiscSpec.hs +39/−32
• test/MustSpec.hs +318/−0
• test/ParserSpec.hs +117/−110
• test/PrinterSpec.hs +244/−0
• test/RandomSpec.hs +150/−0
• test/ReplacerSpec.hs +81/−76
• test/RewriterSpec.hs +9/−9
• test/RuleSpec.hs +5/−5
• test/SugarSpec.hs +289/−0
• test/XMIRSpec.hs +47/−39

@@ -0,0 +1,380 @@+# Command-Line Manipulator of 𝜑-Calculus Expressions++[![DevOps By Rultor.com](https://www.rultor.com/b/objectionary/phino)](https://www.rultor.com/p/objectionary/phino)++[![`phino` on Hackage](https://img.shields.io/hackage/v/phino)](http://hackage.haskell.org/package/phino)+[![cabal-linux](https://github.com/objectionary/phino/actions/workflows/cabal.yml/badge.svg)](https://github.com/objectionary/phino/actions/workflows/cabal.yml)+[![stack-linux](https://github.com/objectionary/phino/actions/workflows/stack.yml/badge.svg)](https://github.com/objectionary/phino/actions/workflows/stack.yml)+[![codecov](https://codecov.io/gh/objectionary/phino/branch/master/graph/badge.svg)](https://app.codecov.io/gh/objectionary/phino)+[![Haddock](https://img.shields.io/badge/docs-Haddock-blue.svg)](https://objectionary.github.io/phino/)+[![License](https://img.shields.io/badge/license-MIT-green.svg)](LICENSES/MIT.txt)+[![Hits-of-Code](https://hitsofcode.com/github/objectionary/phino?branch=master&label=Hits-of-Code)](https://hitsofcode.com/github/objectionary/phino/view?branch=master&label=Hits-of-Code)+[![PDD status](https://www.0pdd.com/svg?name=objectionary/phino)](https://www.0pdd.com/p?name=objectionary/phino)++This is a command-line normalizer, rewriter, and dataizer+of [𝜑-calculus](https://www.eolang.org) expressions.++First, you write a simple [𝜑-calculus](https://www.eolang.org) program+in the `hello.phi` file:++```text+Φ ↦ ⟦ φ ↦ ⟦ Δ ⤍ 68-65-6C-6C-6F ⟧, t ↦ ξ.k, k ↦ ⟦⟧ ⟧+```++## Installation++Then you can install `phino` in two ways:++Install [Cabal][cabal] first and then:++```bash+cabal update+cabal install --overwrite-policy=always phino-0.0.0.52+phino --version+```++Or download binary from the internet using [curl](https://curl.se/) or+[wget](https://en.wikipedia.org/wiki/Wget):++```bash+sudo curl -o /usr/local/bin/phino http://phino.objectionary.com/releases/macos-15/phino-latest+sudo chmod +x /usr/local/bin/phino+phino --version+```++Download paths are:++* Ubuntu: <http://phino.objectionary.com/releases/ubuntu-24.04/phino-latest>+* MacOS: <http://phino.objectionary.com/releases/macos-15/phino-latest>++## Build++To build `phino` from source, clone this repository:++```bash+git clone git@github.com:objectionary/phino.git+cd phino+```++Then, run the following command (ensure you have [Cabal][cabal] installed):++```bash+cabal build all+```++Next, run this command to install `phino` system-wide:++```bash+sudo cp "$(cabal list-bin phino)" /usr/local/bin/phino+```++Verify that `phino` is installed correctly:++```bash+phino --version+0.0.0.0+```++## Dataize++Then, you dataize the program:++```bash+$ phino dataize hello.phi+68-65-6C-6C-6F+```++## Rewrite++You can rewrite this expression with the help of [rules](#rule-structure)+defined in the `my-rule.yml` YAML file (here, the `!d` is a capturing group,+similar to regular expressions):++```yaml+name: My custom rule+pattern: Δ ⤍ !d+result: Δ ⤍ 62-79-65+```++Then, rewrite:++```bash+$ phino rewrite --rule=my-rule.yml hello.phi+Φ ↦ ⟦ φ ↦ ⟦ Δ ⤍ 62-79-65 ⟧, t ↦ ξ.k, k ↦ ⟦⟧ ⟧+```++If you want to use many rules, just use `--rule` as many times as you need:++```bash+phino rewrite --rule=rule1.yaml --rule=rule2.yaml ...+```++You can also use [built-in rules](resources), which are designed+to normalize expressions:++```bash+phino rewrite --normalize hello.phi+```++If no input file is provided, the 𝜑-expression is taken from `stdin`:++```bash+$ echo 'Φ ↦ ⟦ φ ↦ ⟦ Δ ⤍ 68-65-6C-6C-6F ⟧ ⟧' | phino rewrite --rule=my-rule.yml+Φ ↦ ⟦ φ ↦ ⟦ Δ ⤍ 62-79-65 ⟧ ⟧+```++You're able to pass [`XMIR`][xmir] as input. Use `--input=xmir` and `phino`+will parse given `XMIR` from file or `stdin` and convert it to `phi` AST.++```bash+phino rewrite --rule=my-rule.yaml --input=xmir file.xmir+```++Also `phino` supports 𝜑-expressions in+[ASCII](https://en.wikipedia.org/wiki/ASCII) format and with+syntax sugar. The `rewrite` command also allows you to desugar the expression+and print it in canonical syntax:++```bash+$ echo 'Q -> [[ @ -> QQ.io.stdout("hello") ]]' | phino rewrite+Φ ↦ ⟦+  φ ↦ Φ.org.eolang.io.stdout(+    α0 ↦ Φ.org.eolang.string(+      α0 ↦ Φ.org.eolang.bytes(+        α0 ↦ ⟦ Δ ⤍ 68-65-6C-6C-6F ⟧+      )+    )+  )+⟧+```++## Merge++You can merge several 𝜑-programs into a single one by merging their+top level formations:++```bash+$ cat bytes.phi+{⟦+  org ↦ ⟦+    eolang ↦ ⟦+      bytes ↦ ⟦+        data ↦ ∅,+        φ ↦ data+      ⟧+    ⟧+  ⟧+⟧}+$ cat number.phi+{⟦+  org ↦ ⟦+    eolang ↦ ⟦+      number ↦ ⟦+        as-bytes ↦ ∅,+        φ ↦ as-bytes,+        plus(x) ↦ ⟦+          λ ⤍ L_org_eolang_number_plus+        ⟧+      ⟧+    ⟧+  ⟧+⟧}+$ cat foo.phi+{⟦+  foo ↦ 5.plus(3)+⟧}+$ phino merge bytes.phi number.phi foo.phi --sweet+{⟦+  org ↦ ⟦+    eolang ↦ ⟦+      bytes ↦ ⟦+        data ↦ ∅,+        φ ↦ data+      ⟧,+      number ↦ ⟦+        as-bytes ↦ ∅,+        φ ↦ as-bytes,+        plus(x) ↦ ⟦+          λ ⤍ L_org_eolang_number_plus+        ⟧+      ⟧+    ⟧+  ⟧,+  foo ↦ 5.plus(3)+⟧}+```++## Match++You can test the 𝜑-program matches against the [rule](#rule-structure)+pattern. The result output contains matched substitutions:++```bash+$ phino match --pattern='⟦ Δ ⤍ !d, !B ⟧' hello.phi+B >> ⟦ ρ ↦ ∅ ⟧+d >> 68-65-6C-6C-6F+```++## Explain (under development)++You can _explain_ rewriting rule by printing them in [LaTeX][latex]format:++```bash+$ phino explain --rule=my-rule.yaml+\documentclass{article}+\usepackage{amsmath}+\begin{document}+\rule{My custom rule}+\...+\end{document}+```++For more details, use `phino [COMMAND] --help` option.++## Rule structure++This is BNF-like yaml rule structure. Here types ended with+apostrophe, like `Attribute'` are built types from 𝜑-program [AST](src/AST.hs)++```bnfc+Rule:+  name: String?+  pattern: String+  result: String+  when: Condition?       # predicate, works with substitutions before extension+  where: [Extension]?    # substitution extensions+  having: Condition?     # predicate, works with substitutions after extension++Condition:+  = and: [Condition]     # logical AND+  | or:  [Condition]     # logical OR+  | not: Condition       # logical NOT+  | alpha: Attribute'    # check if given attribute is alpha+  | eq:                  # compare two comparable objects+      - Comparable+      - Comparable+  | in:                  # check if attributes exist in bindings+      - Attribute'+      - Binding'+  | nf: Expression'      # returns True if given expression in normal form+                         # which means that no more other normalization rules+                         # can be applied+  | xi: Expression'      # special condition for Rcopy normalization rule to+                         # avoid infinite recursion while the condition checking+                         # returns True if there's no ξ outside of the formation+                         # in given expression.+  | matches:             # returns True if given expression after dataization+      - String           # matches to given regex+      - Expression+  | part-of:             # returns True if given expression is attached to any+      - Expression'      # attribute in ginve bindings+      - BiMeta'++Comparable:              # comparable object that may be used in 'eq' condition+  = Attribute'+  | Number+  | Expression'++Number:                  # comparable number+  = Integer              # just regular integer+  | ordinal: Attribute'  # calculate index of alpha attribute+  | length: BiMeta'      # calculate length of bindings by given meta binding++Extension:               # substitutions extension used to introduce new meta variables+  meta: [ExtArgument]    # new introduced meta variable+  function: String       # name of the function+  args: [ExtArgument]    # arguments of the function++ExtArgument+  = Bytes'               # !d+  | Binding'             # !B+  | Expression'          # !e+  | Attribute'           # !a+```++Here's list of functions that are supported for extensions:++* `contextualize` - function of two arguments, that rewrites given expression+  depending on provided context according to the contextualization+  [rules](assets/contextualize.jpg)+* `scope` - resolves the scope for given expression. Works only with meta+  expressions denotes as `𝑒` or `!e`. The scope is nearest outer formation,+  if it's present. In all other cases the default scope is used, which is+  anonymous formation `⟦ ρ ↦ ∅ ⟧`.+* `random-tau` - creates attribute with random unique name. Accepts bindings,+  and attributes. Ensures that created attribute is not present in list of+  provided attributes and does not exist as attribute in provided bindings.+* `dataize` - dataizes given expression and returns bytes.+* `concat` - accepts bytes or dataizable expressions as arguments,+  concatenates them into single sequence and convert it to expression+  that can be pretty printed as human readable string:+  `Φ.org.eolang.string(Φ.org.eolang.bytes⟦ Δ ⤍ !d ⟧)`.+* `sed` - pattern replacer, works like unix `sed` function.+  Accepts two arguments: target expression and pattern.+  Pattern must start with `s/`, consists of three parts+  separated by `/`, for example, this pattern `s/\\s+//g`+  replaces all the spaces with empty string. To escape braces and slashes+  in pattern and replacement parts - use them with `\\`,+  e.g. `s/\\(.+\\)//g`.+* `random-string` - accepts dataizable expression or bytes as pattern.+  Replaces `%x` and `%d` formatters with random hex numbers and+  decimals accordingly. Uniqueness is guaranteed during one+  execution of `phino`.+* `size` - accepts exactly one meta binding and returns size of it and+  `Φ̇.number`.+* `tau` - accepts `Φ̇.string`, dataizes it and converts it to attribute.+  If dataized string can't be converted to attribute - an error is thrown.+* `string` - accepts `Φ̇.string` or `Φ̇.number` or attribute and converts it+  to `Φ̇.string`.+* `number` - accepts `Φ̇.string` and converts it `Φ̇.number`+* `sum` - accepts list of `Φ̇.number` or `Φ̇.bytes` and returns sum of them as `Φ̇.number`+* `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.++## Meta variables++The `phino` supports meta variables to write 𝜑-expression patterns for+capturing attributes, bindings, etc.++This is the list of supported meta variables:++* `!a` || `𝜏` - attribute+* `!e` || `𝑒` - any expression+* `!B` || `𝐵` - list of bindings+* `!d` || `δ` - bytes in meta delta binding+* `!t` - tail after expression, sequence of applications and/or dispatches,+         must start only with dispatch+* `!F` - function name in meta lambda binding++Every meta variable may also be used with an integer index, like `!B1` or `𝜏0`.++Incorrect usage of meta variables in 𝜑-expression patterns leads to+parsing errors.++## How to Contribute++Fork repository, make changes, then send us a [pull request][guidelines].+We will review your changes and apply them to the `master` branch shortly,+provided they don't violate our quality standards. To avoid frustration,+before sending us your pull request please make sure all your tests pass:++```bash+cabal build all+make+```++To generate a local coverage report for development, run:++```bash+cabal test --enable-coverage+```++You will need [GHC] and [Cabal ≥3.0][cabal] or [Stack ≥ 3.0][stack] installed.++[cabal]: https://www.haskell.org/cabal/+[stack]: https://docs.haskellstack.org/en/stable/install_and_upgrade/+[GHC]: https://www.haskell.org/ghc/+[guidelines]: https://www.yegor256.com/2014/04/15/github-guidelines.html+[xmir]: https://news.eolang.org/2022-11-25-xmir-guide.html+[latex]: https://en.wikipedia.org/wiki/LaTeX

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: phino-version: 0.0.0.52+version: 0.0.0.53 license: MIT synopsis: Command-Line Manipulator of 𝜑-Calculus Expressions description: Please see the README on GitHub at <https://github.com/objectionary/phino#readme>@@ -13,6 +13,7 @@ category: Language, Code Analysis build-type: Simple extra-source-files: resources/*.yaml+extra-doc-files: README.md  source-repository head   type: git@@ -112,6 +113,7 @@   main-is: Main.hs   hs-source-dirs: test   other-modules:+    ASTSpec     BuilderSpec     CLISpec     ConditionSpec@@ -119,15 +121,20 @@     DataizeSpec     FilterSpec     FunctionsSpec+    LaTeXSpec     MatcherSpec     MergeSpec     MiscSpec+    MustSpec     ParserSpec     Paths_phino+    PrinterSpec+    RandomSpec     ReplacerSpec     RewriterSpec     RuleSpec     Spec+    SugarSpec     XMIRSpec     YamlSpec 

@@ -18,18 +18,20 @@   | ExThis   | ExGlobal -- Q   | ExTermination -- T-  | ExMeta String -- !e   | ExApplication Expression Binding -- expr(attr -> expr)   | ExDispatch Expression Attribute -- expr.attr+  | ExMeta String -- !e   | ExMetaTail Expression String -- expr * !t+  | ExPhiMeet Int Expression+  | ExPhiAgain Int Expression   deriving (Eq, Ord, Show, Generic)  data Binding   = BiTau Attribute Expression -- attr -> expr-  | BiMeta String -- !B   | BiDelta Bytes -- Δ ⤍ 1F-2A   | BiVoid Attribute -- attr ↦ ?   | BiLambda String -- λ ⤍ Function+  | BiMeta String -- !B   | BiMetaLambda String -- λ ⤍ !F   deriving (Eq, Ord, Show, Generic) @@ -42,7 +44,7 @@  data Attribute   = AtLabel String -- attr-  | AtAlpha Integer -- α1+  | AtAlpha Int -- α1   | AtPhi -- φ   | AtRho -- ρ   | AtLambda -- λ, used only in yaml conditions@@ -59,10 +61,10 @@   show AtLambda = "λ"   show (AtMeta meta) = '!' : meta -countNodes :: Program -> Integer+countNodes :: Program -> Int countNodes (Program expr) = countNodes' expr   where-    countNodes' :: Expression -> Integer+    countNodes' :: Expression -> Int     countNodes' ExGlobal = 1     countNodes' ExTermination = 1     countNodes' ExThis = 1

@@ -8,17 +8,17 @@ -- pattern expression and set of substitutions by replacing -- meta variables with appropriate meta values module Builder-  ( buildExpressions,-    buildExpression,-    buildExpressionThrows,-    buildAttribute,-    buildAttributeThrows,-    buildBinding,-    buildBindingThrows,-    buildBytes,-    buildBytesThrows,-    contextualize,-    BuildException (..),+  ( buildExpressionsThrows+  , buildExpression+  , buildExpressionThrows+  , buildAttribute+  , buildAttributeThrows+  , buildBinding+  , buildBindingThrows+  , buildBytes+  , buildBytesThrows+  , contextualize+  , BuildException (..)   ) where @@ -44,22 +44,22 @@ type Built a = Either String a  instance Show BuildException where-  show CouldNotBuildExpression {..} =+  show CouldNotBuildExpression{..} =     printf       "Couldn't build expression, %s\n--Expression: %s"       _msg       (printExpression _expr)-  show CouldNotBuildAttribute {..} =+  show CouldNotBuildAttribute{..} =     printf       "Couldn't build attribute '%s', %s"       (printAttribute _attr)       _msg-  show CouldNotBuildBinding {..} =+  show CouldNotBuildBinding{..} =     printf       "Couldn't build binding, %s\n--Binding: %s"       _msg       (printBinding _bd)-  show CouldNotBuildBytes {..} =+  show CouldNotBuildBytes{..} =     printf       "Couldn't build bytes '%s', %s"       (printBytes _bts)@@ -177,5 +177,5 @@   Left msg -> throwIO (CouldNotBuildExpression expr msg)  -- Build a several expression from one expression and several substitutions-buildExpressions :: Expression -> [Subst] -> IO [(Expression, Expression)]-buildExpressions expr = traverse (buildExpressionThrows expr)+buildExpressionsThrows :: Expression -> [Subst] -> IO [(Expression, Expression)]+buildExpressionsThrows expr = traverse (buildExpressionThrows expr)

@@ -50,13 +50,14 @@ import qualified Yaml as Y  data PrintProgramContext = PrintProgCtx-  { sugar :: SugarType,-    line :: LineFormat,-    xmirCtx :: XmirContext,-    nonumber :: Bool,-    expression :: Maybe String,-    label :: Maybe String,-    outputFormat :: IOFormat+  { sugar :: SugarType+  , line :: LineFormat+  , xmirCtx :: XmirContext+  , nonumber :: Bool+  , compress :: Bool+  , expression :: Maybe String+  , label :: Maybe String+  , outputFormat :: IOFormat   }  data CmdException@@ -66,8 +67,8 @@   deriving (Exception)  instance Show CmdException where-  show InvalidCLIArguments {..} = printf "Invalid set of arguments: %s" message-  show CouldNotReadFromStdin {..} = printf "Could not read input from stdin\nReason: %s" message+  show InvalidCLIArguments{..} = printf "Invalid set of arguments: %s" message+  show CouldNotReadFromStdin{..} = printf "Could not read input from stdin\nReason: %s" message   show CouldNotDataize = "Could not dataize given program"  data Command@@ -86,91 +87,93 @@   show LATEX = "latex"  data OptsDataize = OptsDataize-  { logLevel :: LogLevel,-    logLines :: Integer,-    inputFormat :: IOFormat,-    outputFormat :: IOFormat,-    sugarType :: SugarType,-    flat :: LineFormat,-    omitListing :: Bool,-    omitComments :: Bool,-    nonumber :: Bool,-    sequence :: Bool,-    depthSensitive :: Bool,-    quiet :: Bool,-    maxDepth :: Integer,-    maxCycles :: Integer,-    hide :: [String],-    show' :: [String],-    expression :: Maybe String,-    label :: Maybe String,-    stepsDir :: Maybe FilePath,-    inputFile :: Maybe FilePath+  { logLevel :: LogLevel+  , logLines :: Int+  , inputFormat :: IOFormat+  , outputFormat :: IOFormat+  , sugarType :: SugarType+  , flat :: LineFormat+  , omitListing :: Bool+  , omitComments :: Bool+  , nonumber :: Bool+  , sequence :: Bool+  , depthSensitive :: Bool+  , quiet :: Bool+  , compress :: Bool+  , maxDepth :: Int+  , maxCycles :: Int+  , hide :: [String]+  , show' :: [String]+  , expression :: Maybe String+  , label :: Maybe String+  , stepsDir :: Maybe FilePath+  , inputFile :: Maybe FilePath   }  data OptsExplain = OptsExplain-  { logLevel :: LogLevel,-    logLines :: Integer,-    rules :: [FilePath],-    normalize :: Bool,-    shuffle :: Bool,-    targetFile :: Maybe FilePath+  { logLevel :: LogLevel+  , logLines :: Int+  , rules :: [FilePath]+  , normalize :: Bool+  , shuffle :: Bool+  , targetFile :: Maybe FilePath   }  data OptsRewrite = OptsRewrite-  { logLevel :: LogLevel,-    logLines :: Integer,-    inputFormat :: IOFormat,-    outputFormat :: IOFormat,-    sugarType :: SugarType,-    flat :: LineFormat,-    must :: Must,-    normalize :: Bool,-    shuffle :: Bool,-    omitListing :: Bool,-    omitComments :: Bool,-    depthSensitive :: Bool,-    nonumber :: Bool,-    inPlace :: Bool,-    sequence :: Bool,-    canonize :: Bool,-    maxDepth :: Integer,-    maxCycles :: Integer,-    rules :: [FilePath],-    hide :: [String],-    show' :: [String],-    expression :: Maybe String,-    label :: Maybe String,-    targetFile :: Maybe FilePath,-    stepsDir :: Maybe FilePath,-    inputFile :: Maybe FilePath+  { logLevel :: LogLevel+  , logLines :: Int+  , inputFormat :: IOFormat+  , outputFormat :: IOFormat+  , sugarType :: SugarType+  , flat :: LineFormat+  , must :: Must+  , normalize :: Bool+  , shuffle :: Bool+  , omitListing :: Bool+  , omitComments :: Bool+  , depthSensitive :: Bool+  , nonumber :: Bool+  , inPlace :: Bool+  , sequence :: Bool+  , canonize :: Bool+  , compress :: Bool+  , maxDepth :: Int+  , maxCycles :: Int+  , rules :: [FilePath]+  , hide :: [String]+  , show' :: [String]+  , expression :: Maybe String+  , label :: Maybe String+  , targetFile :: Maybe FilePath+  , stepsDir :: Maybe FilePath+  , inputFile :: Maybe FilePath   }  data OptsMerge = OptsMerge-  { logLevel :: LogLevel,-    logLines :: Integer,-    inputFormat :: IOFormat,-    outputFormat :: IOFormat,-    sugarType :: SugarType,-    flat :: LineFormat,-    omitListing :: Bool,-    omitComments :: Bool,-    targetFile :: Maybe FilePath,-    inputs :: [FilePath]+  { logLevel :: LogLevel+  , logLines :: Int+  , inputFormat :: IOFormat+  , outputFormat :: IOFormat+  , sugarType :: SugarType+  , flat :: LineFormat+  , omitListing :: Bool+  , omitComments :: Bool+  , targetFile :: Maybe FilePath+  , inputs :: [FilePath]   }  data OptsMatch = OptsMatch-  { logLevel :: LogLevel,-    logLines :: Integer,-    sugarType :: SugarType,-    flat :: LineFormat,-    pattern :: Maybe String,-    when' :: Maybe String,-    inputFile :: Maybe FilePath+  { logLevel :: LogLevel+  , logLines :: Int+  , sugarType :: SugarType+  , flat :: LineFormat+  , pattern :: Maybe String+  , when' :: Maybe String+  , inputFile :: Maybe FilePath   } -validateIntegerOption :: (Integer -> Bool) -> String -> Integer -> ReadM Integer-validateIntegerOption cmp msg num+validateIntOption :: (Int -> Bool) -> String -> Int -> ReadM Int+validateIntOption cmp msg num   | cmp num = return num   | otherwise = readerError msg @@ -196,10 +199,10 @@       "NONE" -> Right NONE       _ -> Left $ "unknown log-level: " <> lvl -optLogLines :: Parser Integer+optLogLines :: Parser Int optLogLines =   option-    (auto >>= validateIntegerOption (>= -1) "--log-lines must be >= -1")+    (auto >>= validateIntOption (>= -1) "--log-lines must be >= -1")     (long "log-lines" <> metavar "LINES" <> help "Amount of lines printed to console per each log operation (0 - print nothing, -1 - no limits)" <> value 25 <> showDefault)  optRule :: Parser [FilePath]@@ -224,16 +227,16 @@ argInputFile :: Parser (Maybe FilePath) argInputFile = optional (argument str (metavar "FILE" <> help "Path to input file")) -optMaxDepth :: Parser Integer+optMaxDepth :: Parser Int optMaxDepth =   option-    (auto >>= validateIntegerOption (> 0) "--max-depth must be positive")+    (auto >>= validateIntOption (> 0) "--max-depth must be positive")     (long "max-depth" <> metavar "DEPTH" <> help "Maximum number of rewriting iterations per rule" <> value 25 <> showDefault) -optMaxCycles :: Parser Integer+optMaxCycles :: Parser Int optMaxCycles =   option-    (auto >>= validateIntegerOption (> 0) "--max-cycles must be positive")+    (auto >>= validateIntOption (> 0) "--max-cycles must be positive")     (long "max-cycles" <> metavar "CYCLES" <> help "Maximum number of rewriting cycles across all rules" <> value 25 <> showDefault)  optDepthSensitive :: Parser Bool@@ -296,6 +299,9 @@ optOmitComments :: Parser Bool optOmitComments = switch (long "omit-comments" <> help "Omit comments in XMIR output") +optCompress :: Parser Bool+optCompress = switch (long "compress" <> help "Compress expressions in LaTeX output using \\phiMeet{} and \\phiAgain{} functions")+ _intermediateOptions :: String _intermediateOptions = intercalate ", " ["--sequence", "--steps-dir"] @@ -327,6 +333,7 @@             <*> optSequence             <*> optDepthSensitive             <*> switch (long "quiet" <> help "Don't print the result of dataization")+            <*> optCompress             <*> optMaxDepth             <*> optMaxCycles             <*> optHide@@ -364,6 +371,7 @@             <*> switch (long "in-place" <> help "Edit file in-place instead of printing to output")             <*> optSequence             <*> switch (long "canonize" <> help "Rename all functions attached to λ binding with F1, F2, etc.")+            <*> optCompress             <*> optMaxDepth             <*> optMaxCycles             <*> optRule@@ -431,11 +439,11 @@ setLogger :: Command -> IO () setLogger cmd =   let (level, lines) = case cmd of-        CmdRewrite OptsRewrite {logLevel, logLines} -> (logLevel, logLines)-        CmdDataize OptsDataize {logLevel, logLines} -> (logLevel, logLines)-        CmdExplain OptsExplain {logLevel, logLines} -> (logLevel, logLines)-        CmdMerge OptsMerge {logLevel, logLines} -> (logLevel, logLines)-        CmdMatch OptsMatch {logLevel, logLines} -> (logLevel, logLines)+        CmdRewrite OptsRewrite{logLevel, logLines} -> (logLevel, logLines)+        CmdDataize OptsDataize{logLevel, logLines} -> (logLevel, logLines)+        CmdExplain OptsExplain{logLevel, logLines} -> (logLevel, logLines)+        CmdMerge OptsMerge{logLevel, logLines} -> (logLevel, logLines)+        CmdMatch OptsMatch{logLevel, logLines} -> (logLevel, logLines)    in setLogConfig level lines  invalidCLIArguments :: String -> IO a@@ -446,7 +454,7 @@   cmd <- handleParseResult (execParserPure defaultPrefs parserInfo args)   setLogger cmd   case cmd of-    CmdRewrite OptsRewrite {..} -> do+    CmdRewrite OptsRewrite{..} -> do       validateOpts       excluded <- expressionsToFilter "hide" hide       included <- expressionsToFilter "show" show'@@ -456,7 +464,7 @@       program <- parseProgram input inputFormat       let listing = if null rules' then const input else (\prog -> P.printProgram' prog (sugarType, UNICODE, flat))           xmirCtx = XmirContext omitListing omitComments listing-          printCtx = PrintProgCtx sugarType flat xmirCtx nonumber expression label outputFormat+          printCtx = PrintProgCtx sugarType flat xmirCtx nonumber compress expression label outputFormat           _canonize = if canonize then C.canonize else id           _hide = (`F.exclude` excluded)           _show = (`F.include` included)@@ -475,7 +483,7 @@             (inPlace && isJust targetFile)             (invalidCLIArguments "The options --in-place and --target cannot be used together")           when (length show' > 1) (invalidCLIArguments "The option --show can be used only once")-          validateLatexOptions outputFormat nonumber expression label+          validateLatexOptions (outputFormat, nonumber, compress, expression, label)           validateMust' must           validateXmirOptions outputFormat omitListing omitComments         output :: Maybe FilePath -> String -> IO ()@@ -500,13 +508,13 @@             buildTerm             must             (saveStepFunc stepsDir ctx)-    CmdDataize OptsDataize {..} -> do+    CmdDataize OptsDataize{..} -> do       validateOpts       excluded <- expressionsToFilter "hide" hide       included <- expressionsToFilter "show" show'       input <- readInput inputFile       prog <- parseProgram input inputFormat-      let printCtx = PrintProgCtx sugarType flat defaultXmirContext nonumber expression label outputFormat+      let printCtx = PrintProgCtx sugarType flat defaultXmirContext nonumber compress expression label outputFormat           _hide = (`F.exclude` excluded)           _show = (`F.include` included)       (maybeBytes, seq) <- dataize prog (context prog printCtx)@@ -515,7 +523,7 @@       where         validateOpts :: IO ()         validateOpts = do-          validateLatexOptions outputFormat nonumber expression label+          validateLatexOptions (outputFormat, nonumber, compress, expression, label)           validateXmirOptions outputFormat omitListing omitComments           when (length show' > 1) (invalidCLIArguments "The option --show can be used only once")         context :: Program -> PrintProgramContext -> DataizeContext@@ -527,7 +535,7 @@             depthSensitive             buildTerm             (saveStepFunc stepsDir ctx)-    CmdExplain OptsExplain {..} -> do+    CmdExplain OptsExplain{..} -> do       validateOpts       rules' <- getRules normalize shuffle rules       let latex = explainRules rules'@@ -538,14 +546,14 @@           when             (null rules && not normalize)             (throwIO (InvalidCLIArguments "Either --rule or --normalize must be specified"))-    CmdMerge OptsMerge {..} -> do+    CmdMerge OptsMerge{..} -> do       validateOpts       inputs' <- traverse (readInput . Just) inputs       progs <- traverse (`parseProgram` inputFormat) inputs'       prog <- merge progs       let listing = const (P.printProgram' prog (sugarType, UNICODE, flat))           xmirCtx = XmirContext omitListing omitComments listing-          printProgCtx = PrintProgCtx sugarType flat xmirCtx False Nothing Nothing outputFormat+          printProgCtx = PrintProgCtx sugarType flat xmirCtx False False Nothing Nothing outputFormat       prog' <- printProgram printProgCtx prog       output targetFile prog'       where@@ -555,7 +563,7 @@             (null inputs)             (throwIO (InvalidCLIArguments "At least one input file must be specified for 'merge' command"))           validateXmirOptions outputFormat omitListing omitComments-    CmdMatch OptsMatch {..} -> do+    CmdMatch OptsMatch{..} -> do       input <- readInput inputFile       prog <- parseProgram input PHI       if isNothing pattern@@ -573,7 +581,7 @@  -- Prepare saveStepFunc saveStepFunc :: Maybe FilePath -> PrintProgramContext -> SaveStepFunc-saveStepFunc stepsDir ctx@PrintProgCtx {..} = saveStep stepsDir ioToExt (printProgram ctx)+saveStepFunc stepsDir ctx@PrintProgCtx{..} = saveStep stepsDir ioToExt (printProgram ctx)   where     ioToExt :: String     ioToExt@@ -599,16 +607,20 @@             )  -- Validate LaTeX options-validateLatexOptions :: IOFormat -> Bool -> Maybe String -> Maybe String -> IO ()-validateLatexOptions outputFormat nonumber expression label = do+validateLatexOptions :: (IOFormat, Bool, Bool, Maybe String, Maybe String) -> IO ()+validateLatexOptions (LATEX, _, _, _, _) = pure ()+validateLatexOptions (_, nonumber, compress, expression, label) = do   when-    (nonumber && outputFormat /= LATEX)+    nonumber     (invalidCLIArguments "The --nonumber option can stay together with --output=latex only")   when-    (isJust expression && outputFormat /= LATEX)+    compress+    (invalidCLIArguments "The --compress option can stay together with --output=latex only")+  when+    (isJust expression)     (invalidCLIArguments "The --expression option can stay together with --output=latex only")   when-    (isJust label && outputFormat /= LATEX)+    (isJust label)     (invalidCLIArguments "The --label option can stay together with --output=latex only")  -- Validate 'must' option@@ -643,16 +655,16 @@   xmirToPhi doc  printRewrittens :: PrintProgramContext -> [Rewritten] -> IO String-printRewrittens ctx@PrintProgCtx {..} rewrittens-  | outputFormat == LATEX = pure (rewrittensToLatex rewrittens (LatexContext sugar line nonumber expression label))+printRewrittens ctx@PrintProgCtx{..} rewrittens+  | outputFormat == LATEX = pure (rewrittensToLatex rewrittens (LatexContext sugar line nonumber compress expression label))   | otherwise = mapM (printProgram ctx . fst) rewrittens <&> intercalate "\n"  -- Convert program to corresponding String format printProgram :: PrintProgramContext -> Program -> IO String-printProgram PrintProgCtx {..} prog = case outputFormat of+printProgram PrintProgCtx{..} prog = case outputFormat of   PHI -> pure (P.printProgram' prog (sugar, UNICODE, line))   XMIR -> programToXMIR prog xmirCtx <&> printXMIR-  LATEX -> pure (programToLaTeX prog (LatexContext sugar line nonumber expression label))+  LATEX -> pure (programToLaTeX prog (LatexContext sugar line nonumber compress expression label))  -- Get rules for rewriting depending on provided flags getRules :: Bool -> Bool -> [FilePath] -> IO [Y.Rule]

@@ -88,7 +88,7 @@   deriving (Eq, Show)  data TAB-  = TAB {indent :: Integer}+  = TAB {indent :: Int}   | TAB'   | NO_TAB   deriving (Eq, Show)@@ -148,18 +148,20 @@   | EX_TERMINATION {termination :: TERMINATION}   | EX_FORMATION {lsb :: LSB, eol :: EOL, tab :: TAB, binding :: BINDING, eol' :: EOL, tab' :: TAB, rsb :: RSB}   | EX_DISPATCH {expr :: EXPRESSION, attr :: ATTRIBUTE}-  | EX_APPLICATION {expr :: EXPRESSION, eol :: EOL, tab :: TAB, tau :: APP_BINDING, eol' :: EOL, tab' :: TAB, indent :: Integer} -- e(a1 -> e1)-  | EX_APPLICATION_TAUS {expr :: EXPRESSION, eol :: EOL, tab :: TAB, taus :: BINDING, eol' :: EOL, tab' :: TAB, indent :: Integer} -- e(a1 -> e1)(a2 -> e2)(...)-  | EX_APPLICATION_EXPRS {expr :: EXPRESSION, eol :: EOL, tab :: TAB, args :: APP_ARG, eol' :: EOL, tab' :: TAB, indent :: Integer} -- e(e1, e2, ...)+  | EX_APPLICATION {expr :: EXPRESSION, eol :: EOL, tab :: TAB, tau :: APP_BINDING, eol' :: EOL, tab' :: TAB, indent :: Int} -- e(a1 -> e1)+  | EX_APPLICATION_TAUS {expr :: EXPRESSION, eol :: EOL, tab :: TAB, taus :: BINDING, eol' :: EOL, tab' :: TAB, indent :: Int} -- e(a1 -> e1)(a2 -> e2)(...)+  | EX_APPLICATION_EXPRS {expr :: EXPRESSION, eol :: EOL, tab :: TAB, args :: APP_ARG, eol' :: EOL, tab' :: TAB, indent :: Int} -- e(e1, e2, ...)   | EX_STRING {str :: String, tab :: TAB, rhos :: [Binding]}-  | EX_NUMBER {num :: Either Integer Double, tab :: TAB, rhos :: [Binding]}+  | EX_NUMBER {num :: Either Int Double, tab :: TAB, rhos :: [Binding]}   | EX_META {meta :: META}   | EX_META_TAIL {expr :: EXPRESSION, meta :: META}+  | EX_PHI_MEET {idx :: Int, expr :: EXPRESSION}+  | EX_PHI_AGAIN {idx :: Int, expr :: EXPRESSION}   deriving (Eq, Show)  data ATTRIBUTE   = AT_LABEL {label :: String}-  | AT_ALPHA {alpha :: ALPHA, idx :: Integer}+  | AT_ALPHA {alpha :: ALPHA, idx :: Int}   | AT_RHO {rho :: RHO}   | AT_PHI {phi :: PHI}   | AT_LAMBDA {lambda :: LAMBDA}@@ -177,7 +179,7 @@ -- CST is created with sugar and unicode -- All further transformations much consider that class ToCST a b where-  toCST :: a -> Integer -> EOL -> b+  toCST :: a -> Int -> EOL -> b  instance ToCST Program PROGRAM where   toCST (Program expr) tabs eol = PR_SWEET LCB (toCST expr tabs eol) RCB@@ -190,6 +192,8 @@   toCST ExTermination _ _ = EX_TERMINATION DEAD   toCST (ExFormation [BiVoid AtRho]) _ eol = toCST (ExFormation []) 0 eol   toCST (ExFormation []) _ _ = EX_FORMATION LSB NO_EOL NO_TAB (BI_EMPTY NO_TAB) NO_EOL NO_TAB RSB+  toCST (ExPhiMeet idx expr) tabs eol = EX_PHI_MEET idx (toCST expr tabs eol)+  toCST (ExPhiAgain idx expr) tabs eol = EX_PHI_AGAIN idx (toCST expr tabs eol)   toCST (ExFormation bds) tabs eol =     let next = tabs + 1         bds' = toCST (withoutLastVoidRho bds) next eol :: BINDING@@ -268,7 +272,7 @@              in (bd : bds', rhos)         | otherwise = (bds, [])       withoutRhosInPrimitives _ bds = (bds, [])-      applicationToPrimitive :: Expression -> Integer -> [Binding] -> EXPRESSION+      applicationToPrimitive :: Expression -> Int -> [Binding] -> EXPRESSION       applicationToPrimitive (DataNumber bts) tabs = EX_NUMBER (btsToNum bts) (TAB tabs)       applicationToPrimitive (DataString bts) tabs = EX_STRING (btsToStr bts) (TAB tabs)       -- Here we unroll nested application sequence into flat structure@@ -361,7 +365,7 @@ inlinedEOL True = NO_EOL inlinedEOL False = EOL -tabOfEOL :: EOL -> Integer -> TAB+tabOfEOL :: EOL -> Int -> TAB tabOfEOL EOL indent = TAB indent tabOfEOL NO_EOL _ = TAB' 

@@ -13,14 +13,14 @@ import Text.Megaparsec import Text.Megaparsec.Char import qualified Text.Megaparsec.Char.Lexer as L-import qualified Yaml as Y import Text.Printf (printf)+import qualified Yaml as Y  newtype ConditionException = CouldNotParseCondition {message :: String}   deriving (Exception)  instance Show ConditionException where-  show CouldNotParseCondition {..} = printf "Couldn't parse given condition, cause: %s" message+  show CouldNotParseCondition{..} = printf "Couldn't parse given condition, cause: %s" message  type Parser = Parsec Void String @@ -52,13 +52,13 @@         _ <- symbol "ordinal" >> lparen         attr <- _attribute phiParser         _ <- rparen-        return (Y.Ordinal attr),-      do+        return (Y.Ordinal attr)+    , do         _ <- symbol "length" >> lparen         bd <- _binding phiParser         _ <- rparen-        return (Y.Length bd),-      do+        return (Y.Length bd)+    , do         sign <- optional (choice [char '-', char '+'])         unsigned <- lexeme L.decimal         return@@ -73,9 +73,9 @@ comparable :: Parser Y.Comparable comparable =   choice-    [ try $ Y.CmpNum <$> number,-      try $ Y.CmpAttr <$> _attribute phiParser,-      Y.CmpExpr <$> _expression phiParser+    [ try $ Y.CmpNum <$> number+    , try $ Y.CmpAttr <$> _attribute phiParser+    , Y.CmpExpr <$> _expression phiParser     ]  condition :: Parser Y.Condition@@ -85,54 +85,54 @@         _ <- symbol "and" >> lparen         args <- condition `sepBy1` comma         _ <- rparen-        return (Y.And args),-      do+        return (Y.And args)+    , do         _ <- symbol "or" >> lparen         args <- condition `sepBy1` comma         _ <- rparen-        return (Y.Or args),-      do+        return (Y.Or args)+    , do         _ <- symbol "in" >> lparen         attr <- _attribute phiParser         _ <- comma         bd <- _binding phiParser         _ <- rparen-        return (Y.In attr bd),-      do+        return (Y.In attr bd)+    , do         _ <- symbol "not" >> lparen         cond <- condition         _ <- rparen-        return (Y.Not cond),-      do+        return (Y.Not cond)+    , do         _ <- symbol "alpha" >> lparen         attr <- _attribute phiParser         _ <- rparen-        return (Y.Alpha attr),-      do+        return (Y.Alpha attr)+    , do         _ <- symbol "eq" >> lparen         left <- comparable         _ <- comma         right <- comparable         _ <- rparen-        return (Y.Eq left right),-      do+        return (Y.Eq left right)+    , do         _ <- symbol "nf" >> lparen         expr <- _expression phiParser         _ <- rparen-        return (Y.NF expr),-      do+        return (Y.NF expr)+    , do         _ <- symbol "xi" >> lparen         expr <- _expression phiParser         _ <- rparen-        return (Y.XI expr),-      do+        return (Y.XI expr)+    , do         _ <- symbol "matches" >> lparen         ptn <- _string phiParser         _ <- comma         expr <- _expression phiParser         _ <- rparen-        return (Y.Matches ptn expr),-      do+        return (Y.Matches ptn expr)+    , do         _ <- symbol "part-of" >> lparen         expr <- _expression phiParser         _ <- comma

@@ -28,16 +28,16 @@ type Morphed = Dataizable  data DataizeContext = DataizeContext-  { _program :: Program,-    _maxDepth :: Integer,-    _maxCycles :: Integer,-    _depthSensitive :: Bool,-    _buildTerm :: BuildTermFunc,-    _saveStep :: SaveStepFunc+  { _program :: Program+  , _maxDepth :: Int+  , _maxCycles :: Int+  , _depthSensitive :: Bool+  , _buildTerm :: BuildTermFunc+  , _saveStep :: SaveStepFunc   }  switchContext :: DataizeContext -> RewriteContext-switchContext DataizeContext {..} =+switchContext DataizeContext{..} =   RewriteContext     _maxDepth     _maxCycles@@ -107,10 +107,10 @@     Just (obj, rule) -> pure (Just (ExDispatch obj attr, rule))     _ -> pure Nothing withTail (ExFormation bds) ctx = formation bds ctx-withTail (ExDispatch (ExDispatch ExGlobal (AtLabel label)) attr) (DataizeContext {_program = Program expr}) = case phiDispatch label expr of+withTail (ExDispatch (ExDispatch ExGlobal (AtLabel label)) attr) (DataizeContext{_program = Program expr}) = case phiDispatch label expr of   Just (obj, rule) -> pure (Just (ExDispatch obj attr, rule))   _ -> pure Nothing-withTail (ExDispatch ExGlobal (AtLabel label)) (DataizeContext {_program = Program expr}) = pure (phiDispatch label expr)+withTail (ExDispatch ExGlobal (AtLabel label)) (DataizeContext{_program = Program expr}) = pure (phiDispatch label expr) withTail (ExDispatch expr attr) ctx = do   tailed <- withTail expr ctx   case tailed of

@@ -27,7 +27,7 @@  type BuildTermFunc = String -> BuildTermMethod -type SaveStepFunc = Program -> Integer -> IO ()+type SaveStepFunc = Program -> Int -> IO ()  saveStep :: Maybe FilePath -> String -> (Program -> IO String) -> SaveStepFunc saveStep Nothing _ _ _ _ = pure ()

@@ -18,57 +18,59 @@   toASCII :: a -> a  instance ToASCII PROGRAM where-  toASCII PR_SALTY {..} = PR_SALTY Q ARROW' (toASCII expr)-  toASCII PR_SWEET {..} = PR_SWEET lcb (toASCII expr) rcb+  toASCII PR_SALTY{..} = PR_SALTY Q ARROW' (toASCII expr)+  toASCII PR_SWEET{..} = PR_SWEET lcb (toASCII expr) rcb  instance ToASCII EXPRESSION where-  toASCII EX_GLOBAL {..} = EX_GLOBAL Q-  toASCII EX_DEF_PACKAGE {..} = EX_DEF_PACKAGE QQ-  toASCII EX_XI {..} = EX_XI DOLLAR-  toASCII EX_ATTR {..} = EX_ATTR (toASCII attr)-  toASCII EX_TERMINATION {..} = EX_TERMINATION T-  toASCII EX_FORMATION {..} = EX_FORMATION LSB' eol tab (toASCII binding) eol' tab' RSB'-  toASCII EX_DISPATCH {..} = EX_DISPATCH (toASCII expr) (toASCII attr)-  toASCII EX_APPLICATION {..} = EX_APPLICATION (toASCII expr) eol tab (toASCII tau) eol' tab' indent-  toASCII EX_APPLICATION_TAUS {..} = EX_APPLICATION_TAUS (toASCII expr) eol tab (toASCII taus) eol' tab' indent-  toASCII EX_APPLICATION_EXPRS {..} = EX_APPLICATION_EXPRS (toASCII expr) eol tab (toASCII args) eol' tab' indent-  toASCII EX_META {..} = EX_META (MT_EXPRESSION' (rest meta))-  toASCII EX_META_TAIL {..} = EX_META_TAIL (toASCII expr) (MT_TAIL (rest meta))+  toASCII EX_GLOBAL{..} = EX_GLOBAL Q+  toASCII EX_DEF_PACKAGE{..} = EX_DEF_PACKAGE QQ+  toASCII EX_XI{..} = EX_XI DOLLAR+  toASCII EX_ATTR{..} = EX_ATTR (toASCII attr)+  toASCII EX_TERMINATION{..} = EX_TERMINATION T+  toASCII EX_FORMATION{..} = EX_FORMATION LSB' eol tab (toASCII binding) eol' tab' RSB'+  toASCII EX_DISPATCH{..} = EX_DISPATCH (toASCII expr) (toASCII attr)+  toASCII EX_APPLICATION{..} = EX_APPLICATION (toASCII expr) eol tab (toASCII tau) eol' tab' indent+  toASCII EX_APPLICATION_TAUS{..} = EX_APPLICATION_TAUS (toASCII expr) eol tab (toASCII taus) eol' tab' indent+  toASCII EX_APPLICATION_EXPRS{..} = EX_APPLICATION_EXPRS (toASCII expr) eol tab (toASCII args) eol' tab' indent+  toASCII EX_META{..} = EX_META (MT_EXPRESSION' (rest meta))+  toASCII EX_META_TAIL{..} = EX_META_TAIL (toASCII expr) (MT_TAIL (rest meta))+  toASCII EX_PHI_MEET{..} = EX_PHI_MEET idx (toASCII expr)+  toASCII EX_PHI_AGAIN{..} = EX_PHI_AGAIN idx (toASCII expr)   toASCII expr = expr  instance ToASCII APP_BINDING where-  toASCII APP_BINDING {..} = APP_BINDING (toASCII pair)+  toASCII APP_BINDING{..} = APP_BINDING (toASCII pair)  instance ToASCII BINDING where-  toASCII BI_PAIR {..} = BI_PAIR (toASCII pair) (toASCII bindings) tab-  toASCII BI_META {..} = BI_META (MT_BINDING' (rest meta)) (toASCII bindings) tab+  toASCII BI_PAIR{..} = BI_PAIR (toASCII pair) (toASCII bindings) tab+  toASCII BI_META{..} = BI_META (MT_BINDING' (rest meta)) (toASCII bindings) tab   toASCII bd = bd  instance ToASCII BINDINGS where-  toASCII BDS_PAIR {..} = BDS_PAIR eol tab (toASCII pair) (toASCII bindings)-  toASCII BDS_META {..} = BDS_META eol tab (MT_BINDING' (rest meta)) (toASCII bindings)+  toASCII BDS_PAIR{..} = BDS_PAIR eol tab (toASCII pair) (toASCII bindings)+  toASCII BDS_META{..} = BDS_META eol tab (MT_BINDING' (rest meta)) (toASCII bindings)   toASCII bds = bds  instance ToASCII APP_ARG where-  toASCII APP_ARG {..} = APP_ARG (toASCII expr) (toASCII args)+  toASCII APP_ARG{..} = APP_ARG (toASCII expr) (toASCII args)  instance ToASCII APP_ARGS where-  toASCII AAS_EXPR {..} = AAS_EXPR eol tab (toASCII expr) (toASCII args)+  toASCII AAS_EXPR{..} = AAS_EXPR eol tab (toASCII expr) (toASCII args)   toASCII args = args  instance ToASCII PAIR where-  toASCII PA_TAU {..} = PA_TAU (toASCII attr) ARROW' (toASCII expr)+  toASCII PA_TAU{..} = PA_TAU (toASCII attr) ARROW' (toASCII expr)   toASCII PA_FORMATION{..} = PA_FORMATION (toASCII attr) (map toASCII voids) ARROW' (toASCII expr)-  toASCII PA_VOID {..} = PA_VOID (toASCII attr) ARROW' QUESTION-  toASCII PA_LAMBDA {..} = PA_LAMBDA' func-  toASCII PA_DELTA {..} = PA_DELTA' bytes-  toASCII PA_META_LAMBDA {..} = PA_META_LAMBDA' meta-  toASCII PA_META_DELTA {..} = PA_META_DELTA' (MT_BYTES' (rest meta))+  toASCII PA_VOID{..} = PA_VOID (toASCII attr) ARROW' QUESTION+  toASCII PA_LAMBDA{..} = PA_LAMBDA' func+  toASCII PA_DELTA{..} = PA_DELTA' bytes+  toASCII PA_META_LAMBDA{..} = PA_META_LAMBDA' meta+  toASCII PA_META_DELTA{..} = PA_META_DELTA' (MT_BYTES' (rest meta))   toASCII pair = pair  instance ToASCII ATTRIBUTE where-  toASCII AT_ALPHA {..} = AT_ALPHA ALPHA' idx-  toASCII AT_PHI {..} = AT_PHI AT-  toASCII AT_RHO {..} = AT_RHO CARET-  toASCII AT_META {..} = AT_META (MT_ATTRIBUTE' (rest meta))+  toASCII AT_ALPHA{..} = AT_ALPHA ALPHA' idx+  toASCII AT_PHI{..} = AT_PHI AT+  toASCII AT_RHO{..} = AT_RHO CARET+  toASCII AT_META{..} = AT_META (MT_ATTRIBUTE' (rest meta))   toASCII attr = attr

@@ -4,67 +4,148 @@ -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com -- SPDX-License-Identifier: MIT -module LaTeX (explainRules, rewrittensToLatex, programToLaTeX, LatexContext (..)) where+module LaTeX+  ( explainRules+  , rewrittensToLatex+  , programToLaTeX+  , defaultLatexContext+  , LatexContext (..)+  , meetInPrograms+  , meetInProgram+  ) where -import AST (Program)+import AST import CST-import Data.Char (toLower)-import Data.List (intercalate)+import Data.List (intercalate, nub) import Data.Maybe (fromMaybe) import Encoding (Encoding (ASCII), withEncoding) import Lining (LineFormat (MULTILINE, SINGLELINE), withLineFormat)+import Matcher+import Misc import Printer (printProgram') import Render (Render (render))+import Replacer (ReplaceContext (ReplaceCtx), replaceProgram) import Rewriter (Rewritten (..)) import Sugar (SugarType (SWEET), withSugarType) import Text.Printf (printf) import qualified Yaml as Y  data LatexContext = LatexContext-  { sugar :: SugarType,-    line :: LineFormat,-    nonumber :: Bool,-    expression :: Maybe String,-    label :: Maybe String+  { sugar :: SugarType+  , line :: LineFormat+  , nonumber :: Bool+  , compress :: Bool+  , expression :: Maybe String+  , label :: Maybe String   } +defaultLatexContext :: LatexContext+defaultLatexContext = LatexContext SWEET MULTILINE False False Nothing Nothing++meetInProgram :: Program -> Program -> [Expression]+meetInProgram (Program expr) = meetInExpression expr+  where+    meetInExpression :: Expression -> Program -> [Expression]+    meetInExpression ExGlobal _ = []+    meetInExpression ExThis _ = []+    meetInExpression ExTermination _ = []+    meetInExpression (ExFormation [BiVoid AtRho]) _ = []+    meetInExpression (ExFormation [BiDelta _, BiVoid AtRho]) _ = []+    meetInExpression (ExFormation []) _ = []+    meetInExpression (ExDispatch ExGlobal _) _ = []+    meetInExpression (ExDispatch ExThis _) _ = []+    meetInExpression (ExDispatch ExTermination _) _ = []+    meetInExpression (DataString _) _ = []+    meetInExpression (DataNumber _) _ = []+    meetInExpression (ExPhiMeet _ _) _ = []+    meetInExpression (ExPhiAgain _ _) _ = []+    meetInExpression expr prog =+      map (const expr) (matchProgram expr prog) ++ case expr of+        ExDispatch exp _ -> meetInExpression exp prog+        ExApplication exp (BiTau _ arg) -> meetInExpression exp prog ++ meetInExpression arg prog+        ExFormation bds -> meetInBindings bds prog+        _ -> []+    meetInBindings :: [Binding] -> Program -> [Expression]+    meetInBindings [] _ = []+    meetInBindings (BiTau _ expr : bds) prog = meetInExpression expr prog ++ meetInBindings bds prog+    meetInBindings (_ : bds) prog = meetInBindings bds prog++{- | Here we're trying to compress sequence of programs with \phiMeet{} and \phiAgain LaTeX functions.+We process the sequence of programs and trying to find all expressions in first program which are present+in following programs. Then we find ONE expression which is the most frequently encountered.+If it's encountered in more than 50% of following programs - we replace it with \phiAgain{} in following+programs and with \phiMeet{} in first program.+-}+meetInPrograms :: [Program] -> [Program]+meetInPrograms = meetInPrograms' 1+  where+    meetInPrograms' :: Int -> [Program] -> [Program]+    meetInPrograms' _ [prog] = [prog]+    meetInPrograms' idx progs@(first : rest) =+      let met = map (meetInProgram first) rest+          unique = nub (concat met)+          (frequent, _) =+            foldl+              ( \(best, count) cur ->+                  let len = length (filter (elem cur) met)+                   in if len > count+                        then (Just cur, len)+                        else (best, count)+              )+              (Nothing, 0)+              unique+          next = first : meetInPrograms' idx rest+       in case frequent of+            Just expr ->+              let met' = map (filter (== expr)) met+                  substs = matchProgram expr first+                  prog = replaceProgram (first, map (const expr) substs, map (const (ExPhiMeet idx)) substs)+                  rest' = zipWith (\prgm exprs -> replaceProgram (prgm, exprs, map (const (ExPhiAgain idx)) exprs)) rest met'+                  found = filter (not . null) met'+               in if length met' > 1 && toDouble (length found) / toDouble (length met') >= 0.5+                    then prog : meetInPrograms' (idx + 1) rest'+                    else next+            _ -> next+ renderToLatex :: Program -> LatexContext -> String-renderToLatex prog LatexContext {..} = render (toLaTeX $ withLineFormat line $ withEncoding ASCII $ withSugarType sugar $ programToCST prog)+renderToLatex prog LatexContext{..} = render (toLaTeX $ withLineFormat line $ withEncoding ASCII $ withSugarType sugar $ programToCST prog)  phiquation :: LatexContext -> String-phiquation LatexContext {nonumber = True} = "phiquation*"-phiquation LatexContext {nonumber = False} = "phiquation"+phiquation LatexContext{nonumber = True} = "phiquation*"+phiquation LatexContext{nonumber = False} = "phiquation"  rewrittensToLatex :: [Rewritten] -> LatexContext -> String-rewrittensToLatex rewrittens ctx@LatexContext {..} =+rewrittensToLatex rewrittens ctx@LatexContext{..} =   let equation = phiquation ctx+      (progs, rules) = unzip rewrittens+      rewrittens' = if compress then zip (meetInPrograms progs) rules else rewrittens    in concat-        [ printf "\\begin{%s}\n" equation,-          maybe "" (printf "\\label{%s}\n") label,-          maybe "" (printf "\\phiExpression{%s} ") expression,-          intercalate+        [ printf "\\begin{%s}\n" equation+        , maybe "" (printf "\\label{%s}\n") label+        , maybe "" (printf "\\phiExpression{%s} ") expression+        , intercalate             "\n  \\leadsto "             ( map                 ( \(program, maybeName) ->                     let prog = renderToLatex program ctx                      in maybe prog (printf "%s \\leadsto_{\\nameref{r:%s}}" prog) maybeName                 )-                rewrittens-            ),-          printf ".\n\\end{%s}" equation+                rewrittens'+            )+        , printf ".\n\\end{%s}" equation         ]  programToLaTeX :: Program -> LatexContext -> String programToLaTeX prog ctx =   let equation = phiquation ctx    in concat-        [ "\\begin{",-          equation,-          "}\n",-          renderToLatex prog ctx,-          "\n\\end{",-          equation,-          "}"+        [ "\\begin{"+        , equation+        , "}\n"+        , renderToLatex prog ctx+        , "\n\\end{"+        , equation+        , "}"         ]  piped :: String -> String@@ -74,47 +155,49 @@   toLaTeX :: a -> a  instance ToLaTeX PROGRAM where-  toLaTeX PR_SWEET {..} = PR_SWEET BIG_LCB (toLaTeX expr) BIG_RCB-  toLaTeX PR_SALTY {..} = PR_SALTY global arrow (toLaTeX expr)+  toLaTeX PR_SWEET{..} = PR_SWEET BIG_LCB (toLaTeX expr) BIG_RCB+  toLaTeX PR_SALTY{..} = PR_SALTY global arrow (toLaTeX expr)  instance ToLaTeX EXPRESSION where-  toLaTeX EX_ATTR {..} = EX_ATTR (toLaTeX attr)-  toLaTeX EX_FORMATION {..} = EX_FORMATION lsb eol tab (toLaTeX binding) eol' tab' rsb-  toLaTeX EX_APPLICATION {..} = EX_APPLICATION (toLaTeX expr) eol tab (toLaTeX tau) eol' tab' indent-  toLaTeX EX_APPLICATION_TAUS {..} = EX_APPLICATION_TAUS (toLaTeX expr) eol tab (toLaTeX taus) eol' tab' indent-  toLaTeX EX_APPLICATION_EXPRS {..} = EX_APPLICATION_EXPRS (toLaTeX expr) eol tab (toLaTeX args) eol' tab' indent-  toLaTeX EX_DISPATCH {..} = EX_DISPATCH (toLaTeX expr) (toLaTeX attr)+  toLaTeX EX_ATTR{..} = EX_ATTR (toLaTeX attr)+  toLaTeX EX_FORMATION{..} = EX_FORMATION lsb eol tab (toLaTeX binding) eol' tab' rsb+  toLaTeX EX_APPLICATION{..} = EX_APPLICATION (toLaTeX expr) eol tab (toLaTeX tau) eol' tab' indent+  toLaTeX EX_APPLICATION_TAUS{..} = EX_APPLICATION_TAUS (toLaTeX expr) eol tab (toLaTeX taus) eol' tab' indent+  toLaTeX EX_APPLICATION_EXPRS{..} = EX_APPLICATION_EXPRS (toLaTeX expr) eol tab (toLaTeX args) eol' tab' indent+  toLaTeX EX_DISPATCH{..} = EX_DISPATCH (toLaTeX expr) (toLaTeX attr)+  toLaTeX EX_PHI_MEET{..} = EX_PHI_MEET idx (toLaTeX expr)+  toLaTeX EX_PHI_AGAIN{..} = EX_PHI_AGAIN idx (toLaTeX expr)   toLaTeX expr = expr  instance ToLaTeX ATTRIBUTE where-  toLaTeX AT_LABEL {..} = AT_LABEL (piped (toLaTeX label))+  toLaTeX AT_LABEL{..} = AT_LABEL (piped (toLaTeX label))   toLaTeX attr = attr  instance ToLaTeX APP_BINDING where-  toLaTeX APP_BINDING {..} = APP_BINDING (toLaTeX pair)+  toLaTeX APP_BINDING{..} = APP_BINDING (toLaTeX pair)  instance ToLaTeX BINDING where-  toLaTeX BI_PAIR {..} = BI_PAIR (toLaTeX pair) (toLaTeX bindings) tab+  toLaTeX BI_PAIR{..} = BI_PAIR (toLaTeX pair) (toLaTeX bindings) tab   toLaTeX bd = bd  instance ToLaTeX BINDINGS where-  toLaTeX BDS_PAIR {..} = BDS_PAIR eol tab (toLaTeX pair) (toLaTeX bindings)+  toLaTeX BDS_PAIR{..} = BDS_PAIR eol tab (toLaTeX pair) (toLaTeX bindings)   toLaTeX bds = bds  instance ToLaTeX PAIR where-  toLaTeX PA_DELTA {..} = PA_DELTA' bytes-  toLaTeX PA_LAMBDA {..} = PA_LAMBDA' (piped (toLaTeX func))-  toLaTeX PA_LAMBDA' {..} = PA_LAMBDA' (piped (toLaTeX func))-  toLaTeX PA_VOID {..} = PA_VOID (toLaTeX attr) arrow void-  toLaTeX PA_TAU {..} = PA_TAU (toLaTeX attr) arrow (toLaTeX expr)-  toLaTeX PA_FORMATION {..} = PA_FORMATION (toLaTeX attr) (map toLaTeX voids) arrow (toLaTeX expr)+  toLaTeX PA_DELTA{..} = PA_DELTA' bytes+  toLaTeX PA_LAMBDA{..} = PA_LAMBDA' (piped (toLaTeX func))+  toLaTeX PA_LAMBDA'{..} = PA_LAMBDA' (piped (toLaTeX func))+  toLaTeX PA_VOID{..} = PA_VOID (toLaTeX attr) arrow void+  toLaTeX PA_TAU{..} = PA_TAU (toLaTeX attr) arrow (toLaTeX expr)+  toLaTeX PA_FORMATION{..} = PA_FORMATION (toLaTeX attr) (map toLaTeX voids) arrow (toLaTeX expr)   toLaTeX pair = pair  instance ToLaTeX APP_ARG where-  toLaTeX APP_ARG {..} = APP_ARG (toLaTeX expr) (toLaTeX args)+  toLaTeX APP_ARG{..} = APP_ARG (toLaTeX expr) (toLaTeX args)  instance ToLaTeX APP_ARGS where-  toLaTeX AAS_EXPR {..} = AAS_EXPR eol tab (toLaTeX expr) (toLaTeX args)+  toLaTeX AAS_EXPR{..} = AAS_EXPR eol tab (toLaTeX expr) (toLaTeX args)   toLaTeX args = args  instance ToLaTeX String where@@ -144,9 +227,9 @@ explainRules :: [Y.Rule] -> String explainRules rules' =   unlines-    [ "\\documentclass{article}",-      "\\usepackage{amsmath}",-      "\\begin{document}"+    [ "\\documentclass{article}"+    , "\\usepackage{amsmath}"+    , "\\begin{document}"     ]     ++ unlines (map explainRule rules')     ++ "\\end{document}"

@@ -19,39 +19,41 @@   toSingleLine :: a -> a  instance ToSingleLine PROGRAM where-  toSingleLine PR_SALTY {..} = PR_SALTY global arrow (toSingleLine expr)-  toSingleLine PR_SWEET {..} = PR_SWEET lcb (toSingleLine expr) rcb+  toSingleLine PR_SALTY{..} = PR_SALTY global arrow (toSingleLine expr)+  toSingleLine PR_SWEET{..} = PR_SWEET lcb (toSingleLine expr) rcb  instance ToSingleLine EXPRESSION where-  toSingleLine EX_FORMATION {lsb, binding = bd@BI_EMPTY {..}, rsb} = EX_FORMATION lsb NO_EOL NO_TAB bd NO_EOL NO_TAB rsb-  toSingleLine EX_FORMATION {..} = EX_FORMATION lsb NO_EOL TAB' (toSingleLine binding) NO_EOL TAB' rsb-  toSingleLine EX_DISPATCH {..} = EX_DISPATCH (toSingleLine expr) attr-  toSingleLine EX_APPLICATION {..} = EX_APPLICATION (toSingleLine expr) NO_EOL TAB' (toSingleLine tau) NO_EOL TAB' indent-  toSingleLine EX_APPLICATION_TAUS {..} = EX_APPLICATION_TAUS (toSingleLine expr) NO_EOL TAB' (toSingleLine taus) NO_EOL TAB' indent-  toSingleLine EX_APPLICATION_EXPRS {..} = EX_APPLICATION_EXPRS (toSingleLine expr) NO_EOL TAB' (toSingleLine args) NO_EOL TAB' indent+  toSingleLine EX_FORMATION{lsb, binding = bd@BI_EMPTY{..}, rsb} = EX_FORMATION lsb NO_EOL NO_TAB bd NO_EOL NO_TAB rsb+  toSingleLine EX_FORMATION{..} = EX_FORMATION lsb NO_EOL TAB' (toSingleLine binding) NO_EOL TAB' rsb+  toSingleLine EX_DISPATCH{..} = EX_DISPATCH (toSingleLine expr) attr+  toSingleLine EX_APPLICATION{..} = EX_APPLICATION (toSingleLine expr) NO_EOL TAB' (toSingleLine tau) NO_EOL TAB' indent+  toSingleLine EX_APPLICATION_TAUS{..} = EX_APPLICATION_TAUS (toSingleLine expr) NO_EOL TAB' (toSingleLine taus) NO_EOL TAB' indent+  toSingleLine EX_APPLICATION_EXPRS{..} = EX_APPLICATION_EXPRS (toSingleLine expr) NO_EOL TAB' (toSingleLine args) NO_EOL TAB' indent+  toSingleLine EX_PHI_MEET{..} = EX_PHI_MEET idx (toSingleLine expr)+  toSingleLine EX_PHI_AGAIN{..} = EX_PHI_AGAIN idx (toSingleLine expr)   toSingleLine expr = expr  instance ToSingleLine APP_BINDING where-  toSingleLine APP_BINDING {..} = APP_BINDING (toSingleLine pair)+  toSingleLine APP_BINDING{..} = APP_BINDING (toSingleLine pair)  instance ToSingleLine BINDING where-  toSingleLine BI_PAIR {..} = BI_PAIR (toSingleLine pair) (toSingleLine bindings) TAB'-  toSingleLine BI_META {..} = BI_META meta (toSingleLine bindings) TAB'+  toSingleLine BI_PAIR{..} = BI_PAIR (toSingleLine pair) (toSingleLine bindings) TAB'+  toSingleLine BI_META{..} = BI_META meta (toSingleLine bindings) TAB'   toSingleLine bd = bd  instance ToSingleLine BINDINGS where-  toSingleLine BDS_PAIR {..} = BDS_PAIR NO_EOL TAB' (toSingleLine pair) (toSingleLine bindings)-  toSingleLine BDS_META {..} = BDS_META NO_EOL TAB' meta (toSingleLine bindings)+  toSingleLine BDS_PAIR{..} = BDS_PAIR NO_EOL TAB' (toSingleLine pair) (toSingleLine bindings)+  toSingleLine BDS_META{..} = BDS_META NO_EOL TAB' meta (toSingleLine bindings)   toSingleLine bds = bds  instance ToSingleLine PAIR where-  toSingleLine PA_TAU {..} = PA_TAU attr arrow (toSingleLine expr)-  toSingleLine PA_FORMATION {..} = PA_FORMATION attr voids arrow (toSingleLine expr)+  toSingleLine PA_TAU{..} = PA_TAU attr arrow (toSingleLine expr)+  toSingleLine PA_FORMATION{..} = PA_FORMATION attr voids arrow (toSingleLine expr)   toSingleLine pair = pair  instance ToSingleLine APP_ARG where-  toSingleLine APP_ARG {..} = APP_ARG (toSingleLine expr) (toSingleLine args)+  toSingleLine APP_ARG{..} = APP_ARG (toSingleLine expr) (toSingleLine args)  instance ToSingleLine APP_ARGS where-  toSingleLine AAS_EXPR {..} = AAS_EXPR NO_EOL TAB' (toSingleLine expr) (toSingleLine args)+  toSingleLine AAS_EXPR{..} = AAS_EXPR NO_EOL TAB' (toSingleLine expr) (toSingleLine args)   toSingleLine args = args

@@ -4,12 +4,12 @@ -- SPDX-License-Identifier: MIT  module Logger-  ( logDebug,-    logInfo,-    logWarning,-    logError,-    setLogConfig,-    LogLevel (DEBUG, INFO, WARNING, ERROR, NONE),+  ( logDebug+  , logInfo+  , logWarning+  , logError+  , setLogConfig+  , LogLevel (DEBUG, INFO, WARNING, ERROR, NONE)   ) where @@ -28,12 +28,12 @@ {-# NOINLINE logger #-} logger = unsafePerformIO (newIORef (Logger INFO 25)) -setLogConfig :: LogLevel -> Integer -> IO ()+setLogConfig :: LogLevel -> Int -> IO () setLogConfig lvl lines = writeIORef logger (Logger lvl (fromIntegral lines))  logMessage :: LogLevel -> String -> IO () logMessage lvl message = do-  Logger {..} <- readIORef logger+  Logger{..} <- readIORef logger   when     (lvl >= level && lines /= 0)     ( let lines' = DL.lines message

@@ -94,8 +94,8 @@   let splits = [splitAt idx tbs | idx <- [0 .. length tbs]]    in catMaybes         [ combine (substSingle name (MvBindings before)) subst-          | (before, after) <- splits,-            subst <- matchBindings pbs after scope+        | (before, after) <- splits+        , subst <- matchBindings pbs after scope         ] matchBindings (pb : pbs) (tb : tbs) scope = combineMany (matchBinding pb tb scope) (matchBindings pbs tbs scope) matchBindings _ _ _ = []@@ -139,11 +139,17 @@ matchExpression (ExMetaTail exp meta) tgt scope = case tailExpressions exp tgt scope of   ([], _) -> []   (substs, tails) -> combineMany substs [substSingle meta (MvTail tails)]+matchExpression (ExPhiAgain idx expr) (ExPhiAgain idx' expr') scope+  | idx == idx' = matchExpression expr expr' scope+  | otherwise = []+matchExpression (ExPhiMeet idx expr) (ExPhiMeet idx' expr') scope+  | idx == idx' = matchExpression expr expr' scope+  | otherwise = [] matchExpression _ _ _ = []  -- Deep match pattern to expression inside binding matchBindingExpression :: Binding -> Expression -> Expression -> [Subst]-matchBindingExpression (BiTau _ texp) ptn scope = matchExpressionDeep ptn texp scope+matchBindingExpression (BiTau _ exp) ptn scope = matchExpressionDeep ptn exp scope matchBindingExpression _ _ _ = []  -- Match expression with deep nested expression(s) matching@@ -151,7 +157,7 @@ matchExpressionDeep ptn tgt scope =   let matched = matchExpression ptn tgt scope       deep = case tgt of-        ExFormation bds -> concatMap (\bd -> matchBindingExpression bd ptn (ExFormation bds)) bds+        ExFormation bds -> concatMap (\bd -> matchBindingExpression bd ptn tgt) bds         ExDispatch exp _ -> matchExpressionDeep ptn exp scope         ExApplication exp tau -> matchExpressionDeep ptn exp scope ++ matchBindingExpression tau ptn scope         _ -> []

@@ -24,11 +24,11 @@   deriving (Exception)  instance Show MergeException where-  show WrongProgramFormat {..} =+  show WrongProgramFormat{..} =     printf       "Invalid program format, only programs with top level formations are supported for 'merge' command, given:\n%s"       (printProgram program)-  show CanNotMergeBinding {..} =+  show CanNotMergeBinding{..} =     printf       "Can't merge two bindings, conflict found:\n%s"       (printExpression (ExFormation [first, second]))

@@ -9,28 +9,28 @@  -- This module provides commonly used helper functions for other modules module Misc-  ( numToBts,-    strToBts,-    bytesToBts,-    btsToStr,-    btsToNum,-    withVoidRho,-    allPathsIn,-    ensuredFile,-    shuffle,-    toDouble,-    btsToUnescapedStr,-    attributesFromBindings,-    attributesFromBindings',-    attributeFromBinding,-    uniqueBindings,-    uniqueBindings',-    validateYamlObject,-    matchDataObject,-    pattern DataObject,-    pattern DataString,-    pattern DataNumber,-    pattern BaseObject,+  ( numToBts+  , strToBts+  , bytesToBts+  , btsToStr+  , btsToNum+  , withVoidRho+  , allPathsIn+  , ensuredFile+  , shuffle+  , toDouble+  , btsToUnescapedStr+  , attributesFromBindings+  , attributesFromBindings'+  , attributeFromBinding+  , uniqueBindings+  , uniqueBindings'+  , validateYamlObject+  , matchDataObject+  , pattern DataObject+  , pattern DataString+  , pattern DataNumber+  , pattern BaseObject   ) where @@ -68,8 +68,8 @@   deriving (Exception)  instance Show FsException where-  show FileDoesNotExist {..} = printf "File '%s' does not exist" file-  show DirectoryDoesNotExist {..} = printf "Directory '%s' does not exist" dir+  show FileDoesNotExist{..} = printf "File '%s' does not exist" file+  show DirectoryDoesNotExist{..} = printf "Directory '%s' does not exist" dir  matchBaseObject :: Expression -> Maybe String matchBaseObject (ExDispatch (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (AtLabel label)) = Just label@@ -208,7 +208,7 @@  -- >>> toDouble 5 -- 5.0-toDouble :: Integer -> Double+toDouble :: Int -> Double toDouble = fromIntegral  -- >>> btsToWord8 BtEmpty@@ -245,7 +245,7 @@ -- Left 42 -- >>> btsToNum (BtMany ["40", "45"]) -- Expected 8 bytes for conversion, got 2-btsToNum :: Bytes -> Either Integer Double+btsToNum :: Bytes -> Either Int Double btsToNum hx =   let bytes = btsToWord8 hx    in if length bytes /= 8

@@ -4,13 +4,13 @@ module Must (Must (..), inRange, exceedsUpperBound, validateMust) where  import Data.List (isInfixOf)-import Text.Read (readMaybe) import Text.Printf (printf)+import Text.Read (readMaybe)  data Must   = MtDisabled-  | MtExact Integer-  | MtRange (Maybe Integer) (Maybe Integer)+  | MtExact Int+  | MtRange (Maybe Int) (Maybe Int)   deriving (Eq)  instance Show Must where@@ -49,7 +49,7 @@         Just _ -> [] -- Invalid value: must be non-negative         Nothing -> [] -- Invalid value: expected integer -inRange :: Must -> Integer -> Bool+inRange :: Must -> Int -> Bool inRange MtDisabled _ = True inRange (MtExact expected) actual = actual == expected inRange (MtRange minVal maxVal) actual =@@ -59,7 +59,7 @@     checkMax = maybe True (>= actual) maxVal  -- | Check if a value exceeds the upper bound of the range-exceedsUpperBound :: Must -> Integer -> Bool+exceedsUpperBound :: Must -> Int -> Bool exceedsUpperBound MtDisabled _ = False exceedsUpperBound (MtExact n) current = current > n exceedsUpperBound (MtRange _ (Just max)) current = current > max

@@ -6,18 +6,18 @@  -- The goal of the module is to parse given phi program to AST module Parser-  ( parseProgram,-    parseProgramThrows,-    parseExpression,-    parseExpressionThrows,-    parseAttribute,-    parseAttributeThrows,-    parseNumber,-    parseNumberThrows,-    parseBinding,-    parseBytes,-    PhiParser (..),-    phiParser,+  ( parseProgram+  , parseProgramThrows+  , parseExpression+  , parseExpressionThrows+  , parseAttribute+  , parseAttributeThrows+  , parseNumber+  , parseNumberThrows+  , parseBinding+  , parseBytes+  , PhiParser (..)+  , phiParser   ) where @@ -45,20 +45,20 @@   deriving (Exception)  data PhiParser = PhiParser-  { _attribute :: Parser Attribute,-    _binding :: Parser Binding,-    _expression :: Parser Expression,-    _string :: Parser String+  { _attribute :: Parser Attribute+  , _binding :: Parser Binding+  , _expression :: Parser Expression+  , _string :: Parser String   }  phiParser :: PhiParser phiParser = PhiParser fullAttribute binding expression quotedStr  instance Show ParserException where-  show CouldNotParseProgram {..} = printf "Couldn't parse given phi program, cause: %s" message-  show CouldNotParseExpression {..} = printf "Couldn't parse given phi expression, cause: %s" message-  show CouldNotParseAttribute {..} = printf "Couldn't parse given attribute, cause: %s" message-  show CouldNotParseNumber {..} = printf "Couldn't parse given number to 'Φ̇.number', cause: %s" message+  show CouldNotParseProgram{..} = printf "Couldn't parse given phi program, cause: %s" message+  show CouldNotParseExpression{..} = printf "Couldn't parse given phi expression, cause: %s" message+  show CouldNotParseAttribute{..} = printf "Couldn't parse given attribute, cause: %s" message+  show CouldNotParseNumber{..} = printf "Couldn't parse given number to 'Φ̇.number', cause: %s" message  -- White space consumer whiteSpace :: Parser ()@@ -92,15 +92,15 @@ delta :: Parser String delta =   choice-    [ symbol "D>",-      symbol "Δ" >> dashedArrow+    [ symbol "D>"+    , symbol "Δ" >> dashedArrow     ]  lambda :: Parser String lambda =   choice-    [ symbol "L>",-      symbol "λ" >> dashedArrow+    [ symbol "L>"+    , symbol "λ" >> dashedArrow     ]  dashedArrow :: Parser String@@ -125,8 +125,8 @@ meta' :: Char -> String -> Parser String meta' ch uni =   choice-    [ meta ch,-      do+    [ meta ch+    , do         _ <- symbol uni         suf <- metaSuffix         return (ch : suf)@@ -151,15 +151,15 @@ bytes =   lexeme     ( choice-        [ BtMeta <$> meta' 'd' "δ",-          symbol "--" >> return BtEmpty,-          try $ do+        [ BtMeta <$> meta' 'd' "δ"+        , symbol "--" >> return BtEmpty+        , try $ do             first <- byte             rest <- some $ do               _ <- char '-'               byte-            return (BtMany (first : rest)),-          do+            return (BtMany (first : rest))+        , do             bte <- byte             _ <- char '-'             return (BtOne bte)@@ -240,13 +240,13 @@   choice     [ try $ do         _ <- arrow-        BiTau attr' <$> expression,-      do+        BiTau attr' <$> expression+    , do         _ <- symbol "("         voids <-           choice-            [ rb >> return [],-              do+            [ rb >> return []+            , do                 voids' <- map BiVoid <$> void' `sepBy1` symbol ","                 rb >> return voids'             ]@@ -273,20 +273,20 @@ binding :: Parser Binding binding =   choice-    [ try (tauBinding attribute),-      try $ do+    [ try (tauBinding attribute)+    , try $ do         attr <- attribute         _ <- arrow         _ <- choice [symbol "?", symbol "∅"]-        return (BiVoid attr),-      try $ do+        return (BiVoid attr)+    , try $ do         _ <- delta-        BiDelta <$> bytes,-      try metaBinding,-      try $ do+        BiDelta <$> bytes+    , try metaBinding+    , try $ do         _ <- lambda-        BiLambda <$> function,-      do+        BiLambda <$> function+    , do         _ <- lambda         BiMetaLambda <$> meta 'F'     ]@@ -299,11 +299,11 @@ void' :: Parser Attribute void' =   choice-    [ AtLabel <$> label',-      do+    [ AtLabel <$> label'+    , do         _ <- choice [symbol "^", symbol "ρ"]-        return AtRho,-      do+        return AtRho+    , do         _ <- choice [symbol "@", symbol "φ"]         return AtPhi     ]@@ -316,8 +316,8 @@ attribute :: Parser Attribute attribute =   choice-    [ void',-      AtMeta <$> meta' 'a' "𝜏"+    [ void'+    , AtMeta <$> meta' 'a' "𝜏"     ]     <?> "attribute" @@ -330,8 +330,8 @@ fullAttribute :: Parser Attribute fullAttribute =   choice-    [ attribute,-      do+    [ attribute+    , do         _ <- choice [symbol "~", symbol "α"]         AtAlpha <$> lexeme L.decimal     ]@@ -347,8 +347,8 @@ formationBindings = do   _ <- choice [symbol "[[", symbol "⟦"]   choice-    [ rsb >> return [],-      do+    [ rsb >> return []+    , do         bs <- binding `sepBy1` symbol ","         rsb >> return bs     ]@@ -368,23 +368,23 @@   choice     [ do         bs <- formationBindings >>= validatedBindings-        return (ExFormation (withVoidRho bs)),-      do+        return (ExFormation (withVoidRho bs))+    , do         _ <- choice [symbol "$", symbol "ξ"]-        return ExThis,-      try $ do+        return ExThis+    , try $ do         _ <- choice [symbol "QQ", symbol "Φ̇"]-        return (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")),-      do+        return (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang"))+    , do         _ <- global-        return ExGlobal,-      do+        return ExGlobal+    , do         _ <- choice [symbol "T", symbol "⊥"]-        return ExTermination,-      number,-      lexeme (DataString . strToBts <$> quotedStr),-      try (ExMeta <$> meta' 'e' "𝑒"),-      ExDispatch ExThis <$> attribute+        return ExTermination+    , number+    , lexeme (DataString . strToBts <$> quotedStr)+    , try (ExMeta <$> meta' 'e' "𝑒")+    , ExDispatch ExThis <$> attribute     ]     <?> "expression head" @@ -403,8 +403,8 @@           choice             [ do                 _ <- symbol "."-                ExDispatch expr <$> attribute,-              do+                ExDispatch expr <$> attribute+            , do                 guard                   ( case expr of                       ExThis -> False@@ -414,14 +414,14 @@                 _ <- symbol "("                 bds <-                   choice-                    [ try $ tauBinding fullAttribute `sepBy1` symbol ",",-                      do+                    [ try $ tauBinding fullAttribute `sepBy1` symbol ","+                    , do                         exprs <- expression `sepBy1` symbol ","                         return (zipWith (BiTau . AtAlpha) [0 ..] exprs) -- \idx expr -> BiTau (AtAlpha idx) expr                     ]                 _ <- symbol ")"-                return (application expr bds),-              do+                return (application expr bds)+            , do                 guard                   ( case expr of                       ExMetaTail _ _ -> False@@ -431,8 +431,8 @@                 ExMetaTail expr <$> meta 't'             ]             <?> "dispatch or application"-        exTail next,-      return expr+        exTail next+    , return expr     ]  expression :: Parser Expression@@ -447,8 +447,8 @@         _ <- symbol "{"         prog <- Program <$> expression         _ <- symbol "}"-        return prog,-      do+        return prog+    , do         _ <- global         _ <- arrow         Program <$> expression

@@ -5,18 +5,18 @@ -- SPDX-License-Identifier: MIT  module Printer-  ( printProgram,-    printProgram',-    printExpression,-    printExpression',-    printAttribute,-    printBinding,-    printBytes,-    printExtraArg,-    printSubsts,-    printSubsts',-    PrintConfig (..),-    logPrintConfig,+  ( printProgram+  , printProgram'+  , printExpression+  , printExpression'+  , printAttribute+  , printBinding+  , printBytes+  , printExtraArg+  , printSubsts+  , printSubsts'+  , PrintConfig (..)+  , logPrintConfig   ) where 

@@ -37,7 +37,7 @@           groups =             [ let (off, len) = arr ! i                in if off == -1 then B.empty else B.take len (B.drop off input)-              | i <- [start .. end]+            | i <- [start .. end]             ]        in pure groups 

@@ -20,6 +20,9 @@ instance Render Integer where   render = show +instance Render Int where+  render = show+ instance Render Double where   render = show @@ -100,85 +103,87 @@   render (BT_MANY bts) = intercalate "-" bts  instance Render META where-  render MT_EXPRESSION {..} = '𝑒' : rest-  render MT_EXPRESSION' {..} = "!e" <> rest-  render MT_ATTRIBUTE {..} = '𝜏' : rest-  render MT_ATTRIBUTE' {..} = "!a" <> rest-  render MT_BINDING {..} = '𝐵' : rest-  render MT_BINDING' {..} = "!B" <> rest-  render MT_BYTES {..} = 'δ' : rest-  render MT_BYTES' {..} = "!d" <> rest-  render MT_TAIL {..} = "!t" <> rest-  render MT_FUNCTION {..} = "!F" <> rest+  render MT_EXPRESSION{..} = '𝑒' : rest+  render MT_EXPRESSION'{..} = "!e" <> rest+  render MT_ATTRIBUTE{..} = '𝜏' : rest+  render MT_ATTRIBUTE'{..} = "!a" <> rest+  render MT_BINDING{..} = '𝐵' : rest+  render MT_BINDING'{..} = "!B" <> rest+  render MT_BYTES{..} = 'δ' : rest+  render MT_BYTES'{..} = "!d" <> rest+  render MT_TAIL{..} = "!t" <> rest+  render MT_FUNCTION{..} = "!F" <> rest  instance Render ALPHA where   render ALPHA = "α"   render ALPHA' = "~"  instance Render TAB where-  render TAB {..} = intercalate "" (replicate (fromIntegral indent) "  ")+  render TAB{..} = intercalate "" (replicate (fromIntegral indent) "  ")   render TAB' = " "   render NO_TAB = ""  instance Render PROGRAM where-  render PR_SWEET {..} = render lcb <> render expr <> render rcb-  render PR_SALTY {..} = render global <> render SPACE <> render arrow <> render SPACE <> render expr+  render PR_SWEET{..} = render lcb <> render expr <> render rcb+  render PR_SALTY{..} = render global <> render SPACE <> render arrow <> render SPACE <> render expr  instance Render PAIR where-  render PA_TAU {..} = render attr <> render SPACE <> render arrow <> render SPACE <> render expr-  render PA_FORMATION {voids = [], attr, arrow, expr} = render (PA_TAU attr arrow expr)-  render PA_FORMATION {..} = render attr <> "(" <> intercalate ", " (map render voids) <> ")" <> render SPACE <> render arrow <> render SPACE <> render expr-  render PA_LAMBDA {..} = render LAMBDA <> render SPACE <> render DASHED_ARROW <> render SPACE <> render func-  render PA_LAMBDA' {..} = "L> " <> func-  render PA_VOID {..} = render attr <> render SPACE <> render arrow <> render SPACE <> render void-  render PA_DELTA {..} = render DELTA <> render SPACE <> render DASHED_ARROW <> render SPACE <> render bytes-  render PA_DELTA' {..} = "D> " <> render bytes-  render PA_META_LAMBDA {..} = render LAMBDA <> render SPACE <> render DASHED_ARROW <> render SPACE <> render meta-  render PA_META_LAMBDA' {..} = render "L> " <> render meta-  render PA_META_DELTA {..} = render DELTA <> render SPACE <> render DASHED_ARROW <> render SPACE <> render meta-  render PA_META_DELTA' {..} = render "D> " <> render meta+  render PA_TAU{..} = render attr <> render SPACE <> render arrow <> render SPACE <> render expr+  render PA_FORMATION{voids = [], attr, arrow, expr} = render (PA_TAU attr arrow expr)+  render PA_FORMATION{..} = render attr <> "(" <> intercalate ", " (map render voids) <> ")" <> render SPACE <> render arrow <> render SPACE <> render expr+  render PA_LAMBDA{..} = render LAMBDA <> render SPACE <> render DASHED_ARROW <> render SPACE <> render func+  render PA_LAMBDA'{..} = "L> " <> func+  render PA_VOID{..} = render attr <> render SPACE <> render arrow <> render SPACE <> render void+  render PA_DELTA{..} = render DELTA <> render SPACE <> render DASHED_ARROW <> render SPACE <> render bytes+  render PA_DELTA'{..} = "D> " <> render bytes+  render PA_META_LAMBDA{..} = render LAMBDA <> render SPACE <> render DASHED_ARROW <> render SPACE <> render meta+  render PA_META_LAMBDA'{..} = render "L> " <> render meta+  render PA_META_DELTA{..} = render DELTA <> render SPACE <> render DASHED_ARROW <> render SPACE <> render meta+  render PA_META_DELTA'{..} = render "D> " <> render meta  instance Render BINDINGS where-  render BDS_EMPTY {..} = ""-  render BDS_PAIR {..} = render COMMA <> render eol <> render tab <> render pair <> render bindings-  render BDS_META {..} = render COMMA <> render eol <> render tab <> render meta <> render bindings+  render BDS_EMPTY{..} = ""+  render BDS_PAIR{..} = render COMMA <> render eol <> render tab <> render pair <> render bindings+  render BDS_META{..} = render COMMA <> render eol <> render tab <> render meta <> render bindings  instance Render APP_BINDING where-  render APP_BINDING {..} = render pair+  render APP_BINDING{..} = render pair  instance Render BINDING where-  render BI_EMPTY {..} = ""-  render BI_PAIR {..} = render pair <> render bindings-  render BI_META {..} = render meta <> render bindings+  render BI_EMPTY{..} = ""+  render BI_PAIR{..} = render pair <> render bindings+  render BI_META{..} = render meta <> render bindings  instance Render APP_ARG where-  render APP_ARG {..} = render expr <> render args+  render APP_ARG{..} = render expr <> render args  instance Render APP_ARGS where   render AAS_EMPTY = ""-  render AAS_EXPR {..} = render COMMA <> render eol <> render tab <> render expr <> render args+  render AAS_EXPR{..} = render COMMA <> render eol <> render tab <> render expr <> render args  instance Render EXPRESSION where-  render EX_GLOBAL {..} = render global-  render EX_DEF_PACKAGE {..} = render pckg-  render EX_XI {..} = render xi-  render EX_ATTR {..} = render attr-  render EX_TERMINATION {..} = render termination-  render EX_FORMATION {..} = render lsb <> render eol <> render tab <> render binding <> render eol' <> render tab' <> render rsb-  render EX_DISPATCH {..} = render expr <> "." <> render attr-  render EX_APPLICATION {..} = render expr <> "(" <> render eol <> render tab <> render tau <> render eol' <> render tab' <> ")"-  render EX_APPLICATION_TAUS {..} = render expr <> "(" <> render eol <> render tab <> render taus <> render eol' <> render tab' <> ")"-  render EX_APPLICATION_EXPRS {..} = render expr <> "(" <> render eol <> render tab <> render args <> render eol' <> render tab' <> ")"-  render EX_STRING {..} = '"' : render str <> "\""-  render EX_NUMBER {..} = either show show num-  render EX_META {..} = render meta-  render EX_META_TAIL {..} = render expr <> " * " <> render meta+  render EX_GLOBAL{..} = render global+  render EX_DEF_PACKAGE{..} = render pckg+  render EX_XI{..} = render xi+  render EX_ATTR{..} = render attr+  render EX_TERMINATION{..} = render termination+  render EX_FORMATION{..} = render lsb <> render eol <> render tab <> render binding <> render eol' <> render tab' <> render rsb+  render EX_DISPATCH{..} = render expr <> "." <> render attr+  render EX_APPLICATION{..} = render expr <> "(" <> render eol <> render tab <> render tau <> render eol' <> render tab' <> ")"+  render EX_APPLICATION_TAUS{..} = render expr <> "(" <> render eol <> render tab <> render taus <> render eol' <> render tab' <> ")"+  render EX_APPLICATION_EXPRS{..} = render expr <> "(" <> render eol <> render tab <> render args <> render eol' <> render tab' <> ")"+  render EX_STRING{..} = '"' : render str <> "\""+  render EX_NUMBER{..} = either show show num+  render EX_META{..} = render meta+  render EX_META_TAIL{..} = render expr <> " * " <> render meta+  render EX_PHI_MEET{..} = "\\phiMeet{" <> render idx <> "}{" <> render expr <> "}"+  render EX_PHI_AGAIN{..} = "\\phiAgain{" <> render idx <> "}"  instance Render ATTRIBUTE where-  render AT_LABEL {..} = label-  render AT_ALPHA {..} = render alpha <> render idx-  render AT_RHO {..} = render rho-  render AT_PHI {..} = render phi-  render AT_LAMBDA {..} = render lambda-  render AT_DELTA {..} = render delta-  render AT_META {..} = render meta+  render AT_LABEL{..} = label+  render AT_ALPHA{..} = render alpha <> render idx+  render AT_RHO{..} = render rho+  render AT_PHI{..} = render phi+  render AT_LAMBDA{..} = render lambda+  render AT_DELTA{..} = render delta+  render AT_META{..} = render meta

@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE RecordWildCards #-} @@ -8,139 +7,100 @@ -- The goal of the module is to traverse though the Program with replacing -- pattern sub expression with target expressions module Replacer-  ( replaceProgram,-    replaceProgramThrows,-    replaceProgramFast,-    replaceProgramFastThrows,-    ReplaceProgramThrowsFunc,-    ReplaceProgramFunc,-    ReplaceProgramContext (..),+  ( replaceProgram+  , replaceProgramFast+  , ReplaceContext (..)+  , ReplaceProgramFunc   ) where  import AST import Control.Exception (Exception, throwIO)-import Matcher (Tail (TaApplication, TaDispatch))-import Text.Printf (printf) import Data.List (isPrefixOf)+import Matcher (Tail (TaApplication, TaDispatch)) import Printer (printProgram)--data ReplaceProgramContext = ReplaceProgramContext-  { _program :: Program,-    _maxDepth :: Integer-  }--data ReplaceExpressionContext = ReplaceExpressionContext-  { _expression :: Expression,-    _maxDepth :: Integer-  }--updateExpressionContext :: ReplaceExpressionContext -> Expression -> ReplaceExpressionContext-updateExpressionContext ReplaceExpressionContext {..} expr = ReplaceExpressionContext expr _maxDepth--type ReplaceProgramThrowsFunc = [Expression] -> [Expression] -> ReplaceProgramContext -> IO Program+import Text.Printf (printf) -type ReplaceProgramFunc = [Expression] -> [Expression] -> ReplaceProgramContext -> Maybe Program+type ReplaceState a = (a, [Expression], [Expression -> Expression]) -type ReplaceExpressionFunc = [Expression] -> [Expression] -> ReplaceExpressionContext -> (Expression, [Expression], [Expression])+type ReplaceExpressionFunc = ReplaceState Expression -> ReplaceContext -> ReplaceState Expression -newtype ReplaceException = CouldNotReplace {prog :: Program}-  deriving (Exception)+type ReplaceProgramFunc = ReplaceState Program -> Program -instance Show ReplaceException where-  show CouldNotReplace {..} =-    printf-      "Couldn't replace expression in program, lists of patterns and targets has different lengths\nProgram: %s"-      (printProgram prog)+newtype ReplaceContext = ReplaceCtx {_maxDepth :: Int} -replaceBindings :: [Binding] -> [Expression] -> [Expression] -> ReplaceExpressionContext -> ReplaceExpressionFunc -> ([Binding], [Expression], [Expression])-replaceBindings bds [] [] _ _ = (bds, [], [])-replaceBindings [] ptns repls _ _ = ([], ptns, repls)-replaceBindings (BiTau attr expr : bds) ptns repls ctx func =-  let (expr', ptns', repls') = func ptns repls (updateExpressionContext ctx expr)-      (bds', ptns'', repls'') = replaceBindings bds ptns' repls' ctx func+replaceBindings :: ReplaceState [Binding] -> ReplaceContext -> ReplaceExpressionFunc -> ReplaceState [Binding]+replaceBindings state@(bds, [], _) _ _ = state+replaceBindings state@(bds, _, []) _ _ = state+replaceBindings state@([], ptns, repls) _ _ = state+replaceBindings (BiTau attr expr : bds, ptns, repls) ctx func =+  let (expr', ptns', repls') = func (expr, ptns, repls) ctx+      (bds', ptns'', repls'') = replaceBindings (bds, ptns', repls') ctx func    in (BiTau attr expr' : bds', ptns'', repls'')-replaceBindings (bd : bds) ptns repls ctx func =-  let (bds', ptns', repls') = replaceBindings bds ptns repls ctx func+replaceBindings (bd : bds, ptns, repls) ctx func =+  let (bds', ptns', repls') = replaceBindings (bds, ptns, repls) ctx func    in (bd : bds', ptns', repls')  replaceExpression :: ReplaceExpressionFunc-replaceExpression [] [] ReplaceExpressionContext {..} = (_expression, [], [])-replaceExpression ptns@(ptn : ptnsRest) repls@(repl : replsRest) ctx@ReplaceExpressionContext {..} =-  if _expression == ptn-    then replaceExpression ptnsRest replsRest (updateExpressionContext ctx repl)-    else case _expression of+replaceExpression state@(expr, ptns@(ptn : _ptns), repls@(repl : _repls)) ctx =+  if expr == ptn+    then replaceExpression (repl expr, _ptns, _repls) ctx+    else case expr of       ExDispatch inner attr ->-        let (expr', ptns', repls') = replaceExpression ptns repls (updateExpressionContext ctx inner)+        let (expr', ptns', repls') = replaceExpression (inner, ptns, repls) ctx          in (ExDispatch expr' attr, ptns', repls')       ExApplication inner tau ->-        let (expr', ptns', repls') = replaceExpression ptns repls (updateExpressionContext ctx inner)-            ([tau'], ptns'', repls'') = replaceBindings [tau] ptns' repls' ctx replaceExpression+        let (expr', ptns', repls') = replaceExpression (inner, ptns, repls) ctx+            ([tau'], ptns'', repls'') = replaceBindings ([tau], ptns', repls') ctx replaceExpression          in (ExApplication expr' tau', ptns'', repls'')       ExFormation bds ->-        let (bds', ptns', repls') = replaceBindings bds ptns repls ctx replaceExpression+        let (bds', ptns', repls') = replaceBindings (bds, ptns, repls) ctx replaceExpression          in (ExFormation bds', ptns', repls')-      _ -> (_expression, ptns, repls)+      _ -> state+replaceExpression state _ = state  replaceBindingsFast :: [Binding] -> [Expression] -> [Expression] -> [Binding]-replaceBindingsFast bds [] [] = bds-replaceBindingsFast bds ((ExFormation pbds) : rptns) ((ExFormation rbds) : rrepls) =-  let replaced = replaceBindingsFast' bds pbds rbds-   in replaceBindingsFast replaced rptns rrepls+replaceBindingsFast bds ((ExFormation pbds) : _ptns) ((ExFormation rbds) : _repls) =+  let replaced = findAndReplace bds pbds rbds+   in replaceBindingsFast replaced _ptns _repls   where-    replaceBindingsFast' :: [Binding] -> [Binding] -> [Binding] -> [Binding]-    replaceBindingsFast' bds pattern replacement-      | null pattern = replacement-      | otherwise = findAndReplace bds pattern replacement     findAndReplace :: [Binding] -> [Binding] -> [Binding] -> [Binding]     findAndReplace [] _ _ = []-    findAndReplace xs@(x : xs') pattern replacement-      | pattern `isPrefixOf` xs = replacement ++ findAndReplace (drop (length pattern) xs) pattern replacement-      | otherwise = x : findAndReplace xs' pattern replacement+    findAndReplace _ [] repl = repl+    findAndReplace xs@(x : xs') ptn repl+      | ptn `isPrefixOf` xs = repl ++ findAndReplace (drop (length ptn) xs) ptn repl+      | otherwise = x : findAndReplace xs' ptn repl+replaceBindingsFast bds _ _ = bds  replaceExpressionFast :: ReplaceExpressionFunc replaceExpressionFast = replaceExpressionFast' 0   where-    replaceExpressionFast' :: Integer -> ReplaceExpressionFunc-    replaceExpressionFast' _ [] [] ReplaceExpressionContext {..} = (_expression, [], [])-    replaceExpressionFast' depth ptns@((ExFormation pbds) : rptns) repls@((ExFormation rbds) : rrepls) ctx@ReplaceExpressionContext {..} =+    replaceExpressionFast' :: Int -> ReplaceExpressionFunc+    replaceExpressionFast' _ state@(expr, [], _) _ = state+    replaceExpressionFast' _ state@(expr, _, []) _ = state+    replaceExpressionFast' depth state@(expr, ptns, repls) ctx@ReplaceCtx{..} =       if depth == _maxDepth-        then (_expression, [], [])-        else case _expression of+        then (expr, [], [])+        else case expr of           ExFormation bds ->-            let replaced = replaceBindingsFast bds ptns repls-                (bds', ptns', repls') = replaceBindings replaced ptns repls ctx (replaceExpressionFast' (depth + 1))+            let replaced = replaceBindingsFast bds ptns (map (\rep -> rep expr) repls)+                (bds', ptns', repls') = replaceBindings (replaced, ptns, repls) ctx (replaceExpressionFast' (depth + 1))              in (ExFormation bds', ptns', repls')           ExDispatch inner attr ->-            let (expr', ptns', repls') = replaceExpressionFast ptns repls (updateExpressionContext ctx inner)+            let (expr', ptns', repls') = replaceExpressionFast (inner, ptns, repls) ctx              in (ExDispatch expr' attr, ptns', repls')-          ExApplication inner (BiTau attr texpr) ->-            let (expr', ptns', repls') = replaceExpressionFast ptns repls (updateExpressionContext ctx inner)-                (expr'', ptns'', repls'') = replaceExpressionFast ptns' repls' (updateExpressionContext ctx texpr)+          ExApplication inner (BiTau attr arg) ->+            let (expr', ptns', repls') = replaceExpressionFast (inner, ptns, repls) ctx+                (expr'', ptns'', repls'') = replaceExpressionFast (arg, ptns', repls') ctx              in (ExApplication expr' (BiTau attr expr''), ptns'', repls'')-          _ -> (_expression, ptns, repls)-    replaceExpressionFast' _ ptns repls ctx@ReplaceExpressionContext{..} = (_expression, ptns, repls)--replaceProgram' :: ReplaceExpressionFunc -> ReplaceProgramFunc-replaceProgram' func ptns repls ReplaceProgramContext {_program = Program expr, ..}-  | length ptns == length repls =-      let (expr', _, _) = func ptns repls (ReplaceExpressionContext expr _maxDepth)-       in Just (Program expr')-  | otherwise = Nothing+          _ -> state  replaceProgram :: ReplaceProgramFunc-replaceProgram = replaceProgram' replaceExpression--replaceProgramThrows' :: ReplaceExpressionFunc -> ReplaceProgramThrowsFunc-replaceProgramThrows' func ptns repls ctx = case replaceProgram' func ptns repls ctx of-  Just prog' -> pure prog'-  _ -> throwIO (CouldNotReplace (_program ctx))--replaceProgramThrows :: ReplaceProgramThrowsFunc-replaceProgramThrows = replaceProgramThrows' replaceExpression--replaceProgramFast :: ReplaceProgramFunc-replaceProgramFast = replaceProgram' replaceExpressionFast+replaceProgram (Program expr, ptns, repls) =+  let (expr', _, _) = replaceExpression (expr, ptns, repls) (ReplaceCtx 0)+   in Program expr' -replaceProgramFastThrows :: ReplaceProgramThrowsFunc-replaceProgramFastThrows = replaceProgramThrows' replaceExpressionFast+replaceProgramFast :: ReplaceContext -> ReplaceProgramFunc+replaceProgramFast ctx (Program expr, ptns, repls) =+  let (expr', _, _) = replaceExpressionFast (expr, ptns, repls) ctx+   in Program expr'

@@ -25,7 +25,7 @@ import Must (Must (..), exceedsUpperBound, inRange) import Parser (parseProgram, parseProgramThrows) import Printer (printProgram)-import Replacer (ReplaceProgramContext (ReplaceProgramContext), ReplaceProgramThrowsFunc, replaceProgramFastThrows, replaceProgramThrows)+import Replacer (ReplaceContext (ReplaceCtx), ReplaceProgramFunc, replaceProgram, replaceProgramFast) import Rule (RuleContext (RuleContext), matchProgramWithRule) import qualified Rule as R import Text.Printf@@ -36,41 +36,43 @@  type Rewritten = (Program, Maybe String) +type ToReplace = (Program, Expression, Expression, [Subst])+ data RewriteContext = RewriteContext-  { _maxDepth :: Integer,-    _maxCycles :: Integer,-    _depthSensitive :: Bool,-    _buildTerm :: BuildTermFunc,-    _must :: Must,-    _saveStep :: SaveStepFunc+  { _maxDepth :: Int+  , _maxCycles :: Int+  , _depthSensitive :: Bool+  , _buildTerm :: BuildTermFunc+  , _must :: Must+  , _saveStep :: SaveStepFunc   }  data RewriteException-  = MustBeGoing {must :: Must, count :: Integer}-  | MustStopBefore {must :: Must, count :: Integer}-  | StoppedOnLimit {flag :: String, limit :: Integer}-  | LoopingRewriting {prog :: String, rule :: String, step :: Integer}+  = MustBeGoing {must :: Must, count :: Int}+  | MustStopBefore {must :: Must, count :: Int}+  | StoppedOnLimit {flag :: String, limit :: Int}+  | LoopingRewriting {prog :: String, rule :: String, step :: Int}   deriving (Exception)  instance Show RewriteException where-  show MustBeGoing {..} =+  show MustBeGoing{..} =     printf       "With option --must=%s it's expected rewriting cycles to be in range [%s], but rewriting stopped after %d cycles"       (show must)       (show must)       count-  show MustStopBefore {..} =+  show MustStopBefore{..} =     printf       "With option --must=%s it's expected rewriting cycles to be in range [%s], but rewriting has already reached %d cycles and is still going"       (show must)       (show must)       count-  show StoppedOnLimit {..} =+  show StoppedOnLimit{..} =     printf       "With option --depth-sensitive it's expected rewriting iterations amount does not reach the limit: --%s=%d"       flag       limit-  show LoopingRewriting {..} =+  show LoopingRewriting{..} =     printf       "On rewriting step '%d' of rule '%s' we got the same program as we got at one of the previous step, it seems rewriting is looping\nProgram: %s"       step@@ -78,13 +80,13 @@       prog  -- Build pattern and result expression and replace patterns to results in given program-buildAndReplace' :: Expression -> Expression -> [Subst] -> ReplaceProgramThrowsFunc -> ReplaceProgramContext -> IO Program-buildAndReplace' ptn res substs func ctx = do-  ptns <- buildExpressions ptn substs-  repls <- buildExpressions res substs-  let repls' = map fst repls-      ptns' = map fst ptns-  func ptns' repls' ctx+buildAndReplace' :: ToReplace -> ReplaceProgramFunc -> IO Program+buildAndReplace' (prog, ptn, res, substs) func = do+  ptns <- buildExpressionsThrows ptn substs+  repls <- buildExpressionsThrows res substs+  let ptns' = map fst ptns+      repls' = map (\ex _ -> fst ex) repls+  pure (func (prog, ptns', repls'))  -- If pattern and replacement are appropriate for fast replacing - does it. -- Pattern and replacement expressions can be used in fast replacing only if@@ -94,8 +96,8 @@ -- In such case we can just replace bindings one by one without building whole expression. -- You can find more details in this ticket: https://github.com/objectionary/phino/issues/321 -- If we don't meet the conditions above - just do a regular replacing-tryBuildAndReplaceFast :: Expression -> Expression -> [Subst] -> ReplaceProgramContext -> IO Program-tryBuildAndReplaceFast (ExFormation pbds) (ExFormation rbds) substs ctx =+tryBuildAndReplaceFast :: ToReplace -> ReplaceContext -> IO Program+tryBuildAndReplaceFast state@(prog, ExFormation pbds, ExFormation rbds, substs) ctx =   let pbds' = init (tail pbds)       rbds' = init (tail rbds)    in if startsAndEndsWithMeta pbds@@ -106,10 +108,10 @@         && not (hasMetaBindings rbds')         then do           logDebug "Applying fast replacing since 'pattern' and 'result' are suitable for this..."-          buildAndReplace' (ExFormation pbds') (ExFormation rbds') substs replaceProgramFastThrows ctx+          buildAndReplace' (prog, ExFormation pbds', ExFormation rbds', substs) (replaceProgramFast ctx)         else do           logDebug "Applying regular replacing..."-          buildAndReplace' (ExFormation pbds) (ExFormation rbds) substs replaceProgramThrows ctx+          buildAndReplace' state replaceProgram   where     startsAndEndsWithMeta :: [Binding] -> Bool     startsAndEndsWithMeta bds =@@ -122,19 +124,19 @@       BiMeta _ -> True       _ -> False     hasMetaBindings = foldl (\acc bd -> acc || isMetaBinding bd) False-tryBuildAndReplaceFast ptn res substs ctx = buildAndReplace' ptn res substs replaceProgramThrows ctx+tryBuildAndReplaceFast state _ = buildAndReplace' state replaceProgram  -- The function returns tuple (X, Y) where -- - X is sequence of programs; -- - Y is Set of unique programs after each rule application. It allows to stop the rewriting if we're getting --   into loop and get back to program which we've already got before-rewrite :: RewriteState -> [Y.Rule] -> Integer -> RewriteContext -> IO RewriteState+rewrite :: RewriteState -> [Y.Rule] -> Int -> RewriteContext -> IO RewriteState rewrite state [] _ _ = pure state-rewrite state (rule : rest) iteration ctx@RewriteContext {..} = do+rewrite state (rule : rest) iteration ctx@RewriteContext{..} = do   state' <- _rewrite state 1   rewrite state' rest iteration ctx   where-    _rewrite :: RewriteState -> Integer -> IO RewriteState+    _rewrite :: RewriteState -> Int -> IO RewriteState     _rewrite (_rewrittens, _unique) _count =       let ruleName = fromMaybe "unknown" (Y.name rule)           ptn = Y.pattern rule@@ -155,7 +157,7 @@                   pure (_rewrittens, _unique)                 else do                   logDebug (printf "Rule '%s' has been matched, applying..." ruleName)-                  prog <- tryBuildAndReplaceFast ptn res matched (ReplaceProgramContext program _maxDepth)+                  prog <- tryBuildAndReplaceFast (program, ptn, res, matched) (ReplaceCtx _maxDepth)                   if program == prog                     then do                       logDebug (printf "Applied '%s', no changes made" ruleName)@@ -184,8 +186,8 @@ rewrite' :: Program -> [Y.Rule] -> RewriteContext -> IO [Rewritten] rewrite' prog rules ctx = _rewrite ([(prog, Nothing)], Set.empty) 1 ctx <&> reverse   where-    _rewrite :: RewriteState -> Integer -> RewriteContext -> IO [Rewritten]-    _rewrite state@(rewrittens, unique) count ctx@RewriteContext {..} = do+    _rewrite :: RewriteState -> Int -> RewriteContext -> IO [Rewritten]+    _rewrite state@(rewrittens, unique) count ctx@RewriteContext{..} = do       let cycles = _maxCycles           must = _must           current = count - 1

@@ -7,8 +7,17 @@ module Rule (RuleContext (..), isNF, matchProgramWithRule, meetCondition) where  import AST-import Builder (buildAttribute, buildBinding, buildBindingThrows, buildExpression, buildExpressionThrows)-import Control.Exception (SomeException (SomeException), evaluate)+import Builder+  ( buildAttribute+  , buildBinding+  , buildBindingThrows+  , buildExpression+  , buildExpressionThrows+  )+import Control.Exception+  ( SomeException (SomeException)+  , evaluate+  ) import Control.Exception.Base (try) import Control.Monad (when) import Data.Aeson (FromJSON)@@ -118,14 +127,14 @@   (Just left_, Just right_) -> pure [subst | left_ == right_]   (_, _) -> pure []   where-    -- Convert Number to Integer-    numToInt :: Y.Number -> Subst -> Maybe Integer+    -- Convert Number to Int+    numToInt :: Y.Number -> Subst -> Maybe Int     numToInt (Y.Ordinal (AtMeta meta)) (Subst mp) = case M.lookup meta mp of       Just (MvAttribute (AtAlpha idx)) -> Just idx       _ -> Nothing     numToInt (Y.Ordinal (AtAlpha idx)) subst = Just idx     numToInt (Y.Length (BiMeta meta)) (Subst mp) = case M.lookup meta mp of-      Just (MvBindings bds) -> Just (toInteger (length bds))+      Just (MvBindings bds) -> Just (length bds)       _ -> Nothing     numToInt (Y.Literal num) subst = Just num     numToInt _ _ = Nothing@@ -230,7 +239,7 @@  -- Extend list of given substitutions with extra substitutions from 'where' yaml rule section extraSubstitutions :: [Subst] -> Maybe [Y.Extra] -> RuleContext -> IO [Subst]-extraSubstitutions substs extras RuleContext {..} = case extras of+extraSubstitutions substs extras RuleContext{..} = case extras of   Nothing -> pure substs   Just extras' -> do     logDebug (printf "Building %d sets of extra substitutions.." (length substs))@@ -266,7 +275,7 @@             )             (Just subst)             extras'-          | subst <- substs+        | subst <- substs         ]     logDebug "Extra substitutions have been built"     pure (catMaybes res)

@@ -19,16 +19,16 @@ voidRho = PA_VOID (AT_RHO RHO) ARROW EMPTY  bdWithVoidRho :: BINDING -> BINDING-bdWithVoidRho BI_EMPTY {..} = BI_PAIR voidRho (BDS_EMPTY tab) tab-bdWithVoidRho bd@BI_PAIR {pair = PA_VOID {attr = AT_RHO _}} = bd-bdWithVoidRho bd@BI_PAIR {pair = PA_TAU {attr = AT_RHO _}} = bd-bdWithVoidRho BI_PAIR {..} = BI_PAIR pair (bdsWithVoidRho bindings) tab+bdWithVoidRho BI_EMPTY{..} = BI_PAIR voidRho (BDS_EMPTY tab) tab+bdWithVoidRho bd@BI_PAIR{pair = PA_VOID{attr = AT_RHO _}} = bd+bdWithVoidRho bd@BI_PAIR{pair = PA_TAU{attr = AT_RHO _}} = bd+bdWithVoidRho BI_PAIR{..} = BI_PAIR pair (bdsWithVoidRho bindings) tab   where     bdsWithVoidRho :: BINDINGS -> BINDINGS-    bdsWithVoidRho BDS_EMPTY {..} = BDS_PAIR EOL tab voidRho (BDS_EMPTY tab)-    bdsWithVoidRho bds@BDS_PAIR {pair = PA_VOID {attr = AT_RHO _}} = bds-    bdsWithVoidRho bds@BDS_PAIR {pair = PA_TAU {attr = AT_RHO _}} = bds-    bdsWithVoidRho BDS_PAIR {..} = BDS_PAIR eol tab pair (bdsWithVoidRho bindings)+    bdsWithVoidRho BDS_EMPTY{..} = BDS_PAIR EOL tab voidRho (BDS_EMPTY tab)+    bdsWithVoidRho bds@BDS_PAIR{pair = PA_VOID{attr = AT_RHO _}} = bds+    bdsWithVoidRho bds@BDS_PAIR{pair = PA_TAU{attr = AT_RHO _}} = bds+    bdsWithVoidRho BDS_PAIR{..} = BDS_PAIR eol tab pair (bdsWithVoidRho bindings)  data SugarType = SWEET | SALTY   deriving (Eq, Show)@@ -52,17 +52,17 @@   toSalty :: a -> a  instance ToSalty PROGRAM where-  toSalty PR_SWEET {..} = PR_SALTY Φ ARROW (toSalty expr)+  toSalty PR_SWEET{..} = PR_SALTY Φ ARROW (toSalty expr)   toSalty prog = prog  instance ToSalty EXPRESSION where-  toSalty EX_DEF_PACKAGE {..} = EX_DISPATCH (EX_DISPATCH (EX_GLOBAL Φ) (AT_LABEL "org")) (AT_LABEL "eolang")-  toSalty EX_ATTR {..} = EX_DISPATCH (EX_XI XI) attr-  toSalty EX_DISPATCH {..} = EX_DISPATCH (toSalty expr) attr-  toSalty EX_FORMATION {lsb, binding = bd@BI_EMPTY {..}, rsb} = EX_FORMATION lsb NO_EOL TAB' (toSalty (bdWithVoidRho bd)) NO_EOL TAB' rsb-  toSalty EX_FORMATION {..} = EX_FORMATION lsb eol tab (toSalty (bdWithVoidRho binding)) eol' tab' rsb-  toSalty EX_APPLICATION {..} = EX_APPLICATION (toSalty expr) EOL (TAB indent) (toSalty tau) EOL (TAB (indent - 1)) indent-  toSalty EX_APPLICATION_TAUS {..} =+  toSalty EX_DEF_PACKAGE{..} = EX_DISPATCH (EX_DISPATCH (EX_GLOBAL Φ) (AT_LABEL "org")) (AT_LABEL "eolang")+  toSalty EX_ATTR{..} = EX_DISPATCH (EX_XI XI) attr+  toSalty EX_DISPATCH{..} = EX_DISPATCH (toSalty expr) attr+  toSalty EX_FORMATION{lsb, binding = bd@BI_EMPTY{..}, rsb} = EX_FORMATION lsb NO_EOL TAB' (toSalty (bdWithVoidRho bd)) NO_EOL TAB' rsb+  toSalty EX_FORMATION{..} = EX_FORMATION lsb eol tab (toSalty (bdWithVoidRho binding)) eol' tab' rsb+  toSalty EX_APPLICATION{..} = EX_APPLICATION (toSalty expr) EOL (TAB indent) (toSalty tau) EOL (TAB (indent - 1)) indent+  toSalty EX_APPLICATION_TAUS{..} =     foldl       toApplication       expr@@ -72,38 +72,40 @@       toApplication exp pair =         EX_APPLICATION (toSalty exp) EOL (TAB indent) (APP_BINDING (toSalty pair)) EOL (TAB (indent - 1)) indent       tauToPairs :: BINDING -> [PAIR]-      tauToPairs BI_PAIR {..} = pair : tausToPairs bindings+      tauToPairs BI_PAIR{..} = pair : tausToPairs bindings       tausToPairs :: BINDINGS -> [PAIR]-      tausToPairs BDS_EMPTY {..} = []-      tausToPairs BDS_PAIR {..} = pair : tausToPairs bindings-  toSalty EX_APPLICATION_EXPRS {..} = toSalty (EX_APPLICATION_TAUS expr EOL (TAB indent) (argToBinding args tab) EOL (TAB (indent - 1)) indent)+      tausToPairs BDS_EMPTY{..} = []+      tausToPairs BDS_PAIR{..} = pair : tausToPairs bindings+  toSalty EX_APPLICATION_EXPRS{..} = toSalty (EX_APPLICATION_TAUS expr EOL (TAB indent) (argToBinding args tab) EOL (TAB (indent - 1)) indent)     where       argToBinding :: APP_ARG -> TAB -> BINDING-      argToBinding APP_ARG {..} =+      argToBinding APP_ARG{..} =         BI_PAIR           (PA_TAU (AT_ALPHA ALPHA 0) ARROW expr)           (argsToBindings args 1 tab)-      argsToBindings :: APP_ARGS -> Integer -> TAB -> BINDINGS+      argsToBindings :: APP_ARGS -> Int -> TAB -> BINDINGS       argsToBindings AAS_EMPTY _ tab = BDS_EMPTY tab-      argsToBindings AAS_EXPR {..} idx tb = BDS_PAIR eol tb (PA_TAU (AT_ALPHA ALPHA idx) ARROW expr) (argsToBindings args (idx + 1) tb)-  toSalty EX_NUMBER {num, tab = tab@TAB {..}, rhos} =+      argsToBindings AAS_EXPR{..} idx tb = BDS_PAIR eol tb (PA_TAU (AT_ALPHA ALPHA idx) ARROW expr) (argsToBindings args (idx + 1) tb)+  toSalty EX_NUMBER{num, tab = tab@TAB{..}, rhos} =     saltifyPrimitive       (toCST (BaseObject "number") (indent + 1) EOL)       (toCST (BaseObject "bytes") (indent + 2) EOL)       (toCST (ExFormation [BiDelta (numToBts (either toDouble id num))]) (indent + 2) EOL)       tab       rhos-  toSalty EX_STRING {str, tab = tab@TAB {..}, rhos} =+  toSalty EX_STRING{str, tab = tab@TAB{..}, rhos} =     saltifyPrimitive       (toCST (BaseObject "string") (indent + 1) EOL)       (toCST (BaseObject "bytes") (indent + 2) EOL)       (toCST (ExFormation [BiDelta (strToBts str)]) (indent + 2) EOL)       tab       rhos+  toSalty EX_PHI_MEET{..} = EX_PHI_MEET idx (toSalty expr)+  toSalty EX_PHI_AGAIN{..} = EX_PHI_AGAIN idx (toSalty expr)   toSalty expr = expr  saltifyPrimitive :: EXPRESSION -> EXPRESSION -> EXPRESSION -> TAB -> [Binding] -> EXPRESSION-saltifyPrimitive base bytes data' tb@TAB {..} rhos =+saltifyPrimitive base bytes data' tb@TAB{..} rhos =   let next = TAB (indent + 1)    in toSalty         ( EX_APPLICATION_TAUS@@ -133,26 +135,26 @@         )  instance ToSalty BINDING where-  toSalty BI_PAIR {..} = BI_PAIR (toSalty pair) (toSalty bindings) tab+  toSalty BI_PAIR{..} = BI_PAIR (toSalty pair) (toSalty bindings) tab   toSalty bd = bd  instance ToSalty APP_BINDING where-  toSalty APP_BINDING {..} = APP_BINDING (toSalty pair)+  toSalty APP_BINDING{..} = APP_BINDING (toSalty pair)  instance ToSalty BINDINGS where-  toSalty BDS_PAIR {..} = BDS_PAIR eol tab (toSalty pair) (toSalty bindings)+  toSalty BDS_PAIR{..} = BDS_PAIR eol tab (toSalty pair) (toSalty bindings)   toSalty bds = bds  instance ToSalty PAIR where-  toSalty PA_TAU {..} = PA_TAU attr arrow (toSalty expr)-  toSalty PA_FORMATION {voids, attr, arrow, expr = expr@EX_FORMATION {..}} =+  toSalty PA_TAU{..} = PA_TAU attr arrow (toSalty expr)+  toSalty PA_FORMATION{voids, attr, arrow, expr = expr@EX_FORMATION{..}} =     PA_TAU attr arrow (toSalty (EX_FORMATION lsb eol tab (joinToBinding voids binding) eol' tab' rsb))     where       joinToBinding :: [ATTRIBUTE] -> BINDING -> BINDING       joinToBinding [] bd = bd       joinToBinding (attr : rest) bd = BI_PAIR (PA_VOID attr arrow EMPTY) (joinToBindings rest bd) tab       joinToBindings :: [ATTRIBUTE] -> BINDING -> BINDINGS-      joinToBindings [] BI_EMPTY {..} = BDS_EMPTY tab-      joinToBindings [] BI_PAIR {..} = BDS_PAIR eol tab pair bindings+      joinToBindings [] BI_EMPTY{..} = BDS_EMPTY tab+      joinToBindings [] BI_PAIR{..} = BDS_PAIR eol tab pair bindings       joinToBindings (attr : rest) bd = BDS_PAIR eol tab (PA_VOID attr arrow EMPTY) (joinToBindings rest bd)   toSalty pair = pair

@@ -7,14 +7,14 @@ -- SPDX-License-Identifier: MIT  module XMIR-  ( programToXMIR,-    printXMIR,-    toName,-    parseXMIR,-    parseXMIRThrows,-    xmirToPhi,-    defaultXmirContext,-    XmirContext (XmirContext),+  ( programToXMIR+  , printXMIR+  , toName+  , parseXMIR+  , parseXMIRThrows+  , xmirToPhi+  , defaultXmirContext+  , XmirContext (XmirContext)   ) where @@ -45,9 +45,9 @@ import qualified Text.XML.Cursor as C  data XmirContext = XmirContext-  { omitListing :: Bool,-    omitComments :: Bool,-    listing :: Program -> String+  { omitListing :: Bool+  , omitComments :: Bool+  , listing :: Program -> String   }  defaultXmirContext :: XmirContext@@ -62,11 +62,11 @@   deriving (Exception)  instance Show XMIRException where-  show UnsupportedProgram {..} = printf "XMIR does not support such program:\n%s" (printProgram prog)-  show UnsupportedExpression {..} = printf "XMIR does not support such expression:\n%s" (printExpression expr)-  show UnsupportedBinding {..} = printf "XMIR does not support such bindings: %s" (printBinding binding)-  show CouldNotParseXMIR {..} = printf "Couldn't parse given XMIR, cause: %s" message-  show InvalidXMIRFormat {..} =+  show UnsupportedProgram{..} = printf "XMIR does not support such program:\n%s" (printProgram prog)+  show UnsupportedExpression{..} = printf "XMIR does not support such expression:\n%s" (printExpression expr)+  show UnsupportedBinding{..} = printf "XMIR does not support such bindings: %s" (printBinding binding)+  show CouldNotParseXMIR{..} = printf "Couldn't parse given XMIR, cause: %s" message+  show InvalidXMIRFormat{..} =     printf       "Couldn't traverse though given XMIR, cause: %s\nXMIR:\n%s"       message@@ -102,32 +102,32 @@       if head base == '.' || not (null children)         then pure ('.' : attr', [object [("base", base)] children])         else pure (base ++ ('.' : attr'), children)-expression (DataNumber bytes) XmirContext {..} =+expression (DataNumber bytes) XmirContext{..} =   let bts =         object           [("as", printAttribute (AtAlpha 0)), ("base", "Φ.org.eolang.bytes")]           [object [] [NodeContent (T.pack (printBytes bytes))]]    in pure-        ( "Φ.org.eolang.number",-          if omitComments+        ( "Φ.org.eolang.number"+        , if omitComments             then [bts]             else-              [ NodeComment (T.pack (either show show (btsToNum bytes))),-                bts+              [ NodeComment (T.pack (either show show (btsToNum bytes)))+              , bts               ]         )-expression (DataString bytes) XmirContext {..} =+expression (DataString bytes) XmirContext{..} =   let bts =         object           [("as", printAttribute (AtAlpha 0)), ("base", "Φ.org.eolang.bytes")]           [object [] [NodeContent (T.pack (printBytes bytes))]]    in pure-        ( "Φ.org.eolang.string",-          if omitComments+        ( "Φ.org.eolang.string"+        , if omitComments             then [bts]             else-              [ NodeComment (T.pack ('"' : btsToStr bytes ++ "\"")),-                bts+              [ NodeComment (T.pack ('"' : btsToStr bytes ++ "\""))+              , bts               ]         ) expression (ExApplication expr (BiTau attr texpr)) ctx = do@@ -164,7 +164,7 @@ nestedBindings bds ctx = catMaybes <$> mapM (`formationBinding` ctx) bds  programToXMIR :: Program -> XmirContext -> IO Document-programToXMIR prog@(Program expr@(ExFormation [BiTau (AtLabel _) arg, BiVoid AtRho])) ctx@XmirContext {..} = case arg of+programToXMIR prog@(Program expr@(ExFormation [BiTau (AtLabel _) arg, BiVoid AtRho])) ctx@XmirContext{..} = case arg of   ExFormation _ -> programToXMIR'   ExApplication _ _ -> programToXMIR'   ExDispatch _ _ -> programToXMIR'@@ -188,13 +188,13 @@             (Prologue [] Nothing [])             ( element                 "object"-                [ ("dob", formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S" now),-                  ("ms", "0"),-                  ("revision", "1234567"),-                  ("time", time now),-                  ("version", showVersion version),-                  ("xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance"),-                  ("xsi:noNamespaceSchemaLocation", "https://raw.githubusercontent.com/objectionary/eo/refs/heads/gh-pages/XMIR.xsd")+                [ ("dob", formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S" now)+                , ("ms", "0")+                , ("revision", "1234567")+                , ("time", time now)+                , ("version", showVersion version)+                , ("xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance")+                , ("xsi:noNamespaceSchemaLocation", "https://raw.githubusercontent.com/objectionary/eo/refs/heads/gh-pages/XMIR.xsd")                 ]                 ( if null pckg                     then [listing', root]@@ -241,9 +241,9 @@                 ( element                     "meta"                     []-                    [ NodeElement (element "head" [] [NodeContent (T.pack "package")]),-                      NodeElement (element "tail" [] [NodeContent (T.pack pckg)]),-                      NodeElement (element "part" [] [NodeContent (T.pack pckg)])+                    [ NodeElement (element "head" [] [NodeContent (T.pack "package")])+                    , NodeElement (element "tail" [] [NodeContent (T.pack pckg)])+                    , NodeElement (element "part" [] [NodeContent (T.pack pckg)])                     ]                 )             ]@@ -308,7 +308,7 @@     attrsText =       mconcat         [ TB.fromString " " <> TB.fromText (nameLocalName k) <> TB.fromString "=\"" <> TB.fromText v <> TB.fromString "\""-          | (k, v) <- M.toList attrs+        | (k, v) <- M.toList attrs         ]      isTextNode (NodeContent _) = True@@ -361,11 +361,11 @@                 _ -> throwIO (InvalidXMIRFormat "Expected single <o> element in <object>" doc)               let pckg =                     [ T.unpack t-                      | meta <- doc C.$/ C.element (toName "metas") C.&/ C.element (toName "meta"),-                        let heads = meta C.$/ C.element (toName "head") C.&/ C.content,-                        heads == ["package"],-                        tail' <- meta C.$/ C.element (toName "tail") C.&/ C.content,-                        t <- T.splitOn "." tail'+                    | meta <- doc C.$/ C.element (toName "metas") C.&/ C.element (toName "meta")+                    , let heads = meta C.$/ C.element (toName "head") C.&/ C.content+                    , heads == ["package"]+                    , tail' <- meta C.$/ C.element (toName "tail") C.&/ C.content+                    , t <- T.splitOn "." tail'                     ]               if null pckg                 then pure (Program (ExFormation [obj, BiVoid AtRho]))@@ -446,7 +446,7 @@ xmirToApplication :: Expression -> [C.Cursor] -> [String] -> IO Expression xmirToApplication = xmirToApplication' 0   where-    xmirToApplication' :: Integer -> Expression -> [C.Cursor] -> [String] -> IO Expression+    xmirToApplication' :: Int -> Expression -> [C.Cursor] -> [String] -> IO Expression     xmirToApplication' _ expr [] _ = pure expr     xmirToApplication' idx expr (arg : args) fqn = do       let app@@ -467,7 +467,7 @@       app' <- app       xmirToApplication' (idx + 1) app' args fqn -    asToAttr :: C.Cursor -> Integer -> IO Attribute+    asToAttr :: C.Cursor -> Int -> IO Attribute     asToAttr cur idx       | hasAttr "as" cur = do           as <- getAttr "as" cur@@ -480,7 +480,7 @@ toAttr :: String -> C.Cursor -> IO Attribute toAttr attr cur = case attr of   'α' : rest' ->-    case TR.readMaybe rest' :: Maybe Integer of+    case TR.readMaybe rest' :: Maybe Int of       Just idx -> pure (AtAlpha idx)       Nothing -> throwIO (InvalidXMIRFormat "The attribute started with 'α' must be followed by integer" cur)   "φ" -> pure AtPhi

@@ -55,8 +55,8 @@     Object o -> do       validateYamlObject o ["ordinal", "length"]       asum-        [ Ordinal <$> o .: "ordinal",-          Length <$> o .: "length"+        [ Ordinal <$> o .: "ordinal"+        , Length <$> o .: "length"         ]     Number num -> pure (Literal (round num))     _ ->@@ -65,9 +65,9 @@ instance FromJSON Comparable where   parseJSON v =     asum-      [ CmpAttr <$> parseJSON v,-        CmpNum <$> parseJSON v,-        CmpExpr <$> parseJSON v+      [ CmpAttr <$> parseJSON v+      , CmpNum <$> parseJSON v+      , CmpExpr <$> parseJSON v       ]  instance FromJSON Condition where@@ -77,31 +77,31 @@       ( \v -> do           validateYamlObject v ["and", "or", "not", "alpha", "nf", "xi", "eq", "in", "matches", "part-of"]           asum-            [ And <$> v .: "and",-              Or <$> v .: "or",-              Not <$> v .: "not",-              Alpha <$> v .: "alpha",-              NF <$> v .: "nf",-              XI <$> v .: "xi",-              do+            [ And <$> v .: "and"+            , Or <$> v .: "or"+            , Not <$> v .: "not"+            , Alpha <$> v .: "alpha"+            , NF <$> v .: "nf"+            , XI <$> v .: "xi"+            , do                 vals <- v .: "eq"                 case vals of                   [left_, right_] -> Eq <$> parseJSON left_ <*> parseJSON right_-                  _ -> fail "'eq' expects exactly two arguments",-              do+                  _ -> fail "'eq' expects exactly two arguments"+            , do                 vals <- v .: "in"                 case vals of                   [attr_, binding_] -> do                     attr <- parseJSON attr_                     bd <- parseJSON binding_                     pure (In attr bd)-                  _ -> fail "'in' expects exactly two arguments",-              do+                  _ -> fail "'in' expects exactly two arguments"+            , do                 vals <- v .: "matches"                 case vals of                   [pat, exp] -> Matches <$> parseJSON pat <*> parseJSON exp-                  _ -> fail "'matches' expects exactly two arguments",-              do+                  _ -> fail "'matches' expects exactly two arguments"+            , do                 vals <- v .: "part-of"                 case vals of                   [exp, bd] -> PartOf <$> parseJSON exp <*> parseJSON bd@@ -112,10 +112,10 @@ instance FromJSON ExtraArgument where   parseJSON v =     asum-      [ ArgAttribute <$> parseJSON v,-        ArgBinding <$> parseJSON v,-        ArgExpression <$> parseJSON v,-        ArgBytes <$> parseJSON v+      [ ArgAttribute <$> parseJSON v+      , ArgBinding <$> parseJSON v+      , ArgExpression <$> parseJSON v+      , ArgBytes <$> parseJSON v       ]  instance FromJSON Extra where@@ -133,7 +133,7 @@ data Number   = Ordinal Attribute   | Length Binding-  | Literal Integer+  | Literal Int   deriving (Eq, Generic, Show)  data Comparable@@ -163,20 +163,20 @@   deriving (Generic, Show)  data Extra = Extra-  { meta :: ExtraArgument,-    function :: String,-    args :: [ExtraArgument]+  { meta :: ExtraArgument+  , function :: String+  , args :: [ExtraArgument]   }   deriving (Generic, Show)  data Rule = Rule-  { name :: Maybe String,-    description :: Maybe String,-    pattern :: Expression,-    result :: Expression,-    when :: Maybe Condition,-    where_ :: Maybe [Extra],-    having :: Maybe Condition+  { name :: Maybe String+  , description :: Maybe String+  , pattern :: Expression+  , result :: Expression+  , when :: Maybe Condition+  , where_ :: Maybe [Extra]+  , having :: Maybe Condition   }   deriving (Generic, Show) 

@@ -0,0 +1,269 @@+-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+-- SPDX-License-Identifier: MIT++{- | Tests for the AST module that defines the abstract syntax tree+for phi-calculus programs including expressions, bindings, attributes, and bytes.+Attention! Most of the tests are generated by LLM. Consider that when refactoring+-}+module ASTSpec where++import AST+import Control.Monad (forM_)+import Data.List (sort)+import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)++spec :: Spec+spec = do+  describe "Attribute Show instance renders AtLabel" $+    forM_+      [ ("simple label", AtLabel "x", "x")+      , ("unicode label", AtLabel "日本語", "日本語")+      , ("long label", AtLabel "myAttribute", "myAttribute")+      ]+      ( \(desc, attr, expected) ->+          it desc $ show attr `shouldBe` expected+      )++  describe "Attribute Show instance renders AtAlpha" $+    forM_+      [ ("zero index", AtAlpha 0, "α0")+      , ("positive index", AtAlpha 42, "α42")+      , ("large index", AtAlpha 999, "α999")+      ]+      ( \(desc, attr, expected) ->+          it desc $ show attr `shouldBe` expected+      )++  describe "Attribute Show instance renders special attributes" $+    forM_+      [ ("rho", AtRho, "ρ")+      , ("phi", AtPhi, "φ")+      , ("delta", AtDelta, "Δ")+      , ("lambda", AtLambda, "λ")+      ]+      ( \(desc, attr, expected) ->+          it desc $ show attr `shouldBe` expected+      )++  describe "Attribute Show instance renders AtMeta" $+    forM_+      [ ("simple meta", AtMeta "a", "!a")+      , ("long meta", AtMeta "attribute", "!attribute")+      , ("unicode meta", AtMeta "メタ", "!メタ")+      ]+      ( \(desc, attr, expected) ->+          it desc $ show attr `shouldBe` expected+      )++  describe "Attribute Eq instance compares same constructors" $+    forM_+      [ ("labels equal", AtLabel "x", AtLabel "x", True)+      , ("labels differ", AtLabel "x", AtLabel "y", False)+      , ("alphas equal", AtAlpha 1, AtAlpha 1, True)+      , ("alphas differ", AtAlpha 1, AtAlpha 2, False)+      , ("metas equal", AtMeta "a", AtMeta "a", True)+      , ("metas differ", AtMeta "a", AtMeta "b", False)+      , ("rho equals rho", AtRho, AtRho, True)+      , ("phi equals phi", AtPhi, AtPhi, True)+      , ("delta equals delta", AtDelta, AtDelta, True)+      , ("lambda equals lambda", AtLambda, AtLambda, True)+      ]+      ( \(desc, lhs, rhs, expected) ->+          it desc $ (lhs == rhs) `shouldBe` expected+      )++  describe "Attribute Eq instance compares different constructors" $+    forM_+      [ ("label vs alpha", AtLabel "x", AtAlpha 0, False)+      , ("rho vs phi", AtRho, AtPhi, False)+      , ("delta vs lambda", AtDelta, AtLambda, False)+      , ("meta vs label", AtMeta "x", AtLabel "x", False)+      ]+      ( \(desc, lhs, rhs, expected) ->+          it desc $ (lhs == rhs) `shouldBe` expected+      )++  describe "Attribute Ord instance orders correctly" $+    it "sorts attributes by constructor order" $+      let attrs = [AtMeta "z", AtDelta, AtLambda, AtRho, AtPhi, AtAlpha 1, AtLabel "a"]+          sorted = sort attrs+          isLabel (AtLabel _) = True+          isLabel _ = False+       in head sorted `shouldSatisfy` isLabel++  describe "Bytes Eq instance compares same constructors" $+    forM_+      [ ("empty equals empty", BtEmpty, BtEmpty, True)+      , ("one equals one", BtOne "FF", BtOne "FF", True)+      , ("one differs", BtOne "FF", BtOne "00", False)+      , ("many equals many", BtMany ["00", "01"], BtMany ["00", "01"], True)+      , ("many differs", BtMany ["00"], BtMany ["01"], False)+      , ("meta equals meta", BtMeta "b", BtMeta "b", True)+      , ("meta differs", BtMeta "b", BtMeta "c", False)+      ]+      ( \(desc, lhs, rhs, expected) ->+          it desc $ (lhs == rhs) `shouldBe` expected+      )++  describe "Bytes Eq instance compares different constructors" $+    forM_+      [ ("empty vs one", BtEmpty, BtOne "00", False)+      , ("one vs many", BtOne "00", BtMany ["00"], False)+      , ("many vs meta", BtMany ["00"], BtMeta "b", False)+      ]+      ( \(desc, lhs, rhs, expected) ->+          it desc $ (lhs == rhs) `shouldBe` expected+      )++  describe "Bytes Ord instance orders correctly" $+    it "sorts bytes by constructor order" $+      let bytes = [BtMeta "z", BtMany ["00"], BtOne "FF", BtEmpty]+          sorted = sort bytes+       in head sorted `shouldBe` BtEmpty++  describe "Binding Eq instance compares same constructors" $+    forM_+      [ ("tau equals tau", BiTau AtRho ExGlobal, BiTau AtRho ExGlobal, True)+      , ("tau differs by attr", BiTau AtRho ExGlobal, BiTau AtPhi ExGlobal, False)+      , ("tau differs by expr", BiTau AtRho ExGlobal, BiTau AtRho ExThis, False)+      , ("meta equals meta", BiMeta "B", BiMeta "B", True)+      , ("meta differs", BiMeta "B", BiMeta "C", False)+      , ("delta equals delta", BiDelta BtEmpty, BiDelta BtEmpty, True)+      , ("delta differs", BiDelta BtEmpty, BiDelta (BtOne "00"), False)+      , ("void equals void", BiVoid AtRho, BiVoid AtRho, True)+      , ("void differs", BiVoid AtRho, BiVoid AtPhi, False)+      , ("lambda equals lambda", BiLambda "Func", BiLambda "Func", True)+      , ("lambda differs", BiLambda "Func", BiLambda "Other", False)+      , ("metalambda equals", BiMetaLambda "F", BiMetaLambda "F", True)+      , ("metalambda differs", BiMetaLambda "F", BiMetaLambda "G", False)+      ]+      ( \(desc, lhs, rhs, expected) ->+          it desc $ (lhs == rhs) `shouldBe` expected+      )++  describe "Binding Eq instance compares different constructors" $+    forM_+      [ ("tau vs meta", BiTau AtRho ExGlobal, BiMeta "B", False)+      , ("delta vs void", BiDelta BtEmpty, BiVoid AtDelta, False)+      , ("lambda vs metalambda", BiLambda "F", BiMetaLambda "F", False)+      ]+      ( \(desc, lhs, rhs, expected) ->+          it desc $ (lhs == rhs) `shouldBe` expected+      )++  describe "Binding Ord instance orders correctly" $+    it "sorts bindings by constructor order" $+      let bindings = [BiMetaLambda "Z", BiLambda "A", BiVoid AtRho, BiDelta BtEmpty, BiMeta "B", BiTau AtRho ExGlobal]+          sorted = sort bindings+          isTau (BiTau _ _) = True+          isTau _ = False+       in head sorted `shouldSatisfy` isTau++  describe "Expression Eq instance compares same constructors" $+    forM_+      [ ("formation equals", ExFormation [], ExFormation [], True)+      , ("formation differs", ExFormation [], ExFormation [BiVoid AtRho], False)+      , ("this equals this", ExThis, ExThis, True)+      , ("global equals global", ExGlobal, ExGlobal, True)+      , ("termination equals", ExTermination, ExTermination, True)+      , ("meta equals meta", ExMeta "e", ExMeta "e", True)+      , ("meta differs", ExMeta "e", ExMeta "f", False)+      , ("application equals", ExApplication ExGlobal (BiTau AtRho ExThis), ExApplication ExGlobal (BiTau AtRho ExThis), True)+      , ("dispatch equals", ExDispatch ExGlobal AtRho, ExDispatch ExGlobal AtRho, True)+      , ("dispatch differs", ExDispatch ExGlobal AtRho, ExDispatch ExGlobal AtPhi, False)+      , ("metatail equals", ExMetaTail ExGlobal "t", ExMetaTail ExGlobal "t", True)+      , ("metatail differs", ExMetaTail ExGlobal "t", ExMetaTail ExGlobal "s", False)+      ]+      ( \(desc, lhs, rhs, expected) ->+          it desc $ (lhs == rhs) `shouldBe` expected+      )++  describe "Expression Eq instance compares different constructors" $+    forM_+      [ ("formation vs this", ExFormation [], ExThis, False)+      , ("global vs termination", ExGlobal, ExTermination, False)+      , ("meta vs dispatch", ExMeta "e", ExDispatch ExGlobal AtRho, False)+      ]+      ( \(desc, lhs, rhs, expected) ->+          it desc $ (lhs == rhs) `shouldBe` expected+      )++  describe "Expression Ord instance orders correctly" $+    it "sorts expressions by constructor order" $+      let exprs = [ExMetaTail ExGlobal "t", ExDispatch ExGlobal AtRho, ExApplication ExGlobal (BiVoid AtRho), ExMeta "e", ExTermination, ExGlobal, ExThis, ExFormation []]+          sorted = sort exprs+       in head sorted `shouldBe` ExFormation []++  describe "Program Eq instance compares programs" $+    forM_+      [ ("same programs equal", Program ExGlobal, Program ExGlobal, True)+      , ("different programs differ", Program ExGlobal, Program ExThis, False)+      ]+      ( \(desc, lhs, rhs, expected) ->+          it desc $ (lhs == rhs) `shouldBe` expected+      )++  describe "Program Ord instance orders correctly" $+    it "orders programs by expression" $+      let progs = [Program ExThis, Program ExGlobal, Program (ExFormation [])]+          sorted = sort progs+       in head sorted `shouldBe` Program (ExFormation [])++  describe "Program Show instance renders programs" $+    it "shows program wrapper" $+      let hasProgram str = "Program" `elem` words str+       in show (Program ExGlobal) `shouldSatisfy` hasProgram++  describe "countNodes counts ExGlobal" $+    it "returns one for global" $+      countNodes (Program ExGlobal) `shouldBe` 1++  describe "countNodes counts ExTermination" $+    it "returns one for termination" $+      countNodes (Program ExTermination) `shouldBe` 1++  describe "countNodes counts ExThis" $+    it "returns one for this" $+      countNodes (Program ExThis) `shouldBe` 1++  describe "countNodes counts ExDispatch" $+    it "returns three for dispatch on global" $+      countNodes (Program (ExDispatch ExGlobal (AtLabel "x"))) `shouldBe` 3++  describe "countNodes counts ExApplication" $+    it "returns four for application with globals" $+      countNodes (Program (ExApplication ExGlobal (BiTau AtRho ExGlobal))) `shouldBe` 4++  describe "countNodes counts ExFormation with tau bindings" $+    it "returns count including nested expressions" $+      countNodes (Program (ExFormation [BiTau AtRho ExGlobal, BiTau AtPhi ExGlobal])) `shouldBe` 3++  describe "countNodes counts ExFormation with non-tau bindings" $+    forM_+      [ ("empty formation", ExFormation [], 1)+      , ("void binding", ExFormation [BiVoid AtRho], 2)+      , ("delta binding", ExFormation [BiDelta BtEmpty], 2)+      , ("lambda binding", ExFormation [BiLambda "Func"], 2)+      , ("meta binding", ExFormation [BiMeta "B"], 2)+      , ("metalambda binding", ExFormation [BiMetaLambda "F"], 2)+      ]+      ( \(desc, expr, expected) ->+          it desc $ countNodes (Program expr) `shouldBe` expected+      )++  describe "countNodes returns zero for meta expressions" $+    forM_+      [ ("meta expression", ExMeta "e", 0)+      , ("metatail expression", ExMetaTail ExGlobal "t", 0)+      ]+      ( \(desc, expr, expected) ->+          it desc $ countNodes (Program expr) `shouldBe` expected+      )++  describe "countNodes counts nested structures" $+    it "counts deeply nested dispatch" $+      countNodes (Program (ExDispatch (ExDispatch ExGlobal (AtLabel "a")) (AtLabel "b"))) `shouldBe` 5++  describe "countNodes counts complex formation" $+    it "counts formation with dispatch inside" $+      countNodes (Program (ExFormation [BiTau AtRho (ExDispatch ExGlobal (AtLabel "x"))])) `shouldBe` 4

@@ -6,10 +6,10 @@ import AST import Builder import Control.Monad+import Data.Either (isLeft) import Data.Map.Strict qualified as Map import Matcher-import Test.Hspec (Example (Arg), Expectation, Spec, SpecWith, anyException, describe, it, shouldBe, shouldThrow, shouldSatisfy)-import Data.Either (isLeft)+import Test.Hspec (Example (Arg), Expectation, Spec, SpecWith, anyException, describe, it, shouldBe, shouldSatisfy, shouldThrow)  test :: (Show a, Eq a) => (a -> Subst -> Either String (a, a)) -> [(String, a, [(String, MetaValue)], Either String (a, a))] -> SpecWith (Arg Expectation) test function useCases =@@ -21,62 +21,71 @@   describe "buildExpression" $     test       buildExpression-      [ ( "Q.!a => (!a >> x) => Q.x",-          ExDispatch ExGlobal (AtMeta "a"),-          [("a", MvAttribute (AtLabel "x"))],-          Right (ExDispatch ExGlobal (AtLabel "x"), defaultScope)-        ),-        ( "Q.c(!a -> !e) => (!a >> x, !e >> $.y.z) => Q.c(x -> $.y.z)",-          ExApplication (ExDispatch ExGlobal (AtLabel "c")) (BiTau (AtMeta "a") (ExMeta "e")),-          [("a", MvAttribute (AtLabel "x")), ("e", MvExpression (ExDispatch (ExDispatch ExThis (AtLabel "y")) (AtLabel "z")) defaultScope)],-          Right (ExApplication (ExDispatch ExGlobal (AtLabel "c")) (BiTau (AtLabel "x") (ExDispatch (ExDispatch ExThis (AtLabel "y")) (AtLabel "z"))), defaultScope)-        ),-        ( "[[!a -> $.x, !B]] => (!a >> y, !B >> [[b -> ?, L> Func]]) => [[y -> $.x, b -> ?, L> Func]]",-          ExFormation [BiTau (AtMeta "a") (ExDispatch ExThis (AtLabel "x")), BiMeta "B"],-          [("a", MvAttribute (AtLabel "y")), ("B", MvBindings [BiVoid (AtLabel "b"), BiLambda "Func"])],-          Right+      [+        ( "Q.!a => (!a >> x) => Q.x"+        , ExDispatch ExGlobal (AtMeta "a")+        , [("a", MvAttribute (AtLabel "x"))]+        , Right (ExDispatch ExGlobal (AtLabel "x"), defaultScope)+        )+      ,+        ( "Q.c(!a -> !e) => (!a >> x, !e >> $.y.z) => Q.c(x -> $.y.z)"+        , ExApplication (ExDispatch ExGlobal (AtLabel "c")) (BiTau (AtMeta "a") (ExMeta "e"))+        , [("a", MvAttribute (AtLabel "x")), ("e", MvExpression (ExDispatch (ExDispatch ExThis (AtLabel "y")) (AtLabel "z")) defaultScope)]+        , Right (ExApplication (ExDispatch ExGlobal (AtLabel "c")) (BiTau (AtLabel "x") (ExDispatch (ExDispatch ExThis (AtLabel "y")) (AtLabel "z"))), defaultScope)+        )+      ,+        ( "[[!a -> $.x, !B]] => (!a >> y, !B >> [[b -> ?, L> Func]]) => [[y -> $.x, b -> ?, L> Func]]"+        , ExFormation [BiTau (AtMeta "a") (ExDispatch ExThis (AtLabel "x")), BiMeta "B"]+        , [("a", MvAttribute (AtLabel "y")), ("B", MvBindings [BiVoid (AtLabel "b"), BiLambda "Func"])]+        , Right             ( ExFormation-                [ BiTau (AtLabel "y") (ExDispatch ExThis (AtLabel "x")),-                  BiVoid (AtLabel "b"),-                  BiLambda "Func"-                ],-              defaultScope+                [ BiTau (AtLabel "y") (ExDispatch ExThis (AtLabel "x"))+                , BiVoid (AtLabel "b")+                , BiLambda "Func"+                ]+            , defaultScope             )-        ),-        ( "Q * !t => (!t >> [.a, .b, (~1 -> $.x)]) => Q.a.b(~1 -> $.x)",-          ExMetaTail ExGlobal "t",-          [("t", MvTail [TaDispatch (AtLabel "a"), TaDispatch (AtLabel "b"), TaApplication (BiTau (AtAlpha 1) (ExDispatch ExThis (AtLabel "x")))])],-          Right (ExApplication (ExDispatch (ExDispatch ExGlobal (AtLabel "a")) (AtLabel "b")) (BiTau (AtAlpha 1) (ExDispatch ExThis (AtLabel "x"))), defaultScope)-        ),-        ( "Q.!a => () => X",-          ExDispatch ExGlobal (AtMeta "a"),-          [],-          Left "meta 'a' is either does not exist or refers to an inappropriate term"-        ),-        ( "!e0(!a1 -> !e1, !a2 => !e2) => (!e0 >> [[]], !a1 >> x, !e1 >> Q, !a2 >> y, !e2 >> $) => [[]](x -> Q, y -> $)",-          ExApplication (ExApplication (ExMeta "e0") (BiTau (AtMeta "a1") (ExMeta "e1"))) (BiTau (AtMeta "a2") (ExMeta "e2")),-          [ ("e0", MvExpression (ExFormation []) defaultScope),-            ("a1", MvAttribute (AtLabel "x")),-            ("e1", MvExpression ExGlobal defaultScope),-            ("a2", MvAttribute (AtLabel "y")),-            ("e2", MvExpression ExThis defaultScope)-          ],-          Right (ExApplication (ExApplication (ExFormation []) (BiTau (AtLabel "x") ExGlobal)) (BiTau (AtLabel "y") ExThis), defaultScope)-        ),-        ( "⟦!a ↦ ∅, !B⟧.!a => (!a >> t, !B >> ⟦ x ↦ ξ.t ⟧ ) => ⟦ t ↦ ∅, x ↦ ξ.t ⟧.t",-          ExDispatch (ExFormation [BiVoid (AtMeta "a"), BiMeta "B"]) (AtMeta "a"),-          [ ("a", MvAttribute (AtLabel "t")),-            ("B", MvBindings [BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t"))])-          ],-          Right+        )+      ,+        ( "Q * !t => (!t >> [.a, .b, (~1 -> $.x)]) => Q.a.b(~1 -> $.x)"+        , ExMetaTail ExGlobal "t"+        , [("t", MvTail [TaDispatch (AtLabel "a"), TaDispatch (AtLabel "b"), TaApplication (BiTau (AtAlpha 1) (ExDispatch ExThis (AtLabel "x")))])]+        , Right (ExApplication (ExDispatch (ExDispatch ExGlobal (AtLabel "a")) (AtLabel "b")) (BiTau (AtAlpha 1) (ExDispatch ExThis (AtLabel "x"))), defaultScope)+        )+      ,+        ( "Q.!a => () => X"+        , ExDispatch ExGlobal (AtMeta "a")+        , []+        , Left "meta 'a' is either does not exist or refers to an inappropriate term"+        )+      ,+        ( "!e0(!a1 -> !e1, !a2 => !e2) => (!e0 >> [[]], !a1 >> x, !e1 >> Q, !a2 >> y, !e2 >> $) => [[]](x -> Q, y -> $)"+        , ExApplication (ExApplication (ExMeta "e0") (BiTau (AtMeta "a1") (ExMeta "e1"))) (BiTau (AtMeta "a2") (ExMeta "e2"))+        ,+          [ ("e0", MvExpression (ExFormation []) defaultScope)+          , ("a1", MvAttribute (AtLabel "x"))+          , ("e1", MvExpression ExGlobal defaultScope)+          , ("a2", MvAttribute (AtLabel "y"))+          , ("e2", MvExpression ExThis defaultScope)+          ]+        , Right (ExApplication (ExApplication (ExFormation []) (BiTau (AtLabel "x") ExGlobal)) (BiTau (AtLabel "y") ExThis), defaultScope)+        )+      ,+        ( "⟦!a ↦ ∅, !B⟧.!a => (!a >> t, !B >> ⟦ x ↦ ξ.t ⟧ ) => ⟦ t ↦ ∅, x ↦ ξ.t ⟧.t"+        , ExDispatch (ExFormation [BiVoid (AtMeta "a"), BiMeta "B"]) (AtMeta "a")+        ,+          [ ("a", MvAttribute (AtLabel "t"))+          , ("B", MvBindings [BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t"))])+          ]+        , Right             ( ExDispatch                 ( ExFormation-                    [ BiVoid (AtLabel "t"),-                      BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t"))+                    [ BiVoid (AtLabel "t")+                    , BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t"))                     ]                 )-                (AtLabel "t"),-              defaultScope+                (AtLabel "t")+            , defaultScope             )         )       ]@@ -84,18 +93,18 @@   describe "buildExpressions" $ do     it "!e => [(!e >> Q.x), (!e >> $.y)] => [Q.x, $.y]" $ do       built <--        buildExpressions+        buildExpressionsThrows           (ExMeta "e")-          [ substSingle "e" (MvExpression (ExDispatch ExGlobal (AtLabel "x")) defaultScope),-            substSingle "e" (MvExpression (ExDispatch ExThis (AtLabel "y")) defaultScope)+          [ substSingle "e" (MvExpression (ExDispatch ExGlobal (AtLabel "x")) defaultScope)+          , substSingle "e" (MvExpression (ExDispatch ExThis (AtLabel "y")) defaultScope)           ]       built `shouldBe` [(ExDispatch ExGlobal (AtLabel "x"), defaultScope), (ExDispatch ExThis (AtLabel "y"), defaultScope)]     it "!e => [(!e1 >> Q.x)] => X" $-      buildExpressions+      buildExpressionsThrows         (ExMeta "e")         [substSingle "e1" (MvExpression (ExDispatch ExGlobal (AtLabel "x")) defaultScope)]         `shouldThrow` anyException-  +   describe "build with duplicate attributes in bindings" $ do     it "build binding with duplicates" $       buildBinding (BiMeta "B") (substSingle "B" (MvBindings [BiVoid AtRho, BiVoid AtRho])) `shouldSatisfy` isLeft

@@ -17,6 +17,7 @@ import System.Directory (doesDirectoryExist, doesFileExist, listDirectory, removeDirectoryRecursive, removeFile) import System.Exit (ExitCode (ExitFailure)) import System.IO+import System.Info (os) import Test.Hspec import Text.Printf (printf) @@ -99,6 +100,9 @@ rule :: String -> String rule file = "--rule=" <> resource file +isWindows :: Bool+isWindows = os == "mingw32"+ spec :: Spec spec = do   it "prints version" $@@ -168,10 +172,10 @@       it "with wrong attribute and valid error message" $         testCLIFailed           ["rewrite", resource "with-$this-attribute.phi"]-          [ "[ERROR]: Couldn't parse given phi program, cause: program:10:13:",-            "10 |             $this ↦ ⟦⟧",-            "   |             ^^",-            "unexpected \"$t\""+          [ "[ERROR]: Couldn't parse given phi program, cause: program:10:13:"+          , "10 |             $this ↦ ⟦⟧"+          , "   |             ^^"+          , "unexpected \"$t\""           ]        it "with --output != latex and --nonumber" $@@ -204,6 +208,12 @@             ["rewrite", "--label=foo", "--output=phi"]             ["--label option can stay together with --output=latex only"] +      it "with --compress and --output != latex" $+        withStdin "{[[]]}" $+          testCLIFailed+            ["rewrite", "--compress", "--output=phi"]+            ["--compress option can stay together with --output=latex only"]+       it "with wrong --hide option" $         withStdin "{[[]]}" $           testCLIFailed@@ -215,7 +225,7 @@           testCLIFailed             ["rewrite", "--show=Q.x.y", "--show=hello"]             ["The option --show can be used only once"]-      +       it "with wrong --show option" $         withStdin "{[[]]}" $           testCLIFailed@@ -254,15 +264,15 @@       testCLISucceeded         ["rewrite", "--normalize", resource "normalize.phi"]         [ unlines-            [ "Φ ↦ ⟦",-              "  x ↦ ⟦",-              "    ρ ↦ ⟦",-              "      y ↦ ⟦ ρ ↦ ∅ ⟧,",-              "      ρ ↦ ∅",-              "    ⟧",-              "  ⟧,",-              "  ρ ↦ ∅",-              "⟧"+            [ "Φ ↦ ⟦"+            , "  x ↦ ⟦"+            , "    ρ ↦ ⟦"+            , "      y ↦ ⟦ ρ ↦ ∅ ⟧,"+            , "      ρ ↦ ∅"+            , "    ⟧"+            , "  ⟧,"+            , "  ρ ↦ ∅"+            , "⟧"             ]         ] @@ -271,13 +281,13 @@         testCLISucceeded           ["rewrite", "--normalize"]           [ unlines-              [ "Φ ↦ ⟦",-                "  a ↦ ⟦",-                "    b ↦ ⟦ ρ ↦ ∅ ⟧,",-                "    ρ ↦ ∅",-                "  ⟧,",-                "  ρ ↦ ∅",-                "⟧"+              [ "Φ ↦ ⟦"+              , "  a ↦ ⟦"+              , "    b ↦ ⟦ ρ ↦ ∅ ⟧,"+              , "    ρ ↦ ∅"+              , "  ⟧,"+              , "  ρ ↦ ∅"+              , "⟧"               ]           ] @@ -297,44 +307,44 @@       withStdin "Q -> [[ x_o -> QQ.z(y -> 5), q$ -> T, w -> $, ^ -> Q, @ -> 1, y -> \"H$@^M\", L> Fu_nc ]]" $         testCLISucceeded           ["rewrite", "--output=latex", "--sweet"]-          [ "\\begin{phiquation}",-            "\\Big\\{[[\n",-            "  |x\\char95{}o| -> QQ.|z|( |y| -> 5 ),\n",-            "  |q\\char36{}| -> T,\n",-            "  |w| -> $,\n",-            "  ^ -> Q,\n",-            "  @ -> 1,\n",-            "  |y| -> \"H$@^M\",\n",-            "  L> |Fu\\char95{}nc|\n",-            "]]\\Big\\}",-            "\\end{phiquation}"+          [ "\\begin{phiquation}"+          , "\\Big\\{[[\n"+          , "  |x\\char95{}o| -> QQ.|z|( |y| -> 5 ),\n"+          , "  |q\\char36{}| -> T,\n"+          , "  |w| -> $,\n"+          , "  ^ -> Q,\n"+          , "  @ -> 1,\n"+          , "  |y| -> \"H$@^M\",\n"+          , "  L> |Fu\\char95{}nc|\n"+          , "]]\\Big\\}"+          , "\\end{phiquation}"           ]      it "rewrites as LaTeX without numeration" $       withStdin "Q -> [[ x -> 5 ]]" $         testCLISucceeded           ["rewrite", "--output=latex", "--sweet", "--nonumber", "--flat"]-          [ "\\begin{phiquation*}",-            "\\Big\\{[[ |x| -> 5 ]]\\Big\\}",-            "\\end{phiquation*}"+          [ "\\begin{phiquation*}"+          , "\\Big\\{[[ |x| -> 5 ]]\\Big\\}"+          , "\\end{phiquation*}"           ]      it "rewrite as LaTeX with expression name" $       withStdin "Q -> [[ x -> 5 ]]" $         testCLISucceeded           ["rewrite", "--output=latex", "--sweet", "--flat", "--expression=foo"]-          [ "\\begin{phiquation}",-            "\\phiExpression{foo} \\Big\\{[[ |x| -> 5 ]]\\Big\\}.\n",-            "\\end{phiquation}"+          [ "\\begin{phiquation}"+          , "\\phiExpression{foo} \\Big\\{[[ |x| -> 5 ]]\\Big\\}.\n"+          , "\\end{phiquation}"           ]      it "rewrite as LaTeX with label name" $       withStdin "Q -> [[ x -> 5 ]]" $         testCLISucceeded           ["rewrite", "--output=latex", "--sweet", "--flat", "--label=foo"]-          [ "\\begin{phiquation}\n\\label{foo}\n",-            "\\Big\\{[[ |x| -> 5 ]]\\Big\\}.\n",-            "\\end{phiquation}"+          [ "\\begin{phiquation}\n\\label{foo}\n"+          , "\\Big\\{[[ |x| -> 5 ]]\\Big\\}.\n"+          , "\\end{phiquation}"           ]      it "rewrites with XMIR as input" $@@ -342,11 +352,11 @@         testCLISucceeded           ["rewrite", "--input=xmir", "--sweet"]           [ unlines-              [ "{⟦",-                "  app ↦ ⟦",-                "    x ↦ Φ.number",-                "  ⟧",-                "⟧}"+              [ "{⟦"+              , "  app ↦ ⟦"+              , "    x ↦ Φ.number"+              , "  ⟧"+              , "⟧}"               ]           ] @@ -365,44 +375,60 @@     it "prints many programs with --sequence" $       withStdin "{[[ x -> \"foo\" ]]}" $         testCLISucceeded-          [ "rewrite",-            rule "first.yaml",-            rule "second.yaml",-            "--max-depth=1",-            "--max-cycles=2",-            "--sequence",-            "--sweet",-            "--flat"+          [ "rewrite"+          , rule "first.yaml"+          , rule "second.yaml"+          , "--max-depth=1"+          , "--max-cycles=2"+          , "--sequence"+          , "--sweet"+          , "--flat"           ]           [ unlines-              [ "{⟦ x ↦ \"foo\" ⟧}",-                "{Φ.x( y ↦ \"foo\" )}",-                "{⟦ x ↦ \"foo\" ⟧}"+              [ "{⟦ x ↦ \"foo\" ⟧}"+              , "{Φ.x( y ↦ \"foo\" )}"+              , "{⟦ x ↦ \"foo\" ⟧}"               ]           ]      it "prints only one latex preamble with --sequence" $       withStdin "{[[ x -> \"foo\" ]]}" $         testCLISucceeded-          [ "rewrite",-            rule "first.yaml",-            rule "second.yaml",-            "--max-depth=1",-            "--max-cycles=2",-            "--sequence",-            "--sweet",-            "--flat",-            "--output=latex"+          [ "rewrite"+          , rule "first.yaml"+          , rule "second.yaml"+          , "--max-depth=1"+          , "--max-cycles=2"+          , "--sequence"+          , "--sweet"+          , "--flat"+          , "--output=latex"           ]           [ unlines-              [ "\\begin{phiquation}",-                "\\Big\\{[[ |x| -> \"foo\" ]]\\Big\\} \\leadsto_{\\nameref{r:first}}",-                "  \\leadsto \\Big\\{Q.|x|( |y| -> \"foo\" )\\Big\\} \\leadsto_{\\nameref{r:second}}",-                "  \\leadsto \\Big\\{[[ |x| -> \"foo\" ]]\\Big\\}.",-                "\\end{phiquation}"+              [ "\\begin{phiquation}"+              , "\\Big\\{[[ |x| -> \"foo\" ]]\\Big\\} \\leadsto_{\\nameref{r:first}}"+              , "  \\leadsto \\Big\\{Q.|x|( |y| -> \"foo\" )\\Big\\} \\leadsto_{\\nameref{r:second}}"+              , "  \\leadsto \\Big\\{[[ |x| -> \"foo\" ]]\\Big\\}."+              , "\\end{phiquation}"               ]           ] +    it "prints with compressed expressions in LaTeX" $+      withStdin "{[[ x -> ?, y -> $.x ]](x -> [[ D> 42- ]]).y}" $+        testCLISucceeded+          ["rewrite", "--normalize", "--sweet", "--sequence", "--output=latex", "--flat", "--compress"]+          [ unlines+              [ "\\begin{phiquation}"+              , "\\Big\\{[[ |x| -> ?, |y| -> |x| ]]( |x| -> [[ D> 42- ]] ).|y|\\Big\\} \\leadsto_{\\nameref{r:copy}}"+              , "  \\leadsto \\Big\\{\\phiMeet{1}{[[ |x| -> [[ D> 42- ]], |y| -> |x| ]]}.|y|\\Big\\} \\leadsto_{\\nameref{r:dot}}"+              , "  \\leadsto \\Big\\{\\phiAgain{1}.|x|( ^ -> \\phiAgain{1} )\\Big\\} \\leadsto_{\\nameref{r:dot}}"+              , "  \\leadsto \\Big\\{[[ D> 42- ]]( ^ -> \\phiAgain{1}, ^ -> \\phiAgain{1} )\\Big\\} \\leadsto_{\\nameref{r:copy}}"+              , "  \\leadsto \\Big\\{[[ D> 42-, ^ -> \\phiAgain{1} ]]( ^ -> \\phiAgain{1} )\\Big\\} \\leadsto_{\\nameref{r:stay}}"+              , "  \\leadsto \\Big\\{[[ D> 42-, ^ -> \\phiAgain{1} ]]\\Big\\}."+              , "\\end{phiquation}"+              ]+          ]+     it "prints input as listing in XMIR" $       withStdin "{[[ app -> [[]] ]]}" $         testCLISucceeded@@ -496,9 +522,9 @@         testCLISucceeded           ["rewrite", "--sweet", rule "infinite.yaml", "--max-depth=1", "--max-cycles=2"]           [ unlines-              [ "{⟦",-                "  x ↦ \"x_hi_hi\"",-                "⟧}"+              [ "{⟦"+              , "  x ↦ \"x_hi_hi\""+              , "⟧}"               ]           ] @@ -529,10 +555,10 @@     it "removes unnecessary rho bindings in primitive applications" $       withStdin         ( unlines-            [ "{[[",-              "  z -> [[ x -> [[ t -> 42 ]].t ]].x,",-              "  org -> [[ eolang -> [[ bytes -> [[ data -> ? ]], number -> [[ as-bytes -> ? ]] ]] ]]",-              "]]}"+            [ "{[["+            , "  z -> [[ x -> [[ t -> 42 ]].t ]].x,"+            , "  org -> [[ eolang -> [[ bytes -> [[ data -> ? ]], number -> [[ as-bytes -> ? ]] ]] ]]"+            , "]]}"             ]         )         ( testCLISucceeded@@ -546,11 +572,11 @@           ["rewrite", "--log-level=debug", "--log-lines=4", "--normalize"]           [ intercalate               "\n"-              [ "[DEBUG]: Applied 'COPY' (28 nodes -> 25 nodes)",-                "{⟦",-                "  x ↦ ⟦",-                "    y ↦ 5",-                "---| log is limited by --log-lines=4 option |---"+              [ "[DEBUG]: Applied 'COPY' (28 nodes -> 25 nodes)"+              , "{⟦"+              , "  x ↦ ⟦"+              , "    y ↦ 5"+              , "---| log is limited by --log-lines=4 option |---"               ]           ] @@ -575,15 +601,15 @@           ["dataize", "--sequence", "--output=latex", "--flat", "--sweet"]           [ intercalate               "\n"-              [ "\\begin{phiquation}",-                "\\Big\\{[[ @ -> [[ |x| -> [[ D> 01-, |y| -> ? ]]( |y| -> [[]] ) ]].|x| ]]\\Big\\} \\leadsto_{\\nameref{r:contextualize}}",-                "  \\leadsto \\Big\\{[[ |x| -> [[ D> 01-, |y| -> ? ]]( |y| -> [[]] ) ]].|x|\\Big\\} \\leadsto_{\\nameref{r:copy}}",-                "  \\leadsto \\Big\\{[[ |x| -> [[ D> 01-, |y| -> [[]] ]] ]].|x|\\Big\\} \\leadsto_{\\nameref{r:dot}}",-                "  \\leadsto \\Big\\{[[ D> 01-, |y| -> [[]] ]]( ^ -> [[ |x| -> [[ D> 01-, |y| -> [[]] ]] ]] )\\Big\\} \\leadsto_{\\nameref{r:copy}}",-                "  \\leadsto \\Big\\{[[ D> 01-, |y| -> [[]], ^ -> [[ |x| -> [[ D> 01-, |y| -> [[]] ]] ]] ]]\\Big\\} \\leadsto_{\\nameref{r:Mprim}}",-                "  \\leadsto \\Big\\{[[ D> 01-, |y| -> [[]], ^ -> [[ |x| -> [[ D> 01-, |y| -> [[]] ]] ]] ]]\\Big\\}.",-                "\\end{phiquation}",-                "01-"+              [ "\\begin{phiquation}"+              , "\\Big\\{[[ @ -> [[ |x| -> [[ D> 01-, |y| -> ? ]]( |y| -> [[]] ) ]].|x| ]]\\Big\\} \\leadsto_{\\nameref{r:contextualize}}"+              , "  \\leadsto \\Big\\{[[ |x| -> [[ D> 01-, |y| -> ? ]]( |y| -> [[]] ) ]].|x|\\Big\\} \\leadsto_{\\nameref{r:copy}}"+              , "  \\leadsto \\Big\\{[[ |x| -> [[ D> 01-, |y| -> [[]] ]] ]].|x|\\Big\\} \\leadsto_{\\nameref{r:dot}}"+              , "  \\leadsto \\Big\\{[[ D> 01-, |y| -> [[]] ]]( ^ -> [[ |x| -> [[ D> 01-, |y| -> [[]] ]] ]] )\\Big\\} \\leadsto_{\\nameref{r:copy}}"+              , "  \\leadsto \\Big\\{[[ D> 01-, |y| -> [[]], ^ -> [[ |x| -> [[ D> 01-, |y| -> [[]] ]] ]] ]]\\Big\\} \\leadsto_{\\nameref{r:Mprim}}"+              , "  \\leadsto \\Big\\{[[ D> 01-, |y| -> [[]], ^ -> [[ |x| -> [[ D> 01-, |y| -> [[]] ]] ]] ]]\\Big\\}."+              , "\\end{phiquation}"+              , "01-"               ]           ] @@ -650,18 +676,21 @@         ["Either --rule or --normalize must be specified"]      it "writes to target file" $-      bracket-        (openTempFile "." "explainXXXXXX.tex")-        (\(path, _) -> removeFile path)-        ( \(path, h) -> do-            hClose h-            testCLISucceeded-              ["explain", "--normalize", printf "--target=%s" path]-              [printf "was saved in '%s'" path]-            content <- readFile path-            content `shouldContain` "\\documentclass{article}"-            content `shouldContain` "\\begin{document}"-        )+      if isWindows+        then pendingWith "Skipped on Windows due to file locking issues"+        else+          bracket+            (openTempFile "." "explainXXXXXX.tex")+            (\(path, _) -> removeFile path)+            ( \(path, h) -> do+                hClose h+                testCLISucceeded+                  ["explain", "--normalize", printf "--target=%s" path]+                  [printf "was saved in '%s'" path]+                content <- readFile path+                content `shouldContain` "\\documentclass{article}"+                content `shouldContain` "\\begin{document}"+            )    describe "merge" $ do     it "merges single program" $@@ -673,17 +702,17 @@       testCLISucceeded         ["merge", "--sweet", resource "number.phi", resource "bytes.phi", resource "string.phi"]         [ unlines-            [ "{⟦",-              "  org ↦ ⟦",-              "    eolang ↦ ⟦",-              "      number(φ) ↦ ⟦⟧,",-              "      bytes(data) ↦ ⟦⟧,",-              "      string(φ) ↦ ⟦⟧,",-              "      λ ⤍ Package",-              "    ⟧,",-              "    λ ⤍ Package",-              "  ⟧",-              "⟧}"+            [ "{⟦"+            , "  org ↦ ⟦"+            , "    eolang ↦ ⟦"+            , "      number(φ) ↦ ⟦⟧,"+            , "      bytes(data) ↦ ⟦⟧,"+            , "      string(φ) ↦ ⟦⟧,"+            , "      λ ⤍ Package"+            , "    ⟧,"+            , "    λ ⤍ Package"+            , "  ⟧"+            , "⟧}"             ]         ] 

@@ -21,8 +21,8 @@ import Test.Hspec  data CSTPack = CSTPack-  { program :: String,-    result :: String+  { program :: String+  , result :: String   }   deriving (Generic, Show, FromJSON) @@ -33,9 +33,10 @@ spec = do   describe "builds valid CST" $     forM_-      [ ("Q -> Q", PR_SWEET LCB (EX_GLOBAL Φ) RCB),-        ( "{[[ x -> Q.y ]]}",-          PR_SWEET+      [ ("Q -> Q", PR_SWEET LCB (EX_GLOBAL Φ) RCB)+      ,+        ( "{[[ x -> Q.y ]]}"+        , PR_SWEET             LCB             ( EX_FORMATION                 LSB

@@ -14,38 +14,38 @@ spec = do   describe "just parses" $     forM_-      [ "in (!a, !B)",-        " not   (in (!a1,   !B))   ",-        "alpha(x)",-        "eq(1, 1)",-        "or(eq(ordinal(a),1),eq(length(!B),-2),eq(!e1,!e2),eq(!a1,x),eq(Q.org.eolang,[[ x -> 2 ]]))",-        "and(alpha(q),eq(-5,21))",-        "nf([[ x -> !e ]].x)",-        "xi(!e1)",-        "matches(\"hello(\\\"\\u0000)\", !e)",-        "part-of ( [[ x -> 1 ]] , !B ) ",-        "and(not(alpha(!a)),eq(!a,x))"+      [ "in (!a, !B)"+      , " not   (in (!a1,   !B))   "+      , "alpha(x)"+      , "eq(1, 1)"+      , "or(eq(ordinal(a),1),eq(length(!B),-2),eq(!e1,!e2),eq(!a1,x),eq(Q.org.eolang,[[ x -> 2 ]]))"+      , "and(alpha(q),eq(-5,21))"+      , "nf([[ x -> !e ]].x)"+      , "xi(!e1)"+      , "matches(\"hello(\\\"\\u0000)\", !e)"+      , "part-of ( [[ x -> 1 ]] , !B ) "+      , "and(not(alpha(!a)),eq(!a,x))"       ]       (\expr -> it expr (parseCondition expr `shouldSatisfy` isRight))    describe "parses correctly" $     forM_-      [ ("in(!a, !B)", Y.In (AtMeta "a") (BiMeta "B")),-        ("not(in(!a,!B))", Y.Not (Y.In (AtMeta "a") (BiMeta "B"))),-        ("alpha(y)", Y.Alpha (AtLabel "y")),-        ("eq(1,-2)", Y.Eq (Y.CmpNum (Y.Literal 1)) (Y.CmpNum (Y.Literal (-2)))),-        ("eq(ordinal(z),length(!B1))", Y.Eq (Y.CmpNum (Y.Ordinal (AtLabel "z"))) (Y.CmpNum (Y.Length (BiMeta "B1")))),-        ("eq(!a1, !e2)", Y.Eq (Y.CmpAttr (AtMeta "a1")) (Y.CmpExpr (ExMeta "e2"))),-        ("or(xi(!e1), nf(Q.x))", Y.Or [Y.XI (ExMeta "e1"), Y.NF (ExDispatch ExGlobal (AtLabel "x"))]),-        ("and(matches(\"hi\", !e),part-of(!e, !B))", Y.And [Y.Matches "hi" (ExMeta "e"), Y.PartOf (ExMeta "e") (BiMeta "B")])+      [ ("in(!a, !B)", Y.In (AtMeta "a") (BiMeta "B"))+      , ("not(in(!a,!B))", Y.Not (Y.In (AtMeta "a") (BiMeta "B")))+      , ("alpha(y)", Y.Alpha (AtLabel "y"))+      , ("eq(1,-2)", Y.Eq (Y.CmpNum (Y.Literal 1)) (Y.CmpNum (Y.Literal (-2))))+      , ("eq(ordinal(z),length(!B1))", Y.Eq (Y.CmpNum (Y.Ordinal (AtLabel "z"))) (Y.CmpNum (Y.Length (BiMeta "B1"))))+      , ("eq(!a1, !e2)", Y.Eq (Y.CmpAttr (AtMeta "a1")) (Y.CmpExpr (ExMeta "e2")))+      , ("or(xi(!e1), nf(Q.x))", Y.Or [Y.XI (ExMeta "e1"), Y.NF (ExDispatch ExGlobal (AtLabel "x"))])+      , ("and(matches(\"hi\", !e),part-of(!e, !B))", Y.And [Y.Matches "hi" (ExMeta "e"), Y.PartOf (ExMeta "e") (BiMeta "B")])       ]       (\(expr, res) -> it expr (parseCondition expr `shouldBe` Right res))    describe "does not parse" $     forM_-      [ "some()",-        "in(!a, !a)",-        "alpha(!B)",-        "or(or(), or())"+      [ "some()"+      , "in(!a, !a)"+      , "alpha(!B)"+      , "or(or(), or())"       ]       (\expr -> it expr (parseCondition expr `shouldSatisfy` isLeft))

@@ -44,34 +44,38 @@   describe "morph" $     test'       morph-      [ ("[[ D> 00- ]] => [[ D> 00- ]]", ExFormation [BiDelta (BtOne "00")], ExGlobal, ExFormation [BiDelta (BtOne "00")]),-        ("T => T", ExTermination, ExGlobal, ExTermination),-        ("$ => X", ExThis, ExGlobal, ExTermination),-        ("Q => X", ExGlobal, ExGlobal, ExTermination),-        ( "Q.x (Q -> [[ x -> [[]] ]]) => [[]]",-          ExDispatch ExGlobal (AtLabel "x"),-          ExFormation [BiTau (AtLabel "x") (ExFormation [])],-          ExFormation []+      [ ("[[ D> 00- ]] => [[ D> 00- ]]", ExFormation [BiDelta (BtOne "00")], ExGlobal, ExFormation [BiDelta (BtOne "00")])+      , ("T => T", ExTermination, ExGlobal, ExTermination)+      , ("$ => X", ExThis, ExGlobal, ExTermination)+      , ("Q => X", ExGlobal, ExGlobal, ExTermination)+      ,+        ( "Q.x (Q -> [[ x -> [[]] ]]) => [[]]"+        , ExDispatch ExGlobal (AtLabel "x")+        , ExFormation [BiTau (AtLabel "x") (ExFormation [])]+        , ExFormation []         )       ]    describe "dataize" $     test       dataize'-      [ ("[[ D> 00- ]] => 00-", ExFormation [BiDelta (BtOne "00")], ExGlobal, Just (BtOne "00")),-        ("T => X", ExTermination, ExGlobal, Nothing),-        ( "[[ @ -> [[ D> 00-]] ]] => 00-",-          ExFormation [BiTau AtPhi (ExFormation [BiDelta (BtOne "00"), BiVoid AtRho]), BiVoid AtRho],-          ExGlobal,-          Just (BtOne "00")-        ),-        ( "[[ x -> [[ D> 01- ]] ]].x => 01-",-          ExDispatch (ExFormation [BiTau (AtLabel "x") (ExFormation [BiDelta (BtOne "01"), BiVoid AtRho]), BiVoid AtRho]) (AtLabel "x"),-          ExGlobal,-          Just (BtOne "01")-        ),-        ( "[[ @ -> [[ x -> [[ D> 01-, y -> ? ]](y -> [[ ]]) ]].x ]] => 01-",-          ExFormation+      [ ("[[ D> 00- ]] => 00-", ExFormation [BiDelta (BtOne "00")], ExGlobal, Just (BtOne "00"))+      , ("T => X", ExTermination, ExGlobal, Nothing)+      ,+        ( "[[ @ -> [[ D> 00-]] ]] => 00-"+        , ExFormation [BiTau AtPhi (ExFormation [BiDelta (BtOne "00"), BiVoid AtRho]), BiVoid AtRho]+        , ExGlobal+        , Just (BtOne "00")+        )+      ,+        ( "[[ x -> [[ D> 01- ]] ]].x => 01-"+        , ExDispatch (ExFormation [BiTau (AtLabel "x") (ExFormation [BiDelta (BtOne "01"), BiVoid AtRho]), BiVoid AtRho]) (AtLabel "x")+        , ExGlobal+        , Just (BtOne "01")+        )+      ,+        ( "[[ @ -> [[ x -> [[ D> 01-, y -> ? ]](y -> [[ ]]) ]].x ]] => 01-"+        , ExFormation             [ BiTau                 AtPhi                 ( ExDispatch@@ -80,9 +84,9 @@                             (AtLabel "x")                             ( ExApplication                                 ( ExFormation-                                    [ BiDelta (BtOne "01"),-                                      BiVoid (AtLabel "y"),-                                      BiVoid AtRho+                                    [ BiDelta (BtOne "01")+                                    , BiVoid (AtLabel "y")+                                    , BiVoid AtRho                                     ]                                 )                                 (BiTau (AtLabel "y") (ExFormation []))@@ -91,85 +95,88 @@                     )                     (AtLabel "x")                 )-            ],-          ExGlobal,-          Just (BtOne "01")+            ]+        , ExGlobal+        , Just (BtOne "01")         )       ]    testDataize-    [ ( "5.plus(5)",-        unlines-          [ "Q -> [[",-            "  org -> [[",-            "    eolang -> [[",-            "      bytes -> [[",-            "        data -> ?,",-            "        @ -> $.data",-            "      ]],",-            "      number -> [[",-            "        as-bytes -> ?,",-            "        @ -> $.as-bytes,",-            "        plus -> [[ x -> ?, L> L_org_eolang_number_plus ]]",-            "      ]]",-            "    ]]",-            "  ]],",-            "  @ -> 5.plus(5)",-            "]]"-          ],-        BtMany ["40", "24", "00", "00", "00", "00", "00", "00"]-      ),-      ( "Fahrenheit",-        unlines-          [ "Q -> [[",-            "  org -> [[",-            "    eolang -> [[",-            "      bytes -> [[",-            "        data -> ?,",-            "        @ -> $.data",-            "      ]],",-            "      number -> [[",-            "        as-bytes -> ?,",-            "        @ -> $.as-bytes,",-            "        plus -> [[ x -> ?, L> L_org_eolang_number_plus ]],",-            "        times -> [[ x -> ?, L> L_org_eolang_number_times ]]",-            "      ]]",-            "    ]]",-            "  ]],",-            "  @ -> $.c.times(1.8).plus(32),",-            "  c -> 25",-            "]]"-          ],-        BtMany ["40", "53", "40", "00", "00", "00", "00", "00"]-      ),-      ( "Factorial",-        unlines-          [ "Q -> [[",-            "  org -> [[",-            "    eolang -> [[",-            "      bytes -> [[",-            "        data -> ?,",-            "        @ -> $.data",-            "      ]],",-            "      number -> [[",-            "        as-bytes -> ?,",-            "        @ -> $.as-bytes,",-            "        times -> [[ x -> ?, L> L_org_eolang_number_times ]],",-            "        plus -> [[ x -> ?, L> L_org_eolang_number_plus ]],",-            "        eq -> [[ x -> ?, y -> ?, L> L_org_eolang_number_eq ]]",-            "      ]]",-            "    ]]",-            "  ]],",-            "  fac -> [[",-            "    x -> ?,",-            "    @ -> $.x.eq(",-            "      1,",-            "      $.x.times($.^.fac($.x.plus(-1)))",-            "    )",-            "  ]],",-            "  @ -> $.fac(3)",-            "]]"-          ],-        BtMany ["40", "18", "00", "00", "00", "00", "00", "00"]+    [+      ( "5.plus(5)"+      , unlines+          [ "Q -> [["+          , "  org -> [["+          , "    eolang -> [["+          , "      bytes -> [["+          , "        data -> ?,"+          , "        @ -> $.data"+          , "      ]],"+          , "      number -> [["+          , "        as-bytes -> ?,"+          , "        @ -> $.as-bytes,"+          , "        plus -> [[ x -> ?, L> L_org_eolang_number_plus ]]"+          , "      ]]"+          , "    ]]"+          , "  ]],"+          , "  @ -> 5.plus(5)"+          , "]]"+          ]+      , BtMany ["40", "24", "00", "00", "00", "00", "00", "00"]+      )+    ,+      ( "Fahrenheit"+      , unlines+          [ "Q -> [["+          , "  org -> [["+          , "    eolang -> [["+          , "      bytes -> [["+          , "        data -> ?,"+          , "        @ -> $.data"+          , "      ]],"+          , "      number -> [["+          , "        as-bytes -> ?,"+          , "        @ -> $.as-bytes,"+          , "        plus -> [[ x -> ?, L> L_org_eolang_number_plus ]],"+          , "        times -> [[ x -> ?, L> L_org_eolang_number_times ]]"+          , "      ]]"+          , "    ]]"+          , "  ]],"+          , "  @ -> $.c.times(1.8).plus(32),"+          , "  c -> 25"+          , "]]"+          ]+      , BtMany ["40", "53", "40", "00", "00", "00", "00", "00"]+      )+    ,+      ( "Factorial"+      , unlines+          [ "Q -> [["+          , "  org -> [["+          , "    eolang -> [["+          , "      bytes -> [["+          , "        data -> ?,"+          , "        @ -> $.data"+          , "      ]],"+          , "      number -> [["+          , "        as-bytes -> ?,"+          , "        @ -> $.as-bytes,"+          , "        times -> [[ x -> ?, L> L_org_eolang_number_times ]],"+          , "        plus -> [[ x -> ?, L> L_org_eolang_number_plus ]],"+          , "        eq -> [[ x -> ?, y -> ?, L> L_org_eolang_number_eq ]]"+          , "      ]]"+          , "    ]]"+          , "  ]],"+          , "  fac -> [["+          , "    x -> ?,"+          , "    @ -> $.x.eq("+          , "      1,"+          , "      $.x.times($.^.fac($.x.plus(-1)))"+          , "    )"+          , "  ]],"+          , "  @ -> $.fac(3)"+          , "]]"+          ]+      , BtMany ["40", "18", "00", "00", "00", "00", "00", "00"]       )     ]

@@ -6,9 +6,13 @@ -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com -- SPDX-License-Identifier: MIT +{- | Tests for the Filter module that provides include and exclude+functions for filtering phi-calculus programs by FQN expressions.+-} module FilterSpec where -import Control.Monad+import AST+import Control.Monad (forM_, when) import Data.Aeson import Data.Yaml qualified as Yaml import Encoding (Encoding (UNICODE))@@ -23,10 +27,10 @@ import Test.Hspec  data YamlPack = YamlPack-  { program :: String,-    shown :: [String],-    hidden :: [String],-    result :: String+  { program :: String+  , shown :: [String]+  , hidden :: [String]+  , result :: String   }   deriving (Generic, Show, FromJSON) @@ -34,14 +38,14 @@ yamlPack = Yaml.decodeFileThrow  spec :: Spec-spec =+spec = do   describe "filter packs" $ do     let resources = "test-resources/filter-packs"     packs <- runIO (allPathsIn resources)     forM_       packs       ( \pth -> it (makeRelative resources pth) $ do-          YamlPack {..} <- yamlPack pth+          YamlPack{..} <- yamlPack pth           prog <- parseProgramThrows program           included <- traverse parseExpressionThrows shown           excluded <- traverse parseExpressionThrows hidden@@ -58,3 +62,194 @@                 )             )       )++  describe "exclude with empty expression list" $+    it "returns programs unchanged" $ do+      prog <- parseProgramThrows "{[[ x -> Q ]]}"+      let result = F.exclude [(prog, Nothing)] []+      result `shouldBe` [(prog, Nothing)]++  describe "exclude with empty program list" $+    it "returns empty list" $ do+      fqn <- parseExpressionThrows "Q.x"+      let result = F.exclude [] [fqn]+      result `shouldBe` []++  describe "exclude with non-formation program" $+    it "returns program unchanged" $ do+      let prog = Program ExGlobal+          fqn = ExDispatch ExGlobal (AtLabel "x")+          result = F.exclude [(prog, Nothing)] [fqn]+      result `shouldBe` [(prog, Nothing)]++  describe "exclude with termination program" $+    it "returns program unchanged" $ do+      let prog = Program ExTermination+          fqn = ExDispatch ExGlobal (AtLabel "x")+          result = F.exclude [(prog, Nothing)] [fqn]+      result `shouldBe` [(prog, Nothing)]++  describe "exclude with non-dispatch FQN" $+    it "handles non-dispatch expression gracefully" $ do+      prog <- parseProgramThrows "{[[ x -> Q ]]}"+      let fqn = ExGlobal+          [(prog', _)] = F.exclude [(prog, Nothing)] [fqn]+      prog' `shouldBe` prog++  describe "exclude with xi FQN" $+    it "handles xi expression gracefully" $ do+      prog <- parseProgramThrows "{[[ x -> Q ]]}"+      let fqn = ExThis+          [(prog', _)] = F.exclude [(prog, Nothing)] [fqn]+      prog' `shouldBe` prog++  describe "exclude multiple programs" $+    it "processes all programs in list" $ do+      prog1 <- parseProgramThrows "{[[ x -> Q, y -> $ ]]}"+      prog2 <- parseProgramThrows "{[[ a -> Q, b -> $ ]]}"+      fqn <- parseExpressionThrows "Q.x"+      let result = F.exclude [(prog1, Nothing), (prog2, Nothing)] [fqn]+      length result `shouldBe` 2++  describe "include with empty expression list" $+    it "returns programs unchanged" $ do+      prog <- parseProgramThrows "{[[ x -> Q ]]}"+      let result = F.include [(prog, Nothing)] []+      result `shouldBe` [(prog, Nothing)]++  describe "include with empty program list" $+    it "returns empty list" $ do+      fqn <- parseExpressionThrows "Q.x"+      let result = F.include [] [fqn]+      result `shouldBe` []++  describe "include with non-formation program" $+    it "returns empty formation" $ do+      let prog = Program ExGlobal+          fqn = ExDispatch ExGlobal (AtLabel "x")+          [(prog', _)] = F.include [(prog, Nothing)] [fqn]+      prog' `shouldBe` Program (ExFormation [BiVoid AtRho])++  describe "include with termination program" $+    it "returns empty formation" $ do+      let prog = Program ExTermination+          fqn = ExDispatch ExGlobal (AtLabel "x")+          [(prog', _)] = F.include [(prog, Nothing)] [fqn]+      prog' `shouldBe` Program (ExFormation [BiVoid AtRho])++  describe "include with non-existent attribute" $+    it "returns empty formation" $ do+      prog <- parseProgramThrows "{[[ x -> Q ]]}"+      fqn <- parseExpressionThrows "Q.nonexistent"+      let [(prog', _)] = F.include [(prog, Nothing)] [fqn]+      prog' `shouldBe` Program (ExFormation [BiVoid AtRho])++  describe "include with non-matching nested attribute" $+    it "returns empty formation when path doesnt exist" $ do+      prog <- parseProgramThrows "{[[ x -> [[ y -> Q ]] ]]}"+      fqn <- parseExpressionThrows "Q.x.nonexistent"+      let [(prog', _)] = F.include [(prog, Nothing)] [fqn]+      prog' `shouldBe` Program (ExFormation [BiVoid AtRho])++  describe "include with non-dispatch FQN" $+    it "handles non-dispatch expression gracefully" $ do+      prog <- parseProgramThrows "{[[ x -> Q ]]}"+      let fqn = ExGlobal+          [(prog', _)] = F.include [(prog, Nothing)] [fqn]+      prog' `shouldBe` Program (ExFormation [BiVoid AtRho])++  describe "include with xi FQN" $+    it "handles xi expression gracefully" $ do+      prog <- parseProgramThrows "{[[ x -> Q ]]}"+      let fqn = ExThis+          [(prog', _)] = F.include [(prog, Nothing)] [fqn]+      prog' `shouldBe` Program (ExFormation [BiVoid AtRho])++  describe "include multiple programs" $+    it "processes all programs in list" $ do+      prog1 <- parseProgramThrows "{[[ x -> Q, y -> $ ]]}"+      prog2 <- parseProgramThrows "{[[ a -> Q, b -> $ ]]}"+      fqn <- parseExpressionThrows "Q.x"+      let result = F.include [(prog1, Nothing), (prog2, Nothing)] [fqn]+      length result `shouldBe` 2++  describe "include with nested formation not matching" $+    it "skips non-matching bindings to find target" $ do+      prog <- parseProgramThrows "{[[ a -> Q, x -> [[ y -> Q ]] ]]}"+      fqn <- parseExpressionThrows "Q.x.y"+      let [(prog', _)] = F.include [(prog, Nothing)] [fqn]+          isFormation (Program (ExFormation _)) = True+          isFormation _ = False+      prog' `shouldSatisfy` isFormation++  describe "include with deep nested path" $+    it "follows multi-level FQN" $ do+      prog <- parseProgramThrows "{[[ a -> [[ b -> [[ c -> Q ]] ]] ]]}"+      fqn <- parseExpressionThrows "Q.a.b.c"+      let [(prog', _)] = F.include [(prog, Nothing)] [fqn]+          isFormation (Program (ExFormation _)) = True+          isFormation _ = False+      prog' `shouldSatisfy` isFormation++  describe "exclude with deep nested path" $+    it "removes from multi-level FQN" $ do+      prog <- parseProgramThrows "{[[ a -> [[ b -> [[ c -> Q, d -> $ ]] ]] ]]}"+      fqn <- parseExpressionThrows "Q.a.b.c"+      let [(prog', _)] = F.exclude [(prog, Nothing)] [fqn]+          isFormation (Program (ExFormation _)) = True+          isFormation _ = False+      prog' `shouldSatisfy` isFormation++  describe "exclude preserves rule metadata" $+    it "keeps Nothing rule through exclude" $ do+      prog <- parseProgramThrows "{[[ x -> Q ]]}"+      fqn <- parseExpressionThrows "Q.y"+      let [(_, rule)] = F.exclude [(prog, Nothing)] [fqn]+      rule `shouldBe` Nothing++  describe "include preserves rule metadata" $+    it "keeps Nothing rule through include" $ do+      prog <- parseProgramThrows "{[[ x -> Q ]]}"+      fqn <- parseExpressionThrows "Q.x"+      let [(_, rule)] = F.include [(prog, Nothing)] [fqn]+      rule `shouldBe` Nothing++  describe "exclude with non-formation nested binding" $+    it "handles tau with non-formation value" $ do+      prog <- parseProgramThrows "{[[ x -> Q ]]}"+      fqn <- parseExpressionThrows "Q.x.y"+      let [(prog', _)] = F.exclude [(prog, Nothing)] [fqn]+      prog' `shouldBe` prog++  describe "include with formation lacking target binding" $+    it "returns empty formation when binding not found" $ do+      prog <- parseProgramThrows "{[[ x -> [[ a -> Q ]] ]]}"+      fqn <- parseExpressionThrows "Q.y.z"+      let [(prog', _)] = F.include [(prog, Nothing)] [fqn]+      prog' `shouldBe` Program (ExFormation [BiVoid AtRho])++  describe "exclude with void binding" $+    it "handles void bindings correctly" $ do+      prog <- parseProgramThrows "{[[ x -> ?, y -> Q ]]}"+      fqn <- parseExpressionThrows "Q.x"+      let [(prog', _)] = F.exclude [(prog, Nothing)] [fqn]+          Program (ExFormation bds) = prog'+      length bds `shouldBe` 2++  describe "exclude with meta binding" $+    it "handles meta bindings correctly" $ do+      let prog = Program (ExFormation [BiMeta "B", BiTau (AtLabel "x") ExGlobal])+          fqn = ExDispatch ExGlobal (AtLabel "x")+          [(prog', _)] = F.exclude [(prog, Nothing)] [fqn]+          Program (ExFormation bds) = prog'+      length bds `shouldBe` 1++  describe "include uses only first FQN" $+    it "ignores additional FQNs in list" $ do+      prog <- parseProgramThrows "{[[ x -> Q, y -> $ ]]}"+      fqn1 <- parseExpressionThrows "Q.x"+      fqn2 <- parseExpressionThrows "Q.y"+      let [(prog', _)] = F.include [(prog, Nothing)] [fqn1, fqn2]+          Program (ExFormation bds) = prog'+          names = [attr | BiTau attr _ <- bds]+      AtLabel "x" `elem` names `shouldBe` True

@@ -0,0 +1,303 @@+-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+-- SPDX-License-Identifier: MIT++{- | Tests for the LaTeX module that provides conversion of phi-calculus+programs and rules to LaTeX format for academic documents.+Attention! Most of the tests are generated by LLM. Consider that when refactoring+-}+module LaTeXSpec where++import AST+import Control.Monad (forM_)+import LaTeX (LatexContext (..), defaultLatexContext, explainRules, meetInProgram, programToLaTeX, rewrittensToLatex)+import LaTeX qualified as L+import Lining (LineFormat (MULTILINE, SINGLELINE))+import Parser (parseExpressionThrows, parseProgramThrows)+import Sugar (SugarType (SALTY, SWEET))+import Test.Hspec (Spec, describe, it, shouldBe, shouldContain, shouldNotContain)+import Yaml qualified as Y++spec :: Spec+spec = do+  describe "meet program in program" $+    forM_+      [ ("Q.x.y", "{Q.x.y}", "{[[ x -> Q.x.y ]]}", ["Q.x.y"])+      , ("Q.x.y twice", "{Q.x.y}", "{[[ x -> Q.x.y, y -> Q.x.y.z ]]}", ["Q.x.y", "Q.x.y"])+      , ("Q.x.y.z.a and Q.x.y", "{Q.x.y.z.a}", "{[[ x -> Q.x.y, y -> Q.x.y.z ]]}", ["Q.x.y.z", "Q.x.y", "Q.x.y"])+      , ("Ignore data objects", "{[[ x -> \"foo\" ]]}", "{Q.x( y -> \"foo\" )}", [])+      ]+      ( \(desc, first, second, exprs) -> it desc $ do+          ptn <- parseProgramThrows first+          tgt <- parseProgramThrows second+          res <- traverse parseExpressionThrows exprs+          meetInProgram ptn tgt `shouldBe` res+      )++  describe "programToLaTeX with nonumber=True" $+    it "uses phiquation* environment" $ do+      prog <- parseProgramThrows "{Q}"+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = True}+          result = programToLaTeX prog ctx+      result `shouldContain` "\\begin{phiquation*}"++  describe "programToLaTeX with nonumber=False" $+    it "uses phiquation environment" $ do+      prog <- parseProgramThrows "{Q}"+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = False}+          result = programToLaTeX prog ctx+      result `shouldContain` "\\begin{phiquation}"++  describe "programToLaTeX output structure" $+    it "contains begin and end tags" $ do+      prog <- parseProgramThrows "{Q}"+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = True}+          result = programToLaTeX prog ctx+      result `shouldContain` "\\end{phiquation*}"++  describe "programToLaTeX with SWEET sugar" $+    it "renders sweet syntax with braces" $ do+      prog <- parseProgramThrows "{Q}"+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = True}+          result = programToLaTeX prog ctx+      result `shouldContain` "\\Big\\{"++  describe "programToLaTeX with SALTY sugar" $+    it "renders salty syntax with arrow" $ do+      prog <- parseProgramThrows "{Q}"+      let ctx = defaultLatexContext{sugar = SALTY, line = SINGLELINE, nonumber = True}+          result = programToLaTeX prog ctx+      result `shouldContain` "->"++  describe "programToLaTeX with MULTILINE format" $+    it "renders multiline format" $ do+      prog <- parseProgramThrows "{[[ x -> Q ]]}"+      let ctx = defaultLatexContext{line = MULTILINE, nonumber = True}+          result = programToLaTeX prog ctx+      result `shouldContain` "|x|"++  describe "rewrittensToLatex with empty list" $+    it "generates valid latex structure" $ do+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = True}+          result = rewrittensToLatex [] ctx+      result `shouldContain` "\\begin{phiquation*}"++  describe "rewrittensToLatex with single program" $+    it "renders single program without rule" $ do+      prog <- parseProgramThrows "{Q}"+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = True}+          result = rewrittensToLatex [(prog, Nothing)] ctx+      result `shouldContain` "\\Big\\{"++  describe "rewrittensToLatex with rule name" $+    it "includes nameref for rule" $ do+      prog <- parseProgramThrows "{Q}"+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = True}+          result = rewrittensToLatex [(prog, Just "myrule")] ctx+      result `shouldContain` "\\nameref{r:myrule}"++  describe "rewrittensToLatex with label" $+    it "includes label command" $ do+      prog <- parseProgramThrows "{Q}"+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = True, label = Just "myeq"}+          result = rewrittensToLatex [(prog, Nothing)] ctx+      result `shouldContain` "\\label{myeq}"++  describe "rewrittensToLatex without label" $+    it "excludes label command" $ do+      prog <- parseProgramThrows "{Q}"+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = True}+          result = rewrittensToLatex [(prog, Nothing)] ctx+      result `shouldNotContain` "\\label"++  describe "rewrittensToLatex with expression" $+    it "includes phiExpression command" $ do+      prog <- parseProgramThrows "{Q}"+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = True, expression = Just "myexpr"}+          result = rewrittensToLatex [(prog, Nothing)] ctx+      result `shouldContain` "\\phiExpression{myexpr}"++  describe "rewrittensToLatex without expression" $+    it "excludes phiExpression command" $ do+      prog <- parseProgramThrows "{Q}"+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = True}+          result = rewrittensToLatex [(prog, Nothing)] ctx+      result `shouldNotContain` "\\phiExpression"++  describe "rewrittensToLatex with multiple programs" $+    it "joins with leadsto" $ do+      prog1 <- parseProgramThrows "{Q.x}"+      prog2 <- parseProgramThrows "{Q.y}"+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = True}+          result = rewrittensToLatex [(prog1, Nothing), (prog2, Nothing)] ctx+      result `shouldContain` "\\leadsto"++  describe "rewrittensToLatex ends with period" $+    it "adds period before end tag" $ do+      prog <- parseProgramThrows "{Q}"+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = True}+          result = rewrittensToLatex [(prog, Nothing)] ctx+      result `shouldContain` ".\n\\end"++  describe "rewrittensToLatex with nonumber=False" $+    it "uses phiquation without asterisk" $ do+      prog <- parseProgramThrows "{Q}"+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = False}+          result = rewrittensToLatex [(prog, Nothing)] ctx+      result `shouldContain` "\\begin{phiquation}"++  describe "escapeUnprintedChars escapes dollar" $+    it "replaces $ with char36 in label via AST" $ do+      let prog = Program (ExFormation [BiTau (AtLabel "$my") ExGlobal])+          ctx = defaultLatexContext{line = SINGLELINE, nonumber = True}+          result = programToLaTeX prog ctx+      result `shouldContain` "\\char36{}"++  describe "escapeUnprintedChars escapes at sign" $+    it "replaces @ with char64 in label via AST" $ do+      let prog = Program (ExFormation [BiTau (AtLabel "@my") ExGlobal])+          ctx = defaultLatexContext{line = SINGLELINE, nonumber = True}+          result = programToLaTeX prog ctx+      result `shouldContain` "\\char64{}"++  describe "escapeUnprintedChars escapes caret" $+    it "replaces ^ with char94 in label via AST" $ do+      let prog = Program (ExFormation [BiTau (AtLabel "^my") ExGlobal])+          ctx = defaultLatexContext{line = SINGLELINE, nonumber = True}+          result = programToLaTeX prog ctx+      result `shouldContain` "\\char94{}"++  describe "escapeUnprintedChars escapes underscore" $+    it "replaces _ in label with char95" $ do+      prog <- parseProgramThrows "{Q.my_label}"+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = True}+          result = programToLaTeX prog ctx+      result `shouldContain` "\\char95{}"++  describe "escapeUnprintedChars preserves regular chars" $+    it "keeps alphanumeric chars unchanged" $ do+      prog <- parseProgramThrows "{Q.abc123}"+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = True}+          result = programToLaTeX prog ctx+      result `shouldContain` "abc123"++  describe "explainRules with empty list" $+    it "generates document structure" $ do+      let result = explainRules []+      result `shouldContain` "\\documentclass{article}"++  describe "explainRules document has amsmath" $+    it "includes amsmath package" $ do+      let result = explainRules []+      result `shouldContain` "\\usepackage{amsmath}"++  describe "explainRules document structure" $+    it "has begin and end document" $ do+      let result = explainRules []+      result `shouldContain` "\\begin{document}"++  describe "explainRules document ends correctly" $+    it "has end document tag" $ do+      let result = explainRules []+      result `shouldContain` "\\end{document}"++  describe "explainRules with named rule" $+    it "includes rule name" $ do+      let rule = Y.Rule (Just "DOT") Nothing ExGlobal ExGlobal Nothing Nothing Nothing+          result = explainRules [rule]+      result `shouldContain` "\\rule{DOT}"++  describe "explainRules with unnamed rule" $+    it "uses unnamed as fallback" $ do+      let rule = Y.Rule Nothing Nothing ExGlobal ExGlobal Nothing Nothing Nothing+          result = explainRules [rule]+      result `shouldContain` "\\rule{unnamed}"++  describe "explainRules with multiple rules" $+    it "includes all rule names" $ do+      let rule1 = Y.Rule (Just "RULE1") Nothing ExGlobal ExGlobal Nothing Nothing Nothing+          rule2 = Y.Rule (Just "RULE2") Nothing ExGlobal ExGlobal Nothing Nothing Nothing+          result = explainRules [rule1, rule2]+      result `shouldContain` "\\rule{RULE1}"++  describe "explainRules with multiple rules second" $+    it "includes second rule name" $ do+      let rule1 = Y.Rule (Just "FIRST") Nothing ExGlobal ExGlobal Nothing Nothing Nothing+          rule2 = Y.Rule (Just "SECOND") Nothing ExGlobal ExGlobal Nothing Nothing Nothing+          result = explainRules [rule1, rule2]+      result `shouldContain` "\\rule{SECOND}"++  describe "LatexContext sugar field" $+    it "stores sugar type correctly" $ do+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = False}+      sugar ctx `shouldBe` SWEET++  describe "LatexContext line field" $+    it "stores line format correctly" $ do+      let ctx = defaultLatexContext{line = MULTILINE, nonumber = True}+      line ctx `shouldBe` MULTILINE++  describe "LatexContext nonumber field" $+    it "stores nonumber flag correctly" $ do+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = False}+      nonumber ctx `shouldBe` False++  describe "LatexContext expression field" $+    it "stores expression correctly" $ do+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = True, expression = Just "expr"}+      L.expression ctx `shouldBe` Just "expr"++  describe "LatexContext label field" $+    it "stores label correctly" $ do+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = True, label = Just "lbl"}+      L.label ctx `shouldBe` Just "lbl"++  describe "programToLaTeX handles formation" $+    it "renders formation with bindings" $ do+      prog <- parseProgramThrows "{[[ x -> Q, y -> $ ]]}"+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = True}+          result = programToLaTeX prog ctx+      result `shouldContain` "|x|"++  describe "programToLaTeX handles dispatch" $+    it "renders dispatch expression" $ do+      prog <- parseProgramThrows "{Q.x.y.z}"+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = True}+          result = programToLaTeX prog ctx+      result `shouldContain` "|z|"++  describe "programToLaTeX handles application" $+    it "renders application expression" $ do+      prog <- parseProgramThrows "{Q.f(x -> Q)}"+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = True}+          result = programToLaTeX prog ctx+      result `shouldContain` "|f|"++  describe "programToLaTeX handles void binding" $+    it "renders void in formation" $ do+      prog <- parseProgramThrows "{[[ x -> ? ]]}"+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = True}+          result = programToLaTeX prog ctx+      result `shouldContain` "|x|"++  describe "programToLaTeX handles nested formations" $+    it "renders nested structures" $ do+      prog <- parseProgramThrows "{[[ x -> [[ y -> Q ]] ]]}"+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = True}+          result = programToLaTeX prog ctx+      result `shouldContain` "|y|"++  describe "rewrittensToLatex with label and expression" $+    it "includes both label and expression" $ do+      prog <- parseProgramThrows "{Q}"+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = True, expression = Just "expr", label = Just "lbl"}+          result = rewrittensToLatex [(prog, Nothing)] ctx+      result `shouldContain` "\\label{lbl}"++  describe "rewrittensToLatex with complex rewrite chain" $+    it "shows rewrite sequence" $ do+      prog1 <- parseProgramThrows "{Q.x}"+      prog2 <- parseProgramThrows "{Q.y}"+      prog3 <- parseProgramThrows "{Q.z}"+      let ctx = defaultLatexContext{line = SINGLELINE, nonumber = True}+          result = rewrittensToLatex [(prog1, Just "r1"), (prog2, Just "r2"), (prog3, Nothing)] ctx+      result `shouldContain` "\\nameref{r:r1}"

@@ -42,38 +42,62 @@   describe "matchExpressionDeep: expression => expression => [substitution]" $     test       matchExpressionDeep-      [ ( "[[!a -> Q.org.!a]] => [[f -> [[x -> Q.org.x]], t -> [[y -> Q.org.y]] => [(!a >> x), (!a >> y)]",-          ExFormation [BiTau (AtMeta "a") (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtMeta "a"))],-          ExFormation-            [ BiTau (AtLabel "f") (ExFormation [BiTau (AtLabel "x") (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "x"))]),-              BiTau (AtLabel "t") (ExFormation [BiTau (AtLabel "y") (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "y"))])-            ],-          defaultScope,-          [[("a", MvAttribute (AtLabel "x"))], [("a", MvAttribute (AtLabel "y"))]]-        ),-        ( "!e => [[x -> Q]] => [(!e >> [[x -> Q]] ), (!e >> Q)]",-          ExMeta "e",-          ExFormation [BiTau (AtLabel "x") ExGlobal],-          defaultScope,-          [ [("e", MvExpression (ExFormation [BiTau (AtLabel "x") ExGlobal]) defaultScope)],-            [("e", MvExpression ExGlobal (ExFormation [BiTau (AtLabel "x") ExGlobal]))]+      [+        ( "Q => [[ @ -> Q, ^ -> Q ]] => [(), ()]"+        , ExGlobal+        , ExFormation [BiTau AtPhi ExGlobal, BiTau AtRho ExGlobal]+        , defaultScope+        , [[], []]+        )+      ,+        ( "Q.!a => [[ @ -> Q.y, ^ -> [[ a -> Q.w ]], @ -> Q.y ]] => [(a >> y), (a >> w), (a >> y)]"+        , ExDispatch ExGlobal (AtMeta "a")+        , ExFormation+            [ BiTau AtPhi (ExDispatch ExGlobal (AtLabel "y"))+            , BiTau AtRho (ExFormation [BiTau (AtLabel "a") (ExDispatch ExGlobal (AtLabel "w"))])+            , BiTau AtPhi (ExDispatch ExGlobal (AtLabel "y"))+            ]+        , defaultScope+        , [[("a", MvAttribute (AtLabel "y"))], [("a", MvAttribute (AtLabel "w"))], [("a", MvAttribute (AtLabel "y"))]]+        )+      ,+        ( "[[!a -> Q.org.!a]] => [[f -> [[x -> Q.org.x]], t -> [[y -> Q.org.y]] => [(!a >> x), (!a >> y)]"+        , ExFormation [BiTau (AtMeta "a") (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtMeta "a"))]+        , ExFormation+            [ BiTau (AtLabel "f") (ExFormation [BiTau (AtLabel "x") (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "x"))])+            , BiTau (AtLabel "t") (ExFormation [BiTau (AtLabel "y") (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "y"))])+            ]+        , defaultScope+        , [[("a", MvAttribute (AtLabel "x"))], [("a", MvAttribute (AtLabel "y"))]]+        )+      ,+        ( "!e => [[x -> Q]] => [(!e >> [[x -> Q]] ), (!e >> Q)]"+        , ExMeta "e"+        , ExFormation [BiTau (AtLabel "x") ExGlobal]+        , defaultScope+        ,+          [ [("e", MvExpression (ExFormation [BiTau (AtLabel "x") ExGlobal]) defaultScope)]+          , [("e", MvExpression ExGlobal (ExFormation [BiTau (AtLabel "x") ExGlobal]))]           ]-        ),-        ( "!e.!a => Q.org.eolang => [(!e >> Q.org, !a >> eolang), (!e >> Q, !a >> org)]",-          ExDispatch (ExMeta "e") (AtMeta "a"),-          ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang"),-          defaultScope,-          [ [("e", MvExpression (ExDispatch ExGlobal (AtLabel "org")) defaultScope), ("a", MvAttribute (AtLabel "eolang"))],-            [("e", MvExpression ExGlobal defaultScope), ("a", MvAttribute (AtLabel "org"))]+        )+      ,+        ( "!e.!a => Q.org.eolang => [(!e >> Q.org, !a >> eolang), (!e >> Q, !a >> org)]"+        , ExDispatch (ExMeta "e") (AtMeta "a")+        , ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")+        , defaultScope+        ,+          [ [("e", MvExpression (ExDispatch ExGlobal (AtLabel "org")) defaultScope), ("a", MvAttribute (AtLabel "eolang"))]+          , [("e", MvExpression ExGlobal defaultScope), ("a", MvAttribute (AtLabel "org"))]           ]-        ),-        ( "⟦!B1, !a ↦ ∅, !B2⟧.!a => ⟦ x ↦ ξ.t, t ↦ ∅ ⟧.t(ρ ↦ ⟦ x ↦ ξ.t, t ↦ ∅ ⟧) => [(!B1 >> ⟦x ↦ ξ.t⟧, !a >> t, !B2 >> ⟦⟧ )]",-          ExDispatch (ExFormation [BiMeta "B1", BiVoid (AtMeta "a"), BiMeta "B2"]) (AtMeta "a"),-          ExApplication+        )+      ,+        ( "⟦!B1, !a ↦ ∅, !B2⟧.!a => ⟦ x ↦ ξ.t, t ↦ ∅ ⟧.t(ρ ↦ ⟦ x ↦ ξ.t, t ↦ ∅ ⟧) => [(!B1 >> ⟦x ↦ ξ.t⟧, !a >> t, !B2 >> ⟦⟧ )]"+        , ExDispatch (ExFormation [BiMeta "B1", BiVoid (AtMeta "a"), BiMeta "B2"]) (AtMeta "a")+        , ExApplication             ( ExDispatch                 ( ExFormation-                    [ BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t")),-                      BiVoid (AtLabel "t")+                    [ BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t"))+                    , BiVoid (AtLabel "t")                     ]                 )                 (AtLabel "t")@@ -81,76 +105,84 @@             ( BiTau                 AtRho                 ( ExFormation-                    [ BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t")),-                      BiVoid (AtLabel "t")+                    [ BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t"))+                    , BiVoid (AtLabel "t")                     ]                 )-            ),-          defaultScope,-          [ [ ("B1", MvBindings [BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t"))]),-              ("a", MvAttribute (AtLabel "t")),-              ("B2", MvBindings [])+            )+        , defaultScope+        ,+          [+            [ ("B1", MvBindings [BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t"))])+            , ("a", MvAttribute (AtLabel "t"))+            , ("B2", MvBindings [])             ]           ]-        ),-        ( "somebody",-          ExFormation+        )+      ,+        ( "somebody"+        , ExFormation             [ BiTau                 (AtLabel "i1")                 ( ExFormation-                    [ BiTau (AtLabel "a") (ExMeta "e0"),-                      BiTau (AtLabel "b") (ExMeta "e-first")+                    [ BiTau (AtLabel "a") (ExMeta "e0")+                    , BiTau (AtLabel "b") (ExMeta "e-first")                     ]-                ),-              BiTau+                )+            , BiTau                 (AtLabel "i2")                 ( ExFormation-                    [ BiTau (AtLabel "a") (ExMeta "e0"),-                      BiTau (AtLabel "b") (ExMeta "e-second")+                    [ BiTau (AtLabel "a") (ExMeta "e0")+                    , BiTau (AtLabel "b") (ExMeta "e-second")                     ]                 )-            ],-          ExFormation+            ]+        , ExFormation             [ BiTau                 (AtLabel "i1")                 ( ExFormation-                    [ BiTau (AtLabel "a") ExGlobal,-                      BiTau (AtLabel "b") ExThis+                    [ BiTau (AtLabel "a") ExGlobal+                    , BiTau (AtLabel "b") ExThis                     ]-                ),-              BiTau+                )+            , BiTau                 (AtLabel "i2")                 ( ExFormation-                    [ BiTau (AtLabel "a") ExGlobal,-                      BiTau (AtLabel "b") (ExFormation [BiVoid AtPhi])+                    [ BiTau (AtLabel "a") ExGlobal+                    , BiTau (AtLabel "b") (ExFormation [BiVoid AtPhi])                     ]                 )-            ],-          defaultScope,-          [ [ ( "e0",-                MvExpression+            ]+        , defaultScope+        ,+          [+            [+              ( "e0"+              , MvExpression                   ExGlobal                   ( ExFormation-                      [ BiTau (AtLabel "a") ExGlobal,-                        BiTau (AtLabel "b") ExThis+                      [ BiTau (AtLabel "a") ExGlobal+                      , BiTau (AtLabel "b") ExThis                       ]                   )-              ),-              ( "e-first",-                MvExpression+              )+            ,+              ( "e-first"+              , MvExpression                   ExThis                   ( ExFormation-                      [ BiTau (AtLabel "a") ExGlobal,-                        BiTau (AtLabel "b") ExThis+                      [ BiTau (AtLabel "a") ExGlobal+                      , BiTau (AtLabel "b") ExThis                       ]                   )-              ),-              ( "e-second",-                MvExpression+              )+            ,+              ( "e-second"+              , MvExpression                   (ExFormation [BiVoid AtPhi])                   ( ExFormation-                      [ BiTau (AtLabel "a") ExGlobal,-                        BiTau (AtLabel "b") (ExFormation [BiVoid AtPhi])+                      [ BiTau (AtLabel "a") ExGlobal+                      , BiTau (AtLabel "b") (ExFormation [BiVoid AtPhi])                       ]                   )               )@@ -161,10 +193,10 @@    describe "matchAttribute: attribute => attribute => substitution" $     forM_-      [ ("~1 => ~1 => [()]", AtAlpha 1, AtAlpha 1, [[]]),-        ("!a => ^ => [(!a >> ^)]", AtMeta "a", AtRho, [[("a", MvAttribute AtRho)]]),-        ("!a => @ => [(!a >> @)]", AtMeta "a", AtPhi, [[("a", MvAttribute AtPhi)]]),-        ("~0 => [] => [()]", AtAlpha 0, AtLabel "x", [])+      [ ("~1 => ~1 => [()]", AtAlpha 1, AtAlpha 1, [[]])+      , ("!a => ^ => [(!a >> ^)]", AtMeta "a", AtRho, [[("a", MvAttribute AtRho)]])+      , ("!a => @ => [(!a >> @)]", AtMeta "a", AtPhi, [[("a", MvAttribute AtPhi)]])+      , ("~0 => [] => [()]", AtAlpha 0, AtLabel "x", [])       ]       ( \(desc, ptn, tgt, mp) ->           it desc $ matchAttribute ptn tgt `shouldBe` toExpected mp@@ -173,171 +205,202 @@   describe "matchBindings: [binding] => [binding] => substitution" $     test       matchBindings-      [ ( "[[]] => [[]] => ()",-          [],-          [],-          defaultScope,-          [[]]-        ),-        ( "[[!B]] => T:[[x -> ?, D> 01-, L> Func]] => (!B >> T)",-          [BiMeta "B"],-          [BiVoid (AtLabel "x"), BiDelta (BtOne "01"), BiLambda "Func"],-          defaultScope,-          [[("B", MvBindings [BiVoid (AtLabel "x"), BiDelta (BtOne "01"), BiLambda "Func"])]]-        ),-        ( "[[D> 00-]] => [[D> 00-, L> Func]] => []",-          [BiDelta (BtOne "00")],-          [BiDelta (BtOne "00"), BiLambda "Func"],-          defaultScope,-          []-        ),-        ( "[[y -> ?, !a -> ?]] => [[y -> ?, x -> ?]] => (!a >> x)",-          [BiVoid (AtLabel "y"), BiVoid (AtMeta "a")],-          [BiVoid (AtLabel "y"), BiVoid (AtLabel "x")],-          defaultScope,-          [[("a", MvAttribute (AtLabel "x"))]]-        ),-        ( "[[!B, x -> ?]] => [[x -> ?]] => (!B >> [[]])",-          [BiMeta "B", BiVoid (AtLabel "x")],-          [BiVoid (AtLabel "x")],-          defaultScope,-          [[("B", MvBindings [])]]-        ),-        ( "[[!B1, x -> ?, !B2]] => [[x -> ?, y -> ?]] => (!B1 >> [[]], !B2 >> [[y -> ?]])",-          [BiMeta "B1", BiVoid (AtLabel "x"), BiMeta "B2"],-          [BiVoid (AtLabel "x"), BiVoid (AtLabel "y")],-          defaultScope,-          [[("B1", MvBindings []), ("B2", MvBindings [BiVoid (AtLabel "y")])]]-        ),-        ( "[[!B1, !x -> ?, !B2]] => [[y -> ?, D> -> 00-, L> Func]] => (!x >> y, !B1 >> [[]], !B2 >> [[D> -> 00-, L> Func]])",-          [BiMeta "B1", BiVoid (AtMeta "x"), BiMeta "B2"],-          [BiVoid (AtLabel "y"), BiDelta (BtOne "00"), BiLambda "Func"],-          defaultScope,-          [[("B1", MvBindings []), ("B2", MvBindings [BiDelta (BtOne "00"), BiLambda "Func"]), ("x", MvAttribute (AtLabel "y"))]]-        ),-        ( "[[!x -> ?, !y -> ?]] => [[a -> ?, b -> ?]] => (!x >> a, !y >> b)",-          [BiVoid (AtMeta "x"), BiVoid (AtMeta "y")],-          [BiVoid (AtLabel "a"), BiVoid (AtLabel "b")],-          defaultScope,-          [[("x", MvAttribute (AtLabel "a")), ("y", MvAttribute (AtLabel "b"))]]-        ),-        ( "[[t -> ?, !B]] => [[t -> ?, x -> Q, y -> $]] => (!B >> [[x -> Q, y -> $]])",-          [BiVoid (AtLabel "t"), BiMeta "B"],-          [BiVoid (AtLabel "t"), BiTau (AtLabel "x") ExGlobal, BiTau (AtLabel "y") ExThis],-          defaultScope,-          [[("B", MvBindings [BiTau (AtLabel "x") ExGlobal, BiTau (AtLabel "y") ExThis])]]-        ),-        ( "[[!B, z -> Q]] => [[x -> Q, y -> $, z -> Q]] => (!B >> [[x -> Q, y -> $]])",-          [BiMeta "B", BiTau (AtLabel "z") ExGlobal],-          [BiTau (AtLabel "x") ExGlobal, BiTau (AtLabel "y") ExThis, BiTau (AtLabel "z") ExGlobal],-          defaultScope,-          [[("B", MvBindings [BiTau (AtLabel "x") ExGlobal, BiTau (AtLabel "y") ExThis])]]-        ),-        ( "[[L> Func, D> 00-]] => [[D> 00-, L> Func]] => []",-          [BiLambda "Func", BiDelta (BtOne "00")],-          [BiDelta (BtOne "00"), BiLambda "Func"],-          defaultScope,-          []-        ),-        ( "[[t -> ?, !B]] => [[x -> ?, t -> ?]] => []",-          [BiVoid (AtLabel "t"), BiMeta "B"],-          [BiVoid (AtLabel "x"), BiVoid (AtLabel "t")],-          defaultScope,-          []-        ),-        ( "[[!B, !a -> ?]] => [[x -> ?, y -> ?]] => (!a >> y, !B >> [[ x -> ? ]] )",-          [BiMeta "B", BiVoid (AtMeta "a")],-          [BiVoid (AtLabel "x"), BiVoid (AtLabel "y")],-          defaultScope,-          [[("a", MvAttribute (AtLabel "y")), ("B", MvBindings [BiVoid (AtLabel "x")])]]-        ),-        ( "[[!B1, !a -> ?, !B2]] => [[ x -> ?, y -> ?, z -> ? ]] => [(!B1 >> [[]], !a >> x, !B2 >> [[ y -> ?, z -> ? ]]), (...), (...)]",-          [BiMeta "B1", BiVoid (AtMeta "a"), BiMeta "B2"],-          [BiVoid (AtLabel "x"), BiVoid (AtLabel "y"), BiVoid (AtLabel "z")],-          defaultScope,-          [ [ ("B1", MvBindings []),-              ("a", MvAttribute (AtLabel "x")),-              ("B2", MvBindings [BiVoid (AtLabel "y"), BiVoid (AtLabel "z")])-            ],-            [ ("B1", MvBindings [BiVoid (AtLabel "x")]),-              ("a", MvAttribute (AtLabel "y")),-              ("B2", MvBindings [BiVoid (AtLabel "z")])-            ],-            [ ("B1", MvBindings [BiVoid (AtLabel "x"), BiVoid (AtLabel "y")]),-              ("a", MvAttribute (AtLabel "z")),-              ("B2", MvBindings [])+      [+        ( "[[]] => [[]] => ()"+        , []+        , []+        , defaultScope+        , [[]]+        )+      ,+        ( "[[!B]] => T:[[x -> ?, D> 01-, L> Func]] => (!B >> T)"+        , [BiMeta "B"]+        , [BiVoid (AtLabel "x"), BiDelta (BtOne "01"), BiLambda "Func"]+        , defaultScope+        , [[("B", MvBindings [BiVoid (AtLabel "x"), BiDelta (BtOne "01"), BiLambda "Func"])]]+        )+      ,+        ( "[[D> 00-]] => [[D> 00-, L> Func]] => []"+        , [BiDelta (BtOne "00")]+        , [BiDelta (BtOne "00"), BiLambda "Func"]+        , defaultScope+        , []+        )+      ,+        ( "[[y -> ?, !a -> ?]] => [[y -> ?, x -> ?]] => (!a >> x)"+        , [BiVoid (AtLabel "y"), BiVoid (AtMeta "a")]+        , [BiVoid (AtLabel "y"), BiVoid (AtLabel "x")]+        , defaultScope+        , [[("a", MvAttribute (AtLabel "x"))]]+        )+      ,+        ( "[[!B, x -> ?]] => [[x -> ?]] => (!B >> [[]])"+        , [BiMeta "B", BiVoid (AtLabel "x")]+        , [BiVoid (AtLabel "x")]+        , defaultScope+        , [[("B", MvBindings [])]]+        )+      ,+        ( "[[!B1, x -> ?, !B2]] => [[x -> ?, y -> ?]] => (!B1 >> [[]], !B2 >> [[y -> ?]])"+        , [BiMeta "B1", BiVoid (AtLabel "x"), BiMeta "B2"]+        , [BiVoid (AtLabel "x"), BiVoid (AtLabel "y")]+        , defaultScope+        , [[("B1", MvBindings []), ("B2", MvBindings [BiVoid (AtLabel "y")])]]+        )+      ,+        ( "[[!B1, !x -> ?, !B2]] => [[y -> ?, D> -> 00-, L> Func]] => (!x >> y, !B1 >> [[]], !B2 >> [[D> -> 00-, L> Func]])"+        , [BiMeta "B1", BiVoid (AtMeta "x"), BiMeta "B2"]+        , [BiVoid (AtLabel "y"), BiDelta (BtOne "00"), BiLambda "Func"]+        , defaultScope+        , [[("B1", MvBindings []), ("B2", MvBindings [BiDelta (BtOne "00"), BiLambda "Func"]), ("x", MvAttribute (AtLabel "y"))]]+        )+      ,+        ( "[[!x -> ?, !y -> ?]] => [[a -> ?, b -> ?]] => (!x >> a, !y >> b)"+        , [BiVoid (AtMeta "x"), BiVoid (AtMeta "y")]+        , [BiVoid (AtLabel "a"), BiVoid (AtLabel "b")]+        , defaultScope+        , [[("x", MvAttribute (AtLabel "a")), ("y", MvAttribute (AtLabel "b"))]]+        )+      ,+        ( "[[t -> ?, !B]] => [[t -> ?, x -> Q, y -> $]] => (!B >> [[x -> Q, y -> $]])"+        , [BiVoid (AtLabel "t"), BiMeta "B"]+        , [BiVoid (AtLabel "t"), BiTau (AtLabel "x") ExGlobal, BiTau (AtLabel "y") ExThis]+        , defaultScope+        , [[("B", MvBindings [BiTau (AtLabel "x") ExGlobal, BiTau (AtLabel "y") ExThis])]]+        )+      ,+        ( "[[!B, z -> Q]] => [[x -> Q, y -> $, z -> Q]] => (!B >> [[x -> Q, y -> $]])"+        , [BiMeta "B", BiTau (AtLabel "z") ExGlobal]+        , [BiTau (AtLabel "x") ExGlobal, BiTau (AtLabel "y") ExThis, BiTau (AtLabel "z") ExGlobal]+        , defaultScope+        , [[("B", MvBindings [BiTau (AtLabel "x") ExGlobal, BiTau (AtLabel "y") ExThis])]]+        )+      ,+        ( "[[L> Func, D> 00-]] => [[D> 00-, L> Func]] => []"+        , [BiLambda "Func", BiDelta (BtOne "00")]+        , [BiDelta (BtOne "00"), BiLambda "Func"]+        , defaultScope+        , []+        )+      ,+        ( "[[t -> ?, !B]] => [[x -> ?, t -> ?]] => []"+        , [BiVoid (AtLabel "t"), BiMeta "B"]+        , [BiVoid (AtLabel "x"), BiVoid (AtLabel "t")]+        , defaultScope+        , []+        )+      ,+        ( "[[!B, !a -> ?]] => [[x -> ?, y -> ?]] => (!a >> y, !B >> [[ x -> ? ]] )"+        , [BiMeta "B", BiVoid (AtMeta "a")]+        , [BiVoid (AtLabel "x"), BiVoid (AtLabel "y")]+        , defaultScope+        , [[("a", MvAttribute (AtLabel "y")), ("B", MvBindings [BiVoid (AtLabel "x")])]]+        )+      ,+        ( "[[!B1, !a -> ?, !B2]] => [[ x -> ?, y -> ?, z -> ? ]] => [(!B1 >> [[]], !a >> x, !B2 >> [[ y -> ?, z -> ? ]]), (...), (...)]"+        , [BiMeta "B1", BiVoid (AtMeta "a"), BiMeta "B2"]+        , [BiVoid (AtLabel "x"), BiVoid (AtLabel "y"), BiVoid (AtLabel "z")]+        , defaultScope+        ,+          [+            [ ("B1", MvBindings [])+            , ("a", MvAttribute (AtLabel "x"))+            , ("B2", MvBindings [BiVoid (AtLabel "y"), BiVoid (AtLabel "z")])             ]+          ,+            [ ("B1", MvBindings [BiVoid (AtLabel "x")])+            , ("a", MvAttribute (AtLabel "y"))+            , ("B2", MvBindings [BiVoid (AtLabel "z")])+            ]+          ,+            [ ("B1", MvBindings [BiVoid (AtLabel "x"), BiVoid (AtLabel "y")])+            , ("a", MvAttribute (AtLabel "z"))+            , ("B2", MvBindings [])+            ]           ]-        ),-        ( "[[!B1, !a1 -> ?, !B2, !a2 -> ?, !B3]] => [[ a -> ?, b -> ?, x -> ?, y -> ?, z -> ? ]] => [10 substs]",-          [BiMeta "B1", BiVoid (AtMeta "a1"), BiMeta "B2", BiVoid (AtMeta "a2"), BiMeta "B3"],-          [ BiVoid (AtLabel "a"),-            BiVoid (AtLabel "b"),-            BiVoid (AtLabel "x"),-            BiVoid (AtLabel "y"),-            BiVoid (AtLabel "z")-          ],-          defaultScope,-          [ [ ("B1", MvBindings []),-              ("a1", MvAttribute (AtLabel "a")),-              ("B2", MvBindings []),-              ("a2", MvAttribute (AtLabel "b")),-              ("B3", MvBindings [BiVoid (AtLabel "x"), BiVoid (AtLabel "y"), BiVoid (AtLabel "z")])-            ],-            [ ("B1", MvBindings []),-              ("a1", MvAttribute (AtLabel "a")),-              ("B2", MvBindings [BiVoid (AtLabel "b")]),-              ("a2", MvAttribute (AtLabel "x")),-              ("B3", MvBindings [BiVoid (AtLabel "y"), BiVoid (AtLabel "z")])-            ],-            [ ("B1", MvBindings []),-              ("a1", MvAttribute (AtLabel "a")),-              ("B2", MvBindings [BiVoid (AtLabel "b"), BiVoid (AtLabel "x")]),-              ("a2", MvAttribute (AtLabel "y")),-              ("B3", MvBindings [BiVoid (AtLabel "z")])-            ],-            [ ("B1", MvBindings []),-              ("a1", MvAttribute (AtLabel "a")),-              ("B2", MvBindings [BiVoid (AtLabel "b"), BiVoid (AtLabel "x"), BiVoid (AtLabel "y")]),-              ("a2", MvAttribute (AtLabel "z")),-              ("B3", MvBindings [])-            ],-            [ ("B1", MvBindings [BiVoid (AtLabel "a")]),-              ("a1", MvAttribute (AtLabel "b")),-              ("B2", MvBindings []),-              ("a2", MvAttribute (AtLabel "x")),-              ("B3", MvBindings [BiVoid (AtLabel "y"), BiVoid (AtLabel "z")])-            ],-            [ ("B1", MvBindings [BiVoid (AtLabel "a")]),-              ("a1", MvAttribute (AtLabel "b")),-              ("B2", MvBindings [BiVoid (AtLabel "x")]),-              ("a2", MvAttribute (AtLabel "y")),-              ("B3", MvBindings [BiVoid (AtLabel "z")])-            ],-            [ ("B1", MvBindings [BiVoid (AtLabel "a")]),-              ("a1", MvAttribute (AtLabel "b")),-              ("B2", MvBindings [BiVoid (AtLabel "x"), BiVoid (AtLabel "y")]),-              ("a2", MvAttribute (AtLabel "z")),-              ("B3", MvBindings [])-            ],-            [ ("B1", MvBindings [BiVoid (AtLabel "a"), BiVoid (AtLabel "b")]),-              ("a1", MvAttribute (AtLabel "x")),-              ("B2", MvBindings []),-              ("a2", MvAttribute (AtLabel "y")),-              ("B3", MvBindings [BiVoid (AtLabel "z")])-            ],-            [ ("B1", MvBindings [BiVoid (AtLabel "a"), BiVoid (AtLabel "b")]),-              ("a1", MvAttribute (AtLabel "x")),-              ("B2", MvBindings [BiVoid (AtLabel "y")]),-              ("a2", MvAttribute (AtLabel "z")),-              ("B3", MvBindings [])-            ],-            [ ("B1", MvBindings [BiVoid (AtLabel "a"), BiVoid (AtLabel "b"), BiVoid (AtLabel "x")]),-              ("a1", MvAttribute (AtLabel "y")),-              ("B2", MvBindings []),-              ("a2", MvAttribute (AtLabel "z")),-              ("B3", MvBindings [])+        )+      ,+        ( "[[!B1, !a1 -> ?, !B2, !a2 -> ?, !B3]] => [[ a -> ?, b -> ?, x -> ?, y -> ?, z -> ? ]] => [10 substs]"+        , [BiMeta "B1", BiVoid (AtMeta "a1"), BiMeta "B2", BiVoid (AtMeta "a2"), BiMeta "B3"]+        ,+          [ BiVoid (AtLabel "a")+          , BiVoid (AtLabel "b")+          , BiVoid (AtLabel "x")+          , BiVoid (AtLabel "y")+          , BiVoid (AtLabel "z")+          ]+        , defaultScope+        ,+          [+            [ ("B1", MvBindings [])+            , ("a1", MvAttribute (AtLabel "a"))+            , ("B2", MvBindings [])+            , ("a2", MvAttribute (AtLabel "b"))+            , ("B3", MvBindings [BiVoid (AtLabel "x"), BiVoid (AtLabel "y"), BiVoid (AtLabel "z")])             ]+          ,+            [ ("B1", MvBindings [])+            , ("a1", MvAttribute (AtLabel "a"))+            , ("B2", MvBindings [BiVoid (AtLabel "b")])+            , ("a2", MvAttribute (AtLabel "x"))+            , ("B3", MvBindings [BiVoid (AtLabel "y"), BiVoid (AtLabel "z")])+            ]+          ,+            [ ("B1", MvBindings [])+            , ("a1", MvAttribute (AtLabel "a"))+            , ("B2", MvBindings [BiVoid (AtLabel "b"), BiVoid (AtLabel "x")])+            , ("a2", MvAttribute (AtLabel "y"))+            , ("B3", MvBindings [BiVoid (AtLabel "z")])+            ]+          ,+            [ ("B1", MvBindings [])+            , ("a1", MvAttribute (AtLabel "a"))+            , ("B2", MvBindings [BiVoid (AtLabel "b"), BiVoid (AtLabel "x"), BiVoid (AtLabel "y")])+            , ("a2", MvAttribute (AtLabel "z"))+            , ("B3", MvBindings [])+            ]+          ,+            [ ("B1", MvBindings [BiVoid (AtLabel "a")])+            , ("a1", MvAttribute (AtLabel "b"))+            , ("B2", MvBindings [])+            , ("a2", MvAttribute (AtLabel "x"))+            , ("B3", MvBindings [BiVoid (AtLabel "y"), BiVoid (AtLabel "z")])+            ]+          ,+            [ ("B1", MvBindings [BiVoid (AtLabel "a")])+            , ("a1", MvAttribute (AtLabel "b"))+            , ("B2", MvBindings [BiVoid (AtLabel "x")])+            , ("a2", MvAttribute (AtLabel "y"))+            , ("B3", MvBindings [BiVoid (AtLabel "z")])+            ]+          ,+            [ ("B1", MvBindings [BiVoid (AtLabel "a")])+            , ("a1", MvAttribute (AtLabel "b"))+            , ("B2", MvBindings [BiVoid (AtLabel "x"), BiVoid (AtLabel "y")])+            , ("a2", MvAttribute (AtLabel "z"))+            , ("B3", MvBindings [])+            ]+          ,+            [ ("B1", MvBindings [BiVoid (AtLabel "a"), BiVoid (AtLabel "b")])+            , ("a1", MvAttribute (AtLabel "x"))+            , ("B2", MvBindings [])+            , ("a2", MvAttribute (AtLabel "y"))+            , ("B3", MvBindings [BiVoid (AtLabel "z")])+            ]+          ,+            [ ("B1", MvBindings [BiVoid (AtLabel "a"), BiVoid (AtLabel "b")])+            , ("a1", MvAttribute (AtLabel "x"))+            , ("B2", MvBindings [BiVoid (AtLabel "y")])+            , ("a2", MvAttribute (AtLabel "z"))+            , ("B3", MvBindings [])+            ]+          ,+            [ ("B1", MvBindings [BiVoid (AtLabel "a"), BiVoid (AtLabel "b"), BiVoid (AtLabel "x")])+            , ("a1", MvAttribute (AtLabel "y"))+            , ("B2", MvBindings [])+            , ("a2", MvAttribute (AtLabel "z"))+            , ("B3", MvBindings [])+            ]           ]         )       ]@@ -345,105 +408,121 @@   describe "matchExpression: expression => pattern => substitution" $     test       matchExpression-      [ ("$ => $ => [()]", ExThis, ExThis, defaultScope, [[]]),-        ("Q => Q => [()]", ExGlobal, ExGlobal, defaultScope, [[]]),-        ( "!e => Q => [(!e >> Q)]",-          ExMeta "e",-          ExGlobal,-          defaultScope,-          [[("e", MvExpression ExGlobal defaultScope)]]-        ),-        ( "!e => Q.org(x -> $) => [(!e >> Q.org(x -> $))]",-          ExMeta "e",-          ExApplication (ExDispatch ExGlobal (AtLabel "org")) (BiTau (AtLabel "x") ExThis),-          defaultScope,-          [[("e", MvExpression (ExApplication (ExDispatch ExGlobal (AtLabel "org")) (BiTau (AtLabel "x") ExThis)) defaultScope)]]-        ),-        ( "!e1.x => Q.org.x => [(!e1 >> Q.org)]",-          ExDispatch (ExMeta "e1") (AtLabel "x"),-          ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "x"),-          defaultScope,-          [[("e1", MvExpression (ExDispatch ExGlobal (AtLabel "org")) defaultScope)]]-        ),-        ( "!e.org.!a => $.org.x => [(!e >> $, !a >> x)]",-          ExDispatch (ExDispatch (ExMeta "e") (AtLabel "org")) (AtMeta "a"),-          ExDispatch (ExDispatch ExThis (AtLabel "org")) (AtLabel "x"),-          defaultScope,-          [[("e", MvExpression ExThis defaultScope), ("a", MvAttribute (AtLabel "x"))]]-        ),-        ( "[[!a -> !e, !B]].!a => [[x -> Q, y -> $]].x => [(!a >> x, !e >> Q, !B >> [y -> $])]",-          ExDispatch (ExFormation [BiTau (AtMeta "a") (ExMeta "e"), BiMeta "B"]) (AtMeta "a"),-          ExDispatch+      [ ("$ => $ => [()]", ExThis, ExThis, defaultScope, [[]])+      , ("Q => Q => [()]", ExGlobal, ExGlobal, defaultScope, [[]])+      ,+        ( "!e => Q => [(!e >> Q)]"+        , ExMeta "e"+        , ExGlobal+        , defaultScope+        , [[("e", MvExpression ExGlobal defaultScope)]]+        )+      ,+        ( "!e => Q.org(x -> $) => [(!e >> Q.org(x -> $))]"+        , ExMeta "e"+        , ExApplication (ExDispatch ExGlobal (AtLabel "org")) (BiTau (AtLabel "x") ExThis)+        , defaultScope+        , [[("e", MvExpression (ExApplication (ExDispatch ExGlobal (AtLabel "org")) (BiTau (AtLabel "x") ExThis)) defaultScope)]]+        )+      ,+        ( "!e1.x => Q.org.x => [(!e1 >> Q.org)]"+        , ExDispatch (ExMeta "e1") (AtLabel "x")+        , ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "x")+        , defaultScope+        , [[("e1", MvExpression (ExDispatch ExGlobal (AtLabel "org")) defaultScope)]]+        )+      ,+        ( "!e.org.!a => $.org.x => [(!e >> $, !a >> x)]"+        , ExDispatch (ExDispatch (ExMeta "e") (AtLabel "org")) (AtMeta "a")+        , ExDispatch (ExDispatch ExThis (AtLabel "org")) (AtLabel "x")+        , defaultScope+        , [[("e", MvExpression ExThis defaultScope), ("a", MvAttribute (AtLabel "x"))]]+        )+      ,+        ( "[[!a -> !e, !B]].!a => [[x -> Q, y -> $]].x => [(!a >> x, !e >> Q, !B >> [y -> $])]"+        , ExDispatch (ExFormation [BiTau (AtMeta "a") (ExMeta "e"), BiMeta "B"]) (AtMeta "a")+        , ExDispatch             ( ExFormation-                [ BiTau (AtLabel "x") ExGlobal,-                  BiTau (AtLabel "y") ExThis+                [ BiTau (AtLabel "x") ExGlobal+                , BiTau (AtLabel "y") ExThis                 ]             )-            (AtLabel "x"),-          defaultScope,-          [ [ ("a", MvAttribute (AtLabel "x")),-              ( "e",-                MvExpression+            (AtLabel "x")+        , defaultScope+        ,+          [+            [ ("a", MvAttribute (AtLabel "x"))+            ,+              ( "e"+              , MvExpression                   ExGlobal                   ( ExFormation-                      [ BiTau (AtLabel "x") ExGlobal,-                        BiTau (AtLabel "y") ExThis+                      [ BiTau (AtLabel "x") ExGlobal+                      , BiTau (AtLabel "y") ExThis                       ]                   )-              ),-              ("B", MvBindings [BiTau (AtLabel "y") ExThis])+              )+            , ("B", MvBindings [BiTau (AtLabel "y") ExThis])             ]           ]-        ),-        ( "Q * !t => Q.org => [(!t >> [.org])]",-          ExMetaTail ExGlobal "t",-          ExDispatch ExGlobal (AtLabel "x"),-          defaultScope,-          [[("t", MvTail [TaDispatch (AtLabel "x")])]]-        ),-        ( "Q * !t => Q.org(x -> [[]]) => [(!t >> [.org, (x -> [[]])])]",-          ExMetaTail ExGlobal "t",-          ExApplication (ExDispatch ExGlobal (AtLabel "org")) (BiTau (AtLabel "x") defaultScope),-          defaultScope,-          [[("t", MvTail [TaDispatch (AtLabel "org"), TaApplication (BiTau (AtLabel "x") defaultScope)])]]-        ),-        ( "Q.!a * !t => Q.org.eolang(x -> [[]]) => [(!a >> org, !t >> [ .eolang, ( x -> [[ ]] ) ])]",-          ExMetaTail (ExDispatch ExGlobal (AtMeta "a")) "t",-          ExApplication (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (BiTau (AtLabel "x") defaultScope),-          defaultScope,-          [[("a", MvAttribute (AtLabel "org")), ("t", MvTail [TaDispatch (AtLabel "eolang"), TaApplication (BiTau (AtLabel "x") defaultScope)])]]-        ),-        ( "Q.x(y -> $ * !t1) * !t2 => Q.x(y -> $.q).p => [(!t1 >> [.q], !t2 >> [.p])]",-          ExMetaTail (ExApplication (ExDispatch ExGlobal (AtLabel "x")) (BiTau (AtLabel "y") (ExMetaTail ExThis "t1"))) "t2",-          ExDispatch (ExApplication (ExDispatch ExGlobal (AtLabel "x")) (BiTau (AtLabel "y") (ExDispatch ExThis (AtLabel "q")))) (AtLabel "p"),-          defaultScope,-          [[("t1", MvTail [TaDispatch (AtLabel "q")]), ("t2", MvTail [TaDispatch (AtLabel "p")])]]-        ),-        ( "[[!B1, !a ↦ !e1, !B2]](!a ↦ !e2) => ⟦ t ↦ ξ.k, x ↦ ξ.t, k ↦ ∅ ⟧(x ↦ ξ) => [(!B1 >> [[ t -> $.k ]], !a >> x, !B2 >> [[ k -> ? ]], !e1 >> $.t, !e2 >> $)]",-          ExApplication (ExFormation [BiMeta "B1", BiTau (AtMeta "a") (ExMeta "e1"), BiMeta "B2"]) (BiTau (AtMeta "a") (ExMeta "e2")),-          ExApplication+        )+      ,+        ( "Q * !t => Q.org => [(!t >> [.org])]"+        , ExMetaTail ExGlobal "t"+        , ExDispatch ExGlobal (AtLabel "x")+        , defaultScope+        , [[("t", MvTail [TaDispatch (AtLabel "x")])]]+        )+      ,+        ( "Q * !t => Q.org(x -> [[]]) => [(!t >> [.org, (x -> [[]])])]"+        , ExMetaTail ExGlobal "t"+        , ExApplication (ExDispatch ExGlobal (AtLabel "org")) (BiTau (AtLabel "x") defaultScope)+        , defaultScope+        , [[("t", MvTail [TaDispatch (AtLabel "org"), TaApplication (BiTau (AtLabel "x") defaultScope)])]]+        )+      ,+        ( "Q.!a * !t => Q.org.eolang(x -> [[]]) => [(!a >> org, !t >> [ .eolang, ( x -> [[ ]] ) ])]"+        , ExMetaTail (ExDispatch ExGlobal (AtMeta "a")) "t"+        , ExApplication (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (BiTau (AtLabel "x") defaultScope)+        , defaultScope+        , [[("a", MvAttribute (AtLabel "org")), ("t", MvTail [TaDispatch (AtLabel "eolang"), TaApplication (BiTau (AtLabel "x") defaultScope)])]]+        )+      ,+        ( "Q.x(y -> $ * !t1) * !t2 => Q.x(y -> $.q).p => [(!t1 >> [.q], !t2 >> [.p])]"+        , ExMetaTail (ExApplication (ExDispatch ExGlobal (AtLabel "x")) (BiTau (AtLabel "y") (ExMetaTail ExThis "t1"))) "t2"+        , ExDispatch (ExApplication (ExDispatch ExGlobal (AtLabel "x")) (BiTau (AtLabel "y") (ExDispatch ExThis (AtLabel "q")))) (AtLabel "p")+        , defaultScope+        , [[("t1", MvTail [TaDispatch (AtLabel "q")]), ("t2", MvTail [TaDispatch (AtLabel "p")])]]+        )+      ,+        ( "[[!B1, !a ↦ !e1, !B2]](!a ↦ !e2) => ⟦ t ↦ ξ.k, x ↦ ξ.t, k ↦ ∅ ⟧(x ↦ ξ) => [(!B1 >> [[ t -> $.k ]], !a >> x, !B2 >> [[ k -> ? ]], !e1 >> $.t, !e2 >> $)]"+        , ExApplication (ExFormation [BiMeta "B1", BiTau (AtMeta "a") (ExMeta "e1"), BiMeta "B2"]) (BiTau (AtMeta "a") (ExMeta "e2"))+        , ExApplication             ( ExFormation-                [ BiTau (AtLabel "t") (ExDispatch ExThis (AtLabel "k")),-                  BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t")),-                  BiVoid (AtLabel "k")+                [ BiTau (AtLabel "t") (ExDispatch ExThis (AtLabel "k"))+                , BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t"))+                , BiVoid (AtLabel "k")                 ]             )-            (BiTau (AtLabel "x") ExThis),-          defaultScope,-          [ [ ("B1", MvBindings [BiTau (AtLabel "t") (ExDispatch ExThis (AtLabel "k"))]),-              ("a", MvAttribute (AtLabel "x")),-              ("B2", MvBindings [BiVoid (AtLabel "k")]),-              ( "e1",-                MvExpression+            (BiTau (AtLabel "x") ExThis)+        , defaultScope+        ,+          [+            [ ("B1", MvBindings [BiTau (AtLabel "t") (ExDispatch ExThis (AtLabel "k"))])+            , ("a", MvAttribute (AtLabel "x"))+            , ("B2", MvBindings [BiVoid (AtLabel "k")])+            ,+              ( "e1"+              , MvExpression                   (ExDispatch ExThis (AtLabel "t"))                   ( ExFormation-                      [ BiTau (AtLabel "t") (ExDispatch ExThis (AtLabel "k")),-                        BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t")),-                        BiVoid (AtLabel "k")+                      [ BiTau (AtLabel "t") (ExDispatch ExThis (AtLabel "k"))+                      , BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t"))+                      , BiVoid (AtLabel "k")                       ]                   )-              ),-              ("e2", MvExpression ExThis defaultScope)+              )+            , ("e2", MvExpression ExThis defaultScope)             ]           ]         )@@ -469,8 +548,8 @@           first =             Subst               ( Map.fromList-                  [ ("first", rho),-                    ("second", MvAttribute AtPhi)+                  [ ("first", rho)+                  , ("second", MvAttribute AtPhi)                   ]               )           second = Subst (Map.singleton "first" rho)@@ -482,8 +561,8 @@       let first =             Subst               ( Map.fromList-                  [ ("x", MvAttribute AtRho),-                    ("y", MvBytes (BtOne "1F"))+                  [ ("x", MvAttribute AtRho)+                  , ("y", MvBytes (BtOne "1F"))                   ]               )           second = Subst (Map.singleton "x" (MvAttribute AtPhi))

@@ -14,27 +14,34 @@ spec = do   describe "merge programs" $     forM_-      [ ( ["[[ x -> 1 ]]", "[[ y -> 2 ]]"],-          "[[ x -> 1, y -> 2 ]]"-        ),-        ( ["[[ x -> [[ y -> 1 ]] ]]", "[[ x -> [[ z -> 2 ]] ]]"],-          "[[ x -> [[ y -> 1, z -> 2 ]] ]]"-        ),-        ( ["[[ x -> 1 ]]", "[[ x -> 1]]"],-          "[[ x -> 1]]"-        ),-        ( ["[[ org -> [[ eolang -> [[ number -> [[ ]] ]] ]] ]]", "[[ org -> [[ eolang -> [[ bytes -> [[ ]] ]] ]] ]]"],-          "[[ org -> [[ eolang -> [[ number -> [[ ]], bytes -> [[ ]] ]] ]] ]]"-        ),-        ( ["[[ x -> 1 ]]", "[[ y -> 2 ]]", "[[ z -> 3 ]]"],-          "[[ x -> 1, y -> 2, z -> 3 ]]"-        ),-        ( ["[[ x -> ? ]]", "[[ x -> ? ]]"],-          "[[ x -> ? ]]"-        ),-        ( ["[[ D> 42-, x -> [[ ]] ]]", "[[ D> 42-, y -> [[ ]] ]]"],-          "[[ x -> [[ ]], y -> [[ ]], D> 42- ]]"+      [+        ( ["[[ x -> 1 ]]", "[[ y -> 2 ]]"]+        , "[[ x -> 1, y -> 2 ]]"         )+      ,+        ( ["[[ x -> [[ y -> 1 ]] ]]", "[[ x -> [[ z -> 2 ]] ]]"]+        , "[[ x -> [[ y -> 1, z -> 2 ]] ]]"+        )+      ,+        ( ["[[ x -> 1 ]]", "[[ x -> 1]]"]+        , "[[ x -> 1]]"+        )+      ,+        ( ["[[ org -> [[ eolang -> [[ number -> [[ ]] ]] ]] ]]", "[[ org -> [[ eolang -> [[ bytes -> [[ ]] ]] ]] ]]"]+        , "[[ org -> [[ eolang -> [[ number -> [[ ]], bytes -> [[ ]] ]] ]] ]]"+        )+      ,+        ( ["[[ x -> 1 ]]", "[[ y -> 2 ]]", "[[ z -> 3 ]]"]+        , "[[ x -> 1, y -> 2, z -> 3 ]]"+        )+      ,+        ( ["[[ x -> ? ]]", "[[ x -> ? ]]"]+        , "[[ x -> ? ]]"+        )+      ,+        ( ["[[ D> 42-, x -> [[ ]] ]]", "[[ D> 42-, y -> [[ ]] ]]"]+        , "[[ x -> [[ ]], y -> [[ ]], D> 42- ]]"+        )       ]       ( \(exprs, res) -> it res $ do           progs <- mapM (fmap Program . parseExpressionThrows) exprs@@ -45,9 +52,9 @@    describe "fails to merge" $     forM_-      [ ["Q", "$"],-        ["[[ x -> 1]]", "[[ x -> 2 ]]"],-        ["[[ x -> [[ y -> Q ]] ]]", "[[ x -> [[ y -> $ ]] ]]"]+      [ ["Q", "$"]+      , ["[[ x -> 1]]", "[[ x -> 2 ]]"]+      , ["[[ x -> [[ y -> Q ]] ]]", "[[ x -> [[ y -> $ ]] ]]"]       ]       ( \exprs -> it (intercalate " and " exprs) $ do           progs <- mapM (fmap Program . parseExpressionThrows) exprs

@@ -3,11 +3,11 @@  module MiscSpec where -import Control.Monad (forM_)-import Misc (withVoidRho, uniqueBindings)-import Test.Hspec (Example (Arg), Expectation, Spec, SpecWith, describe, it, shouldBe, shouldSatisfy) import AST+import Control.Monad (forM_) import Data.Either (isLeft, isRight)+import Misc (uniqueBindings, withVoidRho)+import Test.Hspec (Example (Arg), Expectation, Spec, SpecWith, describe, it, shouldBe, shouldSatisfy)  testWithVoidRho :: [(String, [Binding], [Binding])] -> SpecWith (Arg Expectation) testWithVoidRho useCases =@@ -18,35 +18,42 @@ spec = do   describe "with void rho binding" $     testWithVoidRho-      [ ( "[[x -> ?]] => [[x -> ?, ^ -> ?]]",-          [BiVoid (AtLabel "x")],-          [BiVoid (AtLabel "x"), BiVoid AtRho]-        ),-        ( "[[^ -> ?, x -> ?]] => [[^ -> ?, x -> ?]]",-          [BiVoid AtRho, BiVoid (AtLabel "x")],-          [BiVoid AtRho, BiVoid (AtLabel "x")]-        ),-        ( "[[^ -> Q.x, x -> $.y]] => [[^ -> Q.x, x -> $.y]]",-          [BiTau AtRho (ExDispatch ExGlobal (AtLabel "x")), BiTau AtRho (ExDispatch ExTermination (AtLabel "y"))],-          [BiTau AtRho (ExDispatch ExGlobal (AtLabel "x")), BiTau AtRho (ExDispatch ExTermination (AtLabel "y"))]-        ),-        ("[[!B]] => [[!B]]", [BiMeta "B"], [BiMeta "B"]),-        ("[[x -> ?, !B]] => [[x -> ?, !B]]", [BiVoid (AtLabel "x"), BiMeta "B"], [BiVoid (AtLabel "x"), BiMeta "B"]),-        ( "[[x -> ?, !B, y -> ?]] => [[x -> ?, !B, y -> ?]]",-          [BiVoid (AtLabel "x"), BiMeta "B", BiVoid (AtLabel "y")],-          [BiVoid (AtLabel "x"), BiMeta "B", BiVoid (AtLabel "y")]-        ),-        ( "[[^ -> ?, !B, y -> ?]] => [[^ -> ?, !B, y -> ?]]",-          [BiVoid AtRho, BiMeta "B", BiVoid (AtLabel "y")],-          [BiVoid AtRho, BiMeta "B", BiVoid (AtLabel "y")]-        ),-        ( "[[!a -> ?, x -> $.y]] => [[!a -> Q.x, x -> $.y]]",-          [BiVoid (AtMeta "a"), BiTau AtRho (ExDispatch ExTermination (AtLabel "y"))],-          [BiVoid (AtMeta "a"), BiTau AtRho (ExDispatch ExTermination (AtLabel "y"))]-        ),-        ( "[[!a -> Q.x, x -> $.y]] => [[!a -> Q.x, x -> $.y]]",-          [BiTau (AtMeta "a") (ExDispatch ExGlobal (AtLabel "x")), BiTau AtRho (ExDispatch ExTermination (AtLabel "y"))],-          [BiTau (AtMeta "a") (ExDispatch ExGlobal (AtLabel "x")), BiTau AtRho (ExDispatch ExTermination (AtLabel "y"))]+      [+        ( "[[x -> ?]] => [[x -> ?, ^ -> ?]]"+        , [BiVoid (AtLabel "x")]+        , [BiVoid (AtLabel "x"), BiVoid AtRho]+        )+      ,+        ( "[[^ -> ?, x -> ?]] => [[^ -> ?, x -> ?]]"+        , [BiVoid AtRho, BiVoid (AtLabel "x")]+        , [BiVoid AtRho, BiVoid (AtLabel "x")]+        )+      ,+        ( "[[^ -> Q.x, x -> $.y]] => [[^ -> Q.x, x -> $.y]]"+        , [BiTau AtRho (ExDispatch ExGlobal (AtLabel "x")), BiTau AtRho (ExDispatch ExTermination (AtLabel "y"))]+        , [BiTau AtRho (ExDispatch ExGlobal (AtLabel "x")), BiTau AtRho (ExDispatch ExTermination (AtLabel "y"))]+        )+      , ("[[!B]] => [[!B]]", [BiMeta "B"], [BiMeta "B"])+      , ("[[x -> ?, !B]] => [[x -> ?, !B]]", [BiVoid (AtLabel "x"), BiMeta "B"], [BiVoid (AtLabel "x"), BiMeta "B"])+      ,+        ( "[[x -> ?, !B, y -> ?]] => [[x -> ?, !B, y -> ?]]"+        , [BiVoid (AtLabel "x"), BiMeta "B", BiVoid (AtLabel "y")]+        , [BiVoid (AtLabel "x"), BiMeta "B", BiVoid (AtLabel "y")]+        )+      ,+        ( "[[^ -> ?, !B, y -> ?]] => [[^ -> ?, !B, y -> ?]]"+        , [BiVoid AtRho, BiMeta "B", BiVoid (AtLabel "y")]+        , [BiVoid AtRho, BiMeta "B", BiVoid (AtLabel "y")]+        )+      ,+        ( "[[!a -> ?, x -> $.y]] => [[!a -> Q.x, x -> $.y]]"+        , [BiVoid (AtMeta "a"), BiTau AtRho (ExDispatch ExTermination (AtLabel "y"))]+        , [BiVoid (AtMeta "a"), BiTau AtRho (ExDispatch ExTermination (AtLabel "y"))]+        )+      ,+        ( "[[!a -> Q.x, x -> $.y]] => [[!a -> Q.x, x -> $.y]]"+        , [BiTau (AtMeta "a") (ExDispatch ExGlobal (AtLabel "x")), BiTau AtRho (ExDispatch ExTermination (AtLabel "y"))]+        , [BiTau (AtMeta "a") (ExDispatch ExGlobal (AtLabel "x")), BiTau AtRho (ExDispatch ExTermination (AtLabel "y"))]         )       ] 

@@ -0,0 +1,318 @@+-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+-- SPDX-License-Identifier: MIT++{- | Tests for the Must module that provides constraint specification+for rewriting rules with exact counts and ranges.+-}+module MustSpec where++import Control.Monad (forM_)+import Must (Must (..), exceedsUpperBound, inRange, validateMust)+import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)+import Text.Read (readMaybe)++spec :: Spec+spec = do+  describe "Show instance renders MtDisabled" $+    it "displays zero" $+      show MtDisabled `shouldBe` "0"++  describe "Show instance renders MtExact" $+    forM_+      [ ("positive integer", MtExact 42, "42")+      , ("large integer", MtExact 999999, "999999")+      , ("one", MtExact 1, "1")+      ]+      ( \(desc, must, expected) ->+          it desc $ show must `shouldBe` expected+      )++  describe "Show instance renders MtRange with both bounds" $+    forM_+      [ ("small range", MtRange (Just 1) (Just 5), "1..5")+      , ("same bounds", MtRange (Just 3) (Just 3), "3..3")+      , ("large range", MtRange (Just 0) (Just 1000), "0..1000")+      ]+      ( \(desc, must, expected) ->+          it desc $ show must `shouldBe` expected+      )++  describe "Show instance renders MtRange with only minimum" $+    forM_+      [ ("minimum only", MtRange (Just 5) Nothing, "5..")+      , ("zero minimum", MtRange (Just 0) Nothing, "0..")+      ]+      ( \(desc, must, expected) ->+          it desc $ show must `shouldBe` expected+      )++  describe "Show instance renders MtRange with only maximum" $+    forM_+      [ ("maximum only", MtRange Nothing (Just 10), "..10")+      , ("zero maximum", MtRange Nothing (Just 0), "..0")+      ]+      ( \(desc, must, expected) ->+          it desc $ show must `shouldBe` expected+      )++  describe "Show instance renders MtRange with no bounds" $+    it "displays empty range" $+      show (MtRange Nothing Nothing) `shouldBe` ".."++  describe "Read instance parses zero as MtDisabled" $+    it "parses disabled" $+      (readMaybe "0" :: Maybe Must) `shouldBe` Just MtDisabled++  describe "Read instance parses positive integers as MtExact" $+    forM_+      [ ("single digit", "5", Just (MtExact 5))+      , ("multi digit", "123", Just (MtExact 123))+      , ("large number", "999999", Just (MtExact 999999))+      ]+      ( \(desc, input, expected) ->+          it desc $ (readMaybe input :: Maybe Must) `shouldBe` expected+      )++  describe "Read instance rejects negative integers" $+    forM_+      [ ("negative one", "-1")+      , ("negative large", "-999")+      ]+      ( \(desc, input) ->+          it desc $ (readMaybe input :: Maybe Must) `shouldBe` Nothing+      )++  describe "Read instance rejects non-numeric input" $+    forM_+      [ ("alphabetic", "abc")+      , ("mixed", "12abc")+      , ("empty", "")+      , ("unicode", "日本語")+      ]+      ( \(desc, input) ->+          it desc $ (readMaybe input :: Maybe Must) `shouldBe` Nothing+      )++  describe "Read instance parses full range" $+    forM_+      [ ("simple range", "1..5", Just (MtRange (Just 1) (Just 5)))+      , ("same bounds", "3..3", Just (MtRange (Just 3) (Just 3)))+      , ("zero start", "0..10", Just (MtRange (Just 0) (Just 10)))+      ]+      ( \(desc, input, expected) ->+          it desc $ (readMaybe input :: Maybe Must) `shouldBe` expected+      )++  describe "Read instance parses minimum-only range" $+    forM_+      [ ("with minimum", "5..", Just (MtRange (Just 5) Nothing))+      , ("zero minimum", "0..", Just (MtRange (Just 0) Nothing))+      ]+      ( \(desc, input, expected) ->+          it desc $ (readMaybe input :: Maybe Must) `shouldBe` expected+      )++  describe "Read instance parses maximum-only range" $+    forM_+      [ ("with maximum", "..10", Just (MtRange Nothing (Just 10)))+      , ("zero maximum", "..0", Just (MtRange Nothing (Just 0)))+      ]+      ( \(desc, input, expected) ->+          it desc $ (readMaybe input :: Maybe Must) `shouldBe` expected+      )++  describe "Read instance rejects empty range" $+    it "fails on dots only" $+      (readMaybe ".." :: Maybe Must) `shouldBe` Nothing++  describe "Read instance rejects invalid range with negative minimum" $+    it "fails on negative min" $+      (readMaybe "-1..5" :: Maybe Must) `shouldBe` Nothing++  describe "Read instance rejects invalid range with negative maximum" $+    it "fails on negative max" $+      (readMaybe "1..-5" :: Maybe Must) `shouldBe` Nothing++  describe "Read instance rejects range where min exceeds max" $+    it "fails on inverted range" $+      (readMaybe "10..5" :: Maybe Must) `shouldBe` Nothing++  describe "Read instance rejects non-numeric range parts" $+    forM_+      [ ("alphabetic min", "abc..5")+      , ("alphabetic max", "5..abc")+      , ("both alphabetic", "abc..xyz")+      ]+      ( \(desc, input) ->+          it desc $ (readMaybe input :: Maybe Must) `shouldBe` Nothing+      )++  describe "Eq instance compares MtDisabled" $+    it "equals itself" $+      MtDisabled == MtDisabled `shouldBe` True++  describe "Eq instance compares MtExact" $+    forM_+      [ ("same values equal", MtExact 5, MtExact 5, True)+      , ("different values not equal", MtExact 5, MtExact 10, False)+      ]+      ( \(desc, lhs, rhs, expected) ->+          it desc $ (lhs == rhs) `shouldBe` expected+      )++  describe "Eq instance compares MtRange" $+    forM_+      [ ("same ranges equal", MtRange (Just 1) (Just 5), MtRange (Just 1) (Just 5), True)+      , ("different min not equal", MtRange (Just 1) (Just 5), MtRange (Just 2) (Just 5), False)+      , ("different max not equal", MtRange (Just 1) (Just 5), MtRange (Just 1) (Just 6), False)+      ]+      ( \(desc, lhs, rhs, expected) ->+          it desc $ (lhs == rhs) `shouldBe` expected+      )++  describe "Eq instance compares different types" $+    forM_+      [ ("disabled vs exact", MtDisabled, MtExact 0, False)+      , ("exact vs range", MtExact 5, MtRange (Just 5) (Just 5), False)+      ]+      ( \(desc, lhs, rhs, expected) ->+          it desc $ (lhs == rhs) `shouldBe` expected+      )++  describe "inRange with MtDisabled accepts any value" $+    forM_+      [ ("zero", 0)+      , ("large positive", 999999)+      , ("negative", -42)+      ]+      ( \(desc, val) ->+          it desc $ inRange MtDisabled val `shouldBe` True+      )++  describe "inRange with MtExact checks equality" $+    forM_+      [ ("exact match", MtExact 5, 5, True)+      , ("below exact", MtExact 5, 4, False)+      , ("above exact", MtExact 5, 6, False)+      ]+      ( \(desc, must, val, expected) ->+          it desc $ inRange must val `shouldBe` expected+      )++  describe "inRange with MtRange checks bounds" $+    forM_+      [ ("within range", MtRange (Just 1) (Just 10), 5, True)+      , ("at minimum", MtRange (Just 1) (Just 10), 1, True)+      , ("at maximum", MtRange (Just 1) (Just 10), 10, True)+      , ("below minimum", MtRange (Just 5) (Just 10), 4, False)+      , ("above maximum", MtRange (Just 1) (Just 5), 6, False)+      ]+      ( \(desc, must, val, expected) ->+          it desc $ inRange must val `shouldBe` expected+      )++  describe "inRange with minimum-only range" $+    forM_+      [ ("at minimum", MtRange (Just 5) Nothing, 5, True)+      , ("above minimum", MtRange (Just 5) Nothing, 100, True)+      , ("below minimum", MtRange (Just 5) Nothing, 4, False)+      ]+      ( \(desc, must, val, expected) ->+          it desc $ inRange must val `shouldBe` expected+      )++  describe "inRange with maximum-only range" $+    forM_+      [ ("at maximum", MtRange Nothing (Just 10), 10, True)+      , ("below maximum", MtRange Nothing (Just 10), 0, True)+      , ("above maximum", MtRange Nothing (Just 10), 11, False)+      ]+      ( \(desc, must, val, expected) ->+          it desc $ inRange must val `shouldBe` expected+      )++  describe "inRange with unbounded range" $+    forM_+      [ ("zero", 0)+      , ("large positive", 999999)+      , ("negative", -42)+      ]+      ( \(desc, val) ->+          it desc $ inRange (MtRange Nothing Nothing) val `shouldBe` True+      )++  describe "exceedsUpperBound with MtDisabled" $+    forM_+      [ ("zero", 0)+      , ("large positive", 999999)+      ]+      ( \(desc, val) ->+          it desc $ exceedsUpperBound MtDisabled val `shouldBe` False+      )++  describe "exceedsUpperBound with MtExact" $+    forM_+      [ ("at bound", MtExact 5, 5, False)+      , ("below bound", MtExact 5, 4, False)+      , ("above bound", MtExact 5, 6, True)+      ]+      ( \(desc, must, val, expected) ->+          it desc $ exceedsUpperBound must val `shouldBe` expected+      )++  describe "exceedsUpperBound with MtRange with maximum" $+    forM_+      [ ("at maximum", MtRange (Just 0) (Just 10), 10, False)+      , ("below maximum", MtRange (Just 0) (Just 10), 5, False)+      , ("above maximum", MtRange (Just 0) (Just 10), 11, True)+      ]+      ( \(desc, must, val, expected) ->+          it desc $ exceedsUpperBound must val `shouldBe` expected+      )++  describe "exceedsUpperBound with MtRange without maximum" $+    forM_+      [ ("zero", 0)+      , ("large positive", 999999)+      ]+      ( \(desc, val) ->+          it desc $ exceedsUpperBound (MtRange (Just 0) Nothing) val `shouldBe` False+      )++  describe "validateMust with MtDisabled" $+    it "returns nothing" $+      validateMust MtDisabled `shouldBe` Nothing++  describe "validateMust with valid MtExact" $+    it "returns nothing for positive" $+      validateMust (MtExact 5) `shouldBe` Nothing++  describe "validateMust with valid MtRange" $+    forM_+      [ ("both bounds", MtRange (Just 1) (Just 10))+      , ("minimum only", MtRange (Just 5) Nothing)+      , ("maximum only", MtRange Nothing (Just 10))+      , ("no bounds", MtRange Nothing Nothing)+      ]+      ( \(desc, must) ->+          it desc $ validateMust must `shouldBe` Nothing+      )++  describe "validateMust with inverted MtRange" $+    it "returns error message" $+      validateMust (MtRange (Just 10) (Just 5)) `shouldSatisfy` present++  describe "validateMust with zero MtExact" $+    it "returns error for zero" $+      validateMust (MtExact 0) `shouldSatisfy` present++  describe "validateMust with negative minimum in range" $+    it "returns error for negative min" $+      validateMust (MtRange (Just (-1)) (Just 5)) `shouldSatisfy` present++  describe "validateMust with negative maximum in range" $+    it "returns error for negative max" $+      validateMust (MtRange (Just 0) (Just (-1))) `shouldSatisfy` present+  where+    present (Just _) = True+    present Nothing = False

@@ -30,20 +30,21 @@   describe "parse program" $     test       parseProgram-      [ ("Q -> [[]]", Just (Program (ExFormation [BiVoid AtRho]))),-        ("Q -> T(x -> Q)", Just (Program (ExApplication ExTermination (BiTau (AtLabel "x") ExGlobal)))),-        ("Q -> Q.org.eolang", Just (Program (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")))),-        ("Q -> [[x -> $, y -> ?]]", Just (Program (ExFormation [BiTau (AtLabel "x") ExThis, BiVoid (AtLabel "y"), BiVoid AtRho]))),-        ("{[[foo ↦ QQ]]}", Just (Program (ExFormation [BiTau (AtLabel "foo") (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")), BiVoid AtRho])))+      [ ("Q -> [[]]", Just (Program (ExFormation [BiVoid AtRho])))+      , ("Q -> T(x -> Q)", Just (Program (ExApplication ExTermination (BiTau (AtLabel "x") ExGlobal))))+      , ("Q -> Q.org.eolang", Just (Program (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang"))))+      , ("Q -> [[x -> $, y -> ?]]", Just (Program (ExFormation [BiTau (AtLabel "x") ExThis, BiVoid (AtLabel "y"), BiVoid AtRho])))+      , ("{[[foo ↦ QQ]]}", Just (Program (ExFormation [BiTau (AtLabel "foo") (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")), BiVoid AtRho])))       ]    describe "parse expression" $     test       parseExpression-      [ ("Q.!a", Just (ExDispatch ExGlobal (AtMeta "a"))),-        ("[[]](!a1 -> $)", Just (ExApplication (ExFormation [BiVoid AtRho]) (BiTau (AtMeta "a1") ExThis))),-        ( "[[]](~0 -> $)(~11 -> Q)",-          Just+      [ ("Q.!a", Just (ExDispatch ExGlobal (AtMeta "a")))+      , ("[[]](!a1 -> $)", Just (ExApplication (ExFormation [BiVoid AtRho]) (BiTau (AtMeta "a1") ExThis)))+      ,+        ( "[[]](~0 -> $)(~11 -> Q)"+        , Just             ( ExApplication                 ( ExApplication                     (ExFormation [BiVoid AtRho])@@ -51,78 +52,82 @@                 )                 (BiTau (AtAlpha 11) ExGlobal)             )-        ),-        ("[[]](x -> $, y -> Q)", Just (ExApplication (ExApplication (ExFormation [BiVoid AtRho]) (BiTau (AtLabel "x") ExThis)) (BiTau (AtLabel "y") ExGlobal))),-        ("[[!B, !B1]]", Just (ExFormation [BiMeta "B", BiMeta "B1"])),-        ("[[!B2, !a2 -> $]]", Just (ExFormation [BiMeta "B2", BiTau (AtMeta "a2") ExThis])),-        ("!e0", Just (ExMeta "e0")),-        ("[[x -> !e]]", Just (ExFormation [BiTau (AtLabel "x") (ExMeta "e"), BiVoid AtRho])),-        ("[[!a -> !e1]]", Just (ExFormation [BiTau (AtMeta "a") (ExMeta "e1")])),-        ("Q * !t", Just (ExMetaTail ExGlobal "t")),-        ("[[]](x -> $) * !t1", Just (ExMetaTail (ExApplication (ExFormation [BiVoid AtRho]) (BiTau (AtLabel "x") ExThis)) "t1")),-        ("[[D> --]]", Just (ExFormation [BiDelta BtEmpty, BiVoid AtRho])),-        ("[[D> 1F-]]", Just (ExFormation [BiDelta (BtOne "1F"), BiVoid AtRho])),-        ("[[\n  L> Func,\n  D> 00-\n]]", Just (ExFormation [BiLambda "Func", BiDelta (BtOne "00"), BiVoid AtRho])),-        ("[[D> 1F-2A-00]]", Just (ExFormation [BiDelta (BtMany ["1F", "2A", "00"]), BiVoid AtRho])),-        ("[[D> !d0]]", Just (ExFormation [BiDelta (BtMeta "d0"), BiVoid AtRho])),-        ("[[L> Function]]", Just (ExFormation [BiLambda "Function", BiVoid AtRho])),-        ("[[L> !F3]]", Just (ExFormation [BiMetaLambda "F3", BiVoid AtRho])),-        ("[[x() -> [[]] ]]", Just (ExFormation [BiTau (AtLabel "x") (ExFormation [BiVoid AtRho]), BiVoid AtRho])),-        ( "[[y(^,@,z) -> [[q -> Q.a]] ]]",-          Just+        )+      , ("[[]](x -> $, y -> Q)", Just (ExApplication (ExApplication (ExFormation [BiVoid AtRho]) (BiTau (AtLabel "x") ExThis)) (BiTau (AtLabel "y") ExGlobal)))+      , ("[[!B, !B1]]", Just (ExFormation [BiMeta "B", BiMeta "B1"]))+      , ("[[!B2, !a2 -> $]]", Just (ExFormation [BiMeta "B2", BiTau (AtMeta "a2") ExThis]))+      , ("!e0", Just (ExMeta "e0"))+      , ("[[x -> !e]]", Just (ExFormation [BiTau (AtLabel "x") (ExMeta "e"), BiVoid AtRho]))+      , ("[[!a -> !e1]]", Just (ExFormation [BiTau (AtMeta "a") (ExMeta "e1")]))+      , ("Q * !t", Just (ExMetaTail ExGlobal "t"))+      , ("[[]](x -> $) * !t1", Just (ExMetaTail (ExApplication (ExFormation [BiVoid AtRho]) (BiTau (AtLabel "x") ExThis)) "t1"))+      , ("[[D> --]]", Just (ExFormation [BiDelta BtEmpty, BiVoid AtRho]))+      , ("[[D> 1F-]]", Just (ExFormation [BiDelta (BtOne "1F"), BiVoid AtRho]))+      , ("[[\n  L> Func,\n  D> 00-\n]]", Just (ExFormation [BiLambda "Func", BiDelta (BtOne "00"), BiVoid AtRho]))+      , ("[[D> 1F-2A-00]]", Just (ExFormation [BiDelta (BtMany ["1F", "2A", "00"]), BiVoid AtRho]))+      , ("[[D> !d0]]", Just (ExFormation [BiDelta (BtMeta "d0"), BiVoid AtRho]))+      , ("[[L> Function]]", Just (ExFormation [BiLambda "Function", BiVoid AtRho]))+      , ("[[L> !F3]]", Just (ExFormation [BiMetaLambda "F3", BiVoid AtRho]))+      , ("[[x() -> [[]] ]]", Just (ExFormation [BiTau (AtLabel "x") (ExFormation [BiVoid AtRho]), BiVoid AtRho]))+      ,+        ( "[[y(^,@,z) -> [[q -> Q.a]] ]]"+        , Just             ( ExFormation                 [ BiTau                     (AtLabel "y")                     ( ExFormation-                        [ BiVoid AtRho,-                          BiVoid AtPhi,-                          BiVoid (AtLabel "z"),-                          BiTau (AtLabel "q") (ExDispatch ExGlobal (AtLabel "a"))+                        [ BiVoid AtRho+                        , BiVoid AtPhi+                        , BiVoid (AtLabel "z")+                        , BiTau (AtLabel "q") (ExDispatch ExGlobal (AtLabel "a"))                         ]-                    ),-                  BiVoid AtRho+                    )+                , BiVoid AtRho                 ]             )-        ),-        ( "!e(x(^,@) -> [[w -> !e1]])",-          Just+        )+      ,+        ( "!e(x(^,@) -> [[w -> !e1]])"+        , Just             ( ExApplication                 (ExMeta "e")                 ( BiTau                     (AtLabel "x")                     ( ExFormation-                        [ BiVoid AtRho,-                          BiVoid AtPhi,-                          BiTau (AtLabel "w") (ExMeta "e1")+                        [ BiVoid AtRho+                        , BiVoid AtPhi+                        , BiTau (AtLabel "w") (ExMeta "e1")                         ]                     )                 )             )-        ),-        ( "[[x -> y.z, w -> ^, u -> @, p -> !a, q -> !e]]",-          Just+        )+      ,+        ( "[[x -> y.z, w -> ^, u -> @, p -> !a, q -> !e]]"+        , Just             ( ExFormation                 [ BiTau                     (AtLabel "x")-                    (ExDispatch (ExDispatch ExThis (AtLabel "y")) (AtLabel "z")),-                  BiTau+                    (ExDispatch (ExDispatch ExThis (AtLabel "y")) (AtLabel "z"))+                , BiTau                     (AtLabel "w")-                    (ExDispatch ExThis AtRho),-                  BiTau+                    (ExDispatch ExThis AtRho)+                , BiTau                     (AtLabel "u")-                    (ExDispatch ExThis AtPhi),-                  BiTau+                    (ExDispatch ExThis AtPhi)+                , BiTau                     (AtLabel "p")-                    (ExDispatch ExThis (AtMeta "a")),-                  BiTau+                    (ExDispatch ExThis (AtMeta "a"))+                , BiTau                     (AtLabel "q")-                    (ExMeta "e"),-                  BiVoid AtRho+                    (ExMeta "e")+                , BiVoid AtRho                 ]             )-        ),-        ( "Q.x(y, [[]].z, Q.y(^,@))",-          Just+        )+      ,+        ( "Q.x(y, [[]].z, Q.y(^,@))"+        , Just             ( ExApplication                 ( ExApplication                     ( ExApplication@@ -142,9 +147,10 @@                     )                 )             )-        ),-        ( "5.plus(5.q(\"hello\".length))",-          Just+        )+      ,+        ( "5.plus(5.q(\"hello\".length))"+        , Just             ( ExApplication                 ( ExDispatch                     (DataNumber (BtMany ["40", "14", "00", "00", "00", "00", "00", "00"]))@@ -167,13 +173,14 @@                     )                 )             )-        ),-        ( "[[𝐵1, 𝜏0 -> $, x -> 𝑒]]",-          Just+        )+      ,+        ( "[[𝐵1, 𝜏0 -> $, x -> 𝑒]]"+        , Just             ( ExFormation-                [ BiMeta "B1",-                  BiTau (AtMeta "a0") ExThis,-                  BiTau (AtLabel "x") (ExMeta "e")+                [ BiMeta "B1"+                , BiTau (AtMeta "a0") ExThis+                , BiTau (AtLabel "x") (ExMeta "e")                 ]             )         )@@ -181,26 +188,26 @@    describe "just parses" $     forM_-      [ "[[x -> $, y -> ?]]",-        "[[x() -> [[]] ]]",-        "[[x(^, @, y) -> [[q -> QQ]] ]]",-        "Q.x(y() -> [[]])",-        "Q.x(y(q) -> [[w -> !e]])",-        "Q.x(~1(^,@) -> [[]])",-        "Q.x.^.@.!a0",-        "[[x -> y.z]]",-        "[[x -> ^, y -> @, z -> !a]]",-        "Q.x(a.b.c, Q.a(b), [[]])",-        "Q.x(y, [[]].z, Q.y(^,@))",-        "[[x -> 5.plus(5), y -> \"hello\", z -> 42.5]]",-        "[[\n  x -> \"Hi\",\n  y -> 42\n]]",-        "[[x -> -42, y -> +34]]",-        "⟦x ↦ Φ.org.eolang(z ↦ ξ.f, φ ↦ ρ, t ↦ φ, first ↦ ⟦ λ ⤍ Function_name, Δ ⤍ 42- ⟧)⟧",-        "[[x -> 1.00e+3, y -> 2.32e-4]]",-        "[[ x -> \"\\u0001\\u0001\"]]",-        "[[ x -> \"\\uD835\\uDF11\"]]",-        "[[ x ↦ \"This plugin has \\x01\\x01\" ]]",-        "[[ !afoo -> !e1Some, !a-BAR -> !e_123someW, !Bhi123 ]]"+      [ "[[x -> $, y -> ?]]"+      , "[[x() -> [[]] ]]"+      , "[[x(^, @, y) -> [[q -> QQ]] ]]"+      , "Q.x(y() -> [[]])"+      , "Q.x(y(q) -> [[w -> !e]])"+      , "Q.x(~1(^,@) -> [[]])"+      , "Q.x.^.@.!a0"+      , "[[x -> y.z]]"+      , "[[x -> ^, y -> @, z -> !a]]"+      , "Q.x(a.b.c, Q.a(b), [[]])"+      , "Q.x(y, [[]].z, Q.y(^,@))"+      , "[[x -> 5.plus(5), y -> \"hello\", z -> 42.5]]"+      , "[[\n  x -> \"Hi\",\n  y -> 42\n]]"+      , "[[x -> -42, y -> +34]]"+      , "⟦x ↦ Φ.org.eolang(z ↦ ξ.f, φ ↦ ρ, t ↦ φ, first ↦ ⟦ λ ⤍ Function_name, Δ ⤍ 42- ⟧)⟧"+      , "[[x -> 1.00e+3, y -> 2.32e-4]]"+      , "[[ x -> \"\\u0001\\u0001\"]]"+      , "[[ x -> \"\\uD835\\uDF11\"]]"+      , "[[ x ↦ \"This plugin has \\x01\\x01\" ]]"+      , "[[ !afoo -> !e1Some, !a-BAR -> !e_123someW, !Bhi123 ]]"       ]       (\expr -> it expr (parseExpression expr `shouldSatisfy` isRight)) @@ -209,31 +216,31 @@       parseExpression       ( map           (\input -> (input, Nothing))-          [ "Q.x()",-            "Q * !t1 * !t2",-            "Q(x -> [[]])",-            "$(x -> [[]])",-            "Q.x(x -> ?)",-            "Q.x(L> Func)",-            "Q.x(D> --)",-            "Q.x(~1 -> ?)",-            "Q.x(L> !F)",-            "Q.x(D> !b)",-            "[[~0 -> Q.x]]",-            "[[x(~1) -> [[]] ]]",-            "[[y(!e) -> [[]] ]]",-            "[[z(w) -> Q.x]]",-            "Q.x(y(~1) -> [[]])",-            "Q.x(1, 2, !B)",-            "Q.x.~0",-            "Q.x(~1 -> Q.y, x -> 5, !B1)",-            "Q.x(𝐵1, 𝜏0 -> $, x -> 𝑒)",-            "[[ x -> \"\\uD800\"]]",-            "[[ x -> \"\\uDFFF\"]]",-            "[[ x -> \"\\uD835\\u0041\"]]",-            "[[ x -> 1, x -> 2 ]]",-            "⟦ k ↦ ⟦ λ ⤍ Foo, λ ⤍ Bar ⟧ ⟧",-            "⟦ k ↦ ⟦ Δ ⤍ 42-, Δ ⤍ 55- ⟧ ⟧"+          [ "Q.x()"+          , "Q * !t1 * !t2"+          , "Q(x -> [[]])"+          , "$(x -> [[]])"+          , "Q.x(x -> ?)"+          , "Q.x(L> Func)"+          , "Q.x(D> --)"+          , "Q.x(~1 -> ?)"+          , "Q.x(L> !F)"+          , "Q.x(D> !b)"+          , "[[~0 -> Q.x]]"+          , "[[x(~1) -> [[]] ]]"+          , "[[y(!e) -> [[]] ]]"+          , "[[z(w) -> Q.x]]"+          , "Q.x(y(~1) -> [[]])"+          , "Q.x(1, 2, !B)"+          , "Q.x.~0"+          , "Q.x(~1 -> Q.y, x -> 5, !B1)"+          , "Q.x(𝐵1, 𝜏0 -> $, x -> 𝑒)"+          , "[[ x -> \"\\uD800\"]]"+          , "[[ x -> \"\\uDFFF\"]]"+          , "[[ x -> \"\\uD835\\u0041\"]]"+          , "[[ x -> 1, x -> 2 ]]"+          , "⟦ k ↦ ⟦ λ ⤍ Foo, λ ⤍ Bar ⟧ ⟧"+          , "⟦ k ↦ ⟦ Δ ⤍ 42-, Δ ⤍ 55- ⟧ ⟧"           ]       ) 

@@ -0,0 +1,244 @@+-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+-- SPDX-License-Identifier: MIT++{- | Tests for the Printer module that converts AST to string representation.+The module provides functions to print phi-calculus expressions with+various configurations for sugar, encoding, and line format.+-}+module PrinterSpec where++import AST+import Control.Monad (forM_)+import Data.Map.Strict qualified as Map+import Encoding (Encoding (..))+import Lining (LineFormat (..))+import Matcher (MetaValue (..), Subst (..), Tail (..), defaultScope)+import Printer+import Sugar (SugarType (..))+import Test.Hspec (Spec, describe, it, shouldBe, shouldContain)+import Yaml (ExtraArgument (..))++spec :: Spec+spec = do+  describe "printExpression with ASCII singleline renders primitives" $+    forM_+      [ ("ξ renders as $", ExThis, "$")+      , ("Φ renders as Q", ExGlobal, "Q")+      , ("⊥ renders as T", ExTermination, "T")+      ]+      ( \(desc, expr, expected) ->+          it desc (printExpression' expr (SWEET, ASCII, SINGLELINE) `shouldBe` expected)+      )++  describe "printExpression with ASCII singleline renders formation with void" $+    forM_+      [ ("ρ void becomes empty", ExFormation [BiVoid AtRho], "[[]]")+      , ("φ void", ExFormation [BiVoid AtPhi], "[[ @ -> ? ]]")+      , ("label void", ExFormation [BiVoid (AtLabel "名前")], "[[ 名前 -> ? ]]")+      ]+      ( \(desc, expr, expected) ->+          it desc (printExpression' expr (SWEET, ASCII, SINGLELINE) `shouldBe` expected)+      )++  describe "printExpression with ASCII singleline renders formation with tau" $+    forM_+      [ ("x to Φ", ExFormation [BiTau (AtLabel "x") ExGlobal], "[[ x -> Q ]]")+      , ("α0 to ξ", ExFormation [BiTau (AtAlpha 0) ExThis], "[[ ~0 -> $ ]]")+      , ("ρ to ⊥", ExFormation [BiTau AtRho ExTermination], "[[ ^ -> T ]]")+      ]+      ( \(desc, expr, expected) ->+          it desc (printExpression' expr (SWEET, ASCII, SINGLELINE) `shouldBe` expected)+      )++  describe "printExpression with ASCII singleline renders formation with delta" $+    forM_+      [ ("empty delta", ExFormation [BiDelta BtEmpty], "[[ D> -- ]]")+      , ("single byte", ExFormation [BiDelta (BtOne "1F")], "[[ D> 1F- ]]")+      , ("multiple bytes", ExFormation [BiDelta (BtMany ["00", "01", "02"])], "[[ D> 00-01-02 ]]")+      ]+      ( \(desc, expr, expected) ->+          it desc (printExpression' expr (SWEET, ASCII, SINGLELINE) `shouldBe` expected)+      )++  describe "printExpression with ASCII singleline renders formation with lambda" $+    forM_+      [ ("función lambda", ExFormation [BiLambda "Función"], "[[ L> Función ]]")+      , ("クラス lambda", ExFormation [BiLambda "クラス"], "[[ L> クラス ]]")+      ]+      ( \(desc, expr, expected) ->+          it desc (printExpression' expr (SWEET, ASCII, SINGLELINE) `shouldBe` expected)+      )++  describe "printExpression with ASCII singleline renders dispatch" $+    forM_+      [ ("Φ.org", ExDispatch ExGlobal (AtLabel "org"), "Q.org")+      , ("ξ.ρ as sugar", ExDispatch ExThis AtRho, "^")+      , ("ξ.φ as sugar", ExDispatch ExThis AtPhi, "@")+      , ("chained dispatch", ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "éolang"), "Q.org.éolang")+      , ("ξ.α0 as sugar", ExDispatch ExThis (AtAlpha 0), "~0")+      ]+      ( \(desc, expr, expected) ->+          it desc (printExpression' expr (SWEET, ASCII, SINGLELINE) `shouldBe` expected)+      )++  describe "printExpression with ASCII singleline renders application" $+    forM_+      [+        ( "dispatch with app"+        , ExApplication (ExDispatch ExGlobal (AtLabel "x")) (BiTau (AtLabel "y") ExThis)+        , "Q.x( y -> $ )"+        )+      ,+        ( "formation with app"+        , ExApplication (ExFormation [BiVoid AtRho]) (BiTau (AtAlpha 0) ExGlobal)+        , "[[]]( Q )"+        )+      ]+      ( \(desc, expr, expected) ->+          it desc (printExpression' expr (SWEET, ASCII, SINGLELINE) `shouldBe` expected)+      )++  describe "printExpression with ASCII singleline renders meta expressions" $+    forM_+      [ ("meta expr", ExMeta "e", "!e")+      , ("meta tail", ExMetaTail ExGlobal "t", "Q * !t")+      ]+      ( \(desc, expr, expected) ->+          it desc (printExpression' expr (SWEET, ASCII, SINGLELINE) `shouldBe` expected)+      )++  describe "printExpression with ASCII singleline renders meta bindings" $+    forM_+      [ ("meta binding", ExFormation [BiMeta "B"], "[[ !B ]]")+      , ("meta lambda", ExFormation [BiMetaLambda "F"], "[[ L> !F ]]")+      , ("meta attr tau", ExFormation [BiTau (AtMeta "a") ExThis], "[[ !a -> $ ]]")+      ]+      ( \(desc, expr, expected) ->+          it desc (printExpression' expr (SWEET, ASCII, SINGLELINE) `shouldBe` expected)+      )++  describe "printProgram with default config" $+    forM_+      [ ("empty formation", Program (ExFormation [BiVoid AtRho]), "{⟦⟧}")+      , ("dispatch", Program (ExDispatch ExGlobal (AtLabel "org")), "{Φ.org}")+      ]+      ( \(desc, prog, expected) ->+          it desc (printProgram prog `shouldBe` expected)+      )++  describe "printAttribute with default encoding" $+    forM_+      [ ("label", AtLabel "attr", "attr")+      , ("ρ", AtRho, "ρ")+      , ("φ", AtPhi, "φ")+      , ("α42", AtAlpha 42, "α42")+      , ("λ", AtLambda, "λ")+      , ("Δ", AtDelta, "Δ")+      ]+      ( \(desc, attr, expected) ->+          it desc (printAttribute attr `shouldBe` expected)+      )++  describe "printAttribute in ASCII dispatch expression with sugar" $+    forM_+      [ ("ρ as caret", AtRho, "^")+      , ("φ as at", AtPhi, "@")+      , ("αN as tildeN", AtAlpha 42, "~42")+      ]+      ( \(desc, attr, expected) ->+          it desc (printExpression' (ExDispatch ExThis attr) (SWEET, ASCII, SINGLELINE) `shouldBe` expected)+      )++  describe "printBinding renders as formation" $+    forM_+      [ ("tau binding", BiTau (AtLabel "x") ExGlobal, "x ↦ Φ")+      , ("void binding", BiVoid (AtLabel "y"), "y ↦ ∅")+      , ("delta binding", BiDelta (BtOne "00"), "Δ ⤍ 00-")+      , ("lambda binding", BiLambda "Func", "λ ⤍ Func")+      ]+      ( \(desc, bd, expected) ->+          it desc (printBinding bd `shouldContain` expected)+      )++  describe "printBytes renders bytes" $+    forM_+      [ ("empty bytes", BtEmpty, "--")+      , ("single byte", BtOne "1F", "1F-")+      , ("multiple bytes", BtMany ["00", "01", "02"], "00-01-02")+      ]+      ( \(desc, bts, expected) ->+          it desc (printBytes bts `shouldBe` expected)+      )++  describe "printExtraArg renders arguments" $+    forM_+      [ ("attribute arg", ArgAttribute (AtLabel "tëst"), "tëst")+      , ("binding arg", ArgBinding (BiVoid (AtLabel "βind")), "βind ↦ ∅")+      , ("expression arg", ArgExpression ExGlobal, "Φ")+      , ("bytes arg", ArgBytes (BtOne "FF"), "FF-")+      ]+      ( \(desc, arg, expected) ->+          it desc (printExtraArg arg `shouldContain` expected)+      )++  describe "printSubsts renders empty list" $+    it "returns separator" $+      printSubsts [] `shouldBe` "------"++  describe "printSubsts renders attribute substitution" $+    it "contains key and value" $+      printSubsts [Subst (Map.singleton "α" (MvAttribute (AtLabel "ατρ")))]+        `shouldContain` "α >> ατρ"++  describe "printSubsts renders multiple substitutions" $+    it "separates with dashed line" $+      let substs =+            [ Subst (Map.singleton "a" (MvAttribute AtRho))+            , Subst (Map.singleton "b" (MvAttribute AtPhi))+            ]+       in printSubsts substs `shouldContain` "------"++  describe "printSubsts renders expression value" $+    it "contains expression" $+      printSubsts [Subst (Map.singleton "e" (MvExpression ExGlobal defaultScope))]+        `shouldContain` "e >> Φ"++  describe "printSubsts renders bindings value" $+    it "contains bindings header" $+      printSubsts [Subst (Map.singleton "B" (MvBindings [BiVoid (AtLabel "x")]))]+        `shouldContain` "B >> ⟦"++  describe "printSubsts renders bytes value" $+    it "contains bytes" $+      printSubsts [Subst (Map.singleton "d" (MvBytes (BtMany ["AB", "CD"])))]+        `shouldContain` "d >> AB-CD"++  describe "printSubsts renders function value" $+    it "contains function name" $+      printSubsts [Subst (Map.singleton "F" (MvFunction "MyFunc"))]+        `shouldContain` "F >> MyFunc"++  describe "printSubsts renders tail value with dispatch" $+    it "contains dispatch" $+      printSubsts [Subst (Map.singleton "t" (MvTail [TaDispatch (AtLabel "attr")]))]+        `shouldContain` "t >> .attr"++  describe "printSubsts renders tail value with application" $+    it "contains application" $+      printSubsts [Subst (Map.singleton "t" (MvTail [TaApplication (BiTau (AtLabel "x") ExThis)]))]+        `shouldContain` "(⟦"++  describe "printExpression with salty config" $+    it "adds explicit rho binding" $+      printExpression' (ExFormation [BiVoid (AtLabel "x")]) (SALTY, UNICODE, SINGLELINE)+        `shouldContain` "ρ ↦ ∅"++  describe "printExpression with multiline format" $+    it "adds newlines in formation" $+      let expr = ExFormation [BiTau (AtLabel "x") ExGlobal, BiVoid (AtLabel "y")]+          result = printExpression' expr (SWEET, UNICODE, MULTILINE)+       in result `shouldContain` "\n"++  describe "logPrintConfig" $+    it "is sweet unicode singleline" $+      logPrintConfig `shouldBe` (SWEET, UNICODE, SINGLELINE)

@@ -0,0 +1,150 @@+-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+-- SPDX-License-Identifier: MIT++{- | Tests for the Random module that provides random string generation+with pattern substitution for unique identifier creation.+Attention! Most of the tests are generated by LLM. Consider that when refactoring+-}+module RandomSpec where++import Data.Char (isDigit, isHexDigit)+import Data.Set qualified as Set+import Random (randomString)+import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)++spec :: Spec+spec = do+  describe "randomString with empty pattern" $+    it "returns empty string" $ do+      result <- randomString ""+      result `shouldBe` ""++  describe "randomString with literal pattern" $+    it "returns literal unchanged" $ do+      result <- randomString "hello"+      result `shouldBe` "hello"++  describe "randomString with literal pattern containing spaces" $+    it "returns literal with spaces" $ do+      result <- randomString "hello world"+      result `shouldBe` "hello world"++  describe "randomString with %d pattern" $+    it "generates numeric digits" $ do+      result <- randomString "%d"+      result `shouldSatisfy` all isDigit++  describe "randomString with %d pattern length" $+    it "generates 1-4 digit number" $ do+      result <- randomString "%d"+      let len = length result+      len `shouldSatisfy` (\l -> l >= 1 && l <= 4)++  describe "randomString with %x pattern" $+    it "generates hex digits" $ do+      result <- randomString "%x"+      result `shouldSatisfy` all isHexDigit++  describe "randomString with %x pattern length" $+    it "generates exactly 8 hex chars" $ do+      result <- randomString "%x"+      length result `shouldBe` 8++  describe "randomString with unknown % pattern" $+    it "preserves unknown pattern" $ do+      result <- randomString "%q"+      result `shouldBe` "%q"++  describe "randomString with unknown % pattern z" $+    it "preserves %z pattern" $ do+      result <- randomString "%z"+      result `shouldBe` "%z"++  describe "randomString with prefix and %d" $+    it "combines prefix with digits" $ do+      result <- randomString "id_%d"+      result `shouldSatisfy` (\s -> take 3 s == "id_")++  describe "randomString with suffix and %d" $+    it "combines digits with suffix" $ do+      result <- randomString "%d_end"+      result `shouldSatisfy` (\s -> drop (length s - 4) s == "_end")++  describe "randomString with prefix and %x" $+    it "combines prefix with hex" $ do+      result <- randomString "hex_%x"+      result `shouldSatisfy` (\s -> take 4 s == "hex_" && length s == 12)++  describe "randomString with suffix and %x" $+    it "combines hex with suffix" $ do+      result <- randomString "%x_end"+      result `shouldSatisfy` (\s -> drop 8 s == "_end" && length s == 12)++  describe "randomString with multiple %d patterns" $+    it "replaces all %d patterns" $ do+      result <- randomString "%d-%d"+      result `shouldSatisfy` (\s -> '-' `elem` s)++  describe "randomString with multiple %x patterns" $+    it "replaces all %x patterns" $ do+      result <- randomString "%x-%x"+      let parts = wordsBy (== '-') result+      length parts `shouldBe` 2++  describe "randomString with mixed patterns" $+    it "handles %d and %x together" $ do+      result <- randomString "a%db%xc"+      result `shouldSatisfy` (\s -> head s == 'a')++  describe "randomString generates unique strings" $+    it "produces different results on repeated calls" $ do+      results <- mapM (const (randomString "test_%d")) [1 :: Int .. 10]+      let unique = Set.fromList results+      Set.size unique `shouldBe` 10++  describe "randomString with %x generates unique strings" $+    it "produces different hex results" $ do+      results <- mapM (const (randomString "%x")) [1 :: Int .. 5]+      let unique = Set.fromList results+      Set.size unique `shouldBe` 5++  describe "randomString with complex pattern" $+    it "handles prefix_%d_middle_%x_suffix" $ do+      result <- randomString "pre_%d_mid_%x_suf"+      result `shouldSatisfy` (\s -> take 4 s == "pre_")++  describe "randomString with trailing percent" $+    it "preserves trailing percent" $ do+      result <- randomString "test%"+      result `shouldBe` "test%"++  describe "randomString with double percent" $+    it "handles %% as unknown pattern" $ do+      result <- randomString "%%"+      result `shouldBe` "%%"++  describe "randomString with special chars" $+    it "preserves special characters" $ do+      result <- randomString "a!@#b"+      result `shouldBe` "a!@#b"++  describe "randomString with unicode" $+    it "preserves unicode characters" $ do+      result <- randomString "test"+      result `shouldBe` "test"++  describe "randomString %d range" $+    it "generates numbers in 0-9999 range" $ do+      result <- randomString "%d"+      let num = read result :: Int+      num `shouldSatisfy` (\n -> n >= 0 && n <= 9999)++  describe "randomString %x chars" $+    it "generates lowercase hex digits" $ do+      result <- randomString "%x"+      result `shouldSatisfy` all (\c -> isHexDigit c && (isDigit c || c `elem` "abcdef"))++wordsBy :: (Char -> Bool) -> String -> [String]+wordsBy predicate str = case dropWhile predicate str of+  "" -> []+  str' -> let (word, rest) = break predicate str' in word : wordsBy predicate rest

@@ -8,60 +8,63 @@ import Replacer import Test.Hspec (Example (Arg), Expectation, Spec, SpecWith, describe, it, shouldBe) -test :: ReplaceProgramFunc -> [(String, Program, [Expression], [Expression], Maybe Program)] -> SpecWith (Arg Expectation)+test :: ReplaceProgramFunc -> [(String, Program, [Expression], [Expression], Program)] -> SpecWith (Arg Expectation) test function useCases =   forM_ useCases $ \(desc, prog, ptns, repls, res) ->-    it desc $ function ptns repls (ReplaceProgramContext prog 3) `shouldBe` res+    it desc $ function (prog, ptns, map const repls) `shouldBe` res  spec :: Spec spec = do   describe "replace program: Program => ([Expression], [Expression]) => Program" $     test       replaceProgram-      [ ( "Q -> Q.y.x => ([Q.y], [$]) => Q -> $.x",-          Program (ExDispatch (ExDispatch ExGlobal (AtLabel "y")) (AtLabel "x")),-          [ExDispatch ExGlobal (AtLabel "y")],-          [ExThis],-          Just (Program (ExDispatch ExThis (AtLabel "x")))-        ),-        ( "Q -> [[x -> [[y -> $]], z -> [[w -> $]] ]] => ([[y -> $], [w -> $]], [Q.y, Q.w]) => Q -> [[x -> Q.y, z -> Q.w]]",-          Program+      [+        ( "Q -> Q.y.x => ([Q.y], [$]) => Q -> $.x"+        , Program (ExDispatch (ExDispatch ExGlobal (AtLabel "y")) (AtLabel "x"))+        , [ExDispatch ExGlobal (AtLabel "y")]+        , [ExThis]+        , Program (ExDispatch ExThis (AtLabel "x"))+        )+      ,+        ( "Q -> [[x -> [[y -> $]], z -> [[w -> $]] ]] => ([[y -> $], [w -> $]], [Q.y, Q.w]) => Q -> [[x -> Q.y, z -> Q.w]]"+        , Program             ( ExFormation-                [ BiTau (AtLabel "x") (ExFormation [BiTau (AtLabel "y") ExThis]),-                  BiTau (AtLabel "z") (ExFormation [BiTau (AtLabel "w") ExThis])+                [ BiTau (AtLabel "x") (ExFormation [BiTau (AtLabel "y") ExThis])+                , BiTau (AtLabel "z") (ExFormation [BiTau (AtLabel "w") ExThis])                 ]-            ),-          [ExFormation [BiTau (AtLabel "y") ExThis], ExFormation [BiTau (AtLabel "w") ExThis]],-          [ExDispatch ExGlobal (AtLabel "y"), ExDispatch ExGlobal (AtLabel "w")],-          Just-            ( Program-                ( ExFormation-                    [ BiTau (AtLabel "x") (ExDispatch ExGlobal (AtLabel "y")),-                      BiTau (AtLabel "z") (ExDispatch ExGlobal (AtLabel "w"))-                    ]-                )             )-        ),-        ("Q -> [[]] => ([], [$]) => X", Program (ExFormation []), [], [ExThis], Nothing),-        ( "Q -> [[L> Func, D> 00-]] => ([ [[L> Func, D> 00-]] ], [Q]) => Q -> Q",-          Program (ExFormation [BiLambda "Func", BiDelta (BtOne "00")]),-          [ExFormation [BiLambda "Func", BiDelta (BtOne "00")]],-          [ExGlobal],-          Just (Program ExGlobal)-        ),-        ( "Q -> Q.org.eolang => ([Q.org.eolang, Q.org], [$, $]) => $",-          Program (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")),-          [ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang"), ExDispatch ExGlobal (AtLabel "org")],-          [ExThis, ExThis],-          Just (Program ExThis)-        ),-        ( "Q -> [[ x -> $.t, t -> ? ]].t(^ -> [[ x -> $.t, t -> ? ]]) => ([ [[ x -> $.t, t -> ? ]].t ], [T]) => T(^ -> [[ x -> $.t, t -> ? ]])",-          Program+        , [ExFormation [BiTau (AtLabel "y") ExThis], ExFormation [BiTau (AtLabel "w") ExThis]]+        , [ExDispatch ExGlobal (AtLabel "y"), ExDispatch ExGlobal (AtLabel "w")]+        , Program+            ( ExFormation+                [ BiTau (AtLabel "x") (ExDispatch ExGlobal (AtLabel "y"))+                , BiTau (AtLabel "z") (ExDispatch ExGlobal (AtLabel "w"))+                ]+            )+        )+      , ("Q -> [[]] => ([], [$]) => X", Program (ExFormation []), [], [ExThis], Program (ExFormation []))+      ,+        ( "Q -> [[L> Func, D> 00-]] => ([ [[L> Func, D> 00-]] ], [Q]) => Q -> Q"+        , Program (ExFormation [BiLambda "Func", BiDelta (BtOne "00")])+        , [ExFormation [BiLambda "Func", BiDelta (BtOne "00")]]+        , [ExGlobal]+        , Program ExGlobal+        )+      ,+        ( "Q -> Q.org.eolang => ([Q.org.eolang, Q.org], [$, $]) => $"+        , Program (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang"))+        , [ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang"), ExDispatch ExGlobal (AtLabel "org")]+        , [ExThis, ExThis]+        , Program ExThis+        )+      ,+        ( "Q -> [[ x -> $.t, t -> ? ]].t(^ -> [[ x -> $.t, t -> ? ]]) => ([ [[ x -> $.t, t -> ? ]].t ], [T]) => T(^ -> [[ x -> $.t, t -> ? ]])"+        , Program             ( ExApplication                 ( ExDispatch                     ( ExFormation-                        [ BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t")),-                          BiVoid (AtLabel "t")+                        [ BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t"))+                        , BiVoid (AtLabel "t")                         ]                     )                     (AtLabel "t")@@ -69,32 +72,31 @@                 ( BiTau                     AtRho                     ( ExFormation-                        [ BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t")),-                          BiVoid (AtLabel "t")+                        [ BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t"))+                        , BiVoid (AtLabel "t")                         ]                     )                 )-            ),+            )+        ,           [ ExDispatch               ( ExFormation-                  [ BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t")),-                    BiVoid (AtLabel "t")+                  [ BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t"))+                  , BiVoid (AtLabel "t")                   ]               )               (AtLabel "t")-          ],-          [ExTermination],-          Just-            ( Program-                ( ExApplication-                    ExTermination-                    ( BiTau-                        AtRho-                        ( ExFormation-                            [ BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t")),-                              BiVoid (AtLabel "t")-                            ]-                        )+          ]+        , [ExTermination]+        , Program+            ( ExApplication+                ExTermination+                ( BiTau+                    AtRho+                    ( ExFormation+                        [ BiTau (AtLabel "x") (ExDispatch ExThis (AtLabel "t"))+                        , BiVoid (AtLabel "t")+                        ]                     )                 )             )@@ -103,23 +105,26 @@    describe "replace program fast: Program => ([Expression], [Expression]) => Program" $     test-      replaceProgramFast-      [ ( "Q -> [[^ -> ?, @ -> ?, D> -> ?]] => [[ !B1, !a -> ?, !B2 ]] => [[ !B1, !a -> $, !B2 ]] => Q -> [[ ^ -> $, @ -> $, D> -> $ ]]",-          Program (ExFormation [BiVoid AtRho, BiVoid AtPhi, BiVoid AtDelta]),-          [ExFormation [BiVoid AtRho], ExFormation [BiVoid AtPhi], ExFormation [BiVoid AtDelta]],-          [ExFormation [BiTau AtRho ExThis], ExFormation [BiTau AtPhi ExThis], ExFormation [BiTau AtDelta ExThis]],-          Just (Program (ExFormation [BiTau AtRho ExThis, BiTau AtPhi ExThis, BiTau AtDelta ExThis]))-        ),-        ( "Q -> [[ ^ -> ? ]] => [[ !B1, !a -> ?, !B2 ]] => [[ !B1, !a -> [[ !a -> ? ]], !B2 ]] => Q -> [[ ^ -> [[ ^ -> [[ ^ -> [[ ^ -> ? ]] ]] ]] ]]",-          Program (ExFormation [BiVoid AtRho]),-          [ExFormation [BiVoid AtRho]],-          [ExFormation [BiTau AtRho (ExFormation [BiVoid AtRho])]],-          Just (Program (ExFormation [BiTau AtRho (ExFormation [BiTau AtRho (ExFormation [BiTau AtRho (ExFormation [BiVoid AtRho])])])]))-        ),-        ( "Q -> [[ ^ -> T ]](^ -> [[ ^ -> $]]).@ => [[ !B1, !a -> ?, !B2 ]] => [[ !B1, !a -> $, !B2 ]] => Q -> [[ ^ -> $ ]].@",-          Program (ExDispatch (ExApplication (ExFormation [BiTau AtRho ExTermination]) (BiTau AtRho (ExFormation [BiTau AtRho ExThis]))) AtPhi),-          [ExFormation [BiTau AtRho ExTermination], ExFormation [BiTau AtRho ExThis]],-          [ExFormation [BiTau AtRho ExGlobal], ExFormation [BiVoid AtPhi]],-          Just (Program (ExDispatch (ExApplication (ExFormation [BiTau AtRho ExGlobal]) (BiTau AtRho (ExFormation [BiVoid AtPhi]))) AtPhi))+      (replaceProgramFast (ReplaceCtx 3))+      [+        ( "Q -> [[^ -> ?, @ -> ?, D> -> ?]] => [[ !B1, !a -> ?, !B2 ]] => [[ !B1, !a -> $, !B2 ]] => Q -> [[ ^ -> $, @ -> $, D> -> $ ]]"+        , Program (ExFormation [BiVoid AtRho, BiVoid AtPhi, BiVoid AtDelta])+        , [ExFormation [BiVoid AtRho], ExFormation [BiVoid AtPhi], ExFormation [BiVoid AtDelta]]+        , [ExFormation [BiTau AtRho ExThis], ExFormation [BiTau AtPhi ExThis], ExFormation [BiTau AtDelta ExThis]]+        , Program (ExFormation [BiTau AtRho ExThis, BiTau AtPhi ExThis, BiTau AtDelta ExThis])+        )+      ,+        ( "Q -> [[ ^ -> ? ]] => [[ !B1, !a -> ?, !B2 ]] => [[ !B1, !a -> [[ !a -> ? ]], !B2 ]] => Q -> [[ ^ -> [[ ^ -> [[ ^ -> [[ ^ -> ? ]] ]] ]] ]]"+        , Program (ExFormation [BiVoid AtRho])+        , [ExFormation [BiVoid AtRho]]+        , [ExFormation [BiTau AtRho (ExFormation [BiVoid AtRho])]]+        , Program (ExFormation [BiTau AtRho (ExFormation [BiTau AtRho (ExFormation [BiTau AtRho (ExFormation [BiVoid AtRho])])])])+        )+      ,+        ( "Q -> [[ ^ -> T ]](^ -> [[ ^ -> $]]).@ => [[ !B1, !a -> ?, !B2 ]] => [[ !B1, !a -> $, !B2 ]] => Q -> [[ ^ -> $ ]].@"+        , Program (ExDispatch (ExApplication (ExFormation [BiTau AtRho ExTermination]) (BiTau AtRho (ExFormation [BiTau AtRho ExThis]))) AtPhi)+        , [ExFormation [BiTau AtRho ExTermination], ExFormation [BiTau AtRho ExThis]]+        , [ExFormation [BiTau AtRho ExGlobal], ExFormation [BiVoid AtPhi]]+        , Program (ExDispatch (ExApplication (ExFormation [BiTau AtRho ExGlobal]) (BiTau AtRho (ExFormation [BiVoid AtPhi]))) AtPhi)         )       ]

@@ -26,19 +26,19 @@ import Yaml qualified as Y  data Rules = Rules-  { basic :: Maybe [String],-    custom :: Maybe [Y.Rule]+  { basic :: Maybe [String]+  , custom :: Maybe [Y.Rule]   }   deriving (Generic, FromJSON, Show)  data YamlPack = YamlPack-  { input :: String,-    output :: String,-    rules :: Maybe Rules,-    skip :: Maybe Bool,-    repeat_ :: Maybe Integer,-    must :: Maybe Integer,-    normalize :: Maybe Bool+  { input :: String+  , output :: String+  , rules :: Maybe Rules+  , skip :: Maybe Bool+  , repeat_ :: Maybe Int+  , must :: Maybe Int+  , normalize :: Maybe Bool   }   deriving (Generic, Show) 

@@ -14,17 +14,17 @@ import GHC.Generics import Matcher import Misc+import Printer (printSubsts) import Rule (RuleContext (RuleContext), meetCondition) import System.FilePath import Test.Hspec (Spec, describe, expectationFailure, it, runIO) import Yaml qualified-import Printer (printSubsts)  data ConditionPack = ConditionPack-  { failure :: Maybe Bool,-    expression :: Expression,-    pattern :: Expression,-    condition :: Yaml.Condition+  { failure :: Maybe Bool+  , expression :: Expression+  , pattern :: Expression+  , condition :: Yaml.Condition   }   deriving (Generic, FromJSON, Show) 

@@ -0,0 +1,289 @@+-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+-- SPDX-License-Identifier: MIT++{- | Tests for the Sugar module that provides conversion between sweet+(sugared) and salty (desugared) syntax representations of phi-calculus programs.+Attention! Most of the tests are generated by LLM. Consider that when refactoring+-}+module SugarSpec where++import CST+import Control.Monad (forM_)+import Parser (parseProgramThrows)+import Render (Render (render))+import Sugar (SugarType (..), toSalty, withSugarType)+import Test.Hspec (Spec, describe, it, shouldBe, shouldContain, shouldSatisfy)++spec :: Spec+spec = do+  describe "SugarType Eq instance compares types" $+    forM_+      [ ("sweet equals sweet", SWEET, SWEET, True)+      , ("salty equals salty", SALTY, SALTY, True)+      , ("sweet differs from salty", SWEET, SALTY, False)+      , ("salty differs from sweet", SALTY, SWEET, False)+      ]+      ( \(desc, lhs, rhs, expected) ->+          it desc $ (lhs == rhs) `shouldBe` expected+      )++  describe "SugarType Show instance renders types" $+    forM_+      [ ("shows sweet", SWEET, "SWEET")+      , ("shows salty", SALTY, "SALTY")+      ]+      ( \(desc, sugar, expected) ->+          it desc $ show sugar `shouldBe` expected+      )++  describe "withSugarType SWEET returns unchanged program" $+    it "preserves sweet CST" $ do+      prog <- parseProgramThrows "{Q}"+      let cst = programToCST prog+          result = withSugarType SWEET cst+      result `shouldBe` cst++  describe "withSugarType SALTY converts to salty" $+    it "transforms sweet CST to salty" $ do+      prog <- parseProgramThrows "{Q}"+      let cst = programToCST prog+          result = withSugarType SALTY cst+          isSalty PR_SALTY{} = True+          isSalty _ = False+      result `shouldSatisfy` isSalty++  describe "toSalty PROGRAM converts sweet to salty" $+    it "converts PR_SWEET to PR_SALTY" $ do+      prog <- parseProgramThrows "{Q}"+      let cst = programToCST prog+          salty = toSalty cst+          isSalty PR_SALTY{} = True+          isSalty _ = False+      salty `shouldSatisfy` isSalty++  describe "toSalty PROGRAM leaves salty unchanged" $+    it "preserves PR_SALTY" $ do+      prog <- parseProgramThrows "{Q}"+      let cst = programToCST prog+          salty = toSalty cst+          twice = toSalty salty+      twice `shouldBe` salty++  describe "toSalty EXPRESSION converts default package" $+    it "expands QQ to Q.org.eolang" $ do+      prog <- parseProgramThrows "{QQ}"+      let cst = programToCST prog+          salty = toSalty cst+      render salty `shouldContain` "org"++  describe "toSalty EXPRESSION converts attribute sugar" $+    it "expands x to $.x" $ do+      prog <- parseProgramThrows "{[[ @ -> x ]]}"+      let cst = programToCST prog+          salty = toSalty cst+      render salty `shouldContain` "ξ"++  describe "toSalty EXPRESSION converts empty formation" $+    it "adds void rho to empty formation" $ do+      prog <- parseProgramThrows "{[[]]}"+      let cst = programToCST prog+          salty = toSalty cst+      render salty `shouldContain` "ρ"++  describe "toSalty EXPRESSION converts formation with bindings" $+    it "adds void rho when missing" $ do+      prog <- parseProgramThrows "{[[ x -> Q ]]}"+      let cst = programToCST prog+          salty = toSalty cst+      render salty `shouldContain` "ρ"++  describe "toSalty EXPRESSION preserves existing rho void" $+    it "keeps void rho binding" $ do+      prog <- parseProgramThrows "{[[ ^ -> ?, x -> Q ]]}"+      let cst = programToCST prog+          salty = toSalty cst+          rendered = render salty+          count = length (filter (== 'ρ') rendered)+      count `shouldBe` 1++  describe "toSalty EXPRESSION preserves existing rho tau" $+    it "keeps tau rho binding" $ do+      prog <- parseProgramThrows "{[[ ^ -> Q, x -> $ ]]}"+      let cst = programToCST prog+          salty = toSalty cst+          rendered = render salty+          count = length (filter (== 'ρ') rendered)+      count `shouldBe` 1++  describe "toSalty EXPRESSION converts dispatch" $+    it "recursively processes dispatch expression" $ do+      prog <- parseProgramThrows "{QQ.x}"+      let cst = programToCST prog+          salty = toSalty cst+      render salty `shouldContain` "org"++  describe "toSalty EXPRESSION converts application" $+    it "processes single application" $ do+      prog <- parseProgramThrows "{Q.x(y -> $)}"+      let cst = programToCST prog+          salty = toSalty cst+      render salty `shouldContain` "y"++  describe "toSalty EXPRESSION converts multiple applications" $+    it "processes chained applications" $ do+      prog <- parseProgramThrows "{Q.x(a -> $, b -> Q)}"+      let cst = programToCST prog+          salty = toSalty cst+          rendered = render salty+      rendered `shouldContain` "a"++  describe "toSalty EXPRESSION converts expression arguments" $+    it "converts positional args to alpha bindings" $ do+      prog <- parseProgramThrows "{Q.x($, Q)}"+      let cst = programToCST prog+          salty = toSalty cst+      render salty `shouldContain` "α0"++  describe "toSalty EXPRESSION converts number literal" $+    it "expands number to bytes" $ do+      prog <- parseProgramThrows "{[[ x -> 42 ]]}"+      let cst = programToCST prog+          salty = toSalty cst+      render salty `shouldContain` "number"++  describe "toSalty EXPRESSION converts string literal" $+    it "expands string to bytes" $ do+      prog <- parseProgramThrows "{[[ x -> \"hello\" ]]}"+      let cst = programToCST prog+          salty = toSalty cst+      render salty `shouldContain` "string"++  describe "toSalty EXPRESSION leaves global unchanged" $+    it "preserves Q" $ do+      let expr' = EX_GLOBAL Φ+          salty = toSalty expr'+      salty `shouldBe` expr'++  describe "toSalty EXPRESSION leaves xi unchanged" $+    it "preserves $" $ do+      let expr' = EX_XI XI+          salty = toSalty expr'+      salty `shouldBe` expr'++  describe "toSalty EXPRESSION leaves termination unchanged" $+    it "preserves T" $ do+      let expr' = EX_TERMINATION DEAD+          salty = toSalty expr'+      salty `shouldBe` expr'++  describe "toSalty EXPRESSION leaves meta unchanged" $+    it "preserves meta expression" $ do+      let expr' = EX_META (MT_EXPRESSION "e")+          salty = toSalty expr'+      salty `shouldBe` expr'++  describe "toSalty BINDING converts pair" $+    it "recursively processes binding pair" $ do+      prog <- parseProgramThrows "{[[ x -> QQ ]]}"+      let cst = programToCST prog+          salty = toSalty cst+      render salty `shouldContain` "org"++  describe "toSalty BINDING leaves empty unchanged" $+    it "preserves empty binding" $ do+      let bd = BI_EMPTY (TAB 0)+          salty = toSalty bd+      salty `shouldBe` bd++  describe "toSalty BINDINGS converts pair" $+    it "recursively processes bindings" $ do+      prog <- parseProgramThrows "{[[ x -> Q, y -> QQ ]]}"+      let cst = programToCST prog+          salty = toSalty cst+      render salty `shouldContain` "org"++  describe "toSalty BINDINGS leaves empty unchanged" $+    it "preserves empty bindings" $ do+      let bds = BDS_EMPTY (TAB 0)+          salty = toSalty bds+      salty `shouldBe` bds++  describe "toSalty PAIR converts tau" $+    it "recursively processes tau pair" $ do+      prog <- parseProgramThrows "{[[ x -> QQ ]]}"+      let cst = programToCST prog+          salty = toSalty cst+      render salty `shouldContain` "org"++  describe "toSalty PAIR converts formation with voids" $+    it "expands void parameters into formation" $ do+      prog <- parseProgramThrows "{[[ f(a, b) -> [[]] ]]}"+      let cst = programToCST prog+          salty = toSalty cst+          rendered = render salty+      rendered `shouldContain` "a"++  describe "toSalty PAIR leaves void unchanged" $+    it "preserves void pair" $ do+      let pair' = PA_VOID (AT_LABEL "x") ARROW EMPTY+          salty = toSalty pair'+      salty `shouldBe` pair'++  describe "toSalty PAIR leaves lambda unchanged" $+    it "preserves lambda pair" $ do+      let pair' = PA_LAMBDA "Func"+          salty = toSalty pair'+      salty `shouldBe` pair'++  describe "toSalty PAIR leaves delta unchanged" $+    it "preserves delta pair" $ do+      let pair' = PA_DELTA BT_EMPTY+          salty = toSalty pair'+      salty `shouldBe` pair'++  describe "toSalty APP_BINDING converts pair" $+    it "recursively processes app binding" $ do+      prog <- parseProgramThrows "{Q.x(y -> QQ)}"+      let cst = programToCST prog+          salty = toSalty cst+      render salty `shouldContain` "org"++  describe "toSalty handles nested formations" $+    it "adds rho to nested formations" $ do+      prog <- parseProgramThrows "{[[ x -> [[ y -> Q ]] ]]}"+      let cst = programToCST prog+          salty = toSalty cst+          rendered = render salty+          count = length (filter (== 'ρ') rendered)+      count `shouldBe` 2++  describe "toSalty handles complex program" $+    it "processes fibonacci example" $ do+      prog <- parseProgramThrows "{[[ fac(n) -> [[ @ -> n.eq(1, n.times(^.fac(n.plus(-1)))) ]] ]]}"+      let cst = programToCST prog+          salty = toSalty cst+          rendered = render salty+      rendered `shouldContain` "ρ"++  describe "toSalty handles mixed case identifiers" $+    it "preserves case in labels" $ do+      prog <- parseProgramThrows "{[[ myLabel -> Q ]]}"+      let cst = programToCST prog+          salty = toSalty cst+      render salty `shouldContain` "myLabel"++  describe "toSalty handles deep dispatch chain" $+    it "processes Q.a.b.c.d" $ do+      prog <- parseProgramThrows "{Q.a.b.c.d}"+      let cst = programToCST prog+          salty = toSalty cst+          rendered = render salty+      rendered `shouldContain` "d"++  describe "toSalty handles multiple expression arguments" $+    it "converts all positional args" $ do+      prog <- parseProgramThrows "{Q.f($, Q, $)}"+      let cst = programToCST prog+          salty = toSalty cst+          rendered = render salty+      rendered `shouldContain` "α2"

@@ -21,20 +21,21 @@ import System.Exit (ExitCode (ExitSuccess)) import System.FilePath (makeRelative) import System.IO (hClose, hPutStr, openTempFile)+import System.Info (os) import System.Process (readProcessWithExitCode) import Test.Hspec (Spec, anyException, describe, expectationFailure, it, pendingWith, runIO, shouldBe, shouldThrow) import XMIR (defaultXmirContext, parseXMIRThrows, printXMIR, programToXMIR, xmirToPhi)  data ParsePack = ParsePack-  { failure :: Maybe Bool,-    xmir :: String,-    phi :: String+  { failure :: Maybe Bool+  , xmir :: String+  , phi :: String   }   deriving (Generic, Show, FromJSON)  data PrintPack = PrintPack-  { phi :: String,-    xpaths :: [String]+  { phi :: String+  , xpaths :: [String]   }   deriving (Generic, Show, FromJSON) @@ -50,6 +51,10 @@   let (exitCode, _, _) = unsafePerformIO (readProcessWithExitCode "xmllint" ["--version"] "")    in (exitCode == ExitSuccess) +-- Check if running on Windows+isWindows :: Bool+isWindows = os == "mingw32"+ spec :: Spec spec = do   describe "XMIR parsing packs" $ do@@ -59,7 +64,7 @@       packs       ( \pth -> it (makeRelative resources pth) $ do           pack <- parsePack pth-          let ParsePack {phi = phi'} = pack+          let ParsePack{phi = phi'} = pack               xmir' = do                 doc <- parseXMIRThrows (xmir pack)                 xmirToPhi doc@@ -73,14 +78,14 @@    describe "prohibit to convert to XMIR" $     forM_-      [ "[[ ]]",-        "T",-        "[[ x -> ? ]]",-        "[[ ^ -> 5 ]]",-        "Q.x.y.z",-        "\"Hello\"",-        "Q",-        "$"+      [ "[[ ]]"+      , "T"+      , "[[ x -> ? ]]"+      , "[[ ^ -> 5 ]]"+      , "Q.x.y.z"+      , "\"Hello\""+      , "Q"+      , "$"       ]       ( \phi' -> it phi' $ do           expr <- parseExpressionThrows phi'@@ -95,29 +100,32 @@       packs       ( \pth ->           it (makeRelative resources pth) $-            if not available-              then pendingWith "The 'xmllint' is not available"-              else do-                pack <- printPack pth-                let PrintPack {phi = phi', xpaths = xpaths'} = pack-                prog <- parseProgramThrows phi'-                xmir' <- programToXMIR prog defaultXmirContext-                let xml = printXMIR xmir'-                bracket-                  (openTempFile "." "xmirXXXXXX.tmp")-                  (\(fp, _) -> removeFile fp)-                  ( \(path, hTmp) -> do-                      hPutStr hTmp xml-                      hClose hTmp-                      failed <--                        filterM-                          ( \xpath -> do-                              (code, _, _) <- readProcessWithExitCode "xmllint" ["--xpath", xpath, path] ""-                              pure (code /= ExitSuccess)-                          )-                          xpaths'-                      unless-                        (null failed)-                        (expectationFailure ("Failed xpaths:\n - " ++ intercalate "\n - " failed ++ "\nXMIR is:\n" ++ xml))-                  )+            if isWindows+              then pendingWith "Skipped on Windows due to xmllint Unicode issues"+              else+                if not available+                  then pendingWith "The 'xmllint' is not available"+                  else do+                    pack <- printPack pth+                    let PrintPack{phi = phi', xpaths = xpaths'} = pack+                    prog <- parseProgramThrows phi'+                    xmir' <- programToXMIR prog defaultXmirContext+                    let xml = printXMIR xmir'+                    bracket+                      (openTempFile "." "xmirXXXXXX.tmp")+                      (\(fp, _) -> removeFile fp)+                      ( \(path, hTmp) -> do+                          hPutStr hTmp xml+                          hClose hTmp+                          failed <-+                            filterM+                              ( \xpath -> do+                                  (code, _, _) <- readProcessWithExitCode "xmllint" ["--xpath", xpath, path] ""+                                  pure (code /= ExitSuccess)+                              )+                              xpaths'+                          unless+                            (null failed)+                            (expectationFailure ("Failed xpaths:\n - " ++ intercalate "\n - " failed ++ "\nXMIR is:\n" ++ xml))+                      )       )