phino 0.0.0.45 → 0.0.0.46

raw patch · 38 files changed

+1423/−663 lines, 38 filesdep −prettyprinterPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: prettyprinter

API changes (from Hackage documentation)

Files

• phino.cabal +103/−82
• resources/miss.yaml +1/−1
• src/AST.hs +72/−0
• src/Ast.hs +0/−71
• src/Builder.hs +6/−6
• src/CLI.hs +43/−22
• src/CST.hs +289/−0
• src/Dataize.hs +4/−3
• src/Deps.hs +3/−3
• src/Encoding.hs +62/−0
• src/Functions.hs +27/−21
• src/LaTeX.hs +99/−19
• src/Lining.hs +50/−0
• src/Matcher.hs +2/−2
• src/Misc.hs +4/−1
• src/Parser.hs +2/−2
• src/Pretty.hs +0/−264
• src/Printer.hs +98/−0
• src/Render.hs +152/−0
• src/Replacer.hs +3/−3
• src/Rewriter.hs +59/−32
• src/Rule.hs +10/−10
• src/Sugar.hs +136/−0
• src/XMIR.hs +15/−16
• src/Yaml.hs +1/−1
• test/BuilderSpec.hs +1/−1
• test/CLISpec.hs +53/−10
• test/CSTSpec.hs +103/−0
• test/DataizeSpec.hs +1/−1
• test/FunctionsSpec.hs +4/−4
• test/MatcherSpec.hs +1/−1
• test/MiscSpec.hs +1/−1
• test/ParserSpec.hs +1/−1
• test/PrettySpec.hs +0/−70
• test/ReplacerSpec.hs +1/−1
• test/RewriterSpec.hs +11/−9
• test/RuleSpec.hs +4/−4
• test/XMIRSpec.hs +1/−1

@@ -1,18 +1,17 @@-cabal-version:      3.0--name:               phino-version:            0.0.0.45-license:            MIT-synopsis:           Command-Line Manipulator of 𝜑-Calculus Expressions-description:        Please see the README on GitHub at <https://github.com/objectionary/phino#readme>-homepage:           https://github.com/objectionary/phino#readme-bug-reports:        https://github.com/objectionary/phino/issues-license-file:       LICENSES/MIT.txt-author:             maxonfjvipon-maintainer:         mtrunnikov@gmail.com-copyright:          2025 Objectionary.com-category:           Language, Code Analysis-build-type:         Simple+cabal-version: 3.0+name: phino+version: 0.0.0.46+license: MIT+synopsis: Command-Line Manipulator of 𝜑-Calculus Expressions+description: Please see the README on GitHub at <https://github.com/objectionary/phino#readme>+homepage: https://github.com/objectionary/phino#readme+bug-reports: https://github.com/objectionary/phino/issues+license-file: LICENSES/MIT.txt+author: maxonfjvipon+maintainer: mtrunnikov@gmail.com+copyright: 2025 Objectionary.com+category: Language, Code Analysis+build-type: Simple extra-source-files: resources/*.yaml  source-repository head@@ -20,113 +19,135 @@   location: https://github.com/objectionary/phino  common warnings-  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wno-missing-export-lists+  ghc-options:+    -Wall+    -Wcompat+    -Widentities+    -Wincomplete-record-updates+    -Wincomplete-uni-patterns+    -Wmissing-home-modules+    -Wpartial-fields+    -Wredundant-constraints+    -Wno-missing-export-lists  library   exposed-modules:-    CLI,-    Ast,-    Parser,-    Matcher,-    Builder,-    Replacer,-    Rewriter,-    Yaml,-    Rule,-    Dataize,-    Functions,-    Deps,-    Misc,-    Must,-    Logger,-    Regexp,-    Pretty,-    Random,-    XMIR,+    AST+    Builder+    CLI+    CST+    Dataize+    Deps+    Encoding+    Functions     LaTeX+    Lining+    Logger+    Matcher+    Misc+    Must+    Parser+    Printer+    Random+    Regexp+    Render+    Replacer+    Rewriter+    Rule+    Sugar+    XMIR+    Yaml+   hs-source-dirs: src   other-modules:     Paths_phino+   autogen-modules:     Paths_phino+   build-depends:-    file-embed ^>=0.0.16.0,+    aeson,+    array,     base >=4.18.3.0 && <5,+    binary-ieee754,+    bytestring,     containers,-    megaparsec >= 9.0,-    text,-    aeson,-    yaml,     directory,+    file-embed ^>=0.0.16.0,     filepath,-    scientific,-    binary-ieee754,-    bytestring,-    utf8-string,-    prettyprinter,+    megaparsec >=9.0,     optparse-applicative,-    vector,     random,-    xml-conduit ^>=1.10,+    regex-pcre-builtin,+    scientific,+    text,     time ^>=1.12,     transformers,-    regex-pcre-builtin,-    array+    utf8-string,+    vector,+    xml-conduit ^>=1.10,+    yaml,+   default-language: Haskell2010  -- Executable using the library executable phino-  import:           warnings-  main-is:          Main.hs-  hs-source-dirs:   app+  import: warnings+  main-is: Main.hs+  hs-source-dirs: app   build-depends:+    base,     phino,-    base+   default-language: Haskell2010  -- Test suite for Matcher test-suite spec-  import:           warnings-  type:             exitcode-stdio-1.0-  main-is:          Main.hs-  hs-source-dirs:   test+  import: warnings+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs: test   other-modules:-    Spec,-    CLISpec,-    ParserSpec,-    MatcherSpec,-    BuilderSpec,-    ReplacerSpec,-    PrettySpec,-    RewriterSpec,-    RuleSpec,-    YamlSpec,-    MiscSpec,-    XMIRSpec,-    DataizeSpec,-    FunctionsSpec,+    BuilderSpec+    CLISpec+    CSTSpec+    DataizeSpec+    FunctionsSpec+    MatcherSpec+    MiscSpec+    ParserSpec     Paths_phino+    ReplacerSpec+    RewriterSpec+    RuleSpec+    Spec+    XMIRSpec+    YamlSpec+   autogen-modules:     Paths_phino+   default-extensions:     ImportQualifiedPost+   build-depends:-    optparse-applicative,+    aeson,     base,-    megaparsec,-    phino,     containers,+    directory,+    filepath,     hspec,     hspec-core,-    filepath,-    prettyprinter,-    aeson,-    yaml,-    text,-    silently,-    directory,+    megaparsec,+    optparse-applicative,+    phino,     process,-    xml-conduit ^>=1.10+    silently,+    text,+    xml-conduit ^>=1.10,+    yaml,+   build-tool-depends:     hspec-discover:hspec-discover+   default-language: Haskell2010

@@ -1,7 +1,7 @@ # SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com # SPDX-License-Identifier: MIT ----name: 'MISS'+name: MISS pattern: ⟦𝐵⟧(𝜏 ↦ 𝑒) result: ⊥ when:

@@ -0,0 +1,72 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-}++-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+-- SPDX-License-Identifier: MIT++-- This module represents AST tree for parsed phi-calculus program+module AST where++import Data.List (intercalate)+import GHC.Generics (Generic)++newtype Program = Program Expression -- Q -> expr+  deriving (Eq, Ord, Show)++data Expression+  = ExFormation [Binding] -- [[ bindings ]]+  | ExThis+  | ExGlobal -- Q+  | ExTermination -- T+  | ExMeta String -- !e+  | ExApplication Expression Binding -- expr(attr -> expr)+  | ExDispatch Expression Attribute -- expr.attr+  | ExMetaTail Expression String -- expr * !t+  deriving (Eq, Ord, Show, Generic)++data Binding+  = BiTau Attribute Expression -- attr -> expr+  | BiMeta String -- !B+  | BiDelta Bytes -- Δ ⤍ 1F-2A+  | BiVoid Attribute -- attr ↦ ?+  | BiLambda String -- λ ⤍ Function+  | BiMetaLambda String -- λ ⤍ !F+  deriving (Eq, Ord, Show, Generic)++data Bytes+  = BtEmpty -- --+  | BtOne String -- 1F-+  | BtMany [String] -- 00-01-02-...04+  | BtMeta String -- !b+  deriving (Eq, Ord, Show, Generic)++data Attribute+  = AtLabel String -- attr+  | AtAlpha Integer -- α1+  | AtPhi -- φ+  | AtRho -- ρ+  | AtLambda -- λ, used only in yaml conditions+  | AtDelta -- Δ, used only in yaml conditions+  | AtMeta String -- !a+  deriving (Eq, Generic, Ord)++instance Show Attribute where+  show (AtLabel label) = label+  show (AtAlpha idx) = 'α' : show idx+  show AtRho = "ρ"+  show AtPhi = "φ"+  show AtDelta = "Δ"+  show AtLambda = "λ"+  show (AtMeta meta) = '!' : meta++countNodes :: Program -> Integer+countNodes (Program expr) = countNodes' expr+  where+    countNodes' :: Expression -> Integer+    countNodes' ExGlobal = 1+    countNodes' ExTermination = 1+    countNodes' ExThis = 1+    countNodes' (ExApplication expr' (BiTau attr bexpr')) = 2 + countNodes' expr' + countNodes' bexpr'+    countNodes' (ExDispatch expr' attr) = 2 + countNodes' expr'+    countNodes' (ExFormation bds) = 1 + sum (map (\case BiTau attr expr' -> countNodes' expr'; _ -> 1) bds)+    countNodes' _ = 0

@@ -1,71 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE LambdaCase #-}---- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com--- SPDX-License-Identifier: MIT---- This module represents Ast tree for parsed phi-calculus program-module Ast where--import GHC.Generics (Generic)--newtype Program = Program Expression -- Q -> expr-  deriving (Eq, Ord, Show)--data Expression-  = ExFormation [Binding] -- [[ bindings ]]-  | ExThis -- $-  | ExGlobal -- Q-  | ExTermination -- T-  | ExMeta String -- !e-  | ExApplication Expression Binding -- expr(attr -> expr)-  | ExDispatch Expression Attribute -- expr.attr-  | ExMetaTail Expression String -- expr * !t-  deriving (Eq, Ord, Show, Generic)--data Binding-  = BiTau Attribute Expression -- attr -> expr-  | BiMeta String -- !B-  | BiDelta Bytes -- Δ ⤍ 1F-2A-  | BiVoid Attribute -- attr ↦ ?-  | BiLambda String -- λ ⤍ Function-  | BiMetaLambda String -- λ ⤍ !F-  deriving (Eq, Ord, Show, Generic)--data Bytes-  = BtEmpty -- ---  | BtOne String -- 1F--  | BtMany [String] -- 00-01-02-...04-  | BtMeta String -- !b-  deriving (Eq, Ord, Show, Generic)--data Attribute-  = AtLabel String -- attr-  | AtAlpha Integer -- α1-  | AtPhi -- φ-  | AtRho -- ρ-  | AtLambda -- λ, used only in yaml conditions-  | AtDelta -- Δ, used only in yaml conditions-  | AtMeta String -- !a-  deriving (Eq, Generic, Ord)--instance Show Attribute where-  show (AtLabel label) = label-  show (AtAlpha idx) = 'α' : show idx-  show AtRho = "ρ"-  show AtPhi = "φ"-  show AtDelta = "Δ"-  show AtLambda = "λ"-  show (AtMeta meta) = '!' : meta--countNodes :: Program -> Integer-countNodes (Program expr) = countNodes' expr-  where-    countNodes' :: Expression -> Integer-    countNodes' ExGlobal = 1-    countNodes' ExTermination = 1-    countNodes' ExThis = 1-    countNodes' (ExApplication expr' (BiTau attr bexpr')) = 2 + countNodes' expr' + countNodes' bexpr'-    countNodes' (ExDispatch expr' attr) = 2 + countNodes' expr'-    countNodes' (ExFormation bds) = 1 + sum (map (\case BiTau attr expr' -> countNodes' expr'; _ -> 1) bds)-    countNodes' _ = 0

@@ -22,12 +22,12 @@   ) where -import Ast+import AST import Control.Exception (Exception, throwIO) import qualified Data.Map.Strict as Map import Matcher import Misc (uniqueBindings)-import Pretty (prettyAttribute, prettyBinding, prettyBytes, prettyExpression, prettySubst)+import Printer import Text.Printf (printf) import Yaml (ExtraArgument (..)) @@ -52,21 +52,21 @@     printf       "Couldn't build expression, %s\n--Expression: %s"       _msg-      (prettyExpression _expr)+      (printExpression _expr)   show CouldNotBuildAttribute {..} =     printf       "Couldn't build attribute '%s', %s"-      (prettyAttribute _attr)+      (printAttribute _attr)       _msg   show CouldNotBuildBinding {..} =     printf       "Couldn't build binding, %s\n--Binding: %s"       _msg-      (prettyBinding _bd)+      (printBinding _bd)   show CouldNotBuildBytes {..} =     printf       "Couldn't build bytes '%s', %s"-      (prettyBytes _bts)+      (printBytes _bts)       _msg  contextualize :: Expression -> Expression -> Program -> Expression

@@ -9,19 +9,22 @@  module CLI (runCLI) where -import Ast (Program (Program))+import AST (Program (Program)) import Control.Exception (Exception (displayException), SomeException, handle, throw, throwIO) import Control.Exception.Base import Control.Monad (when) import Data.Char (toLower, toUpper)+import Data.Functor ((<&>)) import Data.List (intercalate) import Data.Maybe (isJust, isNothing) import Data.Version (showVersion) import Dataize (DataizeContext (DataizeContext), dataize) import Deps (saveStep)+import Encoding (Encoding (ASCII, UNICODE)) import Functions (buildTerm) import qualified Functions-import LaTeX (explainRules, programToLaTeX)+import LaTeX (LatexContext (LatexContext), explainRules, programToLaTeX, rewrittensToLatex)+import Lining (LineFormat (MULTILINE, SINGLELINE)) import Logger import Misc (ensuredFile) import qualified Misc@@ -29,8 +32,9 @@ import Options.Applicative import Parser (parseProgramThrows) import Paths_phino (version)-import Pretty (Encoding (UNICODE), PrintMode (SALTY, SWEET), prettyBytes, prettyProgram')-import Rewriter (RewriteContext (RewriteContext), rewrite')+import qualified Printer as P+import Rewriter (RewriteContext (RewriteContext), Rewritten (..), rewrite')+import Sugar import System.Exit (ExitCode (..), exitFailure) import System.IO (getContents') import Text.Printf (printf)@@ -65,6 +69,8 @@ data OptsDataize = OptsDataize   { logLevel :: LogLevel,     inputFormat :: IOFormat,+    sugarType :: SugarType,+    flat :: LineFormat,     maxDepth :: Integer,     maxCycles :: Integer,     depthSensitive :: Bool,@@ -85,7 +91,8 @@     rules :: [FilePath],     inputFormat :: IOFormat,     outputFormat :: IOFormat,-    printMode :: PrintMode,+    sugarType :: SugarType,+    flat :: LineFormat,     normalize :: Bool,     shuffle :: Bool,     omitListing :: Bool,@@ -95,6 +102,7 @@     maxDepth :: Integer,     maxCycles :: Integer,     inPlace :: Bool,+    sequence :: Bool,     targetFile :: Maybe FilePath,     stepsDir :: Maybe FilePath,     inputFile :: Maybe FilePath@@ -159,6 +167,12 @@ optShuffle :: Parser Bool optShuffle = switch (long "shuffle" <> help "Shuffle rules before applying") +optSugar :: Parser SugarType+optSugar = flag SALTY SWEET (long "sweet" <> help "Print result and intermediate (see --steps flag) 𝜑-programs using syntax sugar")++optLineFormat :: Parser LineFormat+optLineFormat = flag MULTILINE SINGLELINE (long "flat" <> help "Print result and intermediate (see --steps flag) 𝜑-programs in one line")+ explainParser :: Parser Command explainParser =   CmdExplain@@ -176,6 +190,8 @@     <$> ( OptsDataize             <$> optLogLevel             <*> optInputFormat+            <*> optSugar+            <*> optLineFormat             <*> optMaxDepth             <*> optMaxCycles             <*> optDepthSensitive@@ -191,7 +207,8 @@             <*> optRule             <*> optInputFormat             <*> option (parseIOFormat "output") (long "output" <> metavar "FORMAT" <> help "Program output format (phi, xmir)" <> value PHI <> showDefault)-            <*> flag SALTY SWEET (long "sweet" <> help "Print 𝜑-program using syntax sugar")+            <*> optSugar+            <*> optLineFormat             <*> optNormalize             <*> optShuffle             <*> switch (long "omit-listing" <> help "Omit full program listing in XMIR output")@@ -208,6 +225,7 @@             <*> 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")             <*> optTarget             <*> optStepsDir             <*> argInputFile@@ -216,8 +234,8 @@ commandParser :: Parser Command commandParser =   hsubparser-    ( command "rewrite" (info rewriteParser (progDesc "Rewrite the program"))-        <> command "dataize" (info dataizeParser (progDesc "Dataize the program"))+    ( command "rewrite" (info rewriteParser (progDesc "Rewrite the 𝜑-program"))+        <> command "dataize" (info dataizeParser (progDesc "Dataize the 𝜑-program"))         <> command "explain" (info explainParser (progDesc "Explain rules in LaTeX format"))     ) @@ -254,15 +272,15 @@       let xmirCtx = Just (XmirContext omitListing omitComments input)       rules' <- getRules normalize shuffle rules       program <- parseProgram input inputFormat-      rewritten <- rewrite' program rules' (context program xmirCtx)+      rewrittens <- rewrite' program rules' (context program xmirCtx)       logDebug (printf "Printing rewritten 𝜑-program as %s" (show outputFormat))-      prog <- printProgram outputFormat printMode xmirCtx rewritten-      output targetFile prog+      progs <- printRewrittens xmirCtx rewrittens+      output targetFile progs       where         validateOpts :: IO ()         validateOpts = do           when-            (printMode == SWEET && outputFormat == XMIR)+            (sugarType == SWEET && outputFormat == XMIR)             (throwIO (InvalidRewriteArguments "The --sweet and --output=xmir can't stay together"))           when             (inPlace && isNothing inputFile)@@ -293,15 +311,20 @@             maxDepth             maxCycles             depthSensitive+            sequence             buildTerm             must-            (saveStep stepsDir (ioToExtension outputFormat) (printProgram outputFormat printMode ctx))+            (saveStep stepsDir (ioToExtension outputFormat) (printProgram outputFormat (sugarType, flat) ctx))+        printRewrittens :: Maybe XmirContext -> [Rewritten] -> IO String+        printRewrittens ctx rewrittens+          | outputFormat == LATEX = pure (rewrittensToLatex rewrittens (LatexContext sugarType flat))+          | otherwise = mapM (printProgram outputFormat (sugarType, flat) ctx . program) rewrittens <&> intercalate "\n"     CmdDataize opts@OptsDataize {..} -> do       validateOpts       input <- readInput inputFile       prog <- parseProgram input inputFormat       dataized <- dataize prog (context prog)-      maybe (throwIO CouldNotDataize) (putStrLn . prettyBytes) dataized+      maybe (throwIO CouldNotDataize) (putStrLn . P.printBytes) dataized       where         validateOpts :: IO ()         validateOpts = do@@ -315,7 +338,7 @@             maxCycles             depthSensitive             buildTerm-            (saveStep stepsDir (ioToExtension PHI) (printProgram PHI SWEET Nothing))+            (saveStep stepsDir (ioToExtension PHI) (printProgram PHI (SWEET, MULTILINE) Nothing))     CmdExplain opts@OptsExplain {..} -> do       validateOpts       rules' <- getRules normalize shuffle rules@@ -364,13 +387,11 @@     parseProgram xmir XMIR = do       doc <- parseXMIRThrows xmir       xmirToPhi doc-    printProgram :: IOFormat -> PrintMode -> Maybe XmirContext -> Program -> IO String-    printProgram PHI mode _ prog = pure (prettyProgram' prog mode UNICODE)-    printProgram XMIR mode Nothing prog = printProgram XMIR mode (Just defaultXmirContext) prog-    printProgram XMIR _ (Just ctx) prog = do-      xmir <- programToXMIR prog ctx-      pure (printXMIR xmir)-    printProgram LATEX mode _ prog = pure (programToLaTeX prog mode)+    printProgram :: IOFormat -> (SugarType, LineFormat) -> Maybe XmirContext -> Program -> IO String+    printProgram PHI (sugar, line) _ prog = pure (P.printProgram' prog (sugar, UNICODE, line))+    printProgram XMIR cfg Nothing prog = printProgram XMIR cfg (Just defaultXmirContext) prog+    printProgram XMIR _ (Just ctx) prog = programToXMIR prog ctx <&> printXMIR+    printProgram LATEX (sugar, line) _ prog = pure (programToLaTeX prog (LatexContext sugar line))     getRules :: Bool -> Bool -> [FilePath] -> IO [Y.Rule]     getRules normalize shuffle rules = do       ordered <-

@@ -0,0 +1,289 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}++-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+-- SPDX-License-Identifier: MIT+-- This module represents concrete syntax tree for phi-calculus program+module CST where++import AST+import Data.List (intercalate)+import Misc++data LSB = LSB | LSB'+  deriving (Eq, Show)++data RSB = RSB | RSB'+  deriving (Eq, Show)++data COMMA = COMMA | NO_COMMA+  deriving (Eq, Show)++data ARROW = ARROW | ARROW'+  deriving (Eq, Show)++data DASHED_ARROW = DASHED_ARROW+  deriving (Eq, Show)++data VOID = EMPTY | QUESTION+  deriving (Eq, Show)++data PHI = PHI | AT+  deriving (Eq, Show)++data RHO = RHO | CARET+  deriving (Eq, Show)++data DELTA = DELTA+  deriving (Eq, Show)++data XI = XI | DOLLAR+  deriving (Eq, Show)++data LAMBDA = LAMBDA+  deriving (Eq, Show)++data GLOBAL = Φ | Q+  deriving (Eq, Show)++data DEF_PACKAGE = Φ̇ | QQ+  deriving (Eq, Show)++data TERMINATION = DEAD | T+  deriving (Eq, Show)++data SPACE = SPACE+  deriving (Eq, Show)++data EOL = EOL | NO_EOL+  deriving (Eq, Show)++data BYTES = BT_EMPTY | BT_ONE String | BT_MANY [String]+  deriving (Eq, Show)++data TAB+  = TAB {indent :: Integer}+  | TAB'+  | NO_TAB+  deriving (Eq, Show)++data ALPHA = ALPHA | ALPHA'+  deriving (Eq, Show)++data PROGRAM+  = PR_SWEET {expr :: EXPRESSION}+  | PR_SALTY {global :: GLOBAL, arrow :: ARROW, expr :: EXPRESSION}+  deriving (Eq, Show)++data PAIR+  = PA_TAU {attr :: 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+  | PA_DELTA {bytes :: BYTES}+  | PA_DELTA' {bytes :: BYTES} -- ASCII version of PA_DELTA+  deriving (Eq, Show)++data BINDING+  = BI_PAIR {pair :: PAIR, bindings :: BINDINGS, tab :: TAB}+  | BI_EMPTY {tab :: TAB}+  deriving (Eq, Show)++data BINDINGS+  = BDS_PAIR {eol :: EOL, tab :: TAB, pair :: PAIR, bindings :: BINDINGS}+  | BDS_EMPTY {tab :: TAB}+  deriving (Eq, Show)++-- Arguments for application with default α attributes+-- which are not necessary to be printed+data APP_ARG = APP_ARG {expr :: EXPRESSION, args :: APP_ARGS}+  deriving (Eq, Show)++data APP_ARGS+  = AAS_EXPR {eol :: EOL, tab :: TAB, expr :: EXPRESSION, args :: APP_ARGS}+  | AAS_EMPTY+  deriving (Eq, Show)++data EXPRESSION+  = EX_GLOBAL {global :: GLOBAL}+  | EX_DEF_PACKAGE {pckg :: DEF_PACKAGE}+  | 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}+  deriving (Eq, Show)++data ATTRIBUTE+  = AT_LABEL {label :: String}+  | AT_ALPHA {alpha :: ALPHA, idx :: Integer}+  | AT_RHO {rho :: RHO}+  | AT_PHI {phi :: PHI}+  | AT_LAMBDA {lambda :: LAMBDA}+  | AT_DELTA {delta :: DELTA}+  deriving (Eq, Show)++programToCST :: Program -> PROGRAM+programToCST prog = toCST prog 0++expressionToCST :: Expression -> EXPRESSION+expressionToCST expr = toCST expr 0++-- 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++instance ToCST Program PROGRAM where+  toCST (Program expr) tabs = PR_SWEET (toCST expr tabs)++instance ToCST Expression EXPRESSION where+  toCST ExGlobal _ = EX_GLOBAL Φ+  toCST ExThis _ = EX_XI XI+  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 =+    let next = tabs + 1+        bds' = toCST (withoutLastVoidRho bds) next :: BINDING+     in EX_FORMATION+          LSB+          EOL+          (TAB next)+          bds'+          EOL+          (TAB tabs)+          RSB+    where+      withoutLastVoidRho :: [Binding] -> [Binding]+      withoutLastVoidRho [] = []+      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 (ExApplication expr tau) tau') tabs =+    let (expr', taus, exprs) = complexApplication app+        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)+          else+            EX_APPLICATION'+              (toCST expr' tabs)+              EOL+              (TAB next)+              (toCST (reverse exprs) next)+              EOL+              (TAB tabs)+    where+      -- Here we unroll nested application sequence into flat structure+      -- The returned tuple consists of:+      -- 1. deepest start expression+      -- 2. list of tau bindings which are applied to start expression+      -- 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], [])+  toCST (ExApplication expr tau) tabs =+    let next = tabs + 1+     in EX_APPLICATION (toCST expr tabs) EOL (TAB next) (toCST [tau] next) EOL (TAB tabs)++instance ToCST [Expression] APP_ARG where+  toCST (expr : exprs) tabs = APP_ARG (toCST expr tabs) (toCST exprs tabs)++instance ToCST [Expression] APP_ARGS where+  toCST [] _ = AAS_EMPTY+  toCST (expr : exprs) tabs = AAS_EXPR EOL (TAB tabs) (toCST expr tabs) (toCST exprs tabs)++instance ToCST [Binding] BINDING where+  toCST [] tabs = BI_EMPTY (TAB tabs)+  toCST (bd : bds) tabs = BI_PAIR (toCST bd tabs) (toCST bds tabs) (TAB tabs)++instance ToCST [Binding] BINDINGS where+  toCST [] tabs = BDS_EMPTY (TAB tabs)+  toCST (bd : bds) tabs = BDS_PAIR EOL (TAB tabs) (toCST bd tabs) (toCST bds tabs)++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++instance ToCST Bytes BYTES where+  toCST BtEmpty _ = BT_EMPTY+  toCST (BtOne byte) _ = BT_ONE byte+  toCST (BtMany bts) _ = BT_MANY bts++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++class HasEOL a where+  hasEOL :: a -> Bool++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++instance HasEOL BINDING where+  hasEOL BI_EMPTY {..} = False+  hasEOL BI_PAIR {..} = hasEOL pair || hasEOL bindings++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 PAIR where+  hasEOL PA_TAU {..} = hasEOL expr+  hasEOL _ = False++instance HasEOL APP_ARG where+  hasEOL APP_ARG {..} = hasEOL expr || hasEOL args++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

@@ -6,14 +6,14 @@  module Dataize (morph, dataize, dataize', DataizeContext (..)) where -import Ast+import AST import Builder (contextualize) import Control.Exception (throwIO) import Data.List (partition) import Deps (BuildTermFunc, SaveStepFunc) import Misc import Must (Must (..))-import Rewriter (RewriteContext (RewriteContext), rewrite')+import Rewriter (RewriteContext (RewriteContext), Rewritten (Rewritten, program), rewrite') import Rule (RuleContext (RuleContext), isNF) import Text.Printf (printf) import XMIR (XmirContext (XmirContext))@@ -35,6 +35,7 @@     _maxDepth     _maxCycles     _depthSensitive+    False     _buildTerm     MtDisabled     _saveStep@@ -130,7 +131,7 @@       if isNF expr (RuleContext (_program ctx) (_buildTerm ctx))         then pure Nothing         else do-          (Program expr') <- rewrite' (Program expr) normalizationRules (switchContext ctx) -- NMZ+          [Rewritten {program = Program expr'}] <- rewrite' (Program expr) normalizationRules (switchContext ctx) -- NMZ           morph expr' ctx  -- The goal of 'dataize' function is retrieve bytes from given expression.

@@ -9,7 +9,7 @@ -- Functions module because Rewriter does not depend on Functions anymore. module Deps where -import Ast+import AST import Logger (logDebug) import Matcher import System.Directory (createDirectoryIfMissing)@@ -31,10 +31,10 @@  saveStep :: Maybe FilePath -> String -> (Program -> IO String) -> SaveStepFunc saveStep Nothing _ _ _ _ = pure ()-saveStep (Just dir) ext print' prog step = do+saveStep (Just dir) ext print prog step = do   createDirectoryIfMissing True dir   let path = dir </> printf "%05d.%s" step ext-  content <- print' prog+  content <- print prog   writeFile path content   logDebug (printf "Saved step '%d' to '%s'" step path) 

@@ -0,0 +1,62 @@+{-# LANGUAGE RecordWildCards #-}++-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+-- SPDX-License-Identifier: MIT++module Encoding (toASCII, withEncoding, Encoding (..)) where++import CST++data Encoding = ASCII | UNICODE+  deriving (Eq, Show)++withEncoding :: (ToASCII a) => Encoding -> a -> a+withEncoding UNICODE prog = prog+withEncoding ASCII prog = toASCII prog++class ToASCII a where+  toASCII :: a -> a++instance ToASCII PROGRAM where+  toASCII PR_SALTY {..} = PR_SALTY Q ARROW' (toASCII expr)+  toASCII PR_SWEET {..} = PR_SWEET (toASCII expr)++instance ToASCII EXPRESSION where+  toASCII EX_GLOBAL {..} = EX_GLOBAL Q+  toASCII EX_DEF_PACKAGE {..} = EX_DEF_PACKAGE QQ+  toASCII EX_XI {..} = EX_XI DOLLAR+  toASCII EX_ATTR {..} = EX_ATTR (toASCII attr)+  toASCII EX_TERMINATION {..} = EX_TERMINATION T+  toASCII EX_FORMATION {..} = EX_FORMATION LSB' eol tab (toASCII binding) eol' tab' RSB'+  toASCII EX_DISPATCH {..} = EX_DISPATCH (toASCII expr) (toASCII attr)+  toASCII EX_APPLICATION {..} = EX_APPLICATION (toASCII expr) eol tab (toASCII bindings) eol' tab'+  toASCII EX_APPLICATION' {..} = EX_APPLICATION' (toASCII expr) eol tab (toASCII args) eol' tab'+  toASCII expr = expr++instance ToASCII BINDING where+  toASCII BI_PAIR {..} = BI_PAIR (toASCII pair) (toASCII bindings) tab+  toASCII bd = bd++instance ToASCII BINDINGS where+  toASCII BDS_PAIR {..} = BDS_PAIR eol tab (toASCII pair) (toASCII bindings)+  toASCII bds = bds++instance ToASCII APP_ARG where+  toASCII APP_ARG {..} = APP_ARG (toASCII expr) (toASCII args)++instance ToASCII APP_ARGS where+  toASCII AAS_EXPR {..} = AAS_EXPR eol tab (toASCII expr) (toASCII args)+  toASCII args = args++instance ToASCII PAIR where+  toASCII PA_TAU {..} = PA_TAU (toASCII attr) ARROW' (toASCII expr)+  toASCII PA_VOID {..} = PA_VOID (toASCII attr) ARROW' QUESTION+  toASCII PA_LAMBDA {..} = PA_LAMBDA' func+  toASCII PA_DELTA {..} = PA_DELTA' bytes+  toASCII pair = pair++instance ToASCII ATTRIBUTE where+  toASCII AT_ALPHA {..} = AT_ALPHA ALPHA' idx+  toASCII AT_PHI {..} = AT_PHI AT+  toASCII AT_RHO {..} = AT_RHO CARET+  toASCII attr = attr

@@ -5,7 +5,7 @@  module Functions (buildTerm) where -import Ast+import AST import Builder import Control.Exception (throwIO) import Control.Monad (replicateM, when)@@ -20,36 +20,42 @@ import Misc import Numeric (showHex) import Parser (parseAttributeThrows, parseNumberThrows)-import Pretty import Random (randomString) import Regexp import System.Random (randomRIO) import Deps import Text.Printf (printf) import qualified Yaml as Y+import Printer (printAttribute, printExpression, printExtraArg)+import Logger (logDebug)  buildTerm :: BuildTermFunc-buildTerm "contextualize" = _contextualize-buildTerm "scope" = _scope-buildTerm "random-tau" = _randomTau-buildTerm "dataize" = _dataize-buildTerm "concat" = _concat-buildTerm "sed" = _sed-buildTerm "random-string" = _randomString-buildTerm "size" = _size-buildTerm "tau" = _tau-buildTerm "string" = _string-buildTerm "number" = _number-buildTerm "sum" = _sum-buildTerm "join" = _join-buildTerm func = _unsupported func+buildTerm func args subst prog = do+  logDebug (printf "Building new term using '%s' function..." func)+  buildTerm' func args subst prog +buildTerm' :: BuildTermFunc+buildTerm' "contextualize" = _contextualize+buildTerm' "scope" = _scope+buildTerm' "random-tau" = _randomTau+buildTerm' "dataize" = _dataize+buildTerm' "concat" = _concat+buildTerm' "sed" = _sed+buildTerm' "random-string" = _randomString+buildTerm' "size" = _size+buildTerm' "tau" = _tau+buildTerm' "string" = _string+buildTerm' "number" = _number+buildTerm' "sum" = _sum+buildTerm' "join" = _join+buildTerm' func = _unsupported func+ argToBytes :: Y.ExtraArgument -> Subst -> Program -> IO Bytes argToBytes (Y.ArgBytes bytes) subst _ = buildBytesThrows bytes subst argToBytes (Y.ArgExpression expr) subst prog = do   (TeBytes bts) <- _dataize [Y.ArgExpression expr] subst prog   pure bts-argToBytes arg _ _ = throwIO (userError (printf "Can't extract bytes from given argument: %s" (prettyExtraArg arg)))+argToBytes arg _ _ = throwIO (userError (printf "Can't extract bytes from given argument: %s" (printExtraArg arg)))  argToString :: Y.ExtraArgument -> Subst -> Program -> IO String argToString arg subst prog = argToBytes arg subst prog <&> btsToUnescapedStr@@ -83,7 +89,7 @@       Y.ArgAttribute attr -> do         attr' <- buildAttributeThrows attr subst         rest' <- argsToAttrs rest-        pure (prettyAttribute attr' : rest')+        pure (printAttribute attr' : rest')       Y.ArgBinding bd -> do         bds <- buildBindingThrows bd subst         rest' <- argsToAttrs rest@@ -186,13 +192,13 @@         ( userError             ( printf                 "Couldn't convert given expression to 'Φ̇.string' object, only 'Φ̇.number' or 'Φ̇.string' are allowed\n%s"-                (prettyExpression' exp)+                (printExpression exp)             )         )   pure (TeExpression str) _string [Y.ArgAttribute attr] subst _ = do   attr' <- buildAttributeThrows attr subst-  pure (TeExpression (DataString (strToBts (prettyAttribute attr'))))+  pure (TeExpression (DataString (strToBts (printAttribute attr')))) _string _ _ _ = throwIO (userError "Function string() requires exactly 1 argument as attribute or data expression (Φ̇.number or Φ̇.string)")  _number :: BuildTermMethod@@ -202,7 +208,7 @@     DataString bts -> do       num <- parseNumberThrows (btsToUnescapedStr bts)       pure (TeExpression num)-    _ -> throwIO (userError (printf "Function number() expects expression to be 'Φ̇.string', but got:\n%s" (prettyExpression' expr')))+    _ -> throwIO (userError (printf "Function number() expects expression to be 'Φ̇.string', but got:\n%s" (printExpression expr'))) _number _ _ _ = throwIO (userError "Function number() requires exactly 1 argument as 'Φ̇.string'")  _sum :: BuildTermMethod

@@ -1,33 +1,113 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RecordWildCards #-}+ -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com -- SPDX-License-Identifier: MIT -module LaTeX (explainRules, programToLaTeX) where+module LaTeX (explainRules, rewrittensToLatex, programToLaTeX, LatexContext (..)) where -import Ast (Program)+import AST (Program)+import CST+import Data.Char (toLower) import Data.List (intercalate) import Data.Maybe (fromMaybe)-import Pretty (Encoding (ASCII), PrintMode, prettyProgram')+import Encoding (Encoding (ASCII), withEncoding)+import Lining (LineFormat (MULTILINE, SINGLELINE), withLineFormat)+import Printer (printProgram')+import Render (Render (render))+import Rewriter (Rewritten (..))+import Sugar (SugarType (SWEET), withSugarType)+import Text.Printf (printf) import qualified Yaml as Y -escapeUnprintedChars :: String -> String-escapeUnprintedChars [] = []-escapeUnprintedChars (ch : rest) = case ch of-  '$' -> "\\char36{}" ++ escapeUnprintedChars rest-  '@' -> "\\char64{}" ++ escapeUnprintedChars rest-  '^' -> "\\char94{}" ++ escapeUnprintedChars rest-  _ -> ch : escapeUnprintedChars rest+data LatexContext = LatexContext+  { sugar :: SugarType,+    line :: LineFormat+  } -programToLaTeX :: Program -> PrintMode -> String-programToLaTeX prog mode =+renderToLatex :: Program -> LatexContext -> String+renderToLatex prog LatexContext {..} = render (toLaTeX $ withLineFormat line $ withEncoding ASCII $ withSugarType sugar $ programToCST prog)++rewrittensToLatex :: [Rewritten] -> LatexContext -> String+rewrittensToLatex rewrittens ctx =+  concat+    [ "\\begin{phiquation}\n",+      intercalate+        "\n\\leadsto "+        ( map+            ( \Rewritten {..} ->+                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+            )+            rewrittens+        ),+      "\n\\end{phiquation}"+    ]++programToLaTeX :: Program -> LatexContext -> String+programToLaTeX prog ctx =   unlines-    [ "\\documentclass{article}",-      "\\usepackage{eolang}",-      "\\begin{document}",-      "\\begin{phiquation}",-      escapeUnprintedChars (prettyProgram' prog mode ASCII),-      "\\end{phiquation}",-      "\\end{document}"+    [ "\\begin{phiquation}",+      renderToLatex prog ctx,+      "\\end{phiquation}"     ]++class ToLaTeX a where+  toLaTeX :: a -> a++instance ToLaTeX PROGRAM where+  toLaTeX PR_SWEET {..} = PR_SWEET (toLaTeX expr)+  toLaTeX PR_SALTY {..} = PR_SALTY global arrow (toLaTeX expr)++instance ToLaTeX EXPRESSION where+  toLaTeX EX_ATTR {..} = EX_ATTR (toLaTeX attr)+  toLaTeX EX_FORMATION {..} = EX_FORMATION lsb eol tab (toLaTeX binding) eol' tab' rsb+  toLaTeX EX_APPLICATION {..} = EX_APPLICATION (toLaTeX expr) eol tab (toLaTeX bindings) eol' tab'+  toLaTeX EX_APPLICATION' {..} = EX_APPLICATION' (toLaTeX expr) eol tab (toLaTeX args) eol' tab'+  toLaTeX expr = expr++instance ToLaTeX ATTRIBUTE where+  toLaTeX AT_LABEL {..} = AT_LABEL (toLaTeX label)+  toLaTeX attr = attr++instance ToLaTeX BINDING where+  toLaTeX BI_PAIR {..} = BI_PAIR (toLaTeX pair) (toLaTeX bindings) tab+  toLaTeX bd = bd++instance ToLaTeX BINDINGS where+  toLaTeX BDS_PAIR {..} = BDS_PAIR eol tab (toLaTeX pair) (toLaTeX bindings)+  toLaTeX bds = bds++instance ToLaTeX PAIR where+  toLaTeX PA_DELTA {..} = PA_DELTA' bytes+  toLaTeX PA_LAMBDA {..} = PA_LAMBDA' func+  toLaTeX PA_VOID {..} = PA_VOID (toLaTeX attr) arrow void+  toLaTeX PA_TAU {..} = PA_TAU (toLaTeX attr) arrow (toLaTeX expr)+  toLaTeX pair = pair++instance ToLaTeX APP_ARG where+  toLaTeX APP_ARG {..} = APP_ARG (toLaTeX expr) (toLaTeX args)++instance ToLaTeX APP_ARGS where+  toLaTeX AAS_EXPR {..} = AAS_EXPR eol tab (toLaTeX expr) (toLaTeX args)+  toLaTeX args = args++instance ToLaTeX String where+  toLaTeX = escapeUnprintedChars+    where+      escapeUnprintedChars :: String -> String+      escapeUnprintedChars [] = []+      escapeUnprintedChars (ch : rest) = case ch of+        '$' -> "\\char36{}" <> escapeUnprintedChars rest+        '@' -> "\\char64{}" <> escapeUnprintedChars rest+        '^' -> "\\char94{}" <> escapeUnprintedChars rest+        _ -> ch : escapeUnprintedChars rest  -- @todo #114:30min Implement LaTeX conversion for rules. --  Convert Rule data structure to LaTeX inference rule format.

@@ -0,0 +1,50 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}++-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+-- SPDX-License-Identifier: MIT++module Lining (toSingleLine, LineFormat (..), withLineFormat) where++import CST++withLineFormat :: (ToSingleLine a) => LineFormat -> a -> a+withLineFormat MULTILINE prog = prog+withLineFormat SINGLELINE prog = toSingleLine prog++data LineFormat = SINGLELINE | MULTILINE+  deriving (Show, Eq)++class ToSingleLine a where+  toSingleLine :: a -> a++instance ToSingleLine PROGRAM where+  toSingleLine PR_SALTY {..} = PR_SALTY global arrow (toSingleLine expr)+  toSingleLine PR_SWEET {..} = PR_SWEET (toSingleLine expr)++instance ToSingleLine EXPRESSION where+  toSingleLine EX_FORMATION {lsb, binding = bd@BI_EMPTY {..}, rsb} = EX_FORMATION lsb NO_EOL NO_TAB bd NO_EOL NO_TAB rsb+  toSingleLine EX_FORMATION {..} = EX_FORMATION lsb NO_EOL TAB' (toSingleLine binding) NO_EOL TAB' rsb+  toSingleLine EX_DISPATCH {..} = EX_DISPATCH (toSingleLine expr) attr+  toSingleLine EX_APPLICATION {..} = EX_APPLICATION (toSingleLine expr) NO_EOL TAB' (toSingleLine bindings) NO_EOL TAB'+  toSingleLine EX_APPLICATION' {..} = EX_APPLICATION' (toSingleLine expr) NO_EOL TAB' (toSingleLine args) NO_EOL TAB'+  toSingleLine expr = expr++instance ToSingleLine BINDING where+  toSingleLine BI_PAIR {..} = BI_PAIR (toSingleLine pair) (toSingleLine bindings) TAB'+  toSingleLine bd = bd++instance ToSingleLine BINDINGS where+  toSingleLine BDS_PAIR {..} = BDS_PAIR NO_EOL TAB' (toSingleLine pair) (toSingleLine bindings)+  toSingleLine bds = bds++instance ToSingleLine PAIR where+  toSingleLine PA_TAU {..} = PA_TAU attr arrow (toSingleLine expr)+  toSingleLine pair = pair++instance ToSingleLine APP_ARG where+  toSingleLine APP_ARG {..} = APP_ARG (toSingleLine expr) (toSingleLine args)++instance ToSingleLine APP_ARGS where+  toSingleLine AAS_EXPR {..} = AAS_EXPR NO_EOL TAB' (toSingleLine expr) (toSingleLine args)+  toSingleLine args = args

@@ -3,11 +3,11 @@ -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com -- SPDX-License-Identifier: MIT --- The goal of the module is to traverse given Ast and build substitutions+-- The goal of the module is to traverse given AST and build substitutions -- from meta variables to appropriate meta values module Matcher where -import Ast+import AST import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Maybe (catMaybes)

@@ -30,7 +30,7 @@   ) where -import Ast+import AST import Control.Exception import Control.Monad import Data.Binary.IEEE754@@ -193,6 +193,7 @@ -- >>> toDouble 5 -- 5.0 toDouble :: Integer -> Double+ toDouble = fromIntegral  -- >>> btsToWord8 BtEmpty@@ -276,6 +277,8 @@ -- BtMany ["68","22"] -- >>> strToBts "\x01\x01" -- BtMany ["01","01"]+-- >>> strToBts "Hey"+-- BtMany ["48","65","79"] strToBts :: String -> Bytes strToBts "" = BtEmpty strToBts [ch] = word8ToBytes (unpack (U.fromString [ch]))

@@ -4,7 +4,7 @@ -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com -- SPDX-License-Identifier: MIT --- The goal of the module is to parse given phi program to Ast+-- The goal of the module is to parse given phi program to AST module Parser   ( parseProgram,     parseProgramThrows,@@ -19,7 +19,7 @@   ) where -import Ast+import AST import Control.Exception (Exception, throwIO) import Control.Monad (guard) import Data.Char (isAsciiLower, isDigit)

@@ -1,264 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}---- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com--- SPDX-License-Identifier: MIT--module Pretty-  ( prettyExpression,-    prettyExpression',-    prettyProgram,-    prettyProgram',-    prettyAttribute,-    prettySubsts,-    prettySubsts',-    prettySubst,-    prettyBinding,-    prettyBytes,-    prettyExtraArg,-    PrintMode (SWEET, SALTY),-    Encoding (ASCII, UNICODE),-  )-where--import Ast-import Data.List (intercalate)-import qualified Data.Map.Strict as Map-import Matcher-import Misc-import Prettyprinter-import Prettyprinter.Render.String (renderString)-import Yaml (ExtraArgument (..))--data PrintMode = SWEET | SALTY-  deriving (Eq)--instance Show PrintMode where-  show SWEET = "sweet"-  show SALTY = "salty"--data Encoding = ASCII | UNICODE--newtype Formatted a = Formatted {unFormatted :: (PrintMode, Encoding, a)}--formatted :: a -> Formatted a-formatted x = Formatted (SALTY, UNICODE, x)--prettyMeta :: String -> Doc ann-prettyMeta meta = pretty "!" <> pretty meta--prettyArrow :: Encoding -> Doc ann-prettyArrow UNICODE = pretty "↦"-prettyArrow ASCII = pretty "->"--prettyLsb :: Encoding -> Doc ann-prettyLsb UNICODE = pretty "⟦"-prettyLsb ASCII = pretty "[["--prettyRsb :: Encoding -> Doc ann-prettyRsb UNICODE = pretty "⟧"-prettyRsb ASCII = pretty "]]"--prettyDashedArrow :: Doc ann-prettyDashedArrow = pretty "⤍"--prettyLambda :: Encoding -> Doc ann-prettyLambda UNICODE = pretty "λ" <+> prettyDashedArrow-prettyLambda ASCII = pretty "L>"--prettyDelta :: Encoding -> Doc ann-prettyDelta UNICODE = pretty "Δ" <+> prettyDashedArrow-prettyDelta ASCII = pretty "D>"--instance Pretty ExtraArgument where-  pretty (ArgExpression expr) = pretty (Formatted (SWEET, UNICODE, expr))-  pretty (ArgBinding bd) = pretty (Formatted (SWEET, UNICODE, bd))-  pretty (ArgAttribute attr) = pretty (formatted attr)-  pretty (ArgBytes bytes) = pretty bytes--instance Pretty Bytes where-  pretty BtEmpty = pretty "--"-  pretty (BtOne bt) = pretty bt <> pretty "-"-  pretty (BtMany bts) = pretty (intercalate "-" bts)-  pretty (BtMeta meta) = prettyMeta meta--instance Pretty (Formatted Attribute) where-  pretty (Formatted (_, _, AtMeta meta)) = prettyMeta meta-  pretty (Formatted (_, ASCII, AtAlpha idx)) = pretty "~" <> pretty idx-  pretty (Formatted (_, ASCII, AtPhi)) = pretty "@"-  pretty (Formatted (_, ASCII, AtRho)) = pretty "^"-  pretty (Formatted (_, _, attr)) = pretty (show attr)--instance Pretty (Formatted Binding) where-  pretty (Formatted (SWEET, encoding, BiTau attr (ExFormation bindings))) =-    let voids' = voids bindings-     in if null voids'-          then pretty (Formatted (SWEET, encoding, attr)) <+> prettyArrow encoding <+> pretty (Formatted (SWEET, encoding, ExFormation bindings))-          else-            if length voids' == length bindings && last voids' == AtRho-              then inlineVoids (init voids') <+> prettyLsb encoding <> prettyRsb encoding-              else inlineVoids voids' <+> pretty (Formatted (SWEET, encoding, ExFormation (drop (length voids') bindings)))-    where-      voids :: [Binding] -> [Attribute]-      voids [] = []-      voids (bd : bds) = case bd of-        BiVoid attr -> attr : voids bds-        _ -> []-      inlineVoids :: [Attribute] -> Doc ann-      inlineVoids [] = pretty (Formatted (SWEET, encoding, attr)) <+> prettyArrow encoding-      inlineVoids voids' =-        pretty (Formatted (SWEET, encoding, attr))-          <> lparen-          <> hsep (punctuate comma (map (\attr -> pretty (Formatted (SWEET, encoding, attr))) voids'))-          <> rparen-          <+> prettyArrow encoding-  pretty (Formatted (mode, encoding, BiTau attr expr)) = pretty (Formatted (mode, encoding, attr)) <+> prettyArrow encoding <+> pretty (Formatted (mode, encoding, expr))-  pretty (Formatted (_, _, BiMeta meta)) = prettyMeta meta-  pretty (Formatted (_, encoding, BiDelta bytes)) = prettyDelta encoding <+> pretty bytes-  pretty (Formatted (_, encoding, BiLambda func)) = prettyLambda encoding <+> pretty func-  pretty (Formatted (_, encoding, BiMetaLambda meta)) = prettyLambda encoding <+> prettyMeta meta-  pretty (Formatted (mode, UNICODE, BiVoid attr)) = pretty (Formatted (mode, UNICODE, attr)) <+> prettyArrow UNICODE <+> pretty "∅"-  pretty (Formatted (mode, ASCII, BiVoid attr)) = pretty (Formatted (mode, ASCII, attr)) <+> prettyArrow ASCII <+> pretty "?"---- >>> render (Formatted (SWEET, UNICODE, [BiVoid AtRho]))--- ""--- >>> render (Formatted (SWEET, UNICODE, [BiTau (AtLabel "x") ExGlobal, BiVoid AtPhi]))--- "x \8614 \934,\n\966 \8614 \8709"-instance {-# OVERLAPPING #-} Pretty (Formatted [Binding]) where-  pretty (Formatted (SWEET, encoding, bds)) = vsep (punctuate comma (excludeVoidRho (\bd -> pretty (Formatted (SWEET, encoding, bd))) [] bds))-    where-      excludeVoidRho :: (Binding -> Doc ann) -> [Doc ann] -> [Binding] -> [Doc ann]-      excludeVoidRho func acc [bd] = case bd of-        BiVoid AtRho -> reverse acc-        _ -> reverse (func bd : acc)-      excludeVoidRho func acc (x : xs) = excludeVoidRho func (func x : acc) xs-      excludeVoidRho func acc [] = reverse acc-  pretty (Formatted (SALTY, encoding, bds)) = vsep (punctuate comma (map (\bd -> pretty (Formatted (SALTY, encoding, bd))) bds))--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], [])---- >>> render (Formatted (SWEET, UNICODE, ExFormation [BiVoid AtRho]))--- "\10214\10215"-instance Pretty (Formatted Expression) where-  pretty (Formatted (SWEET, UNICODE, ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang"))) = pretty "Φ̇"-  pretty (Formatted (SWEET, ASCII, ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang"))) = pretty "QQ"-  pretty (Formatted (SWEET, _, DataString bytes)) = pretty "\"" <> pretty (btsToStr bytes) <> pretty "\""-  pretty (Formatted (SWEET, _, DataNumber bytes)) = either pretty pretty (btsToNum bytes)-  pretty (Formatted (SWEET, encoding, DataObject other bytes)) = pretty (Formatted (SALTY, encoding, DataObject other bytes))-  pretty (Formatted (SWEET, UNICODE, ExFormation [BiVoid AtRho])) = pretty "⟦⟧"-  pretty (Formatted (SWEET, ASCII, ExFormation [BiVoid AtRho])) = pretty "[[]]"-  pretty (Formatted (mode, encoding, ExFormation [binding])) = case binding of-    BiTau _ _ -> vsep [prettyLsb encoding, indent 2 (pretty (Formatted (mode, encoding, binding))), prettyRsb encoding]-    _ -> prettyLsb encoding <+> pretty (Formatted (mode, encoding, binding)) <+> prettyRsb encoding-  pretty (Formatted (_, UNICODE, ExFormation [])) = pretty "⟦⟧"-  pretty (Formatted (_, ASCII, ExFormation [])) = pretty "[[]]"-  pretty (Formatted (mode, encoding, ExFormation bindings)) = vsep [prettyLsb encoding, indent 2 (pretty (Formatted (mode, encoding, bindings))), prettyRsb encoding]-  pretty (Formatted (_, UNICODE, ExThis)) = pretty "ξ"-  pretty (Formatted (_, ASCII, ExThis)) = pretty "$"-  pretty (Formatted (_, UNICODE, ExGlobal)) = pretty "Φ"-  pretty (Formatted (_, ASCII, ExGlobal)) = pretty "Q"-  pretty (Formatted (_, UNICODE, ExTermination)) = pretty "⊥"-  pretty (Formatted (_, ASCII, ExTermination)) = pretty "T"-  pretty (Formatted (_, _, ExMeta meta)) = prettyMeta meta-  pretty (Formatted (SWEET, encoding, ExApplication (ExApplication expr tau) tau')) =-    let (expr', taus, exprs) = complexApplication (ExApplication (ExApplication expr tau) tau')-        args =-          if null exprs-            then pretty (Formatted (SWEET, encoding, reverse taus))-            else vsep (punctuate comma (map (\exp -> pretty (Formatted (SWEET, encoding, exp))) (reverse exprs)))-     in pretty (Formatted (SWEET, encoding, expr')) <> vsep [lparen, indent 2 args, rparen]-  pretty (Formatted (SWEET, encoding, ExApplication expr tau)) =-    let arg = case tau of-          BiTau (AtAlpha 0) expr' -> pretty (Formatted (SWEET, encoding, expr'))-          _ -> pretty (Formatted (SWEET, encoding, tau))-     in pretty (Formatted (SWEET, encoding, expr)) <> vsep [lparen, indent 2 arg, rparen]-  pretty (Formatted (mode, encoding, ExApplication expr tau)) = pretty (Formatted (mode, encoding, expr)) <> vsep [lparen, indent 2 (pretty (Formatted (mode, encoding, tau))), rparen]-  pretty (Formatted (mode, encoding, ExDispatch expr attr)) = pretty (Formatted (mode, encoding, expr)) <> pretty "." <> pretty (Formatted (mode, encoding, attr))-  pretty (Formatted (mode, encoding, ExMetaTail expr meta)) = pretty (Formatted (mode, encoding, expr)) <+> pretty "*" <+> prettyMeta meta--instance Pretty (Formatted Program) where-  pretty (Formatted (SALTY, encoding, Program expr)) = pretty "Φ" <+> prettyArrow encoding <+> pretty (Formatted (SALTY, encoding, expr))-  pretty (Formatted (SWEET, encoding, Program expr)) = pretty "{" <> pretty (Formatted (SWEET, encoding, expr)) <> pretty "}"--instance Pretty Tail where-  pretty (TaApplication tau) = vsep [lparen, indent 2 (pretty (formatted tau)), rparen]-  pretty (TaDispatch attr) = pretty "." <> pretty (formatted attr)--instance Pretty MetaValue where-  pretty (MvAttribute attr) = pretty (formatted attr)-  pretty (MvBytes bytes) = pretty bytes-  pretty (MvBindings []) = pretty "[]"-  pretty (MvBindings bindings) = vsep [pretty "[", indent 2 (pretty (formatted bindings)), pretty "]"]-  pretty (MvFunction func) = pretty func-  pretty (MvExpression expr _) = pretty (formatted expr)-  pretty (MvTail tails) = vsep (punctuate comma (map pretty tails))--instance Pretty Subst where-  pretty (Subst mp) =-    vsep-      [ lparen,-        indent-          2-          ( vsep-              ( punctuate-                  comma-                  ( map-                      (\(key, value) -> prettyMeta key <+> pretty ">>" <+> pretty value)-                      (Map.toList mp)-                  )-              )-          ),-        rparen-      ]--instance {-# OVERLAPPING #-} Pretty (Formatted [Subst]) where-  pretty (Formatted (_, _, [])) = pretty "[]"-  pretty (Formatted (mode, _, substs)) = vsep [pretty "[", indent 2 (vsep (punctuate comma (map pretty substs))), pretty "]"]--render :: (Pretty a) => a -> String-render printable = renderString (layoutPretty defaultLayoutOptions (pretty printable))--prettyBinding :: Binding -> String-prettyBinding binding = render (formatted binding)--prettyExtraArg :: ExtraArgument -> String-prettyExtraArg = render--prettyBytes :: Bytes -> String-prettyBytes = render--prettyAttribute :: Attribute -> String-prettyAttribute attr = render (formatted attr)--prettySubst :: Subst -> String-prettySubst = render--prettySubsts :: [Subst] -> String-prettySubsts = render--prettySubsts' :: [Subst] -> PrintMode -> Encoding -> String-prettySubsts' substs mode encoding = render (Formatted (mode, encoding, substs))--prettyExpression :: Expression -> String-prettyExpression expr = render (formatted expr)--prettyExpression' :: Expression -> String-prettyExpression' expr = render (Formatted (SWEET, UNICODE, expr))--prettyProgram :: Program -> String-prettyProgram prog = render (formatted prog)--prettyProgram' :: Program -> PrintMode -> Encoding -> String-prettyProgram' prog mode encoding = render (Formatted (mode, encoding, prog))

@@ -0,0 +1,98 @@+{-# HLINT ignore "Avoid restricted module" #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}++-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+-- SPDX-License-Identifier: MIT++module Printer+  ( printProgram,+    printProgram',+    printExpression,+    printAttribute,+    printBinding,+    printBytes,+    printExtraArg,+    printSubsts,+    PrintConfig (..),+  )+where++import AST+import CST+import Data.List (intercalate)+import qualified Data.Map.Strict as Map+import Encoding+import Lining+import Matcher+import Render+import Sugar+import Yaml (ExtraArgument (ArgAttribute, ArgBinding, ArgBytes, ArgExpression))+import Prelude hiding (print)++type PrintConfig = (SugarType, Encoding, LineFormat)++defaultPrintConfig :: PrintConfig+defaultPrintConfig = (SWEET, UNICODE, MULTILINE)++printProgram' :: Program -> PrintConfig -> String+printProgram' prog (sugar, encoding, line) = render (withLineFormat line $ withEncoding encoding $ withSugarType sugar $ programToCST prog)++printProgram :: Program -> String+printProgram prog = printProgram' prog defaultPrintConfig++printExpression' :: Expression -> PrintConfig -> String+printExpression' expr (sugar, encoding, line) = render (withLineFormat line $ withEncoding encoding $ withSugarType sugar $ expressionToCST expr)++printExpression :: Expression -> String+printExpression expr = printExpression' expr defaultPrintConfig++printAttribute' :: Attribute -> Encoding -> String+printAttribute' attr encoding = render (withEncoding encoding (toCST attr 0 :: ATTRIBUTE))++printAttribute :: Attribute -> String+printAttribute attr =+  let (_, encoding, _) = defaultPrintConfig+   in printAttribute' attr encoding++printBinding' :: Binding -> PrintConfig -> String+printBinding' bd = printExpression' (ExFormation [bd])++printBinding :: Binding -> String+printBinding bd = printBinding' bd defaultPrintConfig++printBytes :: Bytes -> String+printBytes bts = render (toCST bts 0 :: BYTES)++printExtraArg' :: ExtraArgument -> PrintConfig -> String+printExtraArg' (ArgAttribute attr) (_, encoding, _) = printAttribute' attr encoding+printExtraArg' (ArgBinding bd) config = printBinding' bd config+printExtraArg' (ArgExpression expr) config = printExpression' expr config+printExtraArg' (ArgBytes bts) _ = printBytes bts++printExtraArg :: ExtraArgument -> String+printExtraArg arg = printExtraArg' arg defaultPrintConfig++printTail :: Tail -> PrintConfig -> String+printTail (TaApplication tau) config = "(" <> printBinding' tau config <> ")"+printTail (TaDispatch attr) (_, encoding, _) = "." <> printAttribute' attr encoding++printMetaValue :: MetaValue -> PrintConfig -> String+printMetaValue (MvAttribute attr) (_, encoding, _) = printAttribute' attr encoding+printMetaValue (MvExpression expr _) config = printExpression' expr config+printMetaValue (MvBytes bts) _ = printBytes bts+printMetaValue (MvBindings bds) config = printExpression' (ExFormation bds) config+printMetaValue (MvFunction func) _ = func+printMetaValue (MvTail tails) config = intercalate "," (map (`printTail` config) tails)++printSubst :: Subst -> PrintConfig -> String+printSubst (Subst mp) config =+  "  "+    <> 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 :: [Subst] -> String+printSubsts substs = printSubsts' substs defaultPrintConfig

@@ -0,0 +1,152 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RecordWildCards #-}++-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+-- SPDX-License-Identifier: MIT++module Render where++import AST+import CST+import Data.List++class Render a where+  render :: a -> String++instance Render String where+  render str = str++instance Render Integer where+  render = show++instance Render Double where+  render = show++instance Render Char where+  render ch = [ch]++instance Render LSB where+  render LSB = "⟦"+  render LSB' = "[["++instance Render RSB where+  render RSB = "⟧"+  render RSB' = "]]"++instance Render COMMA where+  render COMMA = ","+  render NO_COMMA = ""++instance Render ARROW where+  render ARROW = "↦"+  render ARROW' = "->"++instance Render DASHED_ARROW where+  render DASHED_ARROW = "⤍"++instance Render VOID where+  render EMPTY = "∅"+  render QUESTION = "?"++instance Render PHI where+  render PHI = "φ"+  render AT = "@"++instance Render RHO where+  render RHO = "ρ"+  render CARET = "^"++instance Render DELTA where+  render DELTA = "Δ"++instance Render XI where+  render XI = "ξ"+  render DOLLAR = "$"++instance Render LAMBDA where+  render LAMBDA = "λ"++instance Render GLOBAL where+  render Φ = "Φ"+  render Q = "Q"++instance Render DEF_PACKAGE where+  render Φ̇ = "Φ̇"+  render QQ = "QQ"++instance Render TERMINATION where+  render DEAD = "⊥"+  render T = "T"++instance Render SPACE where+  render SPACE = " "++instance Render EOL where+  render EOL = "\n"+  render NO_EOL = ""++instance Render BYTES where+  render BT_EMPTY = "--"+  render (BT_ONE bte) = render bte <> "-"+  render (BT_MANY bts) = intercalate "-" bts++instance Render ALPHA where+  render ALPHA = "α"+  render ALPHA' = "~"++instance Render TAB where+  render TAB {..} = intercalate "" (replicate (fromIntegral indent) "  ")+  render TAB' = " "+  render NO_TAB = ""++instance Render PROGRAM where+  render PR_SWEET {..} = "{" <> render expr <> "}"+  render PR_SALTY {..} = render global <> render SPACE <> render arrow <> render SPACE <> render expr++instance Render PAIR where+  render PA_TAU {..} = render attr <> render SPACE <> render arrow <> render SPACE <> render expr+  render PA_LAMBDA {..} = render LAMBDA <> render SPACE <> render DASHED_ARROW <> render SPACE <> render func+  render PA_LAMBDA' {..} = "L> " <> func+  render PA_VOID {..} = render attr <> render SPACE <> render arrow <> render SPACE <> render void+  render PA_DELTA {..} = render DELTA <> render SPACE <> render DASHED_ARROW <> render SPACE <> render bytes+  render PA_DELTA' {..} = "D> " <> render bytes++instance Render BINDINGS where+  render BDS_EMPTY {..} = ""+  render BDS_PAIR {..} = render COMMA <> render eol <> render tab <> render pair <> render bindings++instance Render BINDING where+  render BI_PAIR {..} = render pair <> render bindings+  render BI_EMPTY {..} = ""++instance Render APP_ARG where+  render APP_ARG {..} = render expr <> render args++instance Render APP_ARGS where+  render AAS_EMPTY = ""+  render AAS_EXPR {..} = render COMMA <> render eol <> render tab <> render expr <> render args++-- @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+  render EX_XI {..} = render xi+  render EX_ATTR {..} = render attr+  render EX_TERMINATION {..} = render termination+  render EX_FORMATION {..} = render lsb <> render eol <> render tab <> render binding <> render eol' <> render tab' <> render rsb+  render EX_DISPATCH {..} = render expr <> "." <> render attr+  render EX_APPLICATION {..} = render expr <> "(" <> render eol <> render tab <> render bindings <> render eol' <> render tab' <> ")"+  render EX_APPLICATION' {..} = render expr <> "(" <> render eol <> render tab <> render args <> render eol' <> render tab' <> ")"+  render EX_STRING {..} = '"' : render str <> "\""+  render EX_NUMBER {..} = either show show num++instance Render ATTRIBUTE where+  render AT_LABEL {..} = label+  render AT_ALPHA {..} = render alpha <> render idx+  render AT_RHO {..} = render rho+  render AT_PHI {..} = render phi+  render AT_LAMBDA {..} = render lambda+  render AT_DELTA {..} = render delta

@@ -18,12 +18,12 @@   ) where -import Ast+import AST import Control.Exception (Exception, throwIO) import Matcher (Tail (TaApplication, TaDispatch))-import Pretty (prettyExpression, prettyProgram) import Text.Printf (printf) import Data.List (isPrefixOf)+import Printer (printProgram)  data ReplaceProgramContext = ReplaceProgramContext   { _program :: Program,@@ -51,7 +51,7 @@   show CouldNotReplace {..} =     printf       "Couldn't replace expression in program, lists of patterns and targets has different lengths\nProgram: %s"-      (prettyProgram prog)+      (printProgram prog)  replaceBindings :: [Binding] -> [Expression] -> [Expression] -> ReplaceExpressionContext -> ReplaceExpressionFunc -> ([Binding], [Expression], [Expression]) replaceBindings bds [] [] _ _ = (bds, [], [])

@@ -1,17 +1,19 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-}  -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com -- SPDX-License-Identifier: MIT -module Rewriter (rewrite, rewrite', RewriteContext (..)) where+module Rewriter (rewrite, rewrite', RewriteContext (..), Rewritten (..)) where -import Ast+import AST import Builder import Control.Exception (Exception, throwIO) import Data.Foldable (foldlM)+import Data.Functor ((<&>)) import qualified Data.Map.Strict as M import Data.Maybe (catMaybes, fromMaybe, isJust) import qualified Data.Set as Set@@ -21,7 +23,7 @@ import Misc (ensuredFile) import Must (Must (..), exceedsUpperBound, inRange) import Parser (parseProgram, parseProgramThrows)-import Pretty (Encoding (UNICODE), PrintMode (SWEET), prettyAttribute, prettyBytes, prettyExpression, prettyExpression', prettyProgram, prettyProgram', prettySubsts)+import Printer (printProgram) import Replacer (ReplaceProgramContext (ReplaceProgramContext), ReplaceProgramThrowsFunc, replaceProgramFastThrows, replaceProgramThrows) import Rule (RuleContext (RuleContext), matchProgramWithRule) import qualified Rule as R@@ -29,11 +31,20 @@ import Yaml (ExtraArgument (..)) import qualified Yaml as Y +data Rewritten = Rewritten+  { program :: Program,+    maybeRule :: Maybe Y.Rule+  }++instance Eq Rewritten where+  left == right = program left == program right+ data RewriteContext = RewriteContext   { _program :: Program,     _maxDepth :: Integer,     _maxCycles :: Integer,     _depthSensitive :: Bool,+    _sequence :: Bool,     _buildTerm :: BuildTermFunc,     _must :: Must,     _saveStep :: SaveStepFunc@@ -118,56 +129,72 @@     hasMetaBindings = foldl (\acc bd -> acc || isMetaBinding bd) False tryBuildAndReplaceFast ptn res substs ctx = buildAndReplace' ptn res substs replaceProgramThrows ctx -rewrite :: Program -> [Y.Rule] -> Set.Set Program -> Integer -> RewriteContext -> IO (Program, Set.Set Program)-rewrite program [] progs _ _ = pure (program, progs)-rewrite program (rule : rest) progs iteration ctx@RewriteContext {..} = do-  (prog, _progs) <- _rewrite program 1 progs-  rewrite prog rest _progs iteration ctx+-- The function returns tuple (X, Y) where+-- - X is sequence of programs; for more details about this sequence see description of rewrite' function+-- - 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 :: [Rewritten] -> [Y.Rule] -> Set.Set Program -> Integer -> RewriteContext -> IO ([Rewritten], Set.Set Program)+rewrite rewrittens [] unique _ _ = pure (rewrittens, unique)+rewrite rewrittens (rule : rest) unique iteration ctx@RewriteContext {..} = do+  (rewrittens', unique') <- _rewrite rewrittens 1 unique+  rewrite rewrittens' rest unique' iteration ctx   where-    _rewrite :: Program -> Integer -> Set.Set Program -> IO (Program, Set.Set Program)-    _rewrite prog count progs' =+    _rewrite :: [Rewritten] -> Integer -> Set.Set Program -> IO ([Rewritten], Set.Set Program)+    _rewrite _rewrittens _count _unique =       let ruleName = fromMaybe "unknown" (Y.name rule)           ptn = Y.pattern rule           res = Y.result rule-       in if count - 1 == _maxDepth+          Rewritten {..} = 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)               if _depthSensitive                 then throwIO (StoppedOnLimit "max-depth" _maxDepth)-                else pure (prog, progs')+                else pure (_rewrittens, _unique)             else do-              logDebug (printf "Starting rewriting cycle for rule '%s': %d out of %d" ruleName count _maxDepth)-              matched <- R.matchProgramWithRule prog rule (RuleContext _program _buildTerm)+              logDebug (printf "Starting rewriting cycle for rule '%s': %d out of %d" ruleName _count _maxDepth)+              matched <- R.matchProgramWithRule program rule (RuleContext _program _buildTerm)               if null matched                 then do                   logDebug (printf "Rule '%s' does not match, rewriting is stopped" ruleName)-                  pure (prog, progs')+                  pure (_rewrittens, _unique)                 else do                   logDebug (printf "Rule '%s' has been matched, applying..." ruleName)-                  prog' <- tryBuildAndReplaceFast ptn res matched (ReplaceProgramContext prog _maxDepth)-                  if prog == prog'+                  prog <- tryBuildAndReplaceFast ptn res matched (ReplaceProgramContext program _maxDepth)+                  if program == prog                     then do                       logDebug (printf "Applied '%s', no changes made" ruleName)-                      pure (prog, progs')+                      pure (_rewrittens, _unique)                     else-                      if Set.member prog' progs-                        then throwIO (LoopingRewriting (prettyProgram' prog' SWEET UNICODE) ruleName count)+                      if Set.member prog _unique+                        then throwIO (LoopingRewriting (printProgram prog) ruleName _count)                         else do                           logDebug                             ( printf                                 "Applied '%s' (%d nodes -> %d nodes)"                                 ruleName+                                (countNodes program)                                 (countNodes prog)-                                (countNodes prog')                             )-                          _saveStep prog' (((iteration - 1) * _maxDepth) + count)-                          _rewrite prog' (count + 1) (Set.insert prog' progs)+                          _saveStep prog (((iteration - 1) * _maxDepth) + _count)+                          _rewrite (rewriteSequence prog) (_count + 1) (Set.insert prog _unique)+      where+        rewriteSequence :: Program -> [Rewritten]+        rewriteSequence _prog+          | _sequence =+              let Rewritten {..} : rest = _rewrittens+               in Rewritten _prog Nothing : Rewritten program (Just rule) : rest+          | otherwise = [Rewritten _prog Nothing] -rewrite' :: Program -> [Y.Rule] -> RewriteContext -> IO Program-rewrite' prog rules ctx = _rewrite prog 1 Set.empty+-- 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] 1 Set.empty <&> reverse   where-    _rewrite :: Program -> Integer -> Set.Set Program -> IO Program-    _rewrite prog count progs = do+    _rewrite :: [Rewritten] -> Integer -> Set.Set Program -> IO [Rewritten]+    _rewrite rewrittens count unique = do       let cycles = _maxCycles ctx           must = _must ctx           current = count - 1@@ -179,14 +206,14 @@               logDebug (printf "Max amount of rewriting cycles for all rules (%d) has been reached, rewriting is stopped" cycles)               if _depthSensitive ctx                 then throwIO (StoppedOnLimit "max-cycles" cycles)-                else pure prog+                else pure rewrittens             else do               logDebug (printf "Starting rewriting cycle for all rules: %d out of %d" count cycles)-              (rewritten, progs') <- rewrite prog rules progs count ctx-              if rewritten == prog+              (rewrittens', unique') <- rewrite rewrittens rules unique count ctx+              if head rewrittens' == head rewrittens                 then do                   logDebug "Rewriting is stopped since it has no effect"                   if not (inRange must current)                     then throwIO (MustBeGoing must current)-                    else pure rewritten-                else _rewrite rewritten (count + 1) progs'+                    else pure rewrittens'+                else _rewrite rewrittens' (count + 1) unique'

@@ -6,26 +6,26 @@  module Rule (RuleContext (..), isNF, matchProgramWithRule, meetCondition) where -import Ast+import AST import Builder (buildAttribute, buildBinding, buildBindingThrows, buildExpression, buildExpressionThrows) import Control.Exception (SomeException (SomeException), evaluate) import Control.Exception.Base (try)+import Control.Monad (when) import Data.Aeson (FromJSON) import qualified Data.ByteString.Char8 as B import Data.Foldable (foldlM) import qualified Data.Map.Strict as M import Data.Maybe (catMaybes, fromMaybe)+import Deps (BuildTermFunc, Term (..)) import GHC.IO (unsafePerformIO) import Logger (logDebug) import Matcher-import Misc (allPathsIn, btsToUnescapedStr)-import Pretty (prettyAttribute, prettyBytes, prettyExpression, prettyExpression', prettySubsts, prettyBinding)+import Misc (btsToUnescapedStr)+import Printer import Regexp (match)-import Deps (BuildTermFunc, Term (..)) import Text.Printf (printf) import Yaml (normalizationRules) import qualified Yaml as Y-import Control.Monad (when)  data RuleContext = RuleContext   { _program :: Program,@@ -119,7 +119,7 @@   (Just left_, Just right_) -> pure [subst | left_ == right_]   (_, _) -> pure []   where-      -- Convert Number to Integer+    -- Convert Number to Integer     numToInt :: Y.Number -> Subst -> Maybe Integer     numToInt (Y.Ordinal (AtMeta meta)) (Subst mp) = case M.lookup meta mp of       Just (MvAttribute (AtAlpha idx)) -> Just idx@@ -250,16 +250,16 @@                 term <- _buildTerm func args subst' _program                 meta <- case term of                   TeExpression expr -> do-                    logDebug (printf "Function %s() returned expression:\n%s" func (prettyExpression' expr))+                    logDebug (printf "Function %s() returned expression:\n%s" func (printExpression expr))                     pure (MvExpression expr defaultScope)                   TeAttribute attr -> do-                    logDebug (printf "Function %s() returned attribute: %s" func (prettyAttribute attr))+                    logDebug (printf "Function %s() returned attribute: %s" func (printAttribute attr))                     pure (MvAttribute attr)                   TeBytes bytes -> do-                    logDebug (printf "Function %s() returned bytes: %s" func (prettyBytes bytes))+                    logDebug (printf "Function %s() returned bytes: %s" func (printBytes bytes))                     pure (MvBytes bytes)                   TeBindings bds -> do-                    logDebug (printf "Function %s return bindings: %s" func (prettyExpression' (ExFormation bds)))+                    logDebug (printf "Function %s return bindings: %s" func (printExpression (ExFormation bds)))                     pure (MvBindings bds)                 case maybeName of                   Just name -> pure (combine (substSingle name meta) subst')

@@ -0,0 +1,136 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}++-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+-- SPDX-License-Identifier: MIT++module Sugar (toSalty, withSugarType, SugarType (..)) where++import AST+import CST+import Misc++withSugarType :: (ToSalty a) => SugarType -> a -> a+withSugarType SWEET prog = prog+withSugarType SALTY prog = toSalty prog++voidRho :: PAIR+voidRho = PA_VOID (AT_RHO RHO) ARROW EMPTY++bdWithVoidRho :: BINDING -> BINDING+bdWithVoidRho BI_EMPTY {..} = BI_PAIR voidRho (BDS_EMPTY tab) tab+bdWithVoidRho bd@BI_PAIR {pair = PA_VOID {attr = AT_RHO _}} = bd+bdWithVoidRho bd@BI_PAIR {pair = PA_TAU {attr = AT_RHO _}} = bd+bdWithVoidRho BI_PAIR {..} = BI_PAIR pair (bdsWithVoidRho bindings) tab+  where+    bdsWithVoidRho :: BINDINGS -> BINDINGS+    bdsWithVoidRho BDS_EMPTY {..} = BDS_PAIR EOL tab voidRho (BDS_EMPTY tab)+    bdsWithVoidRho bds@BDS_PAIR {pair = PA_VOID {attr = AT_RHO _}} = bds+    bdsWithVoidRho bds@BDS_PAIR {pair = PA_TAU {attr = AT_RHO _}} = bds+    bdsWithVoidRho BDS_PAIR {..} = BDS_PAIR eol tab pair (bdsWithVoidRho bindings)++data SugarType = SWEET | SALTY+  deriving (Eq, Show)++-- By default CST is generated with all possible syntax sugar+-- The main purpose of this class is to get rid of syntax sugar+--  |----------------------------|-------------------------------------------------------|+--  | sugar                      | verbose version                                       |+--  |----------------------------|-------------------------------------------------------|+--  | {e}                        | Q -> e                                                |+--  | QQ                         | Q.org.eolang                                          |+--  | a1 -> a2                   | a1 ↦ $.a2                                             |+--  | a -> 42                    | QQ.number(QQ.bytes([[ D> 40-45-00-00-00-00-00-00 ]])) |+--  | a -> "Hey"                 | QQ.number(QQ.bytes([[ D> 48-65-79 ]]))                |+--  | [[ B ]]                    | [[ B, ^ -> ? ]], if rho is absent in 'B'              |+--  | a1(a2, a3, ...) -> [[ B ]] | a1 -> [[ a2 -> ?, a3 -> ?, ..., B ]]                  |+--  | e(e0, e1, ...)             | e(~0 -> e0, ~1 -> e1, ...)                            |+--  | e(a1 -> e1, a2 -> e2, ...) | e(a1 -> e1)(a2 -> e2)...                              |+--  |----------------------------|-------------------------------------------------------|+class ToSalty a where+  toSalty :: a -> a++instance ToSalty PROGRAM where+  toSalty PR_SWEET {..} = PR_SALTY Φ ARROW (toSalty expr)+  toSalty prog = prog++instance ToSalty EXPRESSION where+  toSalty EX_DEF_PACKAGE {..} = EX_DISPATCH (EX_DISPATCH (EX_GLOBAL Φ) (AT_LABEL "org")) (AT_LABEL "eolang")+  toSalty EX_ATTR {..} = EX_DISPATCH (EX_XI XI) attr+  toSalty EX_DISPATCH {..} = EX_DISPATCH (toSalty expr) attr+  toSalty EX_FORMATION {lsb, binding = bd@BI_EMPTY {..}, rsb} = EX_FORMATION lsb NO_EOL TAB' (toSalty (bdWithVoidRho bd)) NO_EOL TAB' rsb+  toSalty EX_FORMATION {..} = EX_FORMATION lsb eol tab (toSalty (bdWithVoidRho binding)) eol' tab' rsb+  toSalty EX_APPLICATION {..} = EX_APPLICATION (toSalty expr) eol tab (toSalty bindings) eol' tab'+  toSalty EX_APPLICATION' {..} = EX_APPLICATION (toSalty expr) eol tab (toSalty (argToBinding args tab)) eol' tab'+    where+      argToBinding :: APP_ARG -> TAB -> BINDING+      argToBinding APP_ARG {..} =+        BI_PAIR+          (PA_TAU (AT_ALPHA ALPHA 0) ARROW expr)+          (argsToBindings args 1 tab)+      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 expr = expr++instance ToSalty BINDING where+  toSalty BI_PAIR {..} = BI_PAIR (toSalty pair) (toSalty bindings) tab+  toSalty bd = bd++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 pair = pair

@@ -18,7 +18,7 @@   ) where -import Ast+import AST import Control.Exception (Exception (displayException), SomeException, throwIO) import Control.Exception.Base (Exception) import qualified Data.Bifunctor@@ -36,10 +36,9 @@ import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) import Data.Time.Format (defaultTimeLocale, formatTime) import Data.Version (showVersion)-import Debug.Trace import Misc import Paths_phino (version)-import Pretty (PrintMode (SWEET), prettyAttribute, prettyBinding, prettyBytes, prettyExpression, prettyProgram)+import Printer import Text.Printf (printf) import qualified Text.Read as TR import Text.XML@@ -63,9 +62,9 @@   deriving (Exception)  instance Show XMIRException where-  show UnsupportedProgram {..} = printf "XMIR does not support such program:\n%s" (prettyProgram prog)-  show UnsupportedExpression {..} = printf "XMIR does not support such expression:\n%s" (prettyExpression expr)-  show UnsupportedBinding {..} = printf "XMIR does not support such bindings: %s" (prettyBinding binding)+  show UnsupportedProgram {..} = printf "XMIR does not support such program:\n%s" (printProgram prog)+  show UnsupportedExpression {..} = printf "XMIR does not support such expression:\n%s" (printExpression expr)+  show UnsupportedBinding {..} = printf "XMIR does not support such bindings: %s" (printBinding binding)   show CouldNotParseXMIR {..} = printf "Couldn't parse given XMIR, cause: %s" message   show InvalidXMIRFormat {..} =     printf@@ -89,14 +88,14 @@ object attrs children = NodeElement (element "o" attrs children)  expression :: Expression -> XmirContext -> IO (String, [Node])-expression ExThis _ = pure (prettyExpression ExThis, [])-expression ExGlobal _ = pure (prettyExpression ExGlobal, [])+expression ExThis _ = pure (printExpression ExThis, [])+expression ExGlobal _ = pure (printExpression ExGlobal, []) expression (ExFormation bds) ctx = do   nested <- nestedBindings bds ctx   pure ("", nested) expression (ExDispatch expr attr) ctx = do   (base, children) <- expression expr ctx-  let attr' = prettyAttribute attr+  let attr' = printAttribute attr   if null base     then pure ('.' : attr', [object [] children])     else@@ -106,8 +105,8 @@ expression (DataNumber bytes) XmirContext {..} =   let bts =         object-          [("as", prettyAttribute (AtAlpha 0)), ("base", "Φ.org.eolang.bytes")]-          [object [] [NodeContent (T.pack (prettyBytes bytes))]]+          [("as", printAttribute (AtAlpha 0)), ("base", "Φ.org.eolang.bytes")]+          [object [] [NodeContent (T.pack (printBytes bytes))]]    in pure         ( "Φ.org.eolang.number",           if omitComments@@ -120,8 +119,8 @@ expression (DataString bytes) XmirContext {..} =   let bts =         object-          [("as", prettyAttribute (AtAlpha 0)), ("base", "Φ.org.eolang.bytes")]-          [object [] [NodeContent (T.pack (prettyBytes bytes))]]+          [("as", printAttribute (AtAlpha 0)), ("base", "Φ.org.eolang.bytes")]+          [object [] [NodeContent (T.pack (printBytes bytes))]]    in pure         ( "Φ.org.eolang.string",           if omitComments@@ -134,7 +133,7 @@ expression (ExApplication expr (BiTau attr texpr)) ctx = do   (base, children) <- expression expr ctx   (base', children') <- expression texpr ctx-  let as = prettyAttribute attr+  let as = printAttribute attr       attrs =         if null base'           then [("as", as)]@@ -154,7 +153,7 @@   (base, children) <- expression expr ctx   pure (Just (object [("name", show AtPhi), ("base", base)] children)) formationBinding (BiTau AtRho _) _ = pure Nothing-formationBinding (BiDelta bytes) _ = pure (Just (NodeContent (T.pack (prettyBytes bytes))))+formationBinding (BiDelta bytes) _ = pure (Just (NodeContent (T.pack (printBytes bytes)))) formationBinding (BiLambda func) _ = pure (Just (object [("name", show AtLambda)] [])) formationBinding (BiVoid AtRho) _ = pure Nothing formationBinding (BiVoid AtPhi) _ = pure (Just (object [("name", show AtPhi), ("base", "∅")] []))@@ -216,7 +215,7 @@       pure (label : pckg, expr')     getPackage (ExFormation [BiTau attr expr, BiLambda "Package", BiVoid AtRho]) = pure ([], ExFormation [BiTau attr expr, BiVoid AtRho])     getPackage (ExFormation [bd, BiVoid AtRho]) = pure ([], ExFormation [bd, BiVoid AtRho])-    getPackage expr = throwIO (userError (printf "Can't extract package from given expression:\n %s" (prettyExpression expr)))+    getPackage expr = throwIO (userError (printf "Can't extract package from given expression:\n %s" (printExpression expr)))     -- Convert root Expression to Node     rootExpression :: Expression -> XmirContext -> IO Node     rootExpression (ExFormation [bd, BiVoid AtRho]) ctx = do

@@ -8,7 +8,7 @@  module Yaml where -import Ast+import AST import Control.Applicative (asum) import Data.Aeson import qualified Data.ByteString as BS

@@ -3,7 +3,7 @@  module BuilderSpec where -import Ast+import AST import Builder import Control.Monad import Data.Map.Strict qualified as Map

@@ -238,22 +238,18 @@       withStdin "Q -> [[ x -> QQ.z(y -> 5), q -> T, w -> $, ^ -> Q, @ -> 1, y -> \"H$@^M\"]]" $         testCLISucceeded           ["rewrite", "--output=latex", "--sweet"]-          [ "\\documentclass{article}",-            "\\usepackage{eolang}",-            "\\begin{document}",-            "\\begin{phiquation}",+          [ "\\begin{phiquation}",             "{[[",             "  x -> QQ.z(",             "    y -> 5",             "  ),",             "  q -> T,",-            "  w -> \\char36{},",-            "  \\char94{} -> Q,",-            "  \\char64{} -> 1,",-            "  y -> \"H\\char36{}\\char64{}\\char94{}M\"",+            "  w -> $,",+            "  ^ -> Q,",+            "  @ -> 1,",+            "  y -> \"H$@^M\"",             "]]}",-            "\\end{phiquation}",-            "\\end{document}"+            "\\end{phiquation}"           ]      it "rewrites with XMIR as input" $@@ -281,6 +277,47 @@           ["rewrite", "--rule=test-resources/cli/simple.yaml", "--must=1", "--sweet"]           ["x ↦ \"bar\""] +    it "prints many programs with --sequence" $+      withStdin "{[[ x -> \"foo\" ]]}" $+        testCLISucceeded+          [ "rewrite",+            "--rule=test-resources/cli/first.yaml",+            "--rule=test-resources/cli/second.yaml",+            "--max-depth=1",+            "--max-cycles=2",+            "--sequence",+            "--sweet",+            "--flat"+          ]+          [ unlines+              [ "{⟦ x ↦ \"foo\" ⟧}",+                "{Φ.x( y ↦ \"foo\" )}",+                "{⟦ x ↦ \"foo\" ⟧}"+              ]+          ]++    it "prints only one latex preamble with --sequence" $+      withStdin "{[[ x -> \"foo\" ]]}" $+        testCLISucceeded+          [ "rewrite",+            "--rule=test-resources/cli/first.yaml",+            "--rule=test-resources/cli/second.yaml",+            "--max-depth=1",+            "--max-cycles=2",+            "--sequence",+            "--sweet",+            "--flat",+            "--output=latex"+          ]+          [ unlines+              [ "\\begin{phiquation}",+                "{[[ x -> \"foo\" ]]} \\leadsto_{\\nameref{r:first}}",+                "\\leadsto {Q.x( y -> \"foo\" )} \\leadsto_{\\nameref{r:second}}",+                "\\leadsto {[[ x -> \"foo\" ]]}",+                "\\end{phiquation}"+              ]+          ]+     describe "must range tests" $ do       describe "fails" $ do         it "when cycles exceed range ..1" $@@ -367,6 +404,12 @@                 "⟧}"               ]           ]++    it "prints in line with --flat" $+      withStdin "Q -> [[ x -> 5, y -> \"hey\", z -> [[ w -> [[ ]] ]] ]]" $+        testCLISucceeded+          ["rewrite", "--sweet", "--flat"]+          ["{⟦ x ↦ 5, y ↦ \"hey\", z ↦ ⟦ w ↦ ⟦⟧ ⟧ ⟧}"]    describe "dataize" $ do     it "dataizes simple program" $

@@ -0,0 +1,103 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}++-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+-- SPDX-License-Identifier: MIT++module CSTSpec (spec) where++import CST+import Control.Monad (forM_)+import Data.Aeson+import Data.Yaml qualified as Yaml+import Encoding (Encoding (ASCII), withEncoding)+import GHC.Generics (Generic)+import Lining (LineFormat (SINGLELINE), withLineFormat)+import Misc+import Parser (parseProgramThrows)+import Render (Render (render))+import Sugar+import System.FilePath+import Test.Hspec++data CSTPack = CSTPack+  { program :: String,+    result :: String+  }+  deriving (Generic, Show, FromJSON)++cstPack :: FilePath -> IO CSTPack+cstPack = Yaml.decodeFileThrow++spec :: Spec+spec = do+  describe "builds valid CST" $+    forM_+      [ ("Q -> Q", PR_SWEET (EX_GLOBAL Φ)),+        ( "{[[ x -> Q.y ]]}",+          PR_SWEET+            ( EX_FORMATION+                LSB+                EOL+                (TAB 1)+                (BI_PAIR (PA_TAU (AT_LABEL "x") ARROW (EX_DISPATCH (EX_GLOBAL Φ) (AT_LABEL "y"))) (BDS_EMPTY (TAB 1)) (TAB 1))+                EOL+                (TAB 0)+                RSB+            )+        )+      ]+      ( \(prog, cst) -> it prog $ do+          ast <- parseProgramThrows prog+          programToCST ast `shouldBe` cst+      )++  describe "CST printing packs" $ do+    let resources = "test-resources/cst/printing-packs"+    packs <- runIO (allPathsIn resources)+    forM_+      packs+      ( \pth -> it (makeRelative resources pth) $ do+          pack <- cstPack pth+          prog <- parseProgramThrows (program pack)+          render (programToCST prog) `shouldBe` result pack+      )++  describe "converts to salty CST" $ do+    let resources = "test-resources/cst/to-salty-packs"+    packs <- runIO (allPathsIn resources)+    forM_+      packs+      ( \pth -> it (makeRelative resources pth) $ do+          pack <- cstPack pth+          prog <- parseProgramThrows (program pack)+          let cst = programToCST prog+              salty = toSalty cst+          render salty `shouldBe` result pack+      )++  describe "converts to ascii CST" $ do+    let resources = "test-resources/cst/to-ascii-packs"+    packs <- runIO (allPathsIn resources)+    forM_+      packs+      ( \pth -> it (makeRelative resources pth) $ do+          pack <- cstPack pth+          prog <- parseProgramThrows (program pack)+          let cst = programToCST prog+              ascii = withEncoding ASCII cst+          render ascii `shouldBe` result pack+      )++  describe "converts to singleline CST" $ do+    let resources = "test-resources/cst/to-singleline-packs"+    packs <- runIO (allPathsIn resources)+    forM_+      packs+      ( \pth -> it (makeRelative resources pth) $ do+          pack <- cstPack pth+          prog <- parseProgramThrows (program pack)+          let cst = programToCST prog+              ascii = withLineFormat SINGLELINE cst+          render ascii `shouldBe` result pack+      )

@@ -3,7 +3,7 @@  module DataizeSpec (spec) where -import Ast+import AST import Control.Monad import Dataize (DataizeContext (DataizeContext), dataize, dataize', morph) import Deps (dontSaveStep)

@@ -3,14 +3,14 @@  module FunctionsSpec where -import Ast+import AST import Data.Map.Strict qualified as Map+import Deps (Term (TeBindings)) import Functions (buildTerm) import Logger (logDebug) import Matcher (MetaValue (MvBindings), Subst (Subst)) import Misc (uniqueBindings')-import Pretty (prettyExpression')-import Deps (Term (TeBindings))+import Printer (printExpression) import Test.Hspec (Spec, describe, it, shouldBe) import Text.Printf (printf) import Yaml (ExtraArgument (ArgBinding))@@ -24,5 +24,5 @@         subst = Subst (Map.fromList [first, second, third])     TeBindings bds <- buildTerm "join" [ArgBinding (BiMeta "B1"), ArgBinding (BiMeta "B2"), ArgBinding (BiMeta "B3")] subst (Program ExGlobal)     bds' <- uniqueBindings' bds-    logDebug (printf "Joined bindings:\n%s" (prettyExpression' (ExFormation bds')))+    logDebug (printf "Joined bindings:\n%s" (printExpression (ExFormation bds')))     length bds' `shouldBe` 9

@@ -7,7 +7,7 @@  module MatcherSpec where -import Ast+import AST import Control.Monad (forM_) import Data.Map.Strict qualified as Map import Data.Maybe (fromMaybe)

@@ -6,7 +6,7 @@ import Control.Monad (forM_) import Misc (withVoidRho, uniqueBindings) import Test.Hspec (Example (Arg), Expectation, Spec, SpecWith, describe, it, shouldBe, shouldSatisfy)-import Ast+import AST import Data.Either (isLeft, isRight)  testWithVoidRho :: [(String, [Binding], [Binding])] -> SpecWith (Arg Expectation)

@@ -6,7 +6,7 @@  module ParserSpec where -import Ast+import AST import Control.Monad (forM_) import Data.Either (isLeft, isRight) import Misc (allPathsIn)

@@ -1,70 +0,0 @@--- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com--- SPDX-License-Identifier: MIT--module PrettySpec where--import Ast-import Control.Monad (forM_)-import Matcher (MetaValue (MvAttribute, MvExpression), substEmpty, substSingle, defaultScope)-import Parser (parseProgramThrows)-import Pretty-import Test.Hspec (Example (Arg), Expectation, Spec, SpecWith, describe, it, runIO, shouldBe)--test :: (a -> PrintMode -> Encoding -> String) -> [(String, String, a, PrintMode)] -> SpecWith (Arg Expectation)-test function useCases =-  forM_ useCases $ \(input, output, arg, mode) ->-    it input $ function arg mode UNICODE `shouldBe` output--prep :: PrintMode -> (String, String) -> IO (String, String, Program, PrintMode)-prep mode (input, output) = do-  prog <- parseProgramThrows input-  return (input, output, prog, mode)--spec :: Spec-spec = do-  describe "saltify program" $ do-    useCases <--      runIO $-        mapM-          (prep SALTY)-          [ ("Q -> $", "Φ ↦ ξ"),-            ("Q -> Q.org.x", "Φ ↦ Φ.org.x"),-            ("Q -> [[]]", "Φ ↦ ⟦ ρ ↦ ∅ ⟧"),-            ("Q -> [[@ -> ?]](~1 -> Q.x)", "Φ ↦ ⟦\n  φ ↦ ∅,\n  ρ ↦ ∅\n⟧(\n  α1 ↦ Φ.x\n)"),-            ("Q -> !e * !t", "Φ ↦ !e * !t"),-            ( "Q -> [[D> 00-,L> F,^ -> ?,!B,@ -> [[y -> ?]]]]",-              "Φ ↦ ⟦\n  Δ ⤍ 00-,\n  λ ⤍ F,\n  ρ ↦ ∅,\n  !B,\n  φ ↦ ⟦\n    y ↦ ∅,\n    ρ ↦ ∅\n  ⟧\n⟧"-            )-          ]-    test prettyProgram' useCases--  describe "sweetify program" $ do-    useCases <--      runIO $-        mapM-          (prep SWEET)-          [ ("Q -> $", "{ξ}"),-            ("Q -> Q.org.eolang(x -> Q.x)", "{Φ̇(\n  x ↦ Φ.x\n)}"),-            ("Q -> [[ x -> [[ y -> ?, z -> ? ]] ]]", "{⟦\n  x(y, z) ↦ ⟦⟧\n⟧}"),-            ("Q -> 5", "{5}"),-            ("Q -> [[ x -> \"hello\"]]", "{⟦\n  x ↦ \"hello\"\n⟧}"),-            ("Q -> [[ x -> \"hello\", y -> 5]]", "{⟦\n  x ↦ \"hello\",\n  y ↦ 5\n⟧}"),-            ("Q -> Q.x(x -> 1)(y -> 2)(z -> 3)", "{Φ.x(\n  x ↦ 1,\n  y ↦ 2,\n  z ↦ 3\n)}"),-            ("Q -> Q.x(~0 -> Q.y)", "{Φ.x(\n  Φ.y\n)}"),-            ("Q -> Q.x(~0 -> 1)(~1 -> 2)(~2 -> 3)", "{Φ.x(\n  1,\n  2,\n  3\n)}"),-            ("Q -> Q.x(~0 -> 1)(~2 -> 2)(~1 -> 3)", "{Φ.x(\n  α0 ↦ 1,\n  α2 ↦ 2,\n  α1 ↦ 3\n)}"),-            ("Q -> Φ.jeo.opcode.ldc(18, \"Reading \\\"\")", "{Φ.jeo.opcode.ldc(\n  18,\n  \"Reading \\\"\"\n)}"),-            ("Q -> [[ k -> [[]] ]]", "{⟦\n  k ↦ ⟦⟧\n⟧}"),-            ("Q -> [[ ]]", "{⟦⟧}")-          ]-    test prettyProgram' useCases--  describe "prettify substitution" $ do-    let useCases =-          map-            (\(desc, output, substs) -> (desc, output, substs, SALTY))-            [ ("[()]", "[\n  (\n    \n  )\n]", [substEmpty]),-              ("[(!e >> Q.x)]", "[\n  (\n    !e >> Φ.x\n  )\n]", [substSingle "e" (MvExpression (ExDispatch ExGlobal (AtLabel "x")) defaultScope)]),-              ("[(!a >> x)]", "[\n  (\n    !a >> x\n  )\n]", [substSingle "a" (MvAttribute (AtLabel "x"))])-            ]-    test prettySubsts' useCases

@@ -3,7 +3,7 @@  module ReplacerSpec where -import Ast+import AST import Control.Monad (forM_) import Replacer import Test.Hspec (Example (Arg), Expectation, Spec, SpecWith, describe, it, shouldBe)

@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -Wno-orphans #-}  -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com@@ -18,8 +19,8 @@ import Misc (allPathsIn, ensuredFile) import Must (Must (..)) import Parser (parseProgramThrows)-import Pretty (Encoding (UNICODE), PrintMode (SWEET), prettyProgram')-import Rewriter (RewriteContext (RewriteContext), rewrite')+import Printer (printProgram)+import Rewriter (RewriteContext (RewriteContext), Rewritten (..), rewrite') import System.FilePath (makeRelative, replaceExtension, (</>)) import Test.Hspec (Spec, describe, expectationFailure, it, pending, runIO) import Yaml (normalizationRules)@@ -81,7 +82,7 @@           case skip pack of             Just True -> pending             _ -> do-              program <- parseProgramThrows (input pack)+              prog <- parseProgramThrows (input pack)               rules' <- case rules pack of                 Just _rules -> case custom _rules of                   Just custom' -> pure custom'@@ -98,25 +99,26 @@                   if normalize'                     then pure normalizationRules                     else pure []-              rewritten <-+              [Rewritten {..}] <-                 rewrite'-                  program+                  prog                   rules'                   ( RewriteContext-                      program+                      prog                       repeat'                       repeat'                       False+                      False                       buildTerm                       must'                       dontSaveStep                   )               result' <- parseProgramThrows (output pack)-              unless (rewritten == result') $+              unless (program == result') $                 expectationFailure                   ( "Wrong rewritten program. Expected:\n"-                      ++ prettyProgram' result' SWEET UNICODE+                      ++ printProgram result'                       ++ "\nGot:\n"-                      ++ prettyProgram' rewritten SWEET UNICODE+                      ++ printProgram program                   )       )

@@ -6,7 +6,7 @@  module RuleSpec where -import Ast (Expression, Program (Program))+import AST (Expression, Program (Program)) import Control.Monad import Data.Aeson import Data.Yaml qualified as Y@@ -14,11 +14,11 @@ import GHC.Generics import Matcher import Misc-import Pretty import Rule (RuleContext (RuleContext), meetCondition) import System.FilePath import Test.Hspec (Spec, describe, expectationFailure, it, runIO) import Yaml qualified+import Printer (printSubsts)  data ConditionPack = ConditionPack   { failure :: Maybe Bool,@@ -46,13 +46,13 @@               (null met)               ( expectationFailure $                   "List of substitutions after condition check must be empty, but got:\n"-                    ++ prettySubsts matched+                    ++ printSubsts matched               )           _ ->             when               (null met)               ( expectationFailure $                   "List of substitution after condition check must be not empty\nOriginal substitutions:\n"-                    ++ prettySubsts matched+                    ++ printSubsts matched               )     )

@@ -7,7 +7,7 @@  module XMIRSpec where -import Ast+import AST import Control.Exception (bracket) import Control.Monad (filterM, forM_, unless) import Data.Aeson