phino 0.0.0.56 → 0.0.0.57

raw patch · 17 files changed

+427/−309 lines, 17 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +3/−2
• phino.cabal +3/−1
• src/AST.hs +33/−36
• src/Builder.hs +5/−23
• src/CLI.hs +17/−9
• src/Dataize.hs +66/−72
• src/Locator.hs +85/−0
• src/Matcher.hs +21/−18
• src/Replacer.hs +37/−26
• src/Rewriter.hs +57/−59
• src/Rule.hs +8/−5
• test/ASTSpec.hs +11/−42
• test/CLISpec.hs +7/−1
• test/DataizeSpec.hs +28/−12
• test/LocatorSpec.hs +41/−0
• test/MatcherSpec.hs +1/−1
• test/RewriterSpec.hs +4/−2

@@ -29,7 +29,7 @@  ```bash cabal update-cabal install --overwrite-policy=always phino-0.0.0.55+cabal install --overwrite-policy=always phino-0.0.0.56 phino --version ``` @@ -45,7 +45,8 @@ Download paths are:  * Ubuntu: <http://phino.objectionary.com/releases/ubuntu-24.04/phino-latest>-* MacOS: <http://phino.objectionary.com/releases/macos-15/phino-latest>+* MacOS (ARM): <http://phino.objectionary.com/releases/macos-15/phino-latest>+* MacOS (Intel): <http://phino.objectionary.com/releases/macos-14-large/phino-latest>  ## Build 

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: phino-version: 0.0.0.56+version: 0.0.0.57 license: MIT synopsis: Command-Line Manipulator of 𝜑-Calculus Expressions description: Please see the README on GitHub at <https://github.com/objectionary/phino#readme>@@ -47,6 +47,7 @@     Functions     LaTeX     Lining+    Locator     Logger     Matcher     Merge@@ -124,6 +125,7 @@     FunctionsSpec     LaTeXSpec     LiningSpec+    LocatorSpec     MatcherSpec     MergeSpec     MiscSpec

@@ -9,46 +9,46 @@  import GHC.Generics (Generic) -newtype Program = Program Expression -- Q -> expr+newtype Program = Program Expression   deriving (Eq, Ord, Show)  data Expression-  = ExFormation [Binding] -- [[ bindings ]]+  = ExFormation [Binding]   | ExThis-  | ExGlobal -- Q-  | ExTermination -- T-  | ExApplication Expression Binding -- expr(attr -> expr)-  | ExDispatch Expression Attribute -- expr.attr-  | ExMeta String -- !e-  | ExMetaTail Expression String -- expr * !t+  | ExGlobal+  | ExTermination+  | ExApplication Expression Binding+  | ExDispatch Expression Attribute+  | ExMeta String+  | ExMetaTail Expression String   | ExPhiMeet (Maybe String) Int Expression   | ExPhiAgain (Maybe String) Int Expression   deriving (Eq, Ord, Show, Generic)  data Binding-  = BiTau Attribute Expression -- attr -> expr-  | BiDelta Bytes -- Δ ⤍ 1F-2A-  | BiVoid Attribute -- attr ↦ ?-  | BiLambda String -- λ ⤍ Function-  | BiMeta String -- !B-  | BiMetaLambda String -- λ ⤍ !F+  = BiTau Attribute Expression+  | BiDelta Bytes+  | BiVoid Attribute+  | BiLambda String+  | BiMeta String+  | BiMetaLambda String   deriving (Eq, Ord, Show, Generic)  data Bytes-  = BtEmpty -- ---  | BtOne String -- 1F--  | BtMany [String] -- 00-01-02-...04-  | BtMeta String -- !b+  = BtEmpty+  | BtOne String+  | BtMany [String]+  | BtMeta String   deriving (Eq, Ord, Show, Generic)  data Attribute-  = AtLabel String -- attr-  | AtAlpha Int -- α1-  | AtPhi -- φ-  | AtRho -- ρ-  | AtLambda -- λ, used only in yaml conditions-  | AtDelta -- Δ, used only in yaml conditions-  | AtMeta String -- !a+  = AtLabel String+  | AtAlpha Int+  | AtPhi+  | AtRho+  | AtLambda+  | AtDelta+  | AtMeta String   deriving (Eq, Generic, Ord)  instance Show Attribute where@@ -60,14 +60,11 @@   show AtLambda = "λ"   show (AtMeta meta) = '!' : meta -countNodes :: Program -> Int-countNodes (Program expr) = countNodes' expr-  where-    countNodes' :: Expression -> Int-    countNodes' ExGlobal = 1-    countNodes' ExTermination = 1-    countNodes' ExThis = 1-    countNodes' (ExApplication expr' (BiTau _ bexpr')) = 2 + countNodes' expr' + countNodes' bexpr'-    countNodes' (ExDispatch expr' _) = 2 + countNodes' expr'-    countNodes' (ExFormation bds) = 1 + sum (map (\case BiTau _ expr' -> countNodes' expr'; _ -> 1) bds)-    countNodes' _ = 0+countNodes :: Expression -> Int+countNodes ExGlobal = 1+countNodes ExTermination = 1+countNodes ExThis = 1+countNodes (ExApplication expr' (BiTau _ bexpr')) = 2 + countNodes expr' + countNodes bexpr'+countNodes (ExDispatch expr' _) = 2 + countNodes expr'+countNodes (ExFormation bds) = 1 + sum (map (\case BiTau _ expr' -> countNodes expr'; _ -> 1) bds)+countNodes _ = 0

@@ -43,26 +43,10 @@ type Built a = Either String a  instance Show BuildException where-  show CouldNotBuildExpression{..} =-    printf-      "Couldn't build expression, %s\n--Expression: %s"-      _msg-      (printExpression _expr)-  show CouldNotBuildAttribute{..} =-    printf-      "Couldn't build attribute '%s', %s"-      (printAttribute _attr)-      _msg-  show CouldNotBuildBinding{..} =-    printf-      "Couldn't build binding, %s\n--Binding: %s"-      _msg-      (printBinding _bd)-  show CouldNotBuildBytes{..} =-    printf-      "Couldn't build bytes '%s', %s"-      (printBytes _bts)-      _msg+  show CouldNotBuildExpression{..} = printf "Couldn't build expression, %s\n--Expression: %s" _msg (printExpression _expr)+  show CouldNotBuildAttribute{..} = printf "Couldn't build attribute '%s', %s" (printAttribute _attr) _msg+  show CouldNotBuildBinding{..} = printf "Couldn't build binding, %s\n--Binding: %s" _msg (printBinding _bd)+  show CouldNotBuildBytes{..} = printf "Couldn't build bytes '%s', %s" (printBytes _bts) _msg  contextualize :: Expression -> Expression -> Expression contextualize ExGlobal _ = ExGlobal@@ -71,9 +55,7 @@ contextualize (ExFormation bds) _ = ExFormation bds contextualize (ExDispatch ex at) context = ExDispatch (contextualize ex context) at contextualize (ExApplication ex (BiTau at bexpr)) context =-  let ex' = contextualize ex context-      bexpr' = contextualize bexpr context-   in ExApplication ex' (BiTau at bexpr')+  ExApplication (contextualize ex context) (BiTau at (contextualize bexpr context)) contextualize ex _ = ex  buildAttribute :: Attribute -> Subst -> Built Attribute

@@ -37,7 +37,7 @@ import Parser (parseExpressionThrows, parseProgramThrows) import Paths_phino (version) import qualified Printer as P-import Rewriter (RewriteContext (RewriteContext), Rewritten, rewrite')+import Rewriter (RewriteContext (RewriteContext), Rewritten, rewrite) import Rule (RuleContext (RuleContext), matchProgramWithRule) import Sugar import System.Exit (ExitCode (..), exitFailure)@@ -144,6 +144,7 @@   , rules :: [FilePath]   , hide :: [String]   , show' :: [String]+  , locator :: String   , expression :: Maybe String   , label :: Maybe String   , meetPrefix :: Maybe String@@ -278,6 +279,9 @@         )     ) +optLocator :: Parser String+optLocator = strOption (long "locator" <> metavar "FQN" <> help "Location of object to dataize. Must be a valid dispatch expression; e.g. Q.foo.bar" <> value "Q" <> showDefault)+ optNormalize :: Parser Bool optNormalize = switch (long "normalize" <> help "Use built-in normalization rules") @@ -348,7 +352,7 @@             <*> optMaxCycles             <*> optHide             <*> optShow-            <*> strOption (long "locator" <> metavar "FQN" <> help "Location of object to dataize. Must be a valid dispatch expression; e.g. Q.foo.bar" <> value "Q" <> showDefault)+            <*> optLocator             <*> optExpression             <*> optLabel             <*> optMeetPrefix@@ -389,6 +393,7 @@             <*> optRule             <*> optHide             <*> optShow+            <*> optLocator             <*> optExpression             <*> optLabel             <*> optMeetPrefix@@ -471,6 +476,7 @@       validateOpts       excluded <- validatedDispatches "hide" hide       included <- validatedDispatches "show" show'+      [loc] <- validatedDispatches "locator" [locator]       logDebug (printf "Amount of rewriting cycles across all the rules: %d, per rule: %d" maxCycles maxDepth)       input <- readInput inputFile       rules' <- getRules normalize shuffle rules@@ -481,7 +487,7 @@           _canonize = if canonize then C.canonize else id           _hide = (`F.exclude` excluded)           _show = (`F.include` included)-      rewrittens <- rewrite' program rules' (context printCtx) <&> _canonize . _hide . _show+      rewrittens <- rewrite program rules' (context loc printCtx) <&> _canonize . _hide . _show       let rewrittens' = if sequence then rewrittens else [last rewrittens]       logDebug (printf "Printing rewritten 𝜑-program as %s" (show outputFormat))       progs <- printRewrittens printCtx rewrittens'@@ -519,9 +525,10 @@           (False, Nothing, _) -> do             logDebug "The option '--target' is not specified, printing to console..."             putStrLn prog-        context :: PrintProgramContext -> RewriteContext-        context ctx =+        context :: Expression -> PrintProgramContext -> RewriteContext+        context loc ctx =           RewriteContext+            loc             maxDepth             maxCycles             depthSensitive@@ -539,7 +546,7 @@           _canonize = if canonize then C.canonize else id           _hide = (`F.exclude` excluded)           _show = (`F.include` included)-      (maybeBytes, seq) <- dataize loc (context prog printCtx)+      (maybeBytes, seq) <- dataize (context loc prog printCtx)       when sequence (printRewrittens printCtx (_canonize $ _hide $ _show seq) >>= putStrLn)       unless quiet (putStrLn (maybe (P.printExpression ExTermination) P.printBytes maybeBytes))       where@@ -553,10 +560,11 @@             outputFormat             [(omitListing, "omit-listing"), (omitComments, "omit-comments")]           when (length show' > 1) (invalidCLIArguments "The option --show can be used only once")-        context :: Program -> PrintProgramContext -> DataizeContext-        context program ctx =+        context :: Expression -> Program -> PrintProgramContext -> DataizeContext+        context loc prog ctx =           DataizeContext-            program+            loc+            prog             maxDepth             maxCycles             depthSensitive

@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-}@@ -12,16 +11,17 @@  import AST import Builder (contextualize)-import Control.Exception (Exception, throwIO)+import Control.Exception (throwIO) import Data.List (partition)-import Deps (BuildTermFunc, SaveStepFunc)+import Deps (BuildTermFunc, SaveStepFunc, Term (TeAttribute))+import Locator (locatedExpression, withLocatedExpression)+import Matcher (substEmpty) import Misc import Must (Must (..))-import Printer (printExpression)-import Rewriter (RewriteContext (RewriteContext), Rewritten, rewrite')+import Rewriter (RewriteContext (RewriteContext), Rewritten, rewrite) import Rule (RuleContext (RuleContext), isNF) import Text.Printf (printf)-import Yaml (normalizationRules)+import Yaml (ExtraArgument (ArgAttribute), normalizationRules)  type Dataized = (Maybe Bytes, [Rewritten]) @@ -29,21 +29,9 @@  type Morphed = Dataizable -data LocatorException-  = CanNotFindObjectByLocator {fqn :: Expression}-  | InvalidLocatorProvided {fqn :: Expression}-  deriving Exception--instance Show LocatorException where-  show CanNotFindObjectByLocator{..} = printf "Can't find object by locator: '%s'" (printExpression fqn)-  show InvalidLocatorProvided{..} =-    printf-      "Can't dataize object by invalid locator. \-      \'Q' or dispatch started with 'Q' expected, but got: '%s'"-      (printExpression fqn)- data DataizeContext = DataizeContext-  { _program :: Program+  { _locator :: Expression+  , _program :: Program   , _maxDepth :: Int   , _maxCycles :: Int   , _depthSensitive :: Bool@@ -54,6 +42,7 @@ switchContext :: DataizeContext -> RewriteContext switchContext DataizeContext{..} =   RewriteContext+    _locator     _maxDepth     _maxCycles     _depthSensitive@@ -114,7 +103,7 @@ withTail (ExApplication expr tau) ctx = do   tailed <- withTail expr ctx   case tailed of-    Just (exp, rule) -> pure (Just (ExApplication exp tau, rule))+    Just (expr', rule) -> pure (Just (ExApplication expr' tau, rule))     _ -> pure Nothing withTail (ExDispatch (ExFormation bds) attr) ctx = do   tailed <- formation bds ctx@@ -122,10 +111,11 @@     Just (obj, rule) -> pure (Just (ExDispatch obj attr, rule))     _ -> pure Nothing withTail (ExFormation bds) ctx = formation bds ctx-withTail (ExDispatch (ExDispatch ExGlobal (AtLabel label)) attr) (DataizeContext{_program = Program expr}) = case phiDispatch label expr of-  Just (obj, rule) -> pure (Just (ExDispatch obj attr, rule))-  _ -> pure Nothing-withTail (ExDispatch ExGlobal (AtLabel label)) (DataizeContext{_program = Program expr}) = pure (phiDispatch label expr)+withTail (ExDispatch (ExDispatch ExGlobal (AtLabel label)) attr) DataizeContext{_program = Program expr} =+  case phiDispatch label expr of+    Just (obj, rule) -> pure (Just (ExDispatch obj attr, rule))+    _ -> pure Nothing+withTail (ExDispatch ExGlobal (AtLabel label)) DataizeContext{_program = Program expr} = pure (phiDispatch label expr) withTail (ExDispatch expr attr) ctx = do   tailed <- withTail expr ctx   case tailed of@@ -146,49 +136,39 @@ -- PHI:    M(Q.tau * t) -> M(e * t)               if Q -> [B1, tau -> e, B2], t is tail started with dispatch --         M(e) -> ⊥                              otherwise morph :: Morphed -> DataizeContext -> IO Morphed-morph (ExTermination, seq) _ = pure (ExTermination, leadsTo seq "Mprim" ExTermination) -- PRIM+morph (expr@ExTermination, seq) ctx = do+  seq' <- leadsTo seq "Mprim" expr ctx -- PRIM+  pure (expr, seq') morph (form@(ExFormation _), seq) ctx = do   resolved <- withTail form ctx   case resolved of-    Just (expr, rule) -> morph (expr, leadsTo seq rule expr) ctx -- LAMBDA or PHI-    _ -> pure (form, leadsTo seq "Mprim" form) -- PRIM-morph (expr, seq) ctx = do+    Just (expr, rule) -> do+      seq' <- leadsTo seq rule expr ctx -- LAMBDA or PHI+      morph (expr, seq') ctx+    _ -> do+      seq' <- leadsTo seq "Mprim" form ctx -- PRIM+      pure (form, seq')+morph (expr, seq) ctx@DataizeContext{..} = do   resolved <- withTail expr ctx   case resolved of-    Just (expr', rule) -> morph (expr', leadsTo seq rule expr') ctx+    Just (expr', rule) -> do+      seq' <- leadsTo seq rule expr' ctx+      morph (expr', seq') ctx     _ ->-      if isNF expr (RuleContext (_buildTerm ctx))+      if isNF expr (RuleContext _buildTerm)         then morph (ExTermination, seq) ctx -- PRIM         else do-          rewrittens' <- rewrite' (Program expr) normalizationRules (switchContext ctx) -- NMZ-          let _seq = reverse rewrittens' <> tail seq-              (Program expr') = fst (head _seq)-          morph (expr', _seq) ctx+          prog' <- withLocatedExpression _locator expr _program+          rewrittens' <- rewrite prog' normalizationRules (switchContext ctx) -- NMZ todo+          let seq' = reverse rewrittens' <> tail seq+          expr' <- locatedExpression _locator (fst (head seq'))+          morph (expr', seq') ctx -dataize :: Expression -> DataizeContext -> IO Dataized-dataize locator ctx@DataizeContext{_program = Program expr} = do-  fqn <- case fqnToAttrs locator of-    Just attrs -> pure attrs-    _ -> throwIO (InvalidLocatorProvided locator)-  exp <- located expr fqn-  (maybeBytes, seq) <- dataize' (exp, [(Program exp, Nothing)]) ctx+dataize :: DataizeContext -> IO Dataized+dataize ctx@DataizeContext{..} = do+  expr <- locatedExpression _locator _program+  (maybeBytes, seq) <- dataize' (expr, [(_program, Nothing)]) ctx   pure (maybeBytes, reverse seq)-  where-    located :: Expression -> [Attribute] -> IO Expression-    located expr [] = pure expr-    located (ExFormation bds) [attr] = case locatedInBindings attr bds of-      Just expr -> pure expr-      _ -> throwIO (CanNotFindObjectByLocator locator)-    located (ExFormation bds) (attr : rest) = case locatedInBindings attr bds of-      Just expr -> located expr rest-      _ -> throwIO (CanNotFindObjectByLocator locator)-    located _ _ = throwIO (CanNotFindObjectByLocator locator)-    locatedInBindings :: Attribute -> [Binding] -> Maybe Expression-    locatedInBindings _ [] = Nothing-    locatedInBindings attr (BiTau attr' expr : rest)-      | attr == attr' = Just expr-      | otherwise = locatedInBindings attr rest-    locatedInBindings attr (_ : rest) = locatedInBindings attr rest  -- The goal of 'dataize' function is retrieve bytes from given expression. --@@ -198,31 +178,45 @@ --        nothing                               otherwise dataize' :: Dataizable -> DataizeContext -> IO Dataized dataize' (ExTermination, seq) _ = pure (Nothing, seq)-dataize' (ExFormation bds, seq) ctx = case maybeDelta bds of+dataize' (form@(ExFormation bds), seq) ctx@DataizeContext{..} = case maybeDelta bds of   (Just (BiDelta bytes), _) -> pure (Just bytes, seq)   (Just _, _) -> pure (Nothing, seq)   (Nothing, _) -> case maybePhi bds of     (Just (BiTau AtPhi expr), bds') -> case maybeLambda bds' of       (Just (BiLambda _), _) -> throwIO (userError "The 𝜑 and λ can't be present in formation at the same time")       (Just _, _) -> pure (Nothing, seq)-      (Nothing, _) ->-        let expr' = contextualize expr (ExFormation bds)-         in dataize' (expr', leadsTo seq "contextualize" expr') ctx+      (Nothing, _) -> do+        let expr' = contextualize expr form+        seq' <- leadsTo seq "contextualize" expr' ctx+        dataize' (expr', seq') ctx     (Just _, _) -> pure (Nothing, seq)     (Nothing, _) -> case maybeLambda bds of-      (Just (BiLambda _), _) -> morph (ExFormation bds, seq) ctx >>= (`dataize'` ctx)+      (Just (BiLambda _), _) -> morph (form, seq) ctx >>= (`dataize'` ctx)       (Just _, _) -> pure (Nothing, seq)       (Nothing, _) -> pure (Nothing, seq) dataize' dataizable ctx = morph dataizable ctx >>= (`dataize'` ctx) -leadsTo :: [Rewritten] -> String -> Expression -> [Rewritten]-leadsTo [] rule expr = [(Program expr, Just rule)]-leadsTo ((prog, _) : rest) rule expr = (Program expr, Nothing) : (prog, Just rule) : rest+leadsTo :: [Rewritten] -> String -> Expression -> DataizeContext -> IO [Rewritten]+leadsTo [] _ _ _ = throwIO (userError "Empty rewritten sequence should never met during dataization process")+leadsTo ((prog, _) : rest) rule expr DataizeContext{..} = do+  prog' <- withLocatedExpression _locator expr prog+  pure ((prog', Nothing) : (prog, Just rule) : rest) +-- Synthetic dataize function for internal usage inside atoms+-- Here we modify original program from context by adding new binding+-- which refers to expression we want to dataize.+_dataize :: Expression -> DataizeContext -> IO (Maybe Bytes)+_dataize expr ctx@DataizeContext{_buildTerm = buildTerm, _program = Program (ExFormation bds)} = do+  (TeAttribute attr) <- buildTerm "random-tau" (map ArgAttribute (attributesFromBindings bds)) substEmpty+  let prog = Program (ExFormation (BiTau attr expr : bds))+  (bts, _) <- dataize' (expr, [(prog, Nothing)]) ctx{_program = prog}+  pure bts+_dataize _ _ = throwIO (userError "Can't call _dataize from atoms with non-formation program")+ atom :: String -> Expression -> DataizeContext -> IO Expression atom "L_org_eolang_number_plus" self ctx = do-  (left, _) <- dataize' (ExDispatch self (AtLabel "x"), []) ctx-  (right, _) <- dataize' (ExDispatch self AtRho, []) ctx+  left <- _dataize (ExDispatch self (AtLabel "x")) ctx+  right <- _dataize (ExDispatch self AtRho) ctx   case (left, right) of     (Just left', Just right') -> do       let first = either toDouble id (btsToNum left')@@ -231,8 +225,8 @@       pure (DataNumber (numToBts sum))     _ -> pure ExTermination atom "L_org_eolang_number_times" self ctx = do-  (left, _) <- dataize' (ExDispatch self (AtLabel "x"), []) ctx-  (right, _) <- dataize' (ExDispatch self AtRho, []) ctx+  left <- _dataize (ExDispatch self (AtLabel "x")) ctx+  right <- _dataize (ExDispatch self AtRho) ctx   case (left, right) of     (Just left', Just right') -> do       let first = either toDouble id (btsToNum left')@@ -241,8 +235,8 @@       pure (DataNumber (numToBts sum))     _ -> pure ExTermination atom "L_org_eolang_number_eq" self ctx = do-  (x, _) <- dataize' (ExDispatch self (AtLabel "x"), []) ctx-  (rho, _) <- dataize' (ExDispatch self AtRho, []) ctx+  x <- _dataize (ExDispatch self (AtLabel "x")) ctx+  rho <- _dataize (ExDispatch self AtRho) ctx   case (x, rho) of     (Just x', Just rho') -> do       let self' = either toDouble id (btsToNum rho')

@@ -0,0 +1,85 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE RecordWildCards #-}++-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+-- SPDX-License-Identifier: MIT++module Locator (locatedExpression, withLocatedExpression) where++import AST+import Control.Exception (Exception, throwIO)+import Data.Functor ((<&>))+import Misc+import Printer (printExpression)+import Text.Printf (printf)++data LocatorException+  = InvalidLocatorProvided {fqn :: Expression}+  | CanNotFindObjectByLocator {fqn :: Expression}+  deriving (Exception)++instance Show LocatorException where+  show InvalidLocatorProvided{..} =+    printf+      "Invalid locator is provided. 'Q' or dispatch started with 'Q' expected, but got: '%s'"+      (printExpression fqn)+  show CanNotFindObjectByLocator{..} = printf "Can't find object by locator: '%s'" (printExpression fqn)++locatedExpression :: Expression -> Program -> IO Expression+locatedExpression ExGlobal (Program expr) = pure expr+locatedExpression locator (Program expr) = case fqnToAttrs locator of+  Just attrs -> locatedExpression' expr attrs+  _ -> invalidLocator locator+  where+    locatedExpression' :: Expression -> [Attribute] -> IO Expression+    locatedExpression' expr' [] = pure expr'+    locatedExpression' (ExFormation bds) [attr] = case locatedInBindings attr bds of+      Just expr' -> pure expr'+      _ -> cantFindBy locator+    locatedExpression' (ExFormation bds) (attr : rest) = case locatedInBindings attr bds of+      Just expr' -> locatedExpression' expr' rest+      _ -> cantFindBy locator+    locatedExpression' _ _ = cantFindBy locator++withLocatedExpression :: Expression -> Expression -> Program -> IO Program+withLocatedExpression ExGlobal tgt _ = pure (Program tgt)+withLocatedExpression locator target (Program expr) = case fqnToAttrs locator of+  Just attrs -> Program <$> withLocatedExpression' expr attrs+  _ -> invalidLocator locator+  where+    withLocatedExpression' :: Expression -> [Attribute] -> IO Expression+    withLocatedExpression' (ExFormation bds) [attr] = case locatedInBindings attr bds of+      Just _ -> pure (ExFormation (withReplacedExpression bds))+      _ -> cantFindBy locator+      where+        withReplacedExpression :: [Binding] -> [Binding]+        withReplacedExpression [] = []+        withReplacedExpression (bd@(BiTau at _) : bds')+          | at == attr = BiTau at target : bds'+          | otherwise = bd : withReplacedExpression bds'+        withReplacedExpression (bd@(BiVoid at) : bds')+          | at == attr = BiTau at target : bds'+          | otherwise = bd : withReplacedExpression bds'+        withReplacedExpression (bd : bds') = bd : withReplacedExpression bds'+    withLocatedExpression' (ExFormation bds) attrs = ExFormation <$> withLocatedBindings bds attrs+      where+        withLocatedBindings :: [Binding] -> [Attribute] -> IO [Binding]+        withLocatedBindings (bd@(BiTau at expr') : rbds) attrs'@(at' : rattrs)+          | at == at' = withLocatedExpression' expr' rattrs <&> (: rbds) . BiTau at+          | otherwise = withLocatedBindings rbds attrs' <&> (:) bd+        withLocatedBindings (bd : rbds) attrs' = (:) bd <$> withLocatedBindings rbds attrs'+        withLocatedBindings [] _ = cantFindBy locator+    withLocatedExpression' _ _ = cantFindBy locator++locatedInBindings :: Attribute -> [Binding] -> Maybe Expression+locatedInBindings _ [] = Nothing+locatedInBindings attr (BiTau attr' expr' : rest)+  | attr == attr' = Just expr'+  | otherwise = locatedInBindings attr rest+locatedInBindings attr (_ : rest) = locatedInBindings attr rest++invalidLocator :: Expression -> IO a+invalidLocator = throwIO <$> InvalidLocatorProvided++cantFindBy :: Expression -> IO a+cantFindBy = throwIO <$> CanNotFindObjectByLocator

@@ -84,7 +84,7 @@   | pFunc == tFunc = [substEmpty]   | otherwise = [] matchBinding (BiMetaLambda meta) (BiLambda tFunc) _ = [substSingle meta (MvFunction tFunc)]-matchBinding (BiTau pattr pexp) (BiTau tattr texp) scope = combineMany (matchAttribute pattr tattr) (matchExpression pexp texp scope)+matchBinding (BiTau pattr pexp) (BiTau tattr texp) scope = combineMany (matchAttribute pattr tattr) (matchExpression' pexp texp scope) matchBinding _ _ _ = []  -- Match bindings with ordering@@ -111,7 +111,7 @@   _ -> ([], [])   where     tailExpressionsReversed :: Expression -> Expression -> Maybe ([Subst], [Tail])-    tailExpressionsReversed ptn' tgt' = case matchExpression ptn' tgt' scope of+    tailExpressionsReversed ptn' tgt' = case matchExpression' ptn' tgt' scope of       [] -> case tgt' of         ExDispatch expr attr -> do           (substs, tails) <- tailExpressionsReversed ptn' expr@@ -129,24 +129,24 @@         _ -> Just ([], [])       substs -> Just (substs, []) -matchExpression :: Expression -> Expression -> Expression -> [Subst]-matchExpression (ExMeta meta) tgt scope = [substSingle meta (MvExpression tgt scope)]-matchExpression ExThis ExThis _ = [substEmpty]-matchExpression ExGlobal ExGlobal _ = [substEmpty]-matchExpression ExTermination ExTermination _ = [substEmpty]-matchExpression (ExFormation pbs) (ExFormation tbs) _ = matchBindings pbs tbs (ExFormation tbs)-matchExpression (ExDispatch pexp pattr) (ExDispatch texp tattr) scope = combineMany (matchAttribute pattr tattr) (matchExpression pexp texp scope)-matchExpression (ExApplication pexp pbd) (ExApplication texp tbd) scope = combineMany (matchExpression pexp texp scope) (matchBinding pbd tbd scope)-matchExpression (ExMetaTail expr meta) tgt scope = case tailExpressions expr tgt scope of+matchExpression' :: Expression -> Expression -> Expression -> [Subst]+matchExpression' (ExMeta meta) tgt scope = [substSingle meta (MvExpression tgt scope)]+matchExpression' ExThis ExThis _ = [substEmpty]+matchExpression' ExGlobal ExGlobal _ = [substEmpty]+matchExpression' ExTermination ExTermination _ = [substEmpty]+matchExpression' (ExFormation pbs) (ExFormation tbs) _ = matchBindings pbs tbs (ExFormation tbs)+matchExpression' (ExDispatch pexp pattr) (ExDispatch texp tattr) scope = combineMany (matchAttribute pattr tattr) (matchExpression' pexp texp scope)+matchExpression' (ExApplication pexp pbd) (ExApplication texp tbd) scope = combineMany (matchExpression' pexp texp scope) (matchBinding pbd tbd scope)+matchExpression' (ExMetaTail expr meta) tgt scope = case tailExpressions expr tgt scope of   ([], _) -> []   (substs, tails) -> combineMany substs [substSingle meta (MvTail tails)]-matchExpression (ExPhiAgain prefix idx expr) (ExPhiAgain prefix' idx' expr') scope-  | prefix == prefix' && idx == idx' = matchExpression expr expr' scope+matchExpression' (ExPhiAgain prefix idx expr) (ExPhiAgain prefix' idx' expr') scope+  | prefix == prefix' && idx == idx' = matchExpression' expr expr' scope   | otherwise = []-matchExpression (ExPhiMeet prefix idx expr) (ExPhiMeet prefix' idx' expr') scope-  | prefix == prefix' && idx == idx' = matchExpression expr expr' scope+matchExpression' (ExPhiMeet prefix idx expr) (ExPhiMeet prefix' idx' expr') scope+  | prefix == prefix' && idx == idx' = matchExpression' expr expr' scope   | otherwise = []-matchExpression _ _ _ = []+matchExpression' _ _ _ = []  -- Deep match pattern to expression inside binding matchBindingExpression :: Binding -> Expression -> Expression -> [Subst]@@ -156,7 +156,7 @@ -- Match expression with deep nested expression(s) matching matchExpressionDeep :: Expression -> Expression -> Expression -> [Subst] matchExpressionDeep ptn tgt scope =-  let matched = matchExpression ptn tgt scope+  let matched = matchExpression' ptn tgt scope       deep = case tgt of         ExFormation bds -> concatMap (\bd -> matchBindingExpression bd ptn tgt) bds         ExDispatch expr _ -> matchExpressionDeep ptn expr scope@@ -164,5 +164,8 @@         _ -> []    in matched ++ deep +matchExpression :: Expression -> Expression -> [Subst]+matchExpression ptn tgt = matchExpressionDeep ptn tgt defaultScope+ matchProgram :: Expression -> Program -> [Subst]-matchProgram ptn (Program expr) = matchExpressionDeep ptn expr defaultScope+matchProgram ptn (Program expr) = matchExpression ptn expr

@@ -9,8 +9,11 @@ module Replacer   ( replaceProgram   , replaceProgramFast+  , replaceExpression+  , replaceExpressionFast   , ReplaceContext (..)   , ReplaceProgramFunc+  , ReplaceExpressionFunc   ) where @@ -19,13 +22,15 @@  type ReplaceState a = (a, [Expression], [Expression -> Expression]) -type ReplaceExpressionFunc = ReplaceState Expression -> ReplaceContext -> ReplaceState Expression+type ReplaceExpressionFunc' = ReplaceState Expression -> ReplaceContext -> ReplaceState Expression  type ReplaceProgramFunc = ReplaceState Program -> Program +type ReplaceExpressionFunc = ReplaceState Expression -> Expression+ newtype ReplaceContext = ReplaceCtx {_maxDepth :: Int} -replaceBindings :: ReplaceState [Binding] -> ReplaceContext -> ReplaceExpressionFunc -> ReplaceState [Binding]+replaceBindings :: ReplaceState [Binding] -> ReplaceContext -> ReplaceExpressionFunc' -> ReplaceState [Binding] replaceBindings state@(_, [], _) _ _ = state replaceBindings state@(_, _, []) _ _ = state replaceBindings state@([], _, _) _ _ = state@@ -37,24 +42,24 @@   let (bds', ptns', repls') = replaceBindings (bds, ptns, repls) ctx func    in (bd : bds', ptns', repls') -replaceExpression :: ReplaceExpressionFunc-replaceExpression state@(expr, ptns@(ptn : _ptns), repls@(repl : _repls)) ctx =+replaceExpression' :: ReplaceExpressionFunc'+replaceExpression' state@(expr, ptns@(ptn : _ptns), repls@(repl : _repls)) ctx =   if expr == ptn-    then replaceExpression (repl expr, _ptns, _repls) ctx+    then replaceExpression' (repl expr, _ptns, _repls) ctx     else case expr of       ExDispatch inner attr ->-        let (expr', ptns', repls') = replaceExpression (inner, ptns, repls) ctx+        let (expr', ptns', repls') = replaceExpression' (inner, ptns, repls) ctx          in (ExDispatch expr' attr, ptns', repls')       ExApplication inner tau ->-        let (expr', ptns', repls') = replaceExpression (inner, ptns, repls) ctx-         in case replaceBindings ([tau], ptns', repls') ctx replaceExpression of+        let (expr', ptns', repls') = replaceExpression' (inner, ptns, repls) ctx+         in case replaceBindings ([tau], ptns', repls') ctx replaceExpression' of               ([tau'], ptns'', repls'') -> (ExApplication expr' tau', ptns'', repls'')               (bds', _, _) -> error $ "Expected single binding, got " ++ show (length bds')       ExFormation bds ->-        let (bds', ptns', repls') = replaceBindings (bds, ptns, repls) ctx replaceExpression+        let (bds', ptns', repls') = replaceBindings (bds, ptns, repls) ctx replaceExpression'          in (ExFormation bds', ptns', repls')       _ -> state-replaceExpression state _ = state+replaceExpression' state _ = state  replaceBindingsFast :: [Binding] -> [Expression] -> [Expression] -> [Binding] replaceBindingsFast bds ((ExFormation pbds) : _ptns) ((ExFormation rbds) : _repls) =@@ -69,35 +74,41 @@       | otherwise = x : findAndReplace xs' ptn repl replaceBindingsFast bds _ _ = bds -replaceExpressionFast :: ReplaceExpressionFunc-replaceExpressionFast = replaceExpressionFast' 0+replaceExpressionFast' :: ReplaceExpressionFunc'+replaceExpressionFast' = _replaceExpressionFast 0   where-    replaceExpressionFast' :: Int -> ReplaceExpressionFunc-    replaceExpressionFast' _ state@(_, [], _) _ = state-    replaceExpressionFast' _ state@(_, _, []) _ = state-    replaceExpressionFast' depth state@(expr, ptns, repls) ctx@ReplaceCtx{..} =+    _replaceExpressionFast :: Int -> ReplaceExpressionFunc'+    _replaceExpressionFast _ state@(_, [], _) _ = state+    _replaceExpressionFast _ state@(_, _, []) _ = state+    _replaceExpressionFast depth state@(expr, ptns, repls) ctx@ReplaceCtx{..} =       if depth == _maxDepth         then (expr, [], [])         else case expr of           ExFormation bds ->             let replaced = replaceBindingsFast bds ptns (map (\rep -> rep expr) repls)-                (bds', ptns', repls') = replaceBindings (replaced, ptns, repls) ctx (replaceExpressionFast' (depth + 1))+                (bds', ptns', repls') = replaceBindings (replaced, ptns, repls) ctx (_replaceExpressionFast (depth + 1))              in (ExFormation bds', ptns', repls')           ExDispatch inner attr ->-            let (expr', ptns', repls') = replaceExpressionFast (inner, ptns, repls) ctx+            let (expr', ptns', repls') = replaceExpressionFast' (inner, ptns, repls) ctx              in (ExDispatch expr' attr, ptns', repls')           ExApplication inner (BiTau attr arg) ->-            let (expr', ptns', repls') = replaceExpressionFast (inner, ptns, repls) ctx-                (expr'', ptns'', repls'') = replaceExpressionFast (arg, ptns', repls') ctx+            let (expr', ptns', repls') = replaceExpressionFast' (inner, ptns, repls) ctx+                (expr'', ptns'', repls'') = replaceExpressionFast' (arg, ptns', repls') ctx              in (ExApplication expr' (BiTau attr expr''), ptns'', repls'')           _ -> state +replaceExpression :: ReplaceExpressionFunc+replaceExpression state =+  let (expr, _, _) = replaceExpression' state (ReplaceCtx 0)+   in expr++replaceExpressionFast :: ReplaceContext -> ReplaceExpressionFunc+replaceExpressionFast ctx state =+  let (expr, _, _) = replaceExpressionFast' state ctx+   in expr+ replaceProgram :: ReplaceProgramFunc-replaceProgram (Program expr, ptns, repls) =-  let (expr', _, _) = replaceExpression (expr, ptns, repls) (ReplaceCtx 0)-   in Program expr'+replaceProgram (Program expr, ptns, repls) = Program (replaceExpression (expr, ptns, repls))  replaceProgramFast :: ReplaceContext -> ReplaceProgramFunc-replaceProgramFast ctx (Program expr, ptns, repls) =-  let (expr', _, _) = replaceExpressionFast (expr, ptns, repls) ctx-   in Program expr'+replaceProgramFast ctx (Program expr, ptns, repls) = Program (replaceExpressionFast ctx (expr, ptns, repls))

@@ -8,7 +8,7 @@ -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com -- SPDX-License-Identifier: MIT -module Rewriter (rewrite, rewrite', RewriteContext (..), Rewritten) where+module Rewriter (rewrite, RewriteContext (..), Rewritten) where  import AST import Builder@@ -18,24 +18,26 @@ import Data.Maybe (fromMaybe) import qualified Data.Set as Set import Deps+import Locator (locatedExpression, withLocatedExpression) import Logger (logDebug) import Matcher (Subst) import Must (Must (..), exceedsUpperBound, inRange)-import Printer (printProgram)-import Replacer (ReplaceContext (ReplaceCtx), ReplaceProgramFunc, replaceProgram, replaceProgramFast)+import Printer (printExpression)+import Replacer (ReplaceContext (ReplaceCtx), ReplaceExpressionFunc, replaceExpression, replaceExpressionFast) import Rule (RuleContext (RuleContext)) import qualified Rule as R import Text.Printf (printf) import qualified Yaml as Y -type RewriteState = ([Rewritten], Set.Set Program)+type RewriteState = ([Rewritten], Set.Set Expression)  type Rewritten = (Program, Maybe String) -type ToReplace = (Program, Expression, Expression, [Subst])+type ToReplace = (Expression, Expression, Expression, [Subst])  data RewriteContext = RewriteContext-  { _maxDepth :: Int+  { _locator :: Expression+  , _maxDepth :: Int   , _maxCycles :: Int   , _depthSensitive :: Bool   , _buildTerm :: BuildTermFunc@@ -68,21 +70,21 @@       "With option --depth-sensitive it's expected rewriting iterations amount does not reach the limit: --%s=%d"       flg       lim-  show (LoopingRewriting prg rul stp) =+  show (LoopingRewriting expr rul stp) =     printf-      "On rewriting step '%d' of rule '%s' we got the same program as we got at one of the previous step, it seems rewriting is looping\nProgram: %s"+      "On rewriting step '%d' of rule '%s' we got the same expression as we got at one of the previous step, it seems rewriting is looping\nExpression: %s"       stp       rul-      prg+      expr --- Build pattern and result expression and replace patterns to results in given program-buildAndReplace' :: ToReplace -> ReplaceProgramFunc -> IO Program-buildAndReplace' (prog, ptn, res, substs) func = do+-- Build pattern and result expression and replace patterns to results in given expression+buildAndReplace' :: ToReplace -> ReplaceExpressionFunc -> IO Expression+buildAndReplace' (expr, ptn, res, substs) func = do   ptns <- buildExpressionsThrows ptn substs   repls <- buildExpressionsThrows res substs   let ptns' = map fst ptns       repls' = map (\ex _ -> fst ex) repls-  pure (func (prog, ptns', repls'))+  pure (func (expr, ptns', repls'))  -- If pattern and replacement are appropriate for fast replacing - does it. -- Pattern and replacement expressions can be used in fast replacing only if@@ -92,8 +94,8 @@ -- In such case we can just replace bindings one by one without building whole expression. -- You can find more details in this ticket: https://github.com/objectionary/phino/issues/321 -- If we don't meet the conditions above - just do a regular replacing-tryBuildAndReplaceFast :: ToReplace -> ReplaceContext -> IO Program-tryBuildAndReplaceFast state@(prog, ExFormation pbds, ExFormation rbds, substs) ctx =+tryBuildAndReplaceFast :: ToReplace -> ReplaceContext -> IO Expression+tryBuildAndReplaceFast state@(expr, ExFormation pbds, ExFormation rbds, substs) ctx =   let pbds' = init (tail pbds)       rbds' = init (tail rbds)    in if startsAndEndsWithMeta pbds@@ -104,10 +106,10 @@         && not (hasMetaBindings rbds')         then do           logDebug "Applying fast replacing since 'pattern' and 'result' are suitable for this..."-          buildAndReplace' (prog, ExFormation pbds', ExFormation rbds', substs) (replaceProgramFast ctx)+          buildAndReplace' (expr, ExFormation pbds', ExFormation rbds', substs) (replaceExpressionFast ctx)         else do           logDebug "Applying regular replacing..."-          buildAndReplace' state replaceProgram+          buildAndReplace' state replaceExpression   where     startsAndEndsWithMeta :: [Binding] -> Bool     startsAndEndsWithMeta bds =@@ -120,17 +122,17 @@       BiMeta _ -> True       _ -> False     hasMetaBindings = foldl (\acc bd -> acc || isMetaBinding bd) False-tryBuildAndReplaceFast state _ = buildAndReplace' state replaceProgram+tryBuildAndReplaceFast state _ = buildAndReplace' state replaceExpression  -- The function returns tuple (X, Y) where -- - X is sequence of programs; -- - Y is Set of unique programs after each rule application. It allows to stop the rewriting if we're getting --   into loop and get back to program which we've already got before-rewrite :: RewriteState -> [Y.Rule] -> Int -> RewriteContext -> IO RewriteState-rewrite state [] _ _ = pure state-rewrite state (rule : rest) iteration ctx@RewriteContext{..} = do+rewrite' :: RewriteState -> [Y.Rule] -> Int -> RewriteContext -> IO RewriteState+rewrite' state [] _ _ = pure state+rewrite' state (rule : rest) iteration ctx@RewriteContext{..} = do   state' <- _rewrite state 1-  rewrite state' rest iteration ctx+  rewrite' state' rest iteration ctx   where     _rewrite :: RewriteState -> Int -> IO RewriteState     _rewrite (_rewrittens, _unique) _count =@@ -146,65 +148,61 @@                 else pure (_rewrittens, _unique)             else do               logDebug (printf "Starting rewriting cycle for rule '%s': %d out of %d" ruleName _count _maxDepth)-              matched <- R.matchProgramWithRule program rule (RuleContext _buildTerm)+              expression <- locatedExpression _locator program+              matched <- R.matchExpressionWithRule expression rule (RuleContext _buildTerm)               if null matched                 then do                   logDebug (printf "Rule '%s' does not match, rewriting is stopped" ruleName)                   pure (_rewrittens, _unique)                 else do                   logDebug (printf "Rule '%s' has been matched, applying..." ruleName)-                  prog <- tryBuildAndReplaceFast (program, ptn, res, matched) (ReplaceCtx _maxDepth)-                  if program == prog+                  expr <- tryBuildAndReplaceFast (expression, ptn, res, matched) (ReplaceCtx _maxDepth)+                  if expression == expr                     then do                       logDebug (printf "Applied '%s', no changes made" ruleName)                       pure (_rewrittens, _unique)                     else-                      if Set.member prog _unique-                        then throwIO (LoopingRewriting (printProgram prog) ruleName _count)+                      if Set.member expr _unique+                        then throwIO (LoopingRewriting (printExpression expr) ruleName _count)                         else do                           logDebug                             ( printf                                 "Applied '%s' (%d nodes -> %d nodes)\n%s"                                 ruleName-                                (countNodes program)-                                (countNodes prog)-                                (printProgram prog)+                                (countNodes expression)+                                (countNodes expr)+                                (printExpression expr)                             )+                          prog <- withLocatedExpression _locator expr program                           _saveStep prog (((iteration - 1) * _maxDepth) + _count)-                          _rewrite (leadsTo prog, Set.insert prog _unique) (_count + 1)+                          _rewrite (leadsTo prog, Set.insert expr _unique) (_count + 1)       where         leadsTo :: Program -> [Rewritten]         leadsTo _prog = case _rewrittens of           (program, _) : rest -> (_prog, Nothing) : (program, Just (map toLower (fromMaybe "unknown" (Y.name rule)))) : rest           [] -> [(_prog, Nothing)] --- The function accepts single program but returns sequence of programs-rewrite' :: Program -> [Y.Rule] -> RewriteContext -> IO [Rewritten]-rewrite' prog rules ctx = _rewrite ([(prog, Nothing)], Set.empty) 1 ctx <&> reverse+-- Rewrite program by provided locator from RewriteContext+rewrite :: Program -> [Y.Rule] -> RewriteContext -> IO [Rewritten]+rewrite prog rules ctx@RewriteContext{..} = _rewrite ([(prog, Nothing)], Set.empty) 0 <&> reverse   where-    _rewrite :: RewriteState -> Int -> RewriteContext -> IO [Rewritten]-    _rewrite state@(rewrittens, _) count ctx@RewriteContext{..} = do-      let cycles = _maxCycles-          must = _must-          current = count - 1-      if not (inRange must current) && current > 0 && exceedsUpperBound must current-        then throwIO (MustStopBefore must current)-        else-          if current == cycles+    _rewrite :: RewriteState -> Int -> IO [Rewritten]+    _rewrite state@(rewrittens, _) count+      | not (inRange _must count) && count > 0 && exceedsUpperBound _must count = throwIO (MustStopBefore _must count)+      | count == _maxCycles = do+          logDebug (printf "Max amount of rewriting cycles for all rules (%d) has been reached, rewriting is stopped" _maxCycles)+          if _depthSensitive+            then throwIO (StoppedOnLimit "max-cycles" _maxCycles)+            else pure rewrittens+      | otherwise = do+          logDebug (printf "Starting rewriting cycle for all rules: %d out of %d" count _maxCycles)+          state'@(rewrittens', _) <- rewrite' state rules count ctx+          let (program', _) = head rewrittens'+              (program, _) = head rewrittens+          if program' == program             then do-              logDebug (printf "Max amount of rewriting cycles for all rules (%d) has been reached, rewriting is stopped" cycles)-              if _depthSensitive-                then throwIO (StoppedOnLimit "max-cycles" cycles)-                else pure rewrittens-            else do-              logDebug (printf "Starting rewriting cycle for all rules: %d out of %d" count cycles)-              state'@(rewrittens', _) <- rewrite state rules count ctx-              let (program', _) = head rewrittens'-                  (program, _) = head rewrittens-              if program' == program-                then do-                  logDebug "Rewriting is stopped since it has no effect"-                  if not (inRange must current)-                    then throwIO (MustBeGoing must current)-                    else pure rewrittens'-                else _rewrite state' (count + 1) ctx+              logDebug "Rewriting is stopped since it has no effect"+              if not (inRange _must count)+                then throwIO (MustBeGoing _must count)+                else pure rewrittens'+            else _rewrite state' (count + 1)

@@ -5,7 +5,7 @@ -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com -- SPDX-License-Identifier: MIT -module Rule (RuleContext (..), isNF, matchProgramWithRule, meetCondition) where+module Rule (RuleContext (..), isNF, matchProgramWithRule, matchExpressionWithRule, meetCondition) where  import AST import Builder@@ -44,7 +44,7 @@     matchesAnyNormalizationRule' :: Expression -> [Y.Rule] -> RuleContext -> Bool     matchesAnyNormalizationRule' _ [] _ = False     matchesAnyNormalizationRule' expr (rule : rules) ctx =-      let matched = unsafePerformIO (matchProgramWithRule (Program expr) rule ctx)+      let matched = unsafePerformIO (matchExpressionWithRule expr rule ctx)        in not (null matched) || matchesAnyNormalizationRule' expr rules ctx  -- Returns True if given expression is in the normal form@@ -278,10 +278,10 @@     logDebug "Extra substitutions have been built"     pure (catMaybes res) -matchProgramWithRule :: Program -> Y.Rule -> RuleContext -> IO [Subst]-matchProgramWithRule program rule ctx =+matchExpressionWithRule :: Expression -> Y.Rule -> RuleContext -> IO [Subst]+matchExpressionWithRule expr rule ctx =   let ptn = Y.pattern rule-      matched = matchProgram ptn program+      matched = matchExpression ptn expr       name = fromMaybe "unknown" (Y.name rule)    in if null matched         then do@@ -304,3 +304,6 @@                   met <- meetMaybeCondition (Y.having rule) extended ctx                   when (null met) (logDebug "The 'having' condition wan't met")                   pure met++matchProgramWithRule :: Program -> Y.Rule -> RuleContext -> IO [Subst]+matchProgramWithRule (Program expr) = matchExpressionWithRule expr

@@ -214,56 +214,25 @@       let hasProgram str = "Program" `elem` words str        in show (Program ExGlobal) `shouldSatisfy` hasProgram -  describe "countNodes counts ExGlobal" $-    it "returns one for global" $-      countNodes (Program ExGlobal) `shouldBe` 1--  describe "countNodes counts ExTermination" $-    it "returns one for termination" $-      countNodes (Program ExTermination) `shouldBe` 1--  describe "countNodes counts ExThis" $-    it "returns one for this" $-      countNodes (Program ExThis) `shouldBe` 1--  describe "countNodes counts ExDispatch" $-    it "returns three for dispatch on global" $-      countNodes (Program (ExDispatch ExGlobal (AtLabel "x"))) `shouldBe` 3--  describe "countNodes counts ExApplication" $-    it "returns four for application with globals" $-      countNodes (Program (ExApplication ExGlobal (BiTau AtRho ExGlobal))) `shouldBe` 4--  describe "countNodes counts ExFormation with tau bindings" $-    it "returns count including nested expressions" $-      countNodes (Program (ExFormation [BiTau AtRho ExGlobal, BiTau AtPhi ExGlobal])) `shouldBe` 3-   describe "countNodes counts ExFormation with non-tau bindings" $     forM_-      [ ("empty formation", ExFormation [], 1)+      [ ("Q", ExGlobal, 1)+      , ("T", ExTermination, 1)+      , ("$", ExThis, 1)+      , ("dispatch on global", ExDispatch ExGlobal (AtLabel "x"), 3)+      , ("application with globals", ExApplication ExGlobal (BiTau AtRho ExGlobal), 4)+      , ("nested expressions", ExFormation [BiTau AtRho ExGlobal, BiTau AtPhi ExGlobal], 3)+      , ("empty formation", ExFormation [], 1)       , ("void binding", ExFormation [BiVoid AtRho], 2)       , ("delta binding", ExFormation [BiDelta BtEmpty], 2)       , ("lambda binding", ExFormation [BiLambda "Func"], 2)       , ("meta binding", ExFormation [BiMeta "B"], 2)       , ("metalambda binding", ExFormation [BiMetaLambda "F"], 2)-      ]-      ( \(desc, expr, expected) ->-          it desc $ countNodes (Program expr) `shouldBe` expected-      )--  describe "countNodes returns zero for meta expressions" $-    forM_-      [ ("meta expression", ExMeta "e", 0)+      , ("meta expression", ExMeta "e", 0)       , ("metatail expression", ExMetaTail ExGlobal "t", 0)+      , ("deeply nested dispatch", ExDispatch (ExDispatch ExGlobal (AtLabel "a")) (AtLabel "b"), 5)+      , ("formation with dispatch inside", ExFormation [BiTau AtRho (ExDispatch ExGlobal (AtLabel "x"))], 4)       ]       ( \(desc, expr, expected) ->-          it desc $ countNodes (Program expr) `shouldBe` expected+          it desc $ countNodes expr `shouldBe` expected       )--  describe "countNodes counts nested structures" $-    it "counts deeply nested dispatch" $-      countNodes (Program (ExDispatch (ExDispatch ExGlobal (AtLabel "a")) (AtLabel "b"))) `shouldBe` 5--  describe "countNodes counts complex formation" $-    it "counts formation with dispatch inside" $-      countNodes (Program (ExFormation [BiTau AtRho (ExDispatch ExGlobal (AtLabel "x"))])) `shouldBe` 4

@@ -609,7 +609,7 @@           [ intercalate               "\n"               [ "[DEBUG]: Applied 'COPY' (28 nodes -> 25 nodes)"-              , "{⟦"+              , "⟦"               , "  x ↦ ⟦"               , "    y ↦ 5"               , "---| log is limited by --log-lines=4 option |---"@@ -621,6 +621,12 @@         testCLISucceeded           ["rewrite", "--canonize", "--sweet", "--flat"]           ["{⟦ x ↦ ⟦ y ↦ ⟦ λ ⤍ F1 ⟧.q, z ↦ Φ.x( a ↦ ⟦ w ↦ ⟦ λ ⤍ F2 ⟧, λ ⤍ F3 ⟧ ) ⟧, λ ⤍ F4 ⟧}"]++    it "rewrites by locator" $+      withStdin "{[[ ex -> [[ x -> [[ y -> 5 ]].y ]], abc -> [[ x -> ? ]](x -> 5) ]]}" $+        testCLISucceeded+          ["rewrite", "--sweet", "--flat", "--locator=Q.ex", "--normalize"]+          ["{⟦ ex ↦ ⟦ x ↦ 5 ⟧, abc ↦ ⟦ x ↦ ∅ ⟧( x ↦ 5 ) ⟧}"]    describe "dataize" $ do     it "prints help" $

@@ -9,25 +9,26 @@ import Deps (dontSaveStep) import Functions (buildTerm) import Parser (parseExpressionThrows, parseProgramThrows)-import Printer (printProgram) import Rewriter (Rewritten) import Test.Hspec -defaultDataizeContext :: Program -> DataizeContext-defaultDataizeContext prog = DataizeContext prog 25 25 False buildTerm dontSaveStep+defaultDataizeContext :: Expression -> Program -> DataizeContext+defaultDataizeContext loc prog = DataizeContext loc prog 25 25 False buildTerm dontSaveStep  test :: (Eq a, Show a) => ((Expression, [Rewritten]) -> DataizeContext -> IO (Maybe a, [Rewritten])) -> [(String, Expression, Expression, Maybe a)] -> Spec test func useCases =-  forM_ useCases $ \(desc, input, prog, output) ->+  forM_ useCases $ \(desc, input, expr, output) ->     it desc $ do-      (res, _) <- func (input, []) (defaultDataizeContext (Program prog))+      let prog = Program expr+      (res, _) <- func (input, [(prog, Nothing)]) (defaultDataizeContext ExGlobal prog)       res `shouldBe` output  test' :: (Eq a, Show a) => ((Expression, [Rewritten]) -> DataizeContext -> IO (a, [Rewritten])) -> [(String, Expression, Expression, a)] -> Spec test' func useCases =-  forM_ useCases $ \(desc, input, prog, output) ->+  forM_ useCases $ \(desc, input, expr, output) ->     it desc $ do-      (res, _) <- func (input, [(Program prog, Nothing)]) (defaultDataizeContext (Program prog))+      let prog = Program expr+      (res, _) <- func (input, [(prog, Nothing)]) (defaultDataizeContext ExGlobal prog)       res `shouldBe` output  testDataize :: [(String, String, String, Bytes)] -> Spec@@ -36,8 +37,7 @@     it name $ do       prog' <- parseProgramThrows prog       loc' <- parseExpressionThrows loc-      putStrLn (printProgram prog')-      (value, _) <- dataize loc' (defaultDataizeContext prog')+      (value, _) <- dataize (defaultDataizeContext loc' prog')       value `shouldBe` Just res  spec :: Spec@@ -104,7 +104,7 @@    testDataize     [-      ( "5.plus(5)"+      ( "5.plus(6)"       , "Q"       , unlines           [ "Q -> [["@@ -121,10 +121,10 @@           , "      ]]"           , "    ]]"           , "  ]],"-          , "  @ -> 5.plus(5)"+          , "  @ -> 5.plus(6)"           , "]]"           ]-      , BtMany ["40", "24", "00", "00", "00", "00", "00", "00"]+      , BtMany ["40", "26", "00", "00", "00", "00", "00", "00"]       )     ,       ( "Fahrenheit"@@ -197,5 +197,21 @@           , "]]"           ]       , BtOne "42"+      )+    ,+      ( "Five"+      , "Q.x"+      , unlines+          [ "Q -> [["+          , "  org -> [["+          , "    eolang -> [["+          , "      number(as-bytes) -> [[ @ -> as-bytes ]],"+          , "      bytes(data) -> [[ @ -> data ]]"+          , "    ]]"+          , "  ]],"+          , "  x -> 5"+          , "]]"+          ]+      , BtMany ["40", "14", "00", "00", "00", "00", "00", "00"]       )     ]

@@ -0,0 +1,41 @@+-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+-- SPDX-License-Identifier: MIT++module LocatorSpec where++import Control.Monad (forM_)+import Data.List (intercalate)+import Locator (locatedExpression, withLocatedExpression)+import Parser (parseExpressionThrows, parseProgramThrows)+import Test.Hspec (Spec, describe, it, shouldBe)++spec :: Spec+spec = do+  describe "located expression" $+    forM_+      [ ("{[[ x -> [[ y -> [[ z -> ? ]] ]] ]]}", "Q.x.y", "[[ z -> ? ]]")+      , ("{[[ x -> ?, y -> [[ z -> ?, w -> [[ a -> $.x ]] ]], z -> ? ]]}", "Q.y.w.a", "$.x")+      , ("{[[ x -> ?, y -> ? ]]}", "Q", "[[ x -> ?, y -> ? ]]")+      ]+      ( \(prog, locator, res) -> it (intercalate " => " [prog, locator, res]) $ do+          prog' <- parseProgramThrows prog+          locator' <- parseExpressionThrows locator+          res' <- parseExpressionThrows res+          located <- locatedExpression locator' prog'+          located `shouldBe` res'+      )++  describe "with located expression" $+    forM_+      [ ("{[[ x -> $ ]]}", "Q.x", "[[ y -> ? ]]", "{[[ x -> [[ y -> ? ]] ]]}")+      , ("{[[ x -> ?, y -> [[ x -> ?, y -> [[ ]] ]] ]]}", "Q.y.y", "Q.x.y", "{[[ x -> ?, y -> [[ x -> ?, y -> Q.x.y ]] ]]}")+      , ("{[[ x -> [[ y -> [[ z -> [[ w -> ? ]] ]] ]] ]]}", "Q.x.y", "$.a(x -> [[]])", "{[[ x -> [[ y -> $.a(x -> [[]]) ]] ]]}")+      ]+      ( \(prog, locator, expr, res) -> it (intercalate " => " [prog, locator, expr, res]) $ do+          prog' <- parseProgramThrows prog+          locator' <- parseExpressionThrows locator+          expr' <- parseExpressionThrows expr+          res' <- parseProgramThrows res+          loc <- withLocatedExpression locator' expr' prog'+          loc `shouldBe` res'+      )

@@ -407,7 +407,7 @@    describe "matchExpression: expression => pattern => substitution" $     test-      matchExpression+      matchExpression'       [ ("$ => $ => [()]", ExThis, ExThis, defaultScope, [[]])       , ("Q => Q => [()]", ExGlobal, ExGlobal, defaultScope, [[]])       ,

@@ -8,6 +8,7 @@  module RewriterSpec where +import AST (Expression (ExGlobal)) import Control.Monad (forM_, unless) import Data.Aeson import Data.Char (isSpace)@@ -19,7 +20,7 @@ import Must (Must (..)) import Parser (parseProgramThrows) import Printer (printProgram)-import Rewriter (RewriteContext (RewriteContext), rewrite')+import Rewriter (RewriteContext (RewriteContext), rewrite) import System.FilePath (makeRelative, replaceExtension, (</>)) import Test.Hspec (Spec, describe, expectationFailure, it, pending, runIO) import Yaml (normalizationRules)@@ -99,10 +100,11 @@                     then pure normalizationRules                     else pure []               rewrittens <--                rewrite'+                rewrite                   prog                   rules'                   ( RewriteContext+                      ExGlobal                       repeat'                       repeat'                       False