phino 0.0.0.49 → 0.0.0.50

raw patch · 26 files changed

+1207/−642 lines, 26 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• phino.cabal +3/−1
• src/Builder.hs +0/−4
• src/CLI.hs +321/−204
• src/CST.hs +174/−108
• src/Condition.hs +163/−0
• src/Dataize.hs +82/−66
• src/Encoding.hs +7/−2
• src/Functions.hs +1/−1
• src/Hide.hs +2/−4
• src/LaTeX.hs +12/−17
• src/Lining.hs +7/−2
• src/Logger.hs +19/−7
• src/Misc.hs +15/−4
• src/Must.hs +14/−1
• src/Parser.hs +64/−53
• src/Printer.hs +8/−7
• src/Render.hs +9/−6
• src/Rewriter.hs +15/−24
• src/Sugar.hs +74/−52
• src/Yaml.hs +3/−3
• test/CLISpec.hs +136/−18
• test/ConditionSpec.hs +51/−0
• test/DataizeSpec.hs +19/−9
• test/HideSpec.hs +1/−5
• test/ParserSpec.hs +4/−40
• test/RewriterSpec.hs +3/−4

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: phino-version: 0.0.0.49+version: 0.0.0.50 license: MIT synopsis: Command-Line Manipulator of 𝜑-Calculus Expressions description: Please see the README on GitHub at <https://github.com/objectionary/phino#readme>@@ -35,6 +35,7 @@     AST     Builder     CLI+    Condition     CST     Dataize     Deps@@ -112,6 +113,7 @@   other-modules:     BuilderSpec     CLISpec+    ConditionSpec     CSTSpec     DataizeSpec     FunctionsSpec

@@ -43,10 +43,6 @@  type Built a = Either String a --- @todo #277:30min Error messages are too verbose. Now, if we can't build expression or binding, we---  throw an exception and just print whole expression or binding to console.---  If this elements are big, it's just a mess and error message became unreadable. It would be nice to---  print expression or binding in some reduce way, removing some parts or printing only first N lines instance Show BuildException where   show CouldNotBuildExpression {..} =     printf

@@ -10,16 +10,19 @@ module CLI (runCLI) where  import AST+import Condition (parseConditionThrows) import Control.Exception (Exception (displayException), SomeException, handle, throw, throwIO) import Control.Exception.Base import Control.Monad (when, (>=>)) import Data.Char (toLower, toUpper)+import Data.Foldable (for_)+import qualified Data.Foldable import Data.Functor ((<&>)) import Data.List (intercalate)-import Data.Maybe (isJust, isNothing)+import Data.Maybe (fromJust, isJust, isNothing) import Data.Version (showVersion) import Dataize (DataizeContext (DataizeContext), dataize)-import Deps (saveStep)+import Deps (SaveStepFunc, saveStep) import Encoding (Encoding (ASCII, UNICODE)) import Functions (buildTerm) import qualified Functions@@ -30,13 +33,13 @@ import Merge (merge) import Misc (ensuredFile) import qualified Misc-import Must (Must (..))+import Must (Must (..), validateMust) import Options.Applicative import Parser (parseExpressionThrows, parseProgramThrows) import Paths_phino (version)-import Printer (printExpression') import qualified Printer as P import Rewriter (RewriteContext (RewriteContext), Rewritten (..), rewrite')+import Rule (RuleContext (RuleContext), matchProgramWithRule) import Sugar import System.Exit (ExitCode (..), exitFailure) import System.IO (getContents')@@ -51,7 +54,8 @@     xmirCtx :: XmirContext,     nonumber :: Bool,     expression :: Maybe String,-    label :: Maybe String+    label :: Maybe String,+    outputFormat :: IOFormat   }  data CmdException@@ -70,6 +74,7 @@   | CmdDataize OptsDataize   | CmdExplain OptsExplain   | CmdMerge OptsMerge+  | CmdMatch OptsMatch  data IOFormat = XMIR | PHI | LATEX   deriving (Eq)@@ -81,18 +86,28 @@  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,     maxDepth :: Integer,     maxCycles :: Integer,-    depthSensitive :: Bool,+    hide :: [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,@@ -101,25 +116,26 @@  data OptsRewrite = OptsRewrite   { logLevel :: LogLevel,-    rules :: [FilePath],+    logLines :: Integer,     inputFormat :: IOFormat,     outputFormat :: IOFormat,     sugarType :: SugarType,     flat :: LineFormat,+    must :: Must,     normalize :: Bool,     shuffle :: Bool,     omitListing :: Bool,     omitComments :: Bool,     depthSensitive :: Bool,     nonumber :: Bool,-    must :: Must,-    maxDepth :: Integer,-    maxCycles :: Integer,     inPlace :: Bool,     sequence :: Bool,+    maxDepth :: Integer,+    maxCycles :: Integer,+    rules :: [FilePath],+    hide :: [String],     expression :: Maybe String,     label :: Maybe String,-    hide :: [String],     targetFile :: Maybe FilePath,     stepsDir :: Maybe FilePath,     inputFile :: Maybe FilePath@@ -127,6 +143,7 @@  data OptsMerge = OptsMerge   { logLevel :: LogLevel,+    logLines :: Integer,     inputFormat :: IOFormat,     outputFormat :: IOFormat,     sugarType :: SugarType,@@ -137,6 +154,21 @@     inputs :: [FilePath]   } +data OptsMatch = OptsMatch+  { logLevel :: LogLevel,+    logLines :: Integer,+    sugarType :: SugarType,+    flat :: LineFormat,+    pattern :: Maybe String,+    when' :: Maybe String,+    inputFile :: Maybe FilePath+  }++validateIntegerOption :: (Integer -> Bool) -> String -> Integer -> ReadM Integer+validateIntegerOption cmp msg num+  | cmp num = return num+  | otherwise = readerError msg+ optLogLevel :: Parser LogLevel optLogLevel =   option@@ -159,6 +191,18 @@       "NONE" -> Right NONE       _ -> Left $ "unknown log-level: " <> lvl +optLogLines :: Parser Integer+optLogLines =+  option+    (auto >>= validateIntegerOption (>= -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]+optRule = many (strOption (long "rule" <> metavar "[FILE]" <> help "Path to custom rule"))++optInputFormat :: Parser IOFormat+optInputFormat = option (parseIOFormat "input") (long "input" <> metavar "FORMAT" <> help "Program input format (phi, xmir)" <> value PHI <> showDefault)+ parseIOFormat :: String -> ReadM IOFormat parseIOFormat type' = eitherReader $ \format -> case (map toLower format, type') of   ("xmir", _) -> Right XMIR@@ -166,27 +210,45 @@   ("latex", "output") -> Right LATEX   _ -> Left (printf "The value '%s' can't be used for '--%s' option, use --help to check possible values" format type') +optOutputFormat :: Parser IOFormat+optOutputFormat =+  option+    (parseIOFormat "output")+    (long "output" <> metavar "FORMAT" <> help (printf "Result and intermediate (see %s option(s)) programs output format (phi, xmir, latex)" _intermediateOptions) <> value PHI <> showDefault)+ argInputFile :: Parser (Maybe FilePath) argInputFile = optional (argument str (metavar "FILE" <> help "Path to input file"))  optMaxDepth :: Parser Integer-optMaxDepth = option auto (long "max-depth" <> metavar "DEPTH" <> help "Maximum number of rewriting iterations per rule" <> value 25 <> showDefault)+optMaxDepth =+  option+    (auto >>= validateIntegerOption (> 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 = option auto (long "max-cycles" <> metavar "CYCLES" <> help "Maximum number of rewriting cycles across all rules" <> value 25 <> showDefault)--optInputFormat :: Parser IOFormat-optInputFormat = option (parseIOFormat "input") (long "input" <> metavar "FORMAT" <> help "Program input format (phi, xmir)" <> value PHI <> showDefault)--optOutputFormat :: Parser IOFormat-optOutputFormat = option (parseIOFormat "output") (long "output" <> metavar "FORMAT" <> help "Program output format (phi, xmir, latex)" <> value PHI <> showDefault)+optMaxCycles =+  option+    (auto >>= validateIntegerOption (> 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 optDepthSensitive = switch (long "depth-sensitive" <> help "Fail if rewriting is not finished after reaching max attempts (see --max-cycles or --max-depth)") -optRule :: Parser [FilePath]-optRule = many (strOption (long "rule" <> metavar "[FILE]" <> help "Path to custom rule"))+optNonumber :: Parser Bool+optNonumber = switch (long "nonumber" <> help "Turn off equation auto numbering in LaTeX rendering (see --output option)") +optSequence :: Parser Bool+optSequence = switch (long "sequence" <> help "Result output contains all intermediate 𝜑-programs concatenated with EOL")++optExpression :: Parser (Maybe String)+optExpression = optional (strOption (long "expression" <> metavar "NAME" <> help "Name for 'phiExpression' element when rendering to LaTeX (see --output option)"))++optLabel :: Parser (Maybe String)+optLabel = optional (strOption (long "label" <> metavar "NAME" <> help "Name for 'label' element when rendering to LaTeX (see --output option)"))++optHide :: Parser [String]+optHide = many (strOption (long "hide" <> metavar "FQN" <> help "Location of object to exclude from result and intermediate programs after rewriting. Must be a valid dispatch expression; e.g. Q.org.eolang"))+ optNormalize :: Parser Bool optNormalize = switch (long "normalize" <> help "Use built-in normalization rules") @@ -199,14 +261,14 @@ optShuffle :: Parser Bool optShuffle = switch (long "shuffle" <> help "Shuffle rules before applying") -optSugar :: [String] -> Parser SugarType-optSugar opts = flag SALTY SWEET (long "sweet" <> help (printf "Print result and intermediate (see %s option(s)) 𝜑-programs using syntax sugar" (intercalate ", " opts)))+optSugar :: Parser SugarType+optSugar = flag SALTY SWEET (long "sweet" <> help (printf "Print result and intermediate (see %s option(s)) 𝜑-programs using syntax sugar" _intermediateOptions))  optSugar' :: Parser SugarType optSugar' = flag SALTY SWEET (long "sweet" <> help "Print result 𝜑-program using syntax sugar") -optLineFormat :: [String] -> Parser LineFormat-optLineFormat opts = flag MULTILINE SINGLELINE (long "flat" <> help (printf "Print result and intermediate (see %s option(s)) 𝜑-programs in one line" (intercalate ", " opts)))+optLineFormat :: Parser LineFormat+optLineFormat = flag MULTILINE SINGLELINE (long "flat" <> help (printf "Print result and intermediate (see %s option(s)) 𝜑-programs in one line" _intermediateOptions))  optLineFormat' :: Parser LineFormat optLineFormat' = flag MULTILINE SINGLELINE (long "flat" <> help "Print result 𝜑-program in one line")@@ -217,11 +279,15 @@ optOmitComments :: Parser Bool optOmitComments = switch (long "omit-comments" <> help "Omit comments in XMIR output") +_intermediateOptions :: String+_intermediateOptions = intercalate ", " ["--sequence", "--steps-dir"]+ explainParser :: Parser Command explainParser =   CmdExplain     <$> ( OptsExplain             <$> optLogLevel+            <*> optLogLines             <*> optRule             <*> optNormalize             <*> optShuffle@@ -230,64 +296,73 @@  dataizeParser :: Parser Command dataizeParser =-  let steps = ["--steps-dir"]-   in CmdDataize-        <$> ( OptsDataize-                <$> optLogLevel-                <*> optInputFormat-                <*> optSugar steps-                <*> optLineFormat steps-                <*> optMaxDepth-                <*> optMaxCycles-                <*> optDepthSensitive-                <*> optStepsDir-                <*> argInputFile-            )+  CmdDataize+    <$> ( OptsDataize+            <$> optLogLevel+            <*> optLogLines+            <*> optInputFormat+            <*> optOutputFormat+            <*> optSugar+            <*> optLineFormat+            <*> optOmitListing+            <*> optOmitComments+            <*> optNonumber+            <*> optSequence+            <*> optDepthSensitive+            <*> optMaxDepth+            <*> optMaxCycles+            <*> optHide+            <*> optExpression+            <*> optLabel+            <*> optStepsDir+            <*> argInputFile+        )  rewriteParser :: Parser Command rewriteParser =-  let opts = ["--sequence", "--steps-dir"]-   in CmdRewrite-        <$> ( OptsRewrite-                <$> optLogLevel-                <*> optRule-                <*> optInputFormat-                <*> optOutputFormat-                <*> optSugar opts-                <*> optLineFormat opts-                <*> optNormalize-                <*> optShuffle-                <*> optOmitListing-                <*> optOmitComments-                <*> optDepthSensitive-                <*> switch (long "nonumber" <> help "Turn off equation auto numbering in LaTeX rendering")-                <*> option-                  auto-                  ( long "must"-                      <> metavar "RANGE"-                      <> help "Must-rewrite range (e.g., '3', '..5', '3..', '3..5'). Stops execution if number of rules applied is not in range. Use 0 to disable."-                      <> value MtDisabled-                      <> showDefaultWith show-                  )-                <*> optMaxDepth-                <*> optMaxCycles-                <*> switch (long "in-place" <> help "Edit file in-place instead of printing to output")-                <*> switch (long "sequence" <> help "Result output contains all intermediate 𝜑-programs concatenated with EOL")-                <*> optional (strOption (long "expression" <> metavar "NAME" <> help "Name for 'phiExpression' element when rendering to LaTeX"))-                <*> optional (strOption (long "label" <> metavar "NAME" <> help "Name for 'label' element when rendering to LaTeX"))-                <*> many (strOption (long "hide" <> metavar "FQN" <> help "Location of object to exclude from result program after rewriting, must be a valid dispatch expression; e.g. Q.org.eolang"))-                <*> optTarget-                <*> optStepsDir-                <*> argInputFile-            )+  CmdRewrite+    <$> ( OptsRewrite+            <$> optLogLevel+            <*> optLogLines+            <*> optInputFormat+            <*> optOutputFormat+            <*> optSugar+            <*> optLineFormat+            <*> option+              auto+              ( long "must"+                  <> metavar "RANGE"+                  <> help "Must-rewrite range (e.g., '3', '..5', '3..', '3..5'). Stops execution if number of rules applied is not in range. Use 0 to disable."+                  <> value MtDisabled+                  <> showDefaultWith show+              )+            <*> optNormalize+            <*> optShuffle+            <*> optOmitListing+            <*> optOmitComments+            <*> optDepthSensitive+            <*> optNonumber+            <*> switch (long "in-place" <> help "Edit file in-place instead of printing to output")+            <*> optSequence+            <*> optMaxDepth+            <*> optMaxCycles+            <*> optRule+            <*> optHide+            <*> optExpression+            <*> optLabel+            <*> optTarget+            <*> optStepsDir+            <*> argInputFile+        )  mergeParser :: Parser Command mergeParser =   CmdMerge     <$> ( OptsMerge             <$> optLogLevel+            <*> optLogLines             <*> optInputFormat-            <*> optOutputFormat+            <*> option (parseIOFormat "output") (long "output" <> metavar "FORMAT" <> help (printf "Result program output format (phi, xmir, latex)") <> value PHI <> showDefault)             <*> optSugar'             <*> optLineFormat'             <*> optOmitListing@@ -296,6 +371,19 @@             <*> many (argument str (metavar "[FILE]" <> help "Paths to input files"))         ) +matchParser :: Parser Command+matchParser =+  CmdMatch+    <$> ( OptsMatch+            <$> optLogLevel+            <*> optLogLines+            <*> optSugar+            <*> optLineFormat+            <*> optional (strOption (long "pattern" <> metavar "EXPRESSION" <> help "Pattern expression to match against"))+            <*> optional (strOption (long "when" <> metavar "CONDITION" <> help "Predicate for matched substitutions"))+            <*> argInputFile+        )+ commandParser :: Parser Command commandParser =   hsubparser@@ -303,6 +391,7 @@         <> command "dataize" (info dataizeParser (progDesc "Dataize the 𝜑-program"))         <> command "explain" (info explainParser (progDesc "Explain rules in LaTeX format"))         <> command "merge" (info mergeParser (progDesc "Merge 𝜑-programs into single one by merging their top level formations"))+        <> command "match" (info matchParser (progDesc "Match 𝜑-program against provided pattern and build matched substitutions"))     )  parserInfo :: ParserInfo Command@@ -318,14 +407,15 @@     logError (displayException e)     exitFailure -setLogLevel' :: Command -> IO ()-setLogLevel' cmd =-  let level = case cmd of-        CmdRewrite OptsRewrite {logLevel} -> logLevel-        CmdDataize OptsDataize {logLevel} -> logLevel-        CmdExplain OptsExplain {logLevel} -> logLevel-        CmdMerge OptsMerge {logLevel} -> logLevel-   in setLogLevel level+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)+   in setLogConfig level lines  invalidCLIArguments :: String -> IO a invalidCLIArguments msg = throwIO (InvalidCLIArguments msg)@@ -333,21 +423,22 @@ runCLI :: [String] -> IO () runCLI args = handle handler $ do   cmd <- handleParseResult (execParserPure defaultPrefs parserInfo args)-  setLogLevel' cmd+  setLogger cmd   case cmd of     CmdRewrite OptsRewrite {..} -> do       validateOpts-      exclude <- traverse (parseExpressionThrows >=> canBeHidden) hide+      exclude <- expressionsToHide hide       logDebug (printf "Amount of rewriting cycles across all the rules: %d, per rule: %d" maxCycles maxDepth)       input <- readInput inputFile       rules' <- getRules normalize shuffle rules       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-          printProgCtx = PrintProgCtx sugarType flat xmirCtx nonumber expression label-      rewrittens <- rewrite' program rules' (context printProgCtx) <&> (`H.hide` exclude)+          printCtx = PrintProgCtx sugarType flat xmirCtx nonumber expression label outputFormat+      rewrittens <- rewrite' program rules' (context printCtx) <&> (`H.hide` exclude)+      let rewrittens' = if sequence then rewrittens else [last rewrittens]       logDebug (printf "Printing rewritten 𝜑-program as %s" (show outputFormat))-      progs <- printRewrittens printProgCtx rewrittens+      progs <- printRewrittens printCtx rewrittens'       output targetFile progs       where         validateOpts :: IO ()@@ -358,18 +449,8 @@           when             (inPlace && isJust targetFile)             (invalidCLIArguments "--in-place and --target cannot be used together")-          when-            (nonumber && outputFormat /= LATEX)-            (invalidCLIArguments "The --nonumber option can stay together with --output=latex only")-          when-            (isJust expression && outputFormat /= LATEX)-            (invalidCLIArguments "The --expression option can stay together with --output=latex only")-          when-            (isJust label && outputFormat /= LATEX)-            (invalidCLIArguments "The --label option can stay together with --output=latex only")-          validateMaxDepth maxDepth-          validateMaxCycles maxCycles-          validateMust must+          validateLatexOptions outputFormat nonumber expression label+          validateMust' must           validateXmirOptions outputFormat omitListing omitComments         output :: Maybe FilePath -> String -> IO ()         output target prog = case (inPlace, target, inputFile) of@@ -390,46 +471,32 @@             maxDepth             maxCycles             depthSensitive-            sequence             buildTerm             must-            (saveStep stepsDir (ioToExtension outputFormat) (printProgram outputFormat ctx))-        printRewrittens :: PrintProgramContext -> [Rewritten] -> IO String-        printRewrittens ctx rewrittens-          | outputFormat == LATEX = pure (rewrittensToLatex rewrittens (LatexContext sugarType flat nonumber expression label))-          | otherwise = mapM (printProgram outputFormat ctx . program) rewrittens <&> intercalate "\n"-        canBeHidden :: Expression -> IO Expression-        canBeHidden expr = canBeHidden' expr expr-          where-            canBeHidden' :: Expression -> Expression -> IO Expression-            canBeHidden' exp@(ExDispatch ExGlobal _) _ = pure exp-            canBeHidden' exp@(ExDispatch expr attr) full = canBeHidden' expr full >> pure exp-            canBeHidden' _ full =-              invalidCLIArguments-                ( printf-                    "Only dispatch expression started with Φ (or Q) can be used in --hide, but given: %s"-                    (printExpression' full P.logPrintConfig)-                )+            (saveStepFunc stepsDir ctx)     CmdDataize OptsDataize {..} -> do       validateOpts+      exclude <- expressionsToHide hide       input <- readInput inputFile       prog <- parseProgram input inputFormat-      dataized <- dataize prog (context prog)-      maybe (throwIO CouldNotDataize) (putStrLn . P.printBytes) dataized+      let printCtx = PrintProgCtx sugarType flat defaultXmirContext nonumber expression label outputFormat+      (maybeBytes, seq) <- dataize prog (context prog printCtx)+      when sequence (putStrLn =<< printRewrittens printCtx (H.hide seq exclude))+      putStrLn (maybe (P.printExpression ExTermination) P.printBytes maybeBytes)       where         validateOpts :: IO ()         validateOpts = do-          validateMaxDepth maxDepth-          validateMaxCycles maxCycles-        context :: Program -> DataizeContext-        context program =+          validateLatexOptions outputFormat nonumber expression label+          validateXmirOptions outputFormat omitListing omitComments+        context :: Program -> PrintProgramContext -> DataizeContext+        context program ctx =           DataizeContext             program             maxDepth             maxCycles             depthSensitive             buildTerm-            (saveStep stepsDir (ioToExtension PHI) (printProgram PHI (PrintProgCtx sugarType flat defaultXmirContext False Nothing Nothing)))+            (saveStepFunc stepsDir ctx)     CmdExplain OptsExplain {..} -> do       validateOpts       rules' <- getRules normalize shuffle rules@@ -448,8 +515,8 @@       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-      prog' <- printProgram outputFormat printProgCtx prog+          printProgCtx = PrintProgCtx sugarType flat xmirCtx False Nothing Nothing outputFormat+      prog' <- printProgram printProgCtx prog       output targetFile prog'       where         validateOpts :: IO ()@@ -458,84 +525,134 @@             (null inputs)             (throwIO (InvalidCLIArguments "At least one input file must be specified for 'merge' command"))           validateXmirOptions outputFormat omitListing omitComments+    CmdMatch OptsMatch {..} -> do+      input <- readInput inputFile+      prog <- parseProgram input PHI+      if isNothing pattern+        then logInfo "The --pattern is not provided, no substitutions are built"+        else do+          ptn <- parseExpressionThrows (fromJust pattern)+          condition <- traverse parseConditionThrows when'+          substs <- matchProgramWithRule prog (rule ptn condition) (RuleContext buildTerm)+          if null substs+            then logInfo "Provided pattern was not matched, no substitutions are built"+            else putStrLn (P.printSubsts' substs (sugarType, UNICODE, flat))+      where+        rule :: Expression -> Maybe Y.Condition -> Y.Rule+        rule ptn cnd = Y.Rule Nothing Nothing ptn ExGlobal cnd Nothing Nothing++-- Prepare saveStepFunc+saveStepFunc :: Maybe FilePath -> PrintProgramContext -> SaveStepFunc+saveStepFunc stepsDir ctx@PrintProgCtx {..} = saveStep stepsDir ioToExt (printProgram ctx)   where-    validateXmirOptions :: IOFormat -> Bool -> Bool -> IO ()-    validateXmirOptions outputFormat omitListing omitComments = do-      when-        (outputFormat /= XMIR && omitListing)-        (invalidCLIArguments "--omit-listing can be used only with --output-format=xmir")-      when-        (outputFormat /= XMIR && omitComments)-        (invalidCLIArguments "--omit-comments can be used only with --output-format=xmir")-    validateIntArgument :: Integer -> (Integer -> Bool) -> String -> IO ()-    validateIntArgument num cmp msg =-      when-        (cmp num)-        (invalidCLIArguments msg)-    validateMaxDepth :: Integer -> IO ()-    validateMaxDepth depth = validateIntArgument depth (<= 0) "--max-depth must be positive"-    validateMaxCycles :: Integer -> IO ()-    validateMaxCycles cycles = validateIntArgument cycles (<= 0) "--max-cycles must be positive"-    validateMust :: Must -> IO ()-    validateMust MtDisabled = pure ()-    validateMust (MtExact n) = validateIntArgument n (<= 0) "--must exact value must be positive"-    validateMust (MtRange minVal maxVal) = do-      maybe (pure ()) (\n -> validateIntArgument n (< 0) "--must minimum must be non-negative") minVal-      maybe (pure ()) (\n -> validateIntArgument n (< 0) "--must maximum must be non-negative") maxVal-      case (minVal, maxVal) of-        (Just min, Just max)-          | min > max ->-              invalidCLIArguments-                (printf "--must range invalid: minimum (%d) is greater than maximum (%d)" min max)-        _ -> pure ()-    readInput :: Maybe FilePath -> IO String-    readInput inputFile' = case inputFile' of-      Just pth -> do-        logDebug (printf "Reading from file: '%s'" pth)-        readFile =<< ensuredFile pth-      Nothing -> do-        logDebug "Reading from stdin"-        getContents' `catch` (\(e :: SomeException) -> throwIO (CouldNotReadFromStdin (show e)))-    parseProgram :: String -> IOFormat -> IO Program-    parseProgram phi PHI = parseProgramThrows phi-    parseProgram xmir XMIR = do-      doc <- parseXMIRThrows xmir-      xmirToPhi doc-    printProgram :: IOFormat -> PrintProgramContext -> Program -> IO String-    printProgram PHI PrintProgCtx {..} prog = pure (P.printProgram' prog (sugar, UNICODE, line))-    printProgram XMIR PrintProgCtx {..} prog = programToXMIR prog xmirCtx <&> printXMIR-    printProgram LATEX PrintProgCtx {..} prog = pure (programToLaTeX prog (LatexContext sugar line nonumber expression label))-    getRules :: Bool -> Bool -> [FilePath] -> IO [Y.Rule]-    getRules normalize shuffle rules = do-      ordered <--        if normalize+    ioToExt :: String+    ioToExt+      | outputFormat == LATEX = "tex"+      | otherwise = show outputFormat++-- Get list of expressions which must be hidden in printed programs+expressionsToHide :: [String] -> IO [Expression]+expressionsToHide = traverse (parseExpressionThrows >=> canBeHidden)+  where+    canBeHidden :: Expression -> IO Expression+    canBeHidden expr = canBeHidden' expr expr+    canBeHidden' :: Expression -> Expression -> IO Expression+    canBeHidden' exp@(ExDispatch ExGlobal _) _ = pure exp+    canBeHidden' exp@(ExDispatch expr attr) full = canBeHidden' expr full >> pure exp+    canBeHidden' _ full =+      invalidCLIArguments+        ( printf+            "Only dispatch expression started with Φ (or Q) can be used in --hide, but given: %s"+            (P.printExpression' full P.logPrintConfig)+        )++-- Validate LaTeX options+validateLatexOptions :: IOFormat -> Bool -> Maybe String -> Maybe String -> IO ()+validateLatexOptions outputFormat nonumber expression label = do+  when+    (nonumber && outputFormat /= LATEX)+    (invalidCLIArguments "The --nonumber option can stay together with --output=latex only")+  when+    (isJust expression && outputFormat /= LATEX)+    (invalidCLIArguments "The --expression option can stay together with --output=latex only")+  when+    (isJust label && outputFormat /= LATEX)+    (invalidCLIArguments "The --label option can stay together with --output=latex only")++-- Validate 'must' option+validateMust' :: Must -> IO ()+validateMust' must = for_ (validateMust must) invalidCLIArguments++-- Validate options for output to XMIR+validateXmirOptions :: IOFormat -> Bool -> Bool -> IO ()+validateXmirOptions outputFormat omitListing omitComments = do+  when+    (outputFormat /= XMIR && omitListing)+    (invalidCLIArguments "--omit-listing can be used only with --output=xmir")+  when+    (outputFormat /= XMIR && omitComments)+    (invalidCLIArguments "--omit-comments can be used only with --output=xmir")++-- Read input from file or stdin+readInput :: Maybe FilePath -> IO String+readInput inputFile' = case inputFile' of+  Just pth -> do+    logDebug (printf "Reading from file: '%s'" pth)+    readFile =<< ensuredFile pth+  Nothing -> do+    logDebug "Reading from stdin"+    getContents' `catch` (\(e :: SomeException) -> throwIO (CouldNotReadFromStdin (show e)))++-- Parse program from String input depending on input IO format+parseProgram :: String -> IOFormat -> IO Program+parseProgram phi PHI = parseProgramThrows phi+parseProgram xmir XMIR = do+  doc <- parseXMIRThrows xmir+  xmirToPhi doc++printRewrittens :: PrintProgramContext -> [Rewritten] -> IO String+printRewrittens ctx@PrintProgCtx {..} rewrittens+  | outputFormat == LATEX = pure (rewrittensToLatex rewrittens (LatexContext sugar line nonumber 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+  PHI -> pure (P.printProgram' prog (sugar, UNICODE, line))+  XMIR -> programToXMIR prog xmirCtx <&> printXMIR+  LATEX -> pure (programToLaTeX prog (LatexContext sugar line nonumber expression label))++-- Get rules for rewriting depending on provided flags+getRules :: Bool -> Bool -> [FilePath] -> IO [Y.Rule]+getRules normalize shuffle rules = do+  ordered <-+    if normalize+      then do+        let rules' = normalizationRules+        logDebug (printf "The --normalize option is provided, %d built-it normalization rules are used" (length rules'))+        pure rules'+      else+        if null rules           then do-            let rules' = normalizationRules-            logDebug (printf "The --normalize option is provided, %d built-it normalization rules are used" (length rules'))-            pure rules'-          else-            if null rules-              then do-                logDebug "No --rule and no --normalize options are provided, no rules are used"-                pure []-              else do-                logDebug (printf "Using rules from files: [%s]" (intercalate ", " rules))-                yamls <- mapM ensuredFile rules-                mapM Y.yamlRule yamls-      if shuffle-        then do-          logDebug "The --shuffle option is provided, rules are used in random order"-          Misc.shuffle ordered-        else pure ordered-    output :: Maybe FilePath -> String -> IO ()-    output target content = case target of-      Nothing -> do-        logDebug "The option '--target' is not specified, printing to console..."-        putStrLn content-      Just file -> do-        logDebug (printf "The option '--target' is specified, printing to '%s'..." file)-        writeFile file content-        logInfo (printf "The command result was saved in '%s'" file)-    ioToExtension :: IOFormat -> String-    ioToExtension LATEX = "tex"-    ioToExtension format = show format+            logDebug "No --rule and no --normalize options are provided, no rules are used"+            pure []+          else do+            logDebug (printf "Using rules from files: [%s]" (intercalate ", " rules))+            yamls <- mapM ensuredFile rules+            mapM Y.yamlRule yamls+  if shuffle+    then do+      logDebug "The --shuffle option is provided, rules are used in random order"+      Misc.shuffle ordered+    else pure ordered++-- Output content+output :: Maybe FilePath -> String -> IO ()+output target content = case target of+  Nothing -> do+    logDebug "The option '--target' is not specified, printing to console..."+    putStrLn content+  Just file -> do+    logDebug (printf "The option '--target' is specified, printing to '%s'..." file)+    writeFile file content+    logInfo (printf "The command result was saved in '%s'" file)

@@ -2,8 +2,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE RecordWildCards #-}  -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com -- SPDX-License-Identifier: MIT@@ -12,6 +10,7 @@  import AST import Data.List (intercalate)+import Data.Maybe (isJust) import Misc  data LCB = LCB | BIG_LCB@@ -104,6 +103,7 @@  data PAIR   = PA_TAU {attr :: ATTRIBUTE, arrow :: ARROW, expr :: EXPRESSION}+  | PA_FORMATION {attr :: ATTRIBUTE, voids :: [ATTRIBUTE], arrow :: ARROW, expr :: EXPRESSION}   | PA_VOID {attr :: ATTRIBUTE, arrow :: ARROW, void :: VOID}   | PA_LAMBDA {func :: String}   | PA_LAMBDA' {func :: String} -- ASCII version of PA_LAMBDA@@ -115,6 +115,9 @@   | PA_META_DELTA' {meta :: META} -- ASCII version of PA_META_DELTA   deriving (Eq, Show) +newtype APP_BINDING = APP_BINDING {pair :: PAIR}+  deriving (Eq, Show)+ data BINDING   = BI_PAIR {pair :: PAIR, bindings :: BINDINGS, tab :: TAB}   | BI_EMPTY {tab :: TAB}@@ -139,16 +142,17 @@  data EXPRESSION   = EX_GLOBAL {global :: GLOBAL}-  | EX_DEF_PACKAGE {pckg :: DEF_PACKAGE}+  | EX_DEF_PACKAGE {pckg :: DEF_PACKAGE} -- sugar for Q.org.eolang   | EX_XI {xi :: XI}   | EX_ATTR {attr :: ATTRIBUTE} -- sugar for $.x -> just x   | 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, bindings :: BINDING, eol' :: EOL, tab' :: TAB}-  | EX_APPLICATION' {expr :: EXPRESSION, eol :: EOL, tab :: TAB, args :: APP_ARG, eol' :: EOL, tab' :: TAB}-  | EX_STRING {str :: String, tab :: TAB}-  | EX_NUMBER {num :: Either Integer Double, tab :: TAB}+  | 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_STRING {str :: String, tab :: TAB, rhos :: [Binding]}+  | EX_NUMBER {num :: Either Integer Double, tab :: TAB, rhos :: [Binding]}   | EX_META {meta :: META}   | EX_META_TAIL {expr :: EXPRESSION, meta :: META}   deriving (Eq, Show)@@ -164,31 +168,31 @@   deriving (Eq, Show)  programToCST :: Program -> PROGRAM-programToCST prog = toCST prog 0+programToCST prog = toCST prog 0 EOL  expressionToCST :: Expression -> EXPRESSION-expressionToCST expr = toCST expr 0+expressionToCST expr = toCST expr 0 EOL  -- This class is used to convert AST to CST -- CST is created with sugar and unicode -- All further transformations much consider that class ToCST a b where-  toCST :: a -> Integer -> b+  toCST :: a -> Integer -> EOL -> b  instance ToCST Program PROGRAM where-  toCST (Program expr) tabs = PR_SWEET LCB (toCST expr tabs) RCB+  toCST (Program expr) tabs eol = PR_SWEET LCB (toCST expr tabs eol) RCB  instance ToCST Expression EXPRESSION where-  toCST ExGlobal _ = EX_GLOBAL Φ-  toCST ExThis _ = EX_XI XI-  toCST (ExMeta mt) _ = EX_META (MT_EXPRESSION (tail mt))-  toCST (ExMetaTail expr mt) tabs = EX_META_TAIL (toCST expr tabs) (MT_TAIL (tail mt))-  toCST ExTermination _ = EX_TERMINATION DEAD-  toCST (ExFormation [BiVoid AtRho]) _ = toCST (ExFormation []) 0-  toCST (ExFormation []) _ = EX_FORMATION LSB NO_EOL NO_TAB (BI_EMPTY NO_TAB) NO_EOL NO_TAB RSB-  toCST (ExFormation bds) tabs =+  toCST ExGlobal _ _ = EX_GLOBAL Φ+  toCST ExThis _ _ = EX_XI XI+  toCST (ExMeta mt) _ _ = EX_META (MT_EXPRESSION (tail mt))+  toCST (ExMetaTail expr mt) tabs eol = EX_META_TAIL (toCST expr tabs eol) (MT_TAIL (tail mt))+  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 (ExFormation bds) tabs eol =     let next = tabs + 1-        bds' = toCST (withoutLastVoidRho bds) next :: BINDING+        bds' = toCST (withoutLastVoidRho bds) next eol :: BINDING      in EX_FORMATION           LSB           EOL@@ -203,33 +207,70 @@       withoutLastVoidRho [BiVoid AtRho] = []       withoutLastVoidRho (bd : [BiVoid AtRho]) = [bd]       withoutLastVoidRho (bd : bds') = bd : withoutLastVoidRho bds'-  toCST (DataString bts) tabs = EX_STRING (btsToStr bts) (TAB tabs)-  toCST (DataNumber bts) tabs = EX_NUMBER (btsToNum bts) (TAB tabs)-  toCST (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) _ = EX_DEF_PACKAGE Φ̇-  toCST (ExDispatch ExThis attr) tabs = EX_ATTR (toCST attr tabs)-  toCST (ExDispatch expr attr) tabs = EX_DISPATCH (toCST expr tabs) (toCST attr tabs)-  toCST app@(ExApplication _ _) tabs =+  toCST (DataString bts) tabs _ = EX_STRING (btsToStr bts) (TAB tabs) []+  toCST (DataNumber bts) tabs _ = EX_NUMBER (btsToNum bts) (TAB tabs) []+  toCST (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) _ _ = EX_DEF_PACKAGE Φ̇+  toCST (ExDispatch ExThis attr) tabs eol = EX_ATTR (toCST attr tabs eol)+  toCST (ExDispatch expr attr) tabs eol = EX_DISPATCH (toCST expr tabs eol) (toCST attr tabs eol)+  -- Since we convert AST to CST in sweet notation, here we're trying to get rid of unnecessary rho bindings+  -- in primitives (more details here: https://github.com/objectionary/phino/issues/451)+  -- If we find something similar to:+  -- `QQ.number(~0 -> QQ.bytes(...), ^ -> ..., ^ -> ...)`+  -- We remove unnecessary rho bindings and save them to EX_STRING or EX_NUMBER so they can be successfully+  -- converted to salty notation without losing information.+  -- In the end we just get CST with data primitive which is printed correctly.+  -- If given application is not such primitive - we just convert it to one of the applications:+  -- 1. either with pure expression with arguments, which means there are incremented only alpha bindings+  -- 2. or with just bindings+  toCST app@(ExApplication exp tau) tabs eol =     let (expr, taus, exprs) = complexApplication app+        expr' = toCST expr tabs eol :: EXPRESSION         next = tabs + 1-        expr'' = toCST expr tabs :: EXPRESSION-     in if null exprs-          then-            EX_APPLICATION-              (toCST expr tabs)-              EOL-              (TAB next)-              (toCST (reverse taus) next)-              EOL-              (TAB tabs)+        (taus', rhos) = withoutRhosInPrimitives expr taus+        obj = ExApplication expr (head taus')+     in if length taus' == 1 && isJust (matchDataObject obj)+          then applicationToPrimitive obj tabs rhos           else-            EX_APPLICATION'-              (toCST expr tabs)-              EOL-              (TAB next)-              (toCST (reverse exprs) next)-              EOL-              (TAB tabs)+            if null exprs+              then+                let eol' = inlinedEOL (not (hasEOL taus))+                 in EX_APPLICATION_TAUS+                      expr'+                      eol'+                      (tabOfEOL eol' next)+                      (toCST taus next eol' :: BINDING)+                      eol'+                      (tabOfEOL eol' tabs)+                      next+              else+                let eol' = inlinedEOL (not (hasEOL exprs))+                 in EX_APPLICATION_EXPRS+                      expr'+                      eol'+                      (tabOfEOL eol' next)+                      (toCST exprs next eol')+                      eol'+                      (tabOfEOL eol' tabs)+                      next     where+      primitives :: [String]+      primitives = ["number", "string"]+      withoutRhosInPrimitives :: Expression -> [Binding] -> ([Binding], [Binding])+      withoutRhosInPrimitives _ [] = ([], [])+      withoutRhosInPrimitives obj@(BaseObject label) bds@(rho@(BiTau AtRho _) : rest)+        | label `elem` primitives =+            let (bds', rhos) = withoutRhosInPrimitives obj rest+             in (bds', rho : rhos)+        | otherwise = (bds, [])+      withoutRhosInPrimitives obj@(BaseObject label) bds@(bd : rest)+        | label `elem` primitives =+            let (bds', rhos) = withoutRhosInPrimitives obj rest+             in (bd : bds', rhos)+        | otherwise = (bds, [])+      withoutRhosInPrimitives _ bds = (bds, [])+      applicationToPrimitive :: Expression -> Integer -> [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       -- The returned tuple consists of:       -- 1. deepest start expression@@ -237,89 +278,114 @@       -- 3. list of expressions which are applied to start expression with default       --    alpha attributes (~0 -> e1, ~1 -> e2, ...)       complexApplication :: Expression -> (Expression, [Binding], [Expression])-      complexApplication (ExApplication (ExApplication expr tau) tau') =-        let (before, taus, exprs) = complexApplication (ExApplication expr tau)-            taus' = tau' : taus-         in if null exprs-              then (before, taus', [])-              else case tau' of-                BiTau (AtAlpha idx) expr' ->-                  if idx == fromIntegral (length exprs)-                    then (before, taus', expr' : exprs)-                    else (before, taus', [])-                _ -> (before, taus', [])-      complexApplication (ExApplication expr (BiTau (AtAlpha 0) expr')) = (expr, [BiTau (AtAlpha 0) expr'], [expr'])-      complexApplication (ExApplication expr tau) = (expr, [tau], [])+      complexApplication expr =+        let (expr', taus', exprs') = complexApplication' expr+         in (expr', reverse taus', reverse exprs')+        where+          complexApplication' :: Expression -> (Expression, [Binding], [Expression])+          complexApplication' (ExApplication (ExApplication expr tau) tau') =+            let (before, taus, exprs) = complexApplication' (ExApplication expr tau)+                taus' = tau' : taus+             in if null exprs+                  then (before, taus', [])+                  else case tau' of+                    BiTau (AtAlpha idx) expr' ->+                      if idx == fromIntegral (length exprs)+                        then (before, taus', expr' : exprs)+                        else (before, taus', [])+                    _ -> (before, taus', [])+          complexApplication' (ExApplication expr (BiTau (AtAlpha 0) expr')) = (expr, [BiTau (AtAlpha 0) expr'], [expr'])+          complexApplication' (ExApplication expr tau) = (expr, [tau], [])  instance ToCST [Expression] APP_ARG where-  toCST (expr : exprs) tabs = APP_ARG (toCST expr tabs) (toCST exprs tabs)+  toCST (expr : exprs) tabs eol = APP_ARG (toCST expr tabs eol) (toCST exprs tabs eol)  instance ToCST [Expression] APP_ARGS where-  toCST [] _ = AAS_EMPTY-  toCST (expr : exprs) tabs = AAS_EXPR EOL (TAB tabs) (toCST expr tabs) (toCST exprs tabs)+  toCST [] _ _ = AAS_EMPTY+  toCST (expr : exprs) tabs eol = AAS_EXPR eol (tabOfEOL eol tabs) (toCST expr tabs eol) (toCST exprs tabs eol)  instance ToCST [Binding] BINDING where-  toCST [] tabs = BI_EMPTY (TAB tabs)-  toCST (BiMeta mt : bds) tabs = BI_META (MT_BINDING (tail mt)) (toCST bds tabs) (TAB tabs)-  toCST (bd : bds) tabs = BI_PAIR (toCST bd tabs) (toCST bds tabs) (TAB tabs)+  toCST [] tabs _ = BI_EMPTY (TAB tabs)+  toCST (BiMeta mt : bds) tabs eol = BI_META (MT_BINDING (tail mt)) (toCST bds tabs eol) (tabOfEOL eol tabs)+  toCST (bd : bds) tabs eol = BI_PAIR (toCST bd tabs eol) (toCST bds tabs eol) (tabOfEOL eol tabs)  instance ToCST [Binding] BINDINGS where-  toCST [] tabs = BDS_EMPTY (TAB tabs)-  toCST (BiMeta mt : bds) tabs = BDS_META EOL (TAB tabs) (MT_BINDING (tail mt)) (toCST bds tabs)-  toCST (bd : bds) tabs = BDS_PAIR EOL (TAB tabs) (toCST bd tabs) (toCST bds tabs)+  toCST [] tabs _ = BDS_EMPTY (TAB tabs)+  toCST (BiMeta mt : bds) tabs eol = BDS_META eol (tabOfEOL eol tabs) (MT_BINDING (tail mt)) (toCST bds tabs eol)+  toCST (bd : bds) tabs eol = BDS_PAIR eol (tabOfEOL eol tabs) (toCST bd tabs eol) (toCST bds tabs eol)  instance ToCST Binding PAIR where-  toCST (BiTau attr exp) tabs = PA_TAU (toCST attr tabs) ARROW (toCST exp tabs)-  toCST (BiVoid attr) tabs = PA_VOID (toCST attr tabs) ARROW EMPTY-  toCST (BiDelta bts) tabs = PA_DELTA (toCST bts tabs)-  toCST (BiLambda func) _ = PA_LAMBDA func-  toCST (BiMetaLambda mt) _ = PA_META_LAMBDA (MT_FUNCTION (tail mt))+  toCST (BiTau attr exp@(ExFormation bds)) tabs eol =+    let voids' = voids bds+        attr' = toCST attr tabs eol+     in if null voids'+          then PA_TAU attr' ARROW (toCST exp tabs eol)+          else+            let (_voids, _bds) = if length voids' == length bds && last voids' == AtRho then (init voids', []) else (voids', drop (length voids') bds)+             in PA_FORMATION+                  attr'+                  (map (\at -> toCST at tabs eol) _voids)+                  ARROW+                  (toCST (ExFormation _bds) tabs eol)+    where+      voids :: [Binding] -> [Attribute]+      voids [] = []+      voids (bd : bds) = case bd of+        BiVoid attr -> attr : voids bds+        _ -> []+  toCST (BiTau attr exp) tabs eol = PA_TAU (toCST attr tabs eol) ARROW (toCST exp tabs eol)+  toCST (BiVoid attr) tabs eol = PA_VOID (toCST attr tabs eol) ARROW EMPTY+  toCST (BiDelta bts) tabs eol = PA_DELTA (toCST bts tabs eol)+  toCST (BiLambda func) _ _ = PA_LAMBDA func+  toCST (BiMetaLambda mt) _ _ = PA_META_LAMBDA (MT_FUNCTION (tail mt)) +instance ToCST Binding APP_BINDING where+  toCST bd@(BiTau _ _) tabs eol = APP_BINDING (toCST bd tabs eol :: PAIR)+ instance ToCST Bytes BYTES where-  toCST BtEmpty _ = BT_EMPTY-  toCST (BtOne byte) _ = BT_ONE byte-  toCST (BtMany bts) _ = BT_MANY bts-  toCST (BtMeta mt) _ = BT_META (MT_BYTES (tail mt))+  toCST BtEmpty _ _ = BT_EMPTY+  toCST (BtOne byte) _ _ = BT_ONE byte+  toCST (BtMany bts) _ _ = BT_MANY bts+  toCST (BtMeta mt) _ _ = BT_META (MT_BYTES (tail mt))  instance ToCST Attribute ATTRIBUTE where-  toCST (AtLabel label) _ = AT_LABEL label-  toCST (AtAlpha idx) _ = AT_ALPHA ALPHA idx-  toCST AtPhi _ = AT_PHI PHI-  toCST AtRho _ = AT_RHO RHO-  toCST AtDelta _ = AT_DELTA DELTA-  toCST AtLambda _ = AT_LAMBDA LAMBDA-  toCST (AtMeta mt) _ = AT_META (MT_ATTRIBUTE (tail mt))+  toCST (AtLabel label) _ _ = AT_LABEL label+  toCST (AtAlpha idx) _ _ = AT_ALPHA ALPHA idx+  toCST AtPhi _ _ = AT_PHI PHI+  toCST AtRho _ _ = AT_RHO RHO+  toCST AtDelta _ _ = AT_DELTA DELTA+  toCST AtLambda _ _ = AT_LAMBDA LAMBDA+  toCST (AtMeta mt) _ _ = AT_META (MT_ATTRIBUTE (tail mt)) -class HasEOL a where-  hasEOL :: a -> Bool+inlinedEOL :: Bool -> EOL+inlinedEOL True = NO_EOL+inlinedEOL False = EOL -instance HasEOL EXPRESSION where-  hasEOL EX_FORMATION {eol = NO_EOL, binding, eol' = NO_EOL} = hasEOL binding-  hasEOL EX_FORMATION {..} = True-  hasEOL EX_DISPATCH {..} = hasEOL expr-  hasEOL EX_APPLICATION {eol = NO_EOL, expr, bindings, eol' = NO_EOL} = hasEOL expr || hasEOL bindings-  hasEOL EX_APPLICATION {..} = True-  hasEOL EX_APPLICATION' {eol = NO_EOL, expr, args, eol' = NO_EOL} = hasEOL expr || hasEOL args-  hasEOL EX_APPLICATION' {..} = True-  hasEOL _ = False+tabOfEOL :: EOL -> Integer -> TAB+tabOfEOL EOL indent = TAB indent+tabOfEOL NO_EOL _ = TAB' -instance HasEOL BINDING where-  hasEOL BI_EMPTY {..} = False-  hasEOL BI_PAIR {..} = hasEOL pair || hasEOL bindings+class HasEOL a where+  hasEOL :: a -> Bool -instance HasEOL BINDINGS where-  hasEOL BDS_PAIR {eol = NO_EOL, pair, bindings} = hasEOL pair || hasEOL bindings-  hasEOL BDS_PAIR {..} = True-  hasEOL BDS_EMPTY {..} = False+instance HasEOL [Binding] where+  hasEOL [] = False+  hasEOL (bd : rest) = hasEOL bd || hasEOL rest -instance HasEOL PAIR where-  hasEOL PA_TAU {..} = hasEOL expr-  hasEOL _ = False+instance HasEOL Binding where+  hasEOL (BiTau _ expr) = hasEOL expr+  hasEOL bd = False -instance HasEOL APP_ARG where-  hasEOL APP_ARG {..} = hasEOL expr || hasEOL args+instance HasEOL [Expression] where+  hasEOL [] = False+  hasEOL (expr : rest) = hasEOL expr || hasEOL rest -instance HasEOL APP_ARGS where-  hasEOL AAS_EMPTY = False-  hasEOL AAS_EXPR {eol = NO_EOL, expr, args} = hasEOL expr || hasEOL args-  hasEOL AAS_EXPR {..} = True+instance HasEOL Expression where+  hasEOL (ExFormation []) = False+  hasEOL (ExFormation _) = True+  hasEOL (DataNumber _) = False+  hasEOL (DataString _) = False+  hasEOL (BaseObject _) = False+  hasEOL (ExDispatch expr _) = hasEOL expr+  hasEOL (ExApplication expr tau) = hasEOL expr || hasEOL tau+  hasEOL expr = False

@@ -0,0 +1,163 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE RecordWildCards #-}++-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+-- SPDX-License-Identifier: MIT++module Condition (parseCondition, parseConditionThrows) where++import Control.Exception (Exception)+import Control.Exception.Base (throwIO)+import Data.Void (Void)+import Parser (PhiParser (..), phiParser)+import Text.Megaparsec+import Text.Megaparsec.Char+import qualified Text.Megaparsec.Char.Lexer as L+import qualified Yaml as Y+import Text.Printf (printf)++newtype ConditionException = CouldNotParseCondition {message :: String}+  deriving (Exception)++instance Show ConditionException where+  show CouldNotParseCondition {..} = printf "Couldn't parse given condition, cause: %s" message++type Parser = Parsec Void String++-- White space consumer+whiteSpace :: Parser ()+whiteSpace = L.space hspace1 empty empty++-- Lexeme that ignores white spaces after+lexeme :: Parser a -> Parser a+lexeme = L.lexeme whiteSpace++-- Strict symbol (or sequence of symbols) with ignored white spaces after+symbol :: String -> Parser String+symbol = L.symbol whiteSpace++lparen :: Parser String+lparen = symbol "("++rparen :: Parser String+rparen = symbol ")"++comma :: Parser String+comma = symbol ","++number :: Parser Y.Number+number =+  choice+    [ do+        _ <- symbol "ordinal" >> lparen+        attr <- _attribute phiParser+        _ <- rparen+        return (Y.Ordinal attr),+      do+        _ <- symbol "length" >> lparen+        bd <- _binding phiParser+        _ <- rparen+        return (Y.Length bd),+      do+        sign <- optional (choice [char '-', char '+'])+        unsigned <- lexeme L.decimal+        return+          ( Y.Literal+              ( case sign of+                  Just '-' -> negate unsigned+                  _ -> unsigned+              )+          )+    ]++comparable :: Parser Y.Comparable+comparable =+  choice+    [ try $ Y.CmpNum <$> number,+      try $ Y.CmpAttr <$> _attribute phiParser,+      Y.CmpExpr <$> _expression phiParser+    ]++condition :: Parser Y.Condition+condition =+  choice+    [ do+        _ <- symbol "and" >> lparen+        args <- condition `sepBy1` comma+        _ <- rparen+        return (Y.And args),+      do+        _ <- symbol "or" >> lparen+        args <- condition `sepBy1` comma+        _ <- rparen+        return (Y.Or args),+      do+        _ <- symbol "in" >> lparen+        attr <- _attribute phiParser+        _ <- comma+        bd <- _binding phiParser+        _ <- rparen+        return (Y.In attr bd),+      do+        _ <- symbol "not" >> lparen+        cond <- condition+        _ <- rparen+        return (Y.Not cond),+      do+        _ <- symbol "alpha" >> lparen+        attr <- _attribute phiParser+        _ <- rparen+        return (Y.Alpha attr),+      do+        _ <- symbol "eq" >> lparen+        left <- comparable+        _ <- comma+        right <- comparable+        _ <- rparen+        return (Y.Eq left right),+      do+        _ <- symbol "nf" >> lparen+        expr <- _expression phiParser+        _ <- rparen+        return (Y.NF expr),+      do+        _ <- symbol "xi" >> lparen+        expr <- _expression phiParser+        _ <- rparen+        return (Y.XI expr),+      do+        _ <- symbol "matches" >> lparen+        ptn <- _string phiParser+        _ <- comma+        expr <- _expression phiParser+        _ <- rparen+        return (Y.Matches ptn expr),+      do+        _ <- symbol "part-of" >> lparen+        expr <- _expression phiParser+        _ <- comma+        bd <- _binding phiParser+        _ <- rparen+        return (Y.PartOf expr bd)+    ]++parseCondition :: String -> Either String Y.Condition+parseCondition input = do+  let parsed =+        runParser+          ( do+              _ <- whiteSpace+              p <- condition+              _ <- eof+              return p+          )+          "condition"+          input+  case parsed of+    Right parsed' -> Right parsed'+    Left err -> Left (errorBundlePretty err)++parseConditionThrows :: String -> IO Y.Condition+parseConditionThrows cnd = case parseCondition cnd of+  Right condition -> pure condition+  Left err -> throwIO (CouldNotParseCondition err)

@@ -1,3 +1,4 @@+{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} @@ -9,16 +10,23 @@ import AST import Builder (contextualize) import Control.Exception (throwIO)+import Data.IntMap (restrictKeys) import Data.List (partition) import Deps (BuildTermFunc, SaveStepFunc) import Misc import Must (Must (..))-import Rewriter (RewriteContext (RewriteContext), Rewritten (Rewritten, program), rewrite')+import Rewriter (RewriteContext (RewriteContext), Rewritten, rewrite') import Rule (RuleContext (RuleContext), isNF) import Text.Printf (printf) import XMIR (XmirContext (XmirContext)) import Yaml (normalizationRules) +type Dataized = (Maybe Bytes, [Rewritten])++type Dataizable = (Expression, [Rewritten])++type Morphed = Dataizable+ data DataizeContext = DataizeContext   { _program :: Program,     _maxDepth :: Integer,@@ -34,7 +42,6 @@     _maxDepth     _maxCycles     _depthSensitive-    False     _buildTerm     MtDisabled     _saveStep@@ -56,50 +63,58 @@ maybePhi :: [Binding] -> (Maybe Binding, [Binding]) maybePhi = maybeBinding (\case (BiTau AtPhi _) -> True; _ -> False) -formation :: [Binding] -> DataizeContext -> IO (Maybe Expression)+-- Resolve formation for LAMBDA Morphing rule.+-- If formation contains λ binding, the called atom+-- result is returned.+formation :: [Binding] -> DataizeContext -> IO (Maybe (Expression, String)) formation bds ctx = do   let (lambda, bds') = maybeLambda bds   case lambda of     Just (BiLambda func) -> do-      obj' <- atom func (ExFormation bds') ctx-      case obj' of-        Just obj -> pure (Just obj)-        _ -> pure Nothing+      obj <- atom func (ExFormation bds') ctx+      pure (Just (obj, "M(lambda)"))     _ -> pure Nothing -phiDispatch :: String -> Expression -> Maybe Expression-phiDispatch attr expr = case expr of+-- Resolve dispatch from global object (Q.tau) for PHI Morphing rule.+-- Here tau is the name of the attribute which is taken from Q+-- and expr is expression which program refers to.+-- If Q refers to formation which contains binding with attribute == tau -+-- the expression from this binding is returned.+phiDispatch :: String -> Expression -> Maybe (Expression, String)+phiDispatch tau expr = case expr of   ExFormation bds -> boundExpr bds   _ -> Nothing   where-    boundExpr :: [Binding] -> Maybe Expression+    boundExpr :: [Binding] -> Maybe (Expression, String)     boundExpr [] = Nothing     boundExpr (bd : bds) = case bd of-      BiTau (AtLabel attr') expr' -> if attr' == attr then Just expr' else boundExpr bds+      BiTau (AtLabel attr) expr' -> if attr == tau then Just (expr', "M(phi)") else boundExpr bds       _ -> boundExpr bds -withTail :: Expression -> DataizeContext -> IO (Maybe Expression)+-- Resolve tail PHI and LAMBDA Morphing rules.+-- Tail MUST start with dispatch, that's why most of the applications return Nothing+withTail :: Expression -> DataizeContext -> IO (Maybe (Expression, String)) withTail (ExApplication (ExFormation _) _) _ = pure Nothing withTail (ExApplication (ExDispatch ExGlobal _) _) _ = pure Nothing withTail (ExApplication expr tau) ctx = do-  exp' <- withTail expr ctx-  case exp' of-    Just exp -> pure (Just (ExApplication exp tau))+  tailed <- withTail expr ctx+  case tailed of+    Just (exp, rule) -> pure (Just (ExApplication exp tau, rule))     _ -> pure Nothing withTail (ExDispatch (ExFormation bds) attr) ctx = do-  obj' <- formation bds ctx-  case obj' of-    Just obj -> pure (Just (ExDispatch obj attr))+  tailed <- formation bds ctx+  case tailed of+    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-  Just obj -> pure (Just (ExDispatch obj attr))+  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 expr attr) ctx = do-  exp' <- withTail expr ctx-  case exp' of-    Just exp -> pure (Just (ExDispatch exp attr))+  tailed <- withTail expr ctx+  case tailed of+    Just (exp, rule) -> pure (Just (ExDispatch exp attr, rule))     _ -> pure Nothing withTail _ _ = pure Nothing @@ -114,24 +129,26 @@ -- NMZ:    M(e1) -> M(e2)                         if e2 := N(e1) and e1 != e2 -- LAMBDA: M([B1, λ -> F, B2] * t) -> M(e2 * t)   if e3 := [B1,B2] and e2 := F(e3) -- PHI:    M(Q.tau * t) -> M(e * t)               if Q -> [B1, tau -> e, B2], t is tail started with dispatch---         M(e) -> nothing                        otherwise-morph :: Expression -> DataizeContext -> IO (Maybe Expression)-morph ExTermination _ = pure (Just ExTermination) -- PRIM-morph (ExFormation bds) ctx = do-  resolved <- withTail (ExFormation bds) ctx+--         M(e) -> ⊥                              otherwise+morph :: Morphed -> DataizeContext -> IO Morphed+morph (ExTermination, seq) _ = pure (ExTermination, leadsTo seq "M(prim)" ExTermination) -- PRIM+morph (form@(ExFormation bds), seq) ctx = do+  resolved <- withTail form ctx   case resolved of-    Just obj -> morph obj ctx -- LAMBDA or PHI-    _ -> pure (Just (ExFormation bds)) -- PRIM-morph expr ctx = do+    Just (expr, rule) -> morph (expr, leadsTo seq rule expr) ctx -- LAMBDA or PHI+    _ -> pure (form, leadsTo seq "M(prim)" form) -- PRIM+morph (expr, seq) ctx = do   resolved <- withTail expr ctx   case resolved of-    Just obj -> morph obj ctx+    Just (expr', rule) -> morph (expr', leadsTo seq rule expr') ctx     _ ->       if isNF expr (RuleContext (_buildTerm ctx))-        then pure Nothing+        then morph (ExTermination, seq) ctx -- PRIM         else do-          [Rewritten {program = Program expr'}] <- rewrite' (Program expr) normalizationRules (switchContext ctx) -- NMZ-          morph expr' ctx+          rewrittens' <- rewrite' (Program expr) normalizationRules (switchContext ctx) -- NMZ+          let _seq = reverse rewrittens' <> tail seq+              (Program expr') = fst (head _seq)+          morph (expr', _seq) ctx  -- The goal of 'dataize' function is retrieve bytes from given expression. --@@ -139,62 +156,61 @@ -- BOX:   D([B1, 𝜑 -> e, B2]) -> D(С(e))        if [B1,B2] has no delta/lambda, where С(e) - contextualization -- NORM:  D(e1) -> D(e2)                        if e2 := M(e1) and e1 is not primitive --        nothing                               otherwise-dataize :: Program -> DataizeContext -> IO (Maybe Bytes)-dataize (Program expr) = dataize' expr+dataize :: Program -> DataizeContext -> IO Dataized+dataize (Program expr) ctx = do+  (maybeBytes, seq) <- dataize' (expr, [(Program expr, Nothing)]) ctx+  pure (maybeBytes, reverse seq) -dataize' :: Expression -> DataizeContext -> IO (Maybe Bytes)-dataize' ExTermination _ = pure Nothing-dataize' (ExFormation bds) ctx = case maybeDelta bds of-  (Just (BiDelta bytes), _) -> pure (Just bytes)+dataize' :: Dataizable -> DataizeContext -> IO Dataized+dataize' (ExTermination, seq) _ = pure (Nothing, seq)+dataize' (ExFormation bds, seq) ctx = case maybeDelta bds of+  (Just (BiDelta bytes), _) -> pure (Just bytes, seq)   (Nothing, _) -> case maybePhi bds of     (Just (BiTau AtPhi expr), bds') -> case maybeLambda bds' of       (Just (BiLambda _), _) -> throwIO (userError "The 𝜑 and λ can't be present in formation at the same time")       (_, _) ->         let expr' = contextualize expr (ExFormation bds)-         in dataize' expr' ctx+         in dataize' (expr', leadsTo seq "contextualize" expr') ctx     (Nothing, _) -> case maybeLambda bds of-      (Just (BiLambda _), _) -> do-        morphed' <- morph (ExFormation bds) ctx-        case morphed' of-          Just morphed -> dataize' morphed ctx-          _ -> pure Nothing-      (Nothing, _) -> pure Nothing-dataize' expr prog = do-  morphed' <- morph expr prog-  case morphed' of-    Just morphed -> dataize' morphed prog-    _ -> pure Nothing+      (Just (BiLambda _), _) -> morph (ExFormation bds, seq) ctx >>= (`dataize'` ctx)+      (Nothing, _) -> pure (Nothing, seq)+dataize' dataizable ctx = morph dataizable ctx >>= (`dataize'` ctx) -atom :: String -> Expression -> DataizeContext -> IO (Maybe Expression)+leadsTo :: [Rewritten] -> String -> Expression -> [Rewritten]+leadsTo seq rule expr =+  let (prog, _) : rest = seq+   in (Program expr, Nothing) : (prog, Just rule) : rest++atom :: String -> Expression -> DataizeContext -> IO Expression atom "L_org_eolang_number_plus" self ctx = do-  left <- dataize' (ExDispatch self (AtLabel "x")) ctx-  right <- dataize' (ExDispatch self AtRho) ctx+  (left, _) <- dataize (Program (ExDispatch self (AtLabel "x"))) ctx+  (right, _) <- dataize (Program (ExDispatch self AtRho)) ctx   case (left, right) of     (Just left', Just right') -> do       let first = either toDouble id (btsToNum left')           second = either toDouble id (btsToNum right')           sum = first + second-      pure (Just (DataNumber (numToBts sum)))-    _ -> pure Nothing+      pure (DataNumber (numToBts sum))+    _ -> pure ExTermination atom "L_org_eolang_number_times" self ctx = do-  left <- dataize' (ExDispatch self (AtLabel "x")) ctx-  right <- dataize' (ExDispatch self AtRho) ctx+  (left, _) <- dataize (Program (ExDispatch self (AtLabel "x"))) ctx+  (right, _) <- dataize (Program (ExDispatch self AtRho)) ctx   case (left, right) of     (Just left', Just right') -> do       let first = either toDouble id (btsToNum left')           second = either toDouble id (btsToNum right')           sum = first * second-      pure (Just (DataNumber (numToBts sum)))-    _ -> pure Nothing+      pure (DataNumber (numToBts sum))+    _ -> pure ExTermination atom "L_org_eolang_number_eq" self ctx = do-  x <- dataize' (ExDispatch self (AtLabel "x")) ctx-  rho <- dataize' (ExDispatch self AtRho) ctx+  (x, _) <- dataize (Program (ExDispatch self (AtLabel "x"))) ctx+  (rho, _) <- dataize (Program (ExDispatch self AtRho)) ctx   case (x, rho) of     (Just x', Just rho') -> do       let self' = either toDouble id (btsToNum rho')           first = either toDouble id (btsToNum x')       if self' == first-        then pure (Just (DataNumber (numToBts first)))-        else pure (Just (ExDispatch self (AtLabel "y")))-    _ -> pure Nothing+        then pure (DataNumber (numToBts first))+        else pure (ExDispatch self (AtLabel "y"))+    _ -> pure ExTermination atom func _ _ = throwIO (userError (printf "Atom '%s' does not exist" func))

@@ -29,12 +29,16 @@   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 bindings) eol' tab'-  toASCII EX_APPLICATION' {..} = EX_APPLICATION' (toASCII expr) eol tab (toASCII args) eol' tab'+  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 expr = expr +instance ToASCII APP_BINDING where+  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@@ -54,6 +58,7 @@  instance ToASCII PAIR where   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

@@ -108,7 +108,7 @@  _concat :: BuildTermMethod _concat args subst = do-  args' <- traverse (\arg -> argToString arg subst) args+  args' <- traverse (`argToString` subst) args   pure (TeExpression (DataString (strToBts (concat args'))))  _sed :: BuildTermMethod

@@ -1,5 +1,3 @@-{-# LANGUAGE RecordWildCards #-}- -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com -- SPDX-License-Identifier: MIT @@ -35,10 +33,10 @@         hiddenBindings (bd@(BiTau attr form@(ExFormation _)) : bds) attrs@(attr' : rest)           | attr == attr' = BiTau attr (hiddenFormation form rest) : bds           | otherwise = bd : hiddenBindings bds attrs-        hiddenBindings bds _ = bds+        hiddenBindings (bd : bds) attrs = bd : hiddenBindings bds attrs     hiddenFormation expr attr = expr hide' prog (fqn : rest) = prog  hide :: [Rewritten] -> [Expression] -> [Rewritten] hide [] _ = []-hide (Rewritten {..} : rest) exprs = Rewritten (hide' program exprs) maybeRule : hide rest exprs+hide ((program, maybeRule) : rest) exprs = (hide' program exprs, maybeRule) : hide rest exprs

@@ -40,28 +40,18 @@   let equation = phiquation ctx    in concat         [ printf "\\begin{%s}\n" equation,-          case label of-            Just lbl -> printf "\\label{%s}\n" lbl-            _ -> "",-          case expression of-            Just expr -> printf "\\phiExpression{%s} " expr-            _ -> "",+          maybe "" (printf "\\label{%s}\n") label,+          maybe "" (printf "\\phiExpression{%s} ") expression,           intercalate             "\n  \\leadsto "             ( map-                ( \Rewritten {..} ->+                ( \(program, maybeName) ->                     let prog = renderToLatex program ctx-                        unknown = "unknown"-                        maybeTo = case maybeRule of-                          Just (Y.Rule {..}) -> Just (map toLower (fromMaybe unknown name))-                          _ -> Nothing-                     in case maybeTo of-                          Just name -> printf "%s \\leadsto_{\\nameref{r:%s}}" prog name-                          _ -> prog+                     in maybe prog (printf "%s \\leadsto_{\\nameref{r:%s}}" prog) maybeName                 )                 rewrittens             ),-          printf "\n\\end{%s}" equation+          printf ".\n\\end{%s}" equation         ]  programToLaTeX :: Program -> LatexContext -> String@@ -90,8 +80,9 @@ 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 bindings) eol' tab'-  toLaTeX EX_APPLICATION' {..} = EX_APPLICATION' (toLaTeX expr) eol tab (toLaTeX args) eol' tab'+  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 expr = expr @@ -99,6 +90,9 @@   toLaTeX AT_LABEL {..} = AT_LABEL (piped (toLaTeX label))   toLaTeX attr = attr +instance ToLaTeX APP_BINDING where+  toLaTeX APP_BINDING {..} = APP_BINDING (toLaTeX pair)+ instance ToLaTeX BINDING where   toLaTeX BI_PAIR {..} = BI_PAIR (toLaTeX pair) (toLaTeX bindings) tab   toLaTeX bd = bd@@ -113,6 +107,7 @@   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

@@ -26,10 +26,14 @@   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 bindings) NO_EOL TAB'-  toSingleLine EX_APPLICATION' {..} = EX_APPLICATION' (toSingleLine expr) NO_EOL TAB' (toSingleLine args) NO_EOL TAB'+  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 expr = expr +instance ToSingleLine APP_BINDING where+  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'@@ -42,6 +46,7 @@  instance ToSingleLine PAIR where   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

@@ -1,3 +1,5 @@+{-# LANGUAGE RecordWildCards #-}+ -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com -- SPDX-License-Identifier: MIT @@ -6,32 +8,42 @@     logInfo,     logWarning,     logError,-    setLogLevel,+    setLogConfig,     LogLevel (DEBUG, INFO, WARNING, ERROR, NONE),   ) where  import Control.Monad (when) import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import qualified Data.List as DL import GHC.IO (unsafePerformIO) import System.IO  data LogLevel = DEBUG | INFO | WARNING | ERROR | NONE   deriving (Show, Ord, Eq, Bounded, Enum, Read) -newtype Logger = Logger {level :: LogLevel}+data Logger = Logger {level :: LogLevel, lines :: Int}  logger :: IORef Logger {-# NOINLINE logger #-}-logger = unsafePerformIO (newIORef (Logger INFO))+logger = unsafePerformIO (newIORef (Logger INFO 25)) -setLogLevel :: LogLevel -> IO ()-setLogLevel lvl = writeIORef logger (Logger lvl)+setLogConfig :: LogLevel -> Integer -> IO ()+setLogConfig lvl lines = writeIORef logger (Logger lvl (fromIntegral lines))  logMessage :: LogLevel -> String -> IO () logMessage lvl message = do-  log <- readIORef logger-  when (lvl >= level log) $ hPutStrLn stderr ("[" ++ show lvl ++ "]: " ++ message)+  Logger {..} <- readIORef logger+  when+    (lvl >= level && lines /= 0)+    ( let lines' = DL.lines message+          toPrint = take lines lines'+          msg+            | lines == -1 = [message]+            | length lines' > lines = toPrint ++ ["---| log is limited by --log-lines=" ++ show lines ++ " option |---"]+            | otherwise = toPrint+       in hPutStrLn stderr ("[" ++ show lvl ++ "]: " ++ DL.intercalate "\n" msg)+    )  logDebug, logInfo, logWarning, logError :: String -> IO () logDebug = logMessage DEBUG

@@ -26,9 +26,11 @@     uniqueBindings,     uniqueBindings',     validateYamlObject,+    matchDataObject,     pattern DataObject,     pattern DataString,     pattern DataNumber,+    pattern BaseObject,   ) where @@ -69,15 +71,24 @@   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+matchBaseObject _ = Nothing++pattern BaseObject :: String -> Expression+pattern BaseObject label <- (matchBaseObject -> Just label)+  where+    BaseObject label = ExDispatch (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (AtLabel label)+ -- Minimal matcher function (required for view pattern) matchDataObject :: Expression -> Maybe (String, Bytes) matchDataObject   ( ExApplication-      (ExDispatch (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (AtLabel label))+      (BaseObject label)       ( BiTau           (AtAlpha 0)           ( ExApplication-              (ExDispatch (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (AtLabel "bytes"))+              (BaseObject "bytes")               ( BiTau                   (AtAlpha 0)                   (ExFormation [BiDelta bts, BiVoid AtRho])@@ -98,11 +109,11 @@   where     DataObject label bts =       ExApplication-        (ExDispatch (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (AtLabel label))+        (BaseObject label)         ( BiTau             (AtAlpha 0)             ( ExApplication-                (ExDispatch (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (AtLabel "bytes"))+                (BaseObject "bytes")                 ( BiTau                     (AtAlpha 0)                     (ExFormation [BiDelta bts, BiVoid AtRho])

@@ -1,10 +1,11 @@ -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com -- SPDX-License-Identifier: MIT -module Must (Must (..), inRange, exceedsUpperBound) where+module Must (Must (..), inRange, exceedsUpperBound, validateMust) where  import Data.List (isInfixOf) import Text.Read (readMaybe)+import Text.Printf (printf)  data Must   = MtDisabled@@ -63,3 +64,15 @@ exceedsUpperBound (MtExact n) current = current > n exceedsUpperBound (MtRange _ (Just max)) current = current > max exceedsUpperBound (MtRange _ Nothing) _ = False++validateMust :: Must -> Maybe String+validateMust MtDisabled = Nothing+validateMust (MtExact n) | n <= 0 = Just "--must exact value must be positive"+validateMust (MtRange (Just minVal) _) | minVal < 0 = Just "--must minimum must be non-negative"+validateMust (MtRange _ (Just maxVal)) | maxVal < 0 = Just "--must maximum must be non-negative"+validateMust (MtRange Nothing _) = Nothing+validateMust (MtRange _ Nothing) = Nothing+validateMust (MtRange (Just min) (Just max))+  | min > max = Just (printf "--must range invalid: minimum (%d) is greater than maximum (%d)" min max)+  | otherwise = Nothing+validateMust _ = Nothing

@@ -16,6 +16,8 @@     parseNumberThrows,     parseBinding,     parseBytes,+    PhiParser (..),+    phiParser,   ) where @@ -42,6 +44,16 @@   | CouldNotParseNumber {message :: String}   deriving (Exception) +data PhiParser = PhiParser+  { _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@@ -66,55 +78,6 @@   rest <- many (satisfy (`notElem` " \r\n\t,.|':;!?][}{)(⟧⟦") <?> "allowed character")   return (first : rest) -escapedChar :: Parser Char-escapedChar = do-  _ <- char '\\'-  c <- oneOf ['\\', '"', 'n', 'r', 't', 'b', 'f', 'u', 'x']-  case c of-    '\\' -> return '\\'-    '"' -> return '"'-    'n' -> return '\n'-    'r' -> return '\r'-    't' -> return '\t'-    'b' -> return '\b'-    'f' -> return '\f'-    'u' -> unicodeEscape-    'x' -> hexEscape-    _ -> fail ("Unknown escape: \\" ++ [c])-  where-    unicodeEscape :: Parser Char-    unicodeEscape = do-      hexDigits <- count 4 hexDigitChar-      case readHex hexDigits of-        [(n, "")] ->-          if n >= 0xD800 && n <= 0xDBFF-            then -- High surrogate, look for low surrogate-              do-                _ <- string "\\u"-                lowHexDigits <- count 4 hexDigitChar-                case readHex lowHexDigits of-                  [(low, "")] ->-                    if low >= 0xDC00 && low <= 0xDFFF-                      then do-                        -- Valid surrogate pair, combine them-                        let codePoint = 0x10000 + ((n - 0xD800) * 0x400) + (low - 0xDC00)-                        return (chr codePoint)-                      else fail ("Invalid low surrogate: \\u" ++ lowHexDigits)-                  _ -> fail ("Invalid low surrogate hex: \\u" ++ lowHexDigits)-            else-              if n >= 0xDC00 && n <= 0xDFFF-                then fail ("Unexpected low surrogate: \\u" ++ hexDigits)-                else-                  if n >= 0 && n <= 0x10FFFF-                    then return (chr n)-                    else fail ("Invalid Unicode code point: \\u" ++ hexDigits)-    hexEscape :: Parser Char-    hexEscape = do-      digits <- count 2 hexDigitChar-      case readHex digits of-        [(n, "")] -> return (chr n)-        _ -> fail ("Invalid hex escape: \\x" ++ digits)- function :: Parser String function = lexeme $ do   first <- oneOf ['A' .. 'Z']@@ -220,6 +183,57 @@         )     ) +quotedStr :: Parser String+quotedStr = char '"' >> manyTill (choice [escapedChar, noneOf ['\\', '"']]) (char '"')+  where+    escapedChar :: Parser Char+    escapedChar = do+      _ <- char '\\'+      c <- oneOf ['\\', '"', 'n', 'r', 't', 'b', 'f', 'u', 'x']+      case c of+        '\\' -> return '\\'+        '"' -> return '"'+        'n' -> return '\n'+        'r' -> return '\r'+        't' -> return '\t'+        'b' -> return '\b'+        'f' -> return '\f'+        'u' -> unicodeEscape+        'x' -> hexEscape+        _ -> fail ("Unknown escape: \\" ++ [c])+    unicodeEscape :: Parser Char+    unicodeEscape = do+      hexDigits <- count 4 hexDigitChar+      case readHex hexDigits of+        [(n, "")] ->+          if n >= 0xD800 && n <= 0xDBFF+            then -- High surrogate, look for low surrogate+              do+                _ <- string "\\u"+                lowHexDigits <- count 4 hexDigitChar+                case readHex lowHexDigits of+                  [(low, "")] ->+                    if low >= 0xDC00 && low <= 0xDFFF+                      then do+                        -- Valid surrogate pair, combine them+                        let codePoint = 0x10000 + ((n - 0xD800) * 0x400) + (low - 0xDC00)+                        return (chr codePoint)+                      else fail ("Invalid low surrogate: \\u" ++ lowHexDigits)+                  _ -> fail ("Invalid low surrogate hex: \\u" ++ lowHexDigits)+            else+              if n >= 0xDC00 && n <= 0xDFFF+                then fail ("Unexpected low surrogate: \\u" ++ hexDigits)+                else+                  if n >= 0 && n <= 0x10FFFF+                    then return (chr n)+                    else fail ("Invalid Unicode code point: \\u" ++ hexDigits)+    hexEscape :: Parser Char+    hexEscape = do+      digits <- count 2 hexDigitChar+      case readHex digits of+        [(n, "")] -> return (chr n)+        _ -> fail ("Invalid hex escape: \\x" ++ digits)+ tauBinding :: Parser Attribute -> Parser Binding tauBinding attr = do   attr' <- attr@@ -368,10 +382,7 @@         _ <- choice [symbol "T", symbol "⊥"]         return ExTermination,       number,-      lexeme $ do-        _ <- char '"'-        str <- manyTill (choice [escapedChar, noneOf ['\\', '"']]) (char '"')-        return (DataString (strToBts str)),+      lexeme (DataString . strToBts <$> quotedStr),       try (ExMeta <$> meta' 'e' "𝑒"),       ExDispatch ExThis <$> attribute     ]

@@ -14,6 +14,7 @@     printBytes,     printExtraArg,     printSubsts,+    printSubsts',     PrintConfig (..),     logPrintConfig,   )@@ -52,7 +53,7 @@ printExpression expr = printExpression' expr defaultPrintConfig  printAttribute' :: Attribute -> Encoding -> String-printAttribute' attr encoding = render (withEncoding encoding (toCST attr 0 :: ATTRIBUTE))+printAttribute' attr encoding = render (withEncoding encoding (toCST attr 0 NO_EOL :: ATTRIBUTE))  printAttribute :: Attribute -> String printAttribute attr =@@ -66,7 +67,7 @@ printBinding bd = printBinding' bd defaultPrintConfig  printBytes :: Bytes -> String-printBytes bts = render (toCST bts 0 :: BYTES)+printBytes bts = render (toCST bts 0 NO_EOL :: BYTES)  printExtraArg' :: ExtraArgument -> PrintConfig -> String printExtraArg' (ArgAttribute attr) (_, encoding, _) = printAttribute' attr encoding@@ -91,13 +92,13 @@  printSubst :: Subst -> PrintConfig -> String printSubst (Subst mp) config =-  "  "-    <> intercalate-      "\n  "-      (map (\(key, value) -> key <> " >> " <> printMetaValue value config) (Map.toList mp))+  intercalate+    "\n"+    (map (\(key, value) -> key <> " >> " <> printMetaValue value config) (Map.toList mp))  printSubsts' :: [Subst] -> PrintConfig -> String-printSubsts' substs config = intercalate "\n---\n" (map (`printSubst` config) substs)+printSubsts' [] _ = "------"+printSubsts' substs config = intercalate "\n------\n" (map (`printSubst` config) substs)  printSubsts :: [Subst] -> String printSubsts substs = printSubsts' substs defaultPrintConfig

@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-}  -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com@@ -125,6 +126,8 @@  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@@ -140,6 +143,9 @@   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+ instance Render BINDING where   render BI_EMPTY {..} = ""   render BI_PAIR {..} = render pair <> render bindings@@ -152,10 +158,6 @@   render AAS_EMPTY = ""   render AAS_EXPR {..} = render COMMA <> render eol <> render tab <> render expr <> render args --- @todo #163:30min Introduce node for formation with inlined voids.---  We need to be able to print formation with inlined void attributes:---  x(a, b) -> [[ y -> 1 ]] => x -> [[ a -> ?, b -> ?, y -> 1 ]]---  Don't forget to extend toSalty instance so such sugar. instance Render EXPRESSION where   render EX_GLOBAL {..} = render global   render EX_DEF_PACKAGE {..} = render pckg@@ -164,8 +166,9 @@   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 bindings <> render eol' <> render tab' <> ")"-  render EX_APPLICATION' {..} = render expr <> "(" <> render eol <> render tab <> render args <> render eol' <> render tab' <> ")"+  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

@@ -7,11 +7,12 @@ -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com -- SPDX-License-Identifier: MIT -module Rewriter (rewrite, rewrite', RewriteContext (..), Rewritten (..)) where+module Rewriter (rewrite, rewrite', RewriteContext (..), Rewritten) where  import AST import Builder import Control.Exception (Exception, throwIO)+import Data.Char (toLower) import Data.Foldable (foldlM) import Data.Functor ((<&>)) import qualified Data.Map.Strict as M@@ -33,19 +34,12 @@  type RewriteState = ([Rewritten], Set.Set Program) -data Rewritten = Rewritten-  { program :: Program,-    maybeRule :: Maybe Y.Rule-  }--instance Eq Rewritten where-  left == right = program left == program right+type Rewritten = (Program, Maybe String)  data RewriteContext = RewriteContext   { _maxDepth :: Integer,     _maxCycles :: Integer,     _depthSensitive :: Bool,-    _sequence :: Bool,     _buildTerm :: BuildTermFunc,     _must :: Must,     _saveStep :: SaveStepFunc@@ -131,7 +125,7 @@ tryBuildAndReplaceFast ptn res substs ctx = buildAndReplace' ptn res substs replaceProgramThrows ctx  -- The function returns tuple (X, Y) where--- - X is sequence of programs; for more details about this sequence see description of rewrite' function+-- - 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@@ -145,7 +139,7 @@       let ruleName = fromMaybe "unknown" (Y.name rule)           ptn = Y.pattern rule           res = Y.result rule-          Rewritten {..} = head _rewrittens+          (program, _) = head _rewrittens        in if _count - 1 == _maxDepth             then do               logDebug (printf "Max amount of rewriting cycles (%d) for rule '%s' has been reached, rewriting is stopped" _maxDepth ruleName)@@ -179,24 +173,19 @@                                 (printProgram prog)                             )                           _saveStep prog (((iteration - 1) * _maxDepth) + _count)-                          _rewrite (rewriteSequence prog, Set.insert prog _unique) (_count + 1)+                          _rewrite (leadsTo prog, Set.insert prog _unique) (_count + 1)       where-        rewriteSequence :: Program -> [Rewritten]-        rewriteSequence _prog-          | _sequence =-              let Rewritten {..} : rest = _rewrittens-               in Rewritten _prog Nothing : Rewritten program (Just rule) : rest-          | otherwise = [Rewritten _prog Nothing]+        leadsTo :: Program -> [Rewritten]+        leadsTo _prog =+          let (program, _) : rest = _rewrittens+           in (_prog, Nothing) : (program, Just (map toLower (fromMaybe "unknown" (Y.name rule)))) : rest  -- The function accepts single program but returns sequence of programs--- If RewriteContext has _sequence == True - all the intermediate--- programs after each rule application are included into sequence--- Otherwise sequence contains only one program rewrite' :: Program -> [Y.Rule] -> RewriteContext -> IO [Rewritten]-rewrite' prog rules ctx = _rewrite ([Rewritten prog Nothing], Set.empty) 1 ctx <&> reverse+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 state@(rewrittens, unique) count ctx@RewriteContext {..} = do       let cycles = _maxCycles           must = _must           current = count - 1@@ -212,7 +201,9 @@             else do               logDebug (printf "Starting rewriting cycle for all rules: %d out of %d" count cycles)               state'@(rewrittens', unique') <- rewrite state rules count ctx-              if head rewrittens' == head rewrittens+              let (program', _) = head rewrittens'+                  (program, _) = head rewrittens+              if program' == program                 then do                   logDebug "Rewriting is stopped since it has no effect"                   if not (inRange must current)

@@ -1,3 +1,4 @@+{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} @@ -60,9 +61,23 @@   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 (toSalty bindings) eol' tab'-  toSalty EX_APPLICATION' {..} = EX_APPLICATION (toSalty expr) eol tab (toSalty (argToBinding args tab)) eol' tab'+  toSalty EX_APPLICATION {..} = EX_APPLICATION (toSalty expr) EOL (TAB indent) (toSalty tau) EOL (TAB (indent - 1)) indent+  toSalty EX_APPLICATION_TAUS {..} =+    foldl+      toApplication+      expr+      (tauToPairs taus)     where+      toApplication :: EXPRESSION -> PAIR -> EXPRESSION+      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+      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)+    where       argToBinding :: APP_ARG -> TAB -> BINDING       argToBinding APP_ARG {..} =         BI_PAIR@@ -71,66 +86,73 @@       argsToBindings :: APP_ARGS -> Integer -> 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 = tb@TAB {..}} =-    let number = ExDispatch (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (AtLabel "number")-        bytes = ExDispatch (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (AtLabel "bytes")-        number' = toCST number (indent + 1) :: EXPRESSION-        bytes' = toCST bytes (indent + 2) :: EXPRESSION-        data' = toCST (ExFormation [BiDelta (numToBts (either toDouble id num))]) (indent + 2) :: EXPRESSION-     in toSalty-          ( EX_APPLICATION'-              number'-              EOL-              (TAB (indent + 1))-              ( APP_ARG-                  ( EX_APPLICATION'-                      bytes'-                      EOL-                      (TAB (indent + 2))-                      (APP_ARG data' AAS_EMPTY)-                      EOL-                      (TAB (indent + 1))-                  )-                  AAS_EMPTY-              )-              EOL-              tb-          )-  toSalty EX_STRING {str, tab = tb@TAB {..}} =-    let string = ExDispatch (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (AtLabel "string")-        bytes = ExDispatch (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (AtLabel "bytes")-        string' = toCST string (indent + 1) :: EXPRESSION-        bytes' = toCST bytes (indent + 2) :: EXPRESSION-        data' = toCST (ExFormation [BiDelta (strToBts str)]) (indent + 2) :: EXPRESSION-     in toSalty-          ( EX_APPLICATION'-              string'-              EOL-              (TAB (indent + 1))-              ( APP_ARG-                  ( EX_APPLICATION'-                      bytes'-                      EOL-                      (TAB (indent + 2))-                      (APP_ARG data' AAS_EMPTY)-                      EOL-                      (TAB (indent + 1))-                  )-                  AAS_EMPTY-              )-              EOL-              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} =+    saltifyPrimitive+      (toCST (BaseObject "string") (indent + 1) EOL)+      (toCST (BaseObject "bytes") (indent + 2) EOL)+      (toCST (ExFormation [BiDelta (strToBts str)]) (indent + 2) EOL)+      tab+      rhos   toSalty expr = expr +saltifyPrimitive :: EXPRESSION -> EXPRESSION -> EXPRESSION -> TAB -> [Binding] -> EXPRESSION+saltifyPrimitive base bytes data' tb@TAB {..} rhos =+  let next = TAB (indent + 1)+   in toSalty+        ( EX_APPLICATION_TAUS+            base+            EOL+            next+            ( BI_PAIR+                ( PA_TAU+                    (AT_ALPHA ALPHA 0)+                    ARROW+                    ( EX_APPLICATION_EXPRS+                        bytes+                        EOL+                        (TAB (indent + 2))+                        (APP_ARG data' AAS_EMPTY)+                        EOL+                        next+                        (indent + 2)+                    )+                )+                (toCST rhos (indent + 1) EOL)+                next+            )+            EOL+            tb+            (indent + 1)+        )+ instance ToSalty BINDING where   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)+ instance ToSalty BINDINGS where   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 {..}} =+    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 (attr : rest) bd = BDS_PAIR eol tab (PA_VOID attr arrow EMPTY) (joinToBindings rest bd)   toSalty pair = pair

@@ -134,13 +134,13 @@   = Ordinal Attribute   | Length Binding   | Literal Integer-  deriving (Generic, Show)+  deriving (Eq, Generic, Show)  data Comparable   = CmpAttr Attribute   | CmpNum Number   | CmpExpr Expression-  deriving (Generic, Show)+  deriving (Eq, Generic, Show)  data Condition   = And [Condition]@@ -153,7 +153,7 @@   | XI Expression   | Matches String Expression   | PartOf Expression Binding-  deriving (Generic, Show)+  deriving (Eq, Generic, Show)  data ExtraArgument   = ArgAttribute Attribute

@@ -10,7 +10,7 @@ import CLI (runCLI) import Control.Exception import Control.Monad (forM_, unless, when)-import Data.List (isInfixOf)+import Data.List (intercalate, isInfixOf) import Data.Version (showVersion) import GHC.IO.Handle import Paths_phino (version)@@ -116,6 +116,12 @@             ["rewrite", "--input=latex"]             ["The value 'latex' can't be used for '--input' option"] +      it "with negative --log-lines" $+        withStdin "" $+          testCLIFailed+            ["rewrite", "--log-lines=-2"]+            ["--log-lines must be >= -1"]+       it "with negative --max-depth" $         withStdin "" $           testCLIFailed@@ -276,9 +282,7 @@           ["rewrite", "--output=latex", "--sweet"]           [ "\\begin{phiquation}",             "\\Big\\{[[\n",-            "  |x\\char95{}o| -> QQ.|z|(\n",-            "    |y| -> 5\n",-            "  ),\n",+            "  |x\\char95{}o| -> QQ.|z|( |y| -> 5 ),\n",             "  |q\\char36{}| -> T,\n",             "  |w| -> $,\n",             "  ^ -> Q,\n",@@ -303,7 +307,7 @@         testCLISucceeded           ["rewrite", "--output=latex", "--sweet", "--flat", "--expression=foo"]           [ "\\begin{phiquation}",-            "\\phiExpression{foo} \\Big\\{[[ |x| -> 5 ]]\\Big\\}",+            "\\phiExpression{foo} \\Big\\{[[ |x| -> 5 ]]\\Big\\}.\n",             "\\end{phiquation}"           ] @@ -312,7 +316,7 @@         testCLISucceeded           ["rewrite", "--output=latex", "--sweet", "--flat", "--label=foo"]           [ "\\begin{phiquation}\n\\label{foo}\n",-            "\\Big\\{[[ |x| -> 5 ]]\\Big\\}\n",+            "\\Big\\{[[ |x| -> 5 ]]\\Big\\}.\n",             "\\end{phiquation}"           ] @@ -377,7 +381,7 @@               [ "\\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\\}",+                "  \\leadsto \\Big\\{[[ |x| -> \"foo\" ]]\\Big\\}.",                 "\\end{phiquation}"               ]           ]@@ -499,15 +503,98 @@           ["rewrite", "--sweet", "--flat"]           ["{⟦ x ↦ 5, y ↦ \"hey\", z ↦ ⟦ w ↦ ⟦⟧ ⟧ ⟧}"] +    it "removes unnecessary rho bindings in primitive applications" $+      withStdin+        ( unlines+            [ "{[[",+              "  z -> [[ x -> [[ t -> 42 ]].t ]].x,",+              "  org -> [[ eolang -> [[ bytes -> [[ data -> ? ]], number -> [[ as-bytes -> ? ]] ]] ]]",+              "]]}"+            ]+        )+        ( testCLISucceeded+            ["rewrite", "--sweet", "--normalize", "--flat"]+            ["{⟦ z ↦ 42, org ↦ ⟦ eolang ↦ ⟦ bytes(data) ↦ ⟦⟧, number(as-bytes) ↦ ⟦⟧ ⟧ ⟧ ⟧}"]+        )++    it "reduces log message" $+      withStdin "{[[ x -> [[ y -> ? ]](y -> 5) ]]}" $+        testCLISucceeded+          ["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 |---"+              ]+          ]+   describe "dataize" $ do     it "dataizes simple program" $       withStdin "Q -> [[ D> 01- ]]" $         testCLISucceeded ["dataize"] ["01-"] -    it "fails to dataize" $+    it "dataizes to dead" $       withStdin "Q -> [[ ]]" $-        testCLIFailed ["dataize"] ["[ERROR]: Could not dataize given program"]+        testCLISucceeded ["dataize"] ["⊥"] +    it "dataizes with --sequence" $+      withStdin "{[[ @ -> [[ x -> [[ D> 01-, y -> ? ]](y -> [[ ]]) ]].x ]]}" $+        testCLISucceeded+          ["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:M(prim)}}",+                "  \\leadsto \\Big\\{[[ D> 01-, |y| -> [[]], ^ -> [[ |x| -> [[ D> 01-, |y| -> [[]] ]] ]] ]]\\Big\\}.",+                "\\end{phiquation}",+                "01-"+              ]+          ]++    describe "fails" $ do+      it "with --output != latex and --nonumber" $+        withStdin "{[[]]}" $+          testCLIFailed+            ["dataize", "--nonumber", "--output=xmir"]+            ["The --nonumber option can stay together with --output=latex only"]++      it "with --omit-listing and --output != xmir" $+        withStdin "{[[]]}" $+          testCLIFailed+            ["dataize", "--omit-listing", "--output=phi"]+            ["--omit-listing"]++      it "with --omit-comments and --output != xmir" $+        withStdin "{[[]]}" $+          testCLIFailed+            ["dataize", "--omit-comments", "--output=phi"]+            ["--omit-comments"]++      it "with --expression and --output != latex" $+        withStdin "{[[]]}" $+          testCLIFailed+            ["dataize", "--expression=foo", "--output=phi"]+            ["--expression option can stay together with --output=latex only"]++      it "with --label and --output != latex" $+        withStdin "{[[]]}" $+          testCLIFailed+            ["dataize", "--label=foo", "--output=phi"]+            ["--label option can stay together with --output=latex only"]++      it "with wrong --hide option" $+        withStdin "{[[]]}" $+          testCLIFailed+            ["dataize", "--hide=Q.x(Q.y)"]+            ["[ERROR]: Invalid set of arguments: Only dispatch expression", "but given: Φ.x( Φ.y )"]+   describe "explain" $ do     it "explains single rule" $       testCLISucceeded@@ -556,15 +643,9 @@             [ "{⟦",               "  org ↦ ⟦",               "    eolang ↦ ⟦",-              "      number ↦ ⟦",-              "        φ ↦ ∅",-              "      ⟧,",-              "      bytes ↦ ⟦",-              "        data ↦ ∅",-              "      ⟧,",-              "      string ↦ ⟦",-              "        φ ↦ ∅",-              "      ⟧,",+              "      number(φ) ↦ ⟦⟧,",+              "      bytes(data) ↦ ⟦⟧,",+              "      string(φ) ↦ ⟦⟧,",               "      λ ⤍ Package",               "    ⟧,",               "    λ ⤍ Package",@@ -587,3 +668,40 @@       testCLIFailed         ["merge"]         ["At least one input file must be specified for 'merge' command"]+  +  describe "match" $ do+    it "takes from stdin" $+      withStdin "{[[]]}" $+        testCLISucceeded ["match"] ["[INFO]"]+    +    it "takes from file" $+      testCLISucceeded ["match", "test-resources/cli/foo.phi"] ["[INFO]"]+    +    it "does not print substitutions without pattern" $+      withStdin "{[[]]}" $+        testCLISucceeded ["match"] ["[INFO]: The --pattern is not provided, no substitutions are built"]+    +    it "prints one substitution" $+      withStdin "{[[ x -> Q.x ]]}" $+        testCLISucceeded ["match", "--pattern=Q.!a"] ["a >> x"]+    +    it "prints many substitutions" $+      withStdin "{[[ x -> Q.x, y -> Q.y ]]}" $+        testCLISucceeded ["match", "--pattern=Q.!a"] ["a >> x\n------\na >> y"]++    it "builds substitutions with conditions" $+      withStdin "{[[ x -> Q.y ]].x}" $+        testCLISucceeded+          ["match", "--pattern=[[ !a -> Q.y, !B ]].!a", "--when=and(not(alpha(!a)),eq(length(!B),1))"]+          ["B >> ⟦ ρ ↦ ∅ ⟧\na >> x"]+    +    it "builds with condition from file" $+      testCLISucceeded+        ["match", "--pattern=[[ !B ]]", "--when=eq(length(!B),2)", "test-resources/cli/foo.phi"]+        ["B >> ⟦\n  foo ↦ Φ.org.eolang.x,\n  ρ ↦ ∅\n⟧"]+    +    it "fails on parsing --when condition" $+      withStdin "{[[]]}" $+        testCLIFailed+          ["match", "--pattern=[[!B]]", "--when=hello"]+          ["[ERROR]: Couldn't parse given condition"]

@@ -0,0 +1,51 @@+-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+-- SPDX-License-Identifier: MIT++module ConditionSpec where++import AST (Attribute (AtLabel, AtMeta), Binding (BiMeta), Expression (ExDispatch, ExGlobal, ExMeta))+import Condition+import Control.Monad (forM_)+import Data.Either (isLeft, isRight)+import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)+import Yaml qualified as Y++spec :: Spec+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))"+      ]+      (\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")])+      ]+      (\(expr, res) -> it expr (parseCondition expr `shouldBe` Right res))++  describe "does not parse" $+    forM_+      [ "some()",+        "in(!a, !a)",+        "alpha(!B)",+        "or(or(), or())"+      ]+      (\expr -> it expr (parseCondition expr `shouldSatisfy` isLeft))

@@ -9,39 +9,49 @@ import Deps (dontSaveStep) import Functions (buildTerm) import Parser (parseProgramThrows)+import Printer (printProgram)+import Rewriter (Rewritten) import Test.Hspec  defaultDataizeContext :: Program -> DataizeContext defaultDataizeContext prog = DataizeContext prog 25 25 False buildTerm dontSaveStep -test :: (Eq a, Show a) => (Expression -> DataizeContext -> IO (Maybe a)) -> [(String, Expression, Expression, Maybe a)] -> Spec+test :: (Eq a, Show a) => ((Expression, [Rewritten]) -> DataizeContext -> IO (Maybe a, [Rewritten])) -> [(String, Expression, Expression, Maybe a)] -> Spec test func useCases =   forM_ useCases $ \(desc, input, prog, output) ->     it desc $ do-      res <- func input (defaultDataizeContext (Program prog))+      (res, _) <- func (input, []) (defaultDataizeContext (Program prog))       res `shouldBe` output +test' :: (Eq a, Show a) => ((Expression, [Rewritten]) -> DataizeContext -> IO (a, [Rewritten])) -> [(String, Expression, Expression, a)] -> Spec+test' func useCases =+  forM_ useCases $ \(desc, input, prog, output) ->+    it desc $ do+      (res, _) <- func (input, [(Program prog, Nothing)]) (defaultDataizeContext (Program prog))+      res `shouldBe` output+ testDataize :: [(String, String, Bytes)] -> Spec testDataize useCases =   forM_ useCases $ \(name, prog, res) ->     it name $ do       prog' <- parseProgramThrows prog-      value <- dataize prog' (defaultDataizeContext prog')+      putStrLn (printProgram prog')+      (value, _) <- dataize prog' (defaultDataizeContext prog')       value `shouldBe` Just res  spec :: Spec spec = do   describe "morph" $-    test+    test'       morph-      [ ("[[ D> 00- ]] => [[ D> 00- ]]", ExFormation [BiDelta (BtOne "00")], ExGlobal, Just (ExFormation [BiDelta (BtOne "00")])),-        ("T => T", ExTermination, ExGlobal, Just ExTermination),-        ("$ => X", ExThis, ExGlobal, Nothing),-        ("Q => X", ExGlobal, ExGlobal, Nothing),+      [ ("[[ 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 [])],-          Just (ExFormation [])+          ExFormation []         )       ] 

@@ -15,10 +15,8 @@ import Hide (hide) import Misc import Parser (parseExpressionThrows, parseProgramThrows)-import Rewriter import System.FilePath import Test.Hspec-import Yaml (normalizationRules)  data YamlPack = YamlPack   { program :: String,@@ -34,9 +32,7 @@ spec =   describe "hide packs" $ do     let resources = "test-resources/hide-packs"-        rule = head normalizationRules     packs <- runIO (allPathsIn resources)-     forM_       packs       ( \pth -> it (makeRelative resources pth) $ do@@ -44,6 +40,6 @@           prog <- parseProgramThrows program           expr <- parseExpressionThrows hidden           res <- parseProgramThrows result-          let [Rewritten {program = prog'}] = hide [Rewritten prog (Just rule)] [expr]+          let [(prog', _)] = hide [(prog, Nothing)] [expr]           prog' `shouldBe` res       )

@@ -9,7 +9,7 @@ import AST import Control.Monad (forM_) import Data.Either (isLeft, isRight)-import Misc (allPathsIn)+import Misc import Parser import System.FilePath (takeBaseName) import Test.Hspec (Example (Arg), Expectation, Spec, SpecWith, describe, it, runIO, shouldBe, shouldSatisfy)@@ -147,56 +147,20 @@           Just             ( ExApplication                 ( ExDispatch-                    ( ExApplication-                        (ExDispatch (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (AtLabel "number"))-                        ( BiTau-                            (AtAlpha 0)-                            ( ExApplication-                                (ExDispatch (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (AtLabel "bytes"))-                                ( BiTau-                                    (AtAlpha 0)-                                    (ExFormation [BiDelta (BtMany ["40", "14", "00", "00", "00", "00", "00", "00"]), BiVoid AtRho])-                                )-                            )-                        )-                    )+                    (DataNumber (BtMany ["40", "14", "00", "00", "00", "00", "00", "00"]))                     (AtLabel "plus")                 )                 ( BiTau                     (AtAlpha 0)                     ( ExApplication                         ( ExDispatch-                            ( ExApplication-                                (ExDispatch (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (AtLabel "number"))-                                ( BiTau-                                    (AtAlpha 0)-                                    ( ExApplication-                                        (ExDispatch (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (AtLabel "bytes"))-                                        ( BiTau-                                            (AtAlpha 0)-                                            (ExFormation [BiDelta (BtMany ["40", "14", "00", "00", "00", "00", "00", "00"]), BiVoid AtRho])-                                        )-                                    )-                                )-                            )+                            (DataNumber (BtMany ["40", "14", "00", "00", "00", "00", "00", "00"]))                             (AtLabel "q")                         )                         ( BiTau                             (AtAlpha 0)                             ( ExDispatch-                                ( ExApplication-                                    (ExDispatch (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (AtLabel "string"))-                                    ( BiTau-                                        (AtAlpha 0)-                                        ( ExApplication-                                            (ExDispatch (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (AtLabel "bytes"))-                                            ( BiTau-                                                (AtAlpha 0)-                                                (ExFormation [BiDelta (BtMany ["68", "65", "6C", "6C", "6F"]), BiVoid AtRho])-                                            )-                                        )-                                    )-                                )+                                (DataString (BtMany ["68", "65", "6C", "6C", "6F"]))                                 (AtLabel "length")                             )                         )

@@ -1,7 +1,6 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -Wno-orphans #-}  -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com@@ -20,7 +19,7 @@ import Must (Must (..)) import Parser (parseProgramThrows) import Printer (printProgram)-import Rewriter (RewriteContext (RewriteContext), Rewritten (..), rewrite')+import Rewriter (RewriteContext (RewriteContext), rewrite') import System.FilePath (makeRelative, replaceExtension, (</>)) import Test.Hspec (Spec, describe, expectationFailure, it, pending, runIO) import Yaml (normalizationRules)@@ -99,7 +98,7 @@                   if normalize'                     then pure normalizationRules                     else pure []-              [Rewritten {..}] <-+              rewrittens <-                 rewrite'                   prog                   rules'@@ -107,11 +106,11 @@                       repeat'                       repeat'                       False-                      False                       buildTerm                       must'                       dontSaveStep                   )+              let (program, _) = last rewrittens               result' <- parseProgramThrows (output pack)               unless (program == result') $                 expectationFailure