packages feed

phino 0.0.0.17 → 0.0.0.18

raw patch · 22 files changed

+627/−345 lines, 22 filesdep +arraydep +regex-tdfadep +transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: array, regex-tdfa, transformers

API changes (from Hackage documentation)

- Ast: BiMetaDelta :: String -> Binding
- Builder: TeAttribute :: Attribute -> Term
- Builder: TeExpression :: Expression -> Term
- Builder: buildTermFromFunction :: String -> [ExtraArgument] -> Subst -> Program -> Maybe Term
- Builder: data Term
- Dataize: [maxDepth] :: DataizeContext -> Integer
- Dataize: [program] :: DataizeContext -> Program
- Dataize: defaultDataizeContext :: Program -> DataizeContext
- Misc: hexToNum :: String -> Either Integer Double
- Misc: hexToStr :: String -> String
- Misc: numToHex :: Double -> String
- Misc: strToHex :: String -> String
- Rewriter: [maxDepth] :: RewriteContext -> Integer
- Rewriter: [program] :: RewriteContext -> Program
- Rewriter: defaultRewriteContext :: Program -> RewriteContext
- Rewriter: instance GHC.Exception.Type.Exception Rewriter.RewriteException
- Rewriter: instance GHC.Show.Show Rewriter.RewriteException
+ Ast: BtEmpty :: Bytes
+ Ast: BtMany :: [String] -> Bytes
+ Ast: BtMeta :: String -> Bytes
+ Ast: BtOne :: String -> Bytes
+ Ast: countNodes :: Program -> Integer
+ Ast: data Bytes
+ Ast: instance GHC.Classes.Eq Ast.Bytes
+ Ast: instance GHC.Generics.Generic Ast.Bytes
+ Ast: instance GHC.Show.Show Ast.Bytes
+ Builder: CouldNotBuildAttribute :: Attribute -> Subst -> BuildException
+ Builder: CouldNotBuildBinding :: Binding -> Subst -> BuildException
+ Builder: CouldNotBuildBytes :: Bytes -> Subst -> BuildException
+ Builder: CouldNotBuildExpression :: Expression -> Subst -> BuildException
+ Builder: [_attr] :: BuildException -> Attribute
+ Builder: [_bd] :: BuildException -> Binding
+ Builder: [_bts] :: BuildException -> Bytes
+ Builder: [_expr] :: BuildException -> Expression
+ Builder: [_subst] :: BuildException -> Subst
+ Builder: buildAttributeThrows :: Attribute -> Subst -> IO Attribute
+ Builder: buildBindingThrows :: Binding -> Subst -> IO [Binding]
+ Builder: buildBytes :: Bytes -> Subst -> Maybe Bytes
+ Builder: buildBytesThrows :: Bytes -> Subst -> IO Bytes
+ Builder: buildExpressionThrows :: Expression -> Subst -> IO (Expression, Expression)
+ Builder: data BuildException
+ Builder: instance GHC.Exception.Type.Exception Builder.BuildException
+ Builder: instance GHC.Show.Show Builder.BuildException
+ Dataize: [_buildTerm] :: DataizeContext -> BuildTermFunc
+ Dataize: [_maxDepth] :: DataizeContext -> Integer
+ Dataize: [_program] :: DataizeContext -> Program
+ Functions: argToStrBytes :: ExtraArgument -> Subst -> Program -> IO String
+ Functions: buildTermFromFunction :: String -> [ExtraArgument] -> Subst -> Program -> IO Term
+ Functions: perlToPosix :: ByteString -> ByteString
+ Misc: btsToNum :: Bytes -> Either Integer Double
+ Misc: btsToStr :: Bytes -> String
+ Misc: btsToUnescapedStr :: Bytes -> String
+ Misc: bytesToBts :: String -> Bytes
+ Misc: numToBts :: Double -> Bytes
+ Misc: strToBts :: String -> Bytes
+ Parser: parseBytes :: String -> Either String Bytes
+ Pretty: instance Prettyprinter.Internal.Pretty Ast.Bytes
+ Pretty: instance Prettyprinter.Internal.Pretty Yaml.ExtraArgument
+ Pretty: prettyBytes :: Bytes -> String
+ Pretty: prettyExpression' :: Expression -> String
+ Pretty: prettyExtraArg :: ExtraArgument -> String
+ Pretty: prettySubst :: Subst -> String
+ Replacer: instance GHC.Exception.Type.Exception Replacer.ReplaceException
+ Replacer: instance GHC.Show.Show Replacer.ReplaceException
+ Replacer: replaceProgramThrows :: Program -> [Expression] -> [Expression] -> IO Program
+ Rewriter: [_buildTerm] :: RewriteContext -> BuildTermFunc
+ Rewriter: [_maxDepth] :: RewriteContext -> Integer
+ Rewriter: [_program] :: RewriteContext -> Program
+ Term: TeAttribute :: Attribute -> Term
+ Term: TeBytes :: Bytes -> Term
+ Term: TeExpression :: Expression -> Term
+ Term: data Term
+ Term: type BuildTermFunc = String -> [ExtraArgument] -> Subst -> Program -> IO Term
+ Yaml: ArgBytes :: Bytes -> ExtraArgument
+ Yaml: instance Data.Aeson.Types.FromJSON.FromJSON Ast.Bytes
- Ast: BiDelta :: String -> Binding
+ Ast: BiDelta :: Bytes -> Binding
- Builder: buildExpressions :: Expression -> [Subst] -> Maybe [(Expression, Expression)]
+ Builder: buildExpressions :: Expression -> [Subst] -> IO [(Expression, Expression)]
- Dataize: DataizeContext :: Program -> Integer -> DataizeContext
+ Dataize: DataizeContext :: Program -> Integer -> BuildTermFunc -> DataizeContext
- Dataize: dataize :: Program -> DataizeContext -> IO (Maybe String)
+ Dataize: dataize :: Program -> DataizeContext -> IO (Maybe Bytes)
- Dataize: dataize' :: Expression -> DataizeContext -> IO (Maybe String)
+ Dataize: dataize' :: Expression -> DataizeContext -> IO (Maybe Bytes)
- Matcher: MvBytes :: String -> MetaValue
+ Matcher: MvBytes :: Bytes -> MetaValue
- Misc: pattern DataObject :: String -> String -> Expression
+ Misc: pattern DataObject :: String -> Bytes -> Expression
- Rewriter: RewriteContext :: Program -> Integer -> RewriteContext
+ Rewriter: RewriteContext :: Program -> Integer -> BuildTermFunc -> RewriteContext
- Rewriter: rewrite :: Program -> Program -> [Rule] -> IO Program
+ Rewriter: rewrite :: Program -> [Rule] -> RewriteContext -> IO Program

Files

phino.cabal view
@@ -1,7 +1,7 @@ cabal-version:      3.0  name:               phino-version:            0.0.0.17+version:            0.0.0.18 license:            MIT synopsis:           Command-Line Manipulator of 𝜑-Calculus Expressions description:        Please see the README on GitHub at <https://github.com/objectionary/phino#readme>@@ -34,6 +34,8 @@     Yaml,     Condition,     Dataize,+    Functions,+    Term,     Misc,     Logger,     Pretty,@@ -62,7 +64,10 @@     vector,     random,     xml-conduit ^>=1.10,-    time ^>=1.12+    time ^>=1.12,+    transformers,+    regex-tdfa,+    array   default-language: Haskell2010  -- Executable using the library
src/Ast.hs view
@@ -1,42 +1,62 @@ {-# 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+newtype Program = Program Expression -- Q -> expr   deriving (Eq, 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+  = 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, Show, Generic)  data Binding-  = BiTau Attribute Expression            -- attr -> expr-  | BiMeta String                         -- !B-  | BiDelta String                        -- D> 1F-2A-  | BiMetaDelta String                    -- D> !b-  | BiVoid Attribute                      -- attr -> ?-  | BiLambda String                       -- L> Function-  | BiMetaLambda String                   -- L> !F+  = BiTau Attribute Expression -- attr -> expr+  | BiMeta String -- !B+  | BiDelta Bytes -- Δ ⤍ 1F-2A+  | BiVoid Attribute -- attr ↦ ?+  | BiLambda String -- λ ⤍ Function+  | BiMetaLambda String -- λ ⤍ !F   deriving (Eq, Show, Generic) +data Bytes+  = BtEmpty -- --+  | BtOne String -- 1F-+  | BtMany [String] -- 00-01-02-...04+  | BtMeta String -- !b+  deriving (Eq, 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+  = 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, Show, Generic)++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
src/Builder.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE RecordWildCards #-}+ -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com -- SPDX-License-Identifier: MIT @@ -7,22 +10,55 @@ module Builder   ( buildExpressions,     buildExpression,-    buildTermFromFunction,+    buildExpressionThrows,     buildAttribute,+    buildAttributeThrows,     buildBinding,+    buildBindingThrows,+    buildBytes,+    buildBytesThrows,     contextualize,-    Term (..),+    BuildException (..),   ) where  import Ast+import Control.Exception (Exception, throwIO) import qualified Data.Map.Strict as Map import Matcher-import Pretty (prettyAttribute)+import Pretty (prettyAttribute, prettyBinding, prettyExpression, prettySubst, prettyBytes)+import Text.Printf (printf) import Yaml (ExtraArgument (..)) -data Term = TeExpression Expression | TeAttribute Attribute+data BuildException+  = CouldNotBuildExpression {_expr :: Expression, _subst :: Subst}+  | CouldNotBuildAttribute {_attr :: Attribute, _subst :: Subst}+  | CouldNotBuildBinding {_bd :: Binding, _subst :: Subst}+  | CouldNotBuildBytes {_bts :: Bytes, _subst :: Subst}+  deriving (Exception) +instance Show BuildException where+  show CouldNotBuildExpression {..} =+    printf+      "Couldn't build given expression with provided substitutions\n--Expression: %s\n--Substitutions: %s"+      (prettyExpression _expr)+      (prettySubst _subst)+  show CouldNotBuildAttribute {..} =+    printf+      "Couldn't build given attribute with provided substitutions\n--Attribute: %s\n--Substitutions: %s"+      (prettyAttribute _attr)+      (prettySubst _subst)+  show CouldNotBuildBinding {..} =+    printf+      "Couldn't build given binding with provided substitutions\n--Binding: %s\n--Substitutions: %s"+      (prettyBinding _bd)+      (prettySubst _subst)+  show CouldNotBuildBytes {..} =+    printf+      "Couldn't build given bytes with provided substitutions\n--Bytes: %s\n--Substitutions: %s"+      (prettyBytes _bts)+      (prettySubst _subst)+ contextualize :: Expression -> Expression -> Program -> Expression contextualize ExGlobal _ (Program expr) = expr contextualize ExThis expr _ = expr@@ -40,6 +76,12 @@   _ -> Nothing buildAttribute attr _ = Just attr +buildBytes :: Bytes -> Subst -> Maybe Bytes+buildBytes (BtMeta meta) (Subst mp) = case Map.lookup meta mp of+  Just (MvBytes bytes) -> Just bytes+  _ -> Nothing+buildBytes bts _ = Just bts+ -- Build binding -- The function returns [Binding] because the BiMeta is always attached -- to the list of bindings@@ -54,9 +96,9 @@ buildBinding (BiMeta meta) (Subst mp) = case Map.lookup meta mp of   Just (MvBindings bds) -> Just bds   _ -> Nothing-buildBinding (BiMetaDelta meta) (Subst mp) = case Map.lookup meta mp of-  Just (MvBytes bytes) -> Just [BiDelta bytes]-  _ -> Nothing+buildBinding (BiDelta bytes) subst = do+  bts <- buildBytes bytes subst+  Just [BiDelta bts] buildBinding (BiMetaLambda meta) (Subst mp) = case Map.lookup meta mp of   Just (MvFunction func) -> Just [BiLambda func]   _ -> Nothing@@ -105,47 +147,26 @@     _ -> Nothing buildExpression expr _ = Just (expr, defaultScope) -buildTermFromFunction :: String -> [ExtraArgument] -> Subst -> Program -> Maybe Term-buildTermFromFunction "contextualize" [ArgExpression expr, ArgExpression context] subst prog = do-  (expr', _) <- buildExpression expr subst-  (context', _) <- buildExpression context subst-  return (TeExpression (contextualize expr' context' prog))-buildTermFromFunction "scope" [ArgExpression expr] subst prog = do-  (expr', scope) <- buildExpression expr subst-  return (TeExpression scope)-buildTermFromFunction "random-tau" args subst _ = do-  attrs <- argsToAttrs args-  return (TeAttribute (AtLabel (randomTau 0 attrs)))-  where-    argsToAttrs :: [ExtraArgument] -> Maybe [String]-    argsToAttrs [] = Just []-    argsToAttrs (arg : rest) = case arg of-      ArgExpression _ -> argsToAttrs rest-      ArgAttribute attr -> do-        attr' <- buildAttribute attr subst-        rest' <- argsToAttrs rest-        Just (prettyAttribute attr' : rest')-      ArgBinding bd -> do-        bds <- buildBinding bd subst-        rest' <- argsToAttrs rest-        Just (attrsFromBindings bds ++ rest')-    attrsFromBindings :: [Binding] -> [String]-    attrsFromBindings [] = []-    attrsFromBindings (bd : bds) =-      let attr = case bd of-            BiTau attr _ -> attr-            BiDelta _ -> AtDelta-            BiLambda _ -> AtLambda-            BiVoid attr -> attr-       in prettyAttribute attr : attrsFromBindings bds-    randomTau :: Integer -> [String] -> String-    randomTau _ [] = cactoos-    randomTau idx attrs =-      let tau = if idx == 0 then cactoos else cactoos ++ show idx-       in if tau `elem` attrs then randomTau (idx + 1) attrs else tau-    cactoos = "a🌵"-buildTermFromFunction _ _ _ _ = Nothing+buildBytesThrows :: Bytes -> Subst -> IO Bytes+buildBytesThrows bytes subst = case buildBytes bytes subst of+  Just bts -> pure bts+  _ -> throwIO (CouldNotBuildBytes bytes subst) +buildBindingThrows :: Binding -> Subst -> IO [Binding]+buildBindingThrows bd subst = case buildBinding bd subst of+  Just bds -> pure bds+  _ -> throwIO (CouldNotBuildBinding bd subst)++buildAttributeThrows :: Attribute -> Subst -> IO Attribute+buildAttributeThrows attr subst = case buildAttribute attr subst of+  Just attr' -> pure attr'+  _ -> throwIO (CouldNotBuildAttribute attr subst)++buildExpressionThrows :: Expression -> Subst -> IO (Expression, Expression)+buildExpressionThrows expr subst = case buildExpression expr subst of+  Just built -> pure built+  _ -> throwIO (CouldNotBuildExpression expr subst)+ -- Build a several expression from one expression and several substitutions-buildExpressions :: Expression -> [Subst] -> Maybe [(Expression, Expression)]-buildExpressions expr = traverse (buildExpression expr)+buildExpressions :: Expression -> [Subst] -> IO [(Expression, Expression)]+buildExpressions expr = traverse (buildExpressionThrows expr)
src/CLI.hs view
@@ -16,15 +16,17 @@ import Data.Char (toLower, toUpper) import Data.List (intercalate) import Data.Version (showVersion)-import Dataize (dataize, DataizeContext (DataizeContext))+import Dataize (DataizeContext (DataizeContext), dataize)+import Functions (buildTermFromFunction)+import qualified Functions import Logger import Misc (ensuredFile) import qualified Misc import Options.Applicative import Parser (parseProgramThrows) import Paths_phino (version)-import Pretty (PrintMode (SALTY, SWEET), prettyProgram')-import Rewriter (rewrite', RewriteContext (RewriteContext))+import Pretty (PrintMode (SALTY, SWEET), prettyProgram', prettyBytes)+import Rewriter (RewriteContext (RewriteContext), rewrite') import System.Exit (ExitCode (..), exitFailure) import System.IO (getContents') import Text.Printf (printf)@@ -179,7 +181,7 @@       input <- readInput inputFile       rules' <- getRules       program <- parseProgram input inputFormat-      rewritten <- rewrite' program rules' (RewriteContext program maxDepth)+      rewritten <- rewrite' program rules' (RewriteContext program maxDepth buildTermFromFunction)       logDebug (printf "Printing rewritten 𝜑-program as %s" (show outputFormat))       out <- printProgram rewritten outputFormat printMode       putStrLn out@@ -194,8 +196,9 @@               else                 if normalize                   then do-                    logDebug "The --normalize option is provided, built-it normalization rules are used"-                    pure normalizationRules+                    let rules' = normalizationRules+                    logDebug (printf "The --normalize option is provided, %d built-it normalization rules are used" (length rules'))+                    pure rules'                   else                     if null rules                       then throwIO (InvalidRewriteArguments "no --rule, no --normalize, no --nothing are provided")@@ -217,8 +220,8 @@       validateMaxDepth maxDepth       input <- readInput inputFile       prog <- parseProgram input inputFormat-      dataized <- dataize prog (DataizeContext prog maxDepth)-      maybe (throwIO CouldNotDataize) putStrLn dataized+      dataized <- dataize prog (DataizeContext prog maxDepth buildTermFromFunction)+      maybe (throwIO CouldNotDataize) (putStrLn . prettyBytes) dataized   where     validateMaxDepth :: Integer -> IO ()     validateMaxDepth depth =
src/Dataize.hs view
@@ -4,7 +4,7 @@ -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com -- SPDX-License-Identifier: MIT -module Dataize (morph, dataize, dataize', DataizeContext (..), defaultDataizeContext) where+module Dataize (morph, dataize, dataize', DataizeContext (..)) where  import Ast import Builder (contextualize)@@ -13,20 +13,19 @@ import Data.List (partition) import Misc import Rewriter (RewriteContext (RewriteContext), rewrite')+import Term (BuildTermFunc) import Text.Printf (printf) import XMIR (XmirContext (XmirContext)) import Yaml (normalizationRules)  data DataizeContext = DataizeContext-  { program :: Program,-    maxDepth :: Integer+  { _program :: Program,+    _maxDepth :: Integer,+    _buildTerm :: BuildTermFunc   } -defaultDataizeContext :: Program -> DataizeContext-defaultDataizeContext prog = DataizeContext prog 25- switchContext :: DataizeContext -> RewriteContext-switchContext DataizeContext {..} = RewriteContext program maxDepth+switchContext DataizeContext {..} = RewriteContext _program _maxDepth _buildTerm  maybeBinding :: (Binding -> Bool) -> [Binding] -> (Maybe Binding, [Binding]) maybeBinding _ [] = (Nothing, [])@@ -81,10 +80,10 @@     Just obj -> pure (Just (ExDispatch obj attr))     _ -> pure Nothing withTail (ExFormation bds) ctx = formation bds ctx-withTail (ExDispatch (ExDispatch ExGlobal (AtLabel label)) attr) (DataizeContext {program = Program expr}) = case phiDispatch label expr of+withTail (ExDispatch (ExDispatch ExGlobal (AtLabel label)) attr) (DataizeContext {_program = Program expr}) = case phiDispatch label expr of   Just obj -> pure (Just (ExDispatch obj attr))   _ -> pure Nothing-withTail (ExDispatch ExGlobal (AtLabel label)) (DataizeContext {program = Program expr}) = pure (phiDispatch label expr)+withTail (ExDispatch ExGlobal (AtLabel label)) (DataizeContext {_program = Program expr}) = pure (phiDispatch label expr) withTail (ExDispatch expr attr) ctx = do   exp' <- withTail expr ctx   case exp' of@@ -128,10 +127,10 @@ -- BOX:   D([B1, 𝜑 -> e, B2]) -> D(С(e))        if [B1,B2] has no delta/lambda, where С(e) - contextualization -- NORM:  D(e1) -> D(e2)                        if e2 := M(e1) and e1 is not primitive --        nothing                               otherwise-dataize :: Program -> DataizeContext -> IO (Maybe String)+dataize :: Program -> DataizeContext -> IO (Maybe Bytes) dataize (Program expr) = dataize' expr -dataize' :: Expression -> DataizeContext -> IO (Maybe String)+dataize' :: Expression -> DataizeContext -> IO (Maybe Bytes) dataize' ExTermination _ = pure Nothing dataize' (ExFormation bds) ctx = case maybeDelta bds of   (Just (BiDelta bytes), _) -> pure (Just bytes)@@ -139,7 +138,7 @@     (Just (BiTau AtPhi expr), bds') -> case maybeLambda bds' of       (Just (BiLambda _), _) -> throwIO (userError "The 𝜑 and λ can't be present in formation at the same time")       (_, _) ->-        let expr' = contextualize expr (ExFormation bds) (program ctx)+        let expr' = contextualize expr (ExFormation bds) (_program ctx)          in dataize' expr' ctx     (Nothing, _) -> case maybeLambda bds of       (Just (BiLambda _), _) -> do@@ -163,30 +162,30 @@   right <- dataize' (ExDispatch self AtRho) ctx   case (left, right) of     (Just left', Just right') -> do-      let first = either toDouble id (hexToNum left')-          second = either toDouble id (hexToNum right')+      let first = either toDouble id (btsToNum left')+          second = either toDouble id (btsToNum right')           sum = first + second-      pure (Just (DataObject "number" (numToHex sum)))+      pure (Just (DataObject "number" (numToBts sum)))     _ -> pure Nothing atom "L_org_eolang_number_times" self ctx = do   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 (hexToNum left')-          second = either toDouble id (hexToNum right')+      let first = either toDouble id (btsToNum left')+          second = either toDouble id (btsToNum right')           sum = first * second-      pure (Just (DataObject "number" (numToHex sum)))+      pure (Just (DataObject "number" (numToBts sum)))     _ -> pure Nothing atom "L_org_eolang_number_eq" self ctx = do   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 (hexToNum rho')-          first = either toDouble id (hexToNum x')+      let self' = either toDouble id (btsToNum rho')+          first = either toDouble id (btsToNum x')       if self' == first-        then pure (Just (DataObject "number" (numToHex first)))+        then pure (Just (DataObject "number" (numToBts first)))         else pure (Just (ExDispatch self (AtLabel "y")))     _ -> pure Nothing atom func _ _ = throwIO (userError (printf "Atom '%s' does not exist" func))
+ src/Functions.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE OverloadedStrings #-}++-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+-- SPDX-License-Identifier: MIT++module Functions where++import Ast+import Builder+import Control.Exception (throwIO)+import Data.Array ((!))+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as B+import Data.Maybe (catMaybes, mapMaybe)+import Matcher+import Misc+import Pretty+import Term+import Text.Printf (printf)+import Text.Regex.TDFA+import Yaml++argToStrBytes :: ExtraArgument -> Subst -> Program -> IO String+argToStrBytes (ArgBytes bytes) subst _ = do+  bts <- buildBytesThrows bytes subst+  pure (btsToUnescapedStr bts)+argToStrBytes (ArgExpression expr) subst prog = do+  (TeBytes bts) <- buildTermFromFunction "dataize" [ArgExpression expr] subst prog+  pure (btsToUnescapedStr bts)+argToStrBytes arg _ _ = throwIO (userError (printf "Can't extract bytes from given argument: %s" (prettyExtraArg arg)))++-- Translate perl-like shorthand characters to posix equivalent.+-- >>> perlToPosix "\\s+\\W"+-- "[[:space:]]+[^[:alnum:]_]"+perlToPosix :: B.ByteString -> B.ByteString+perlToPosix bs = go bs B.empty+  where+    go input acc+      | B.null input = acc+      | B.isPrefixOf "\\s" input = go (B.drop 2 input) (acc `B.append` "[[:space:]]")+      | B.isPrefixOf "\\S" input = go (B.drop 2 input) (acc `B.append` "[^[:space:]]")+      | B.isPrefixOf "\\d" input = go (B.drop 2 input) (acc `B.append` "[[:digit:]]")+      | B.isPrefixOf "\\D" input = go (B.drop 2 input) (acc `B.append` "[^[:digit:]]")+      | B.isPrefixOf "\\w" input = go (B.drop 2 input) (acc `B.append` "[[:alnum:]_]")+      | B.isPrefixOf "\\W" input = go (B.drop 2 input) (acc `B.append` "[^[:alnum:]_]")+      | B.head input == '\\' && B.length input >= 2 =+          let escapedChar = B.take 2 input+           in go (B.drop 2 input) (acc `B.append` escapedChar)+      | otherwise = go (B.tail input) (acc `B.snoc` B.head input)++buildTermFromFunction :: String -> [ExtraArgument] -> Subst -> Program -> IO Term+buildTermFromFunction "contextualize" [ArgExpression expr, ArgExpression context] subst prog = do+  (expr', _) <- buildExpressionThrows expr subst+  (context', _) <- buildExpressionThrows context subst+  pure (TeExpression (contextualize expr' context' prog))+buildTermFromFunction "contextualize" _ _ _ = throwIO (userError "Function contextualize() requires exactly 2 arguments as expression")+buildTermFromFunction "scope" [ArgExpression expr] subst _ = do+  (expr', scope) <- buildExpressionThrows expr subst+  pure (TeExpression scope)+buildTermFromFunction "scope" _ _ _ = throwIO (userError "Function scope() requires exactly 1 argument as expression")+buildTermFromFunction "random-tau" args subst _ = do+  attrs <- argsToAttrs args+  pure (TeAttribute (AtLabel (randomTau 0 attrs)))+  where+    argsToAttrs :: [ExtraArgument] -> IO [String]+    argsToAttrs [] = pure []+    argsToAttrs (arg : rest) = case arg of+      ArgExpression _ -> argsToAttrs rest+      ArgAttribute attr -> do+        attr' <- buildAttributeThrows attr subst+        rest' <- argsToAttrs rest+        pure (prettyAttribute attr' : rest')+      ArgBinding bd -> do+        bds <- buildBindingThrows bd subst+        rest' <- argsToAttrs rest+        pure (attrsFromBindings bds ++ rest')+      ArgBytes _ -> throwIO (userError "Bytes can't be argument of random-tau() function")+    attrsFromBindings :: [Binding] -> [String]+    attrsFromBindings [] = []+    attrsFromBindings (bd : bds) =+      let attr = case bd of+            BiTau attr _ -> attr+            BiDelta _ -> AtDelta+            BiLambda _ -> AtLambda+            BiVoid attr -> attr+       in prettyAttribute attr : attrsFromBindings bds+    randomTau :: Integer -> [String] -> String+    randomTau idx attrs =+      let cactoos = "a🌵"+          tau = if idx == 0 then cactoos else cactoos ++ show idx+       in if tau `elem` attrs then randomTau (idx + 1) attrs else tau+buildTermFromFunction "dataize" [ArgExpression expr] subst _ = do+  (expr', _) <- buildExpressionThrows expr subst+  case expr' of+    DataObject _ bytes -> pure (TeBytes bytes)+    _ -> throwIO (userError "Only data objects are supported by 'dataize' function now")+buildTermFromFunction "dataize" _ _ _ = throwIO (userError "Function dataize() requires exactly 1 argument as expression")+buildTermFromFunction "concat" args subst prog = do+  args' <- traverse (\arg -> argToStrBytes arg subst prog) args+  pure (TeExpression (DataObject "string" (strToBts (concat args'))))+buildTermFromFunction "sed" [tgt, ptn] subst prog = do+  [tgt', ptn'] <- traverse (\arg -> argToStrBytes arg subst prog) [tgt, ptn]+  (pat, rep, global) <- parse (B.pack ptn')+  let pat' = perlToPosix pat+      res =+        if global+          then replaceAll pat' rep (B.pack tgt')+          else replaceFirst pat' rep (B.pack tgt')+  pure (TeExpression (DataObject "string" (strToBts (B.unpack res))))+  where+    parse :: B.ByteString -> IO (B.ByteString, B.ByteString, Bool)+    parse input =+      case B.stripPrefix "s/" input of+        Just rest ->+          let parts = B.split '/' rest+           in case parts of+                [pat, rep, "g"] -> pure (pat, rep, True)+                [pat, rep, ""] -> pure (pat, rep, False)+                [pat, rep] -> pure (pat, rep, False)+                _ ->+                  throwIO+                    (userError "The 'sed' 2nd argument must consist of three parts separated by '/', the last part must be either empty or 'g'")+        _ -> throwIO (userError "The 'sed' 2nd argument must start with 's/'")+    replaceFirst :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString+    replaceFirst pat rep input =+      let result :: MatchResult B.ByteString+          result = input =~ pat+       in if mrMatch result == ""+            then input+            else BS.concat [mrBefore result, rep, mrAfter result]+    replaceAll :: B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString+    replaceAll pat rep input =+      let matches = getAllMatches (input =~ pat :: AllMatches [] (Int, Int))+       in go 0 matches+      where+        go offset [] = BS.drop offset input+        go offset ((start, len) : rest) =+          let prefix = BS.take (start - offset) (BS.drop offset input)+              newOffset = start + len+           in BS.concat [prefix, rep, go newOffset rest]+buildTermFromFunction "sed" _ _ _ = throwIO (userError "Function sed() requires exactly 2 dataizable arguments")+buildTermFromFunction func _ _ _ = throwIO (userError (printf "Function %s() is not supported or does not exist" func))
src/Logger.hs view
@@ -7,7 +7,7 @@     logWarning,     logError,     setLogLevel,-    LogLevel(DEBUG, INFO, WARNING, ERROR, NONE),+    LogLevel (DEBUG, INFO, WARNING, ERROR, NONE),   ) where @@ -15,8 +15,6 @@ import Data.IORef (IORef, newIORef, readIORef, writeIORef) import GHC.IO (unsafePerformIO) import System.IO-import Text.Printf (printf)-import Options.Applicative (ReadM)  data LogLevel = DEBUG | INFO | WARNING | ERROR | NONE   deriving (Show, Ord, Eq, Bounded, Enum, Read)@@ -25,7 +23,7 @@  logger :: IORef Logger {-# NOINLINE logger #-}-logger = unsafePerformIO (newIORef (Logger INFO))+logger = unsafePerformIO (newIORef (Logger DEBUG))  setLogLevel :: LogLevel -> IO () setLogLevel lvl = writeIORef logger (Logger lvl)
src/Matcher.hs view
@@ -16,7 +16,7 @@ -- The right part of substitution data MetaValue   = MvAttribute Attribute -- !a-  | MvBytes String -- !b+  | MvBytes Bytes -- !b   | MvBindings [Binding] -- !B   | MvFunction String -- !F   | MvExpression Expression Expression -- !e, the second expression is scope, which is closest formation@@ -70,10 +70,10 @@  matchBinding :: Binding -> Binding -> Expression -> [Subst] matchBinding (BiVoid pattr) (BiVoid tattr) _ = matchAttribute pattr tattr-matchBinding (BiDelta pbts) (BiDelta tbts) _-  | pbts == tbts = [substEmpty]+matchBinding (BiDelta (BtMeta meta)) (BiDelta tdata) _ = [substSingle meta (MvBytes tdata)]  +matchBinding (BiDelta pdata) (BiDelta tdata) _+  | pdata == tdata = [substEmpty]   | otherwise = []-matchBinding (BiMetaDelta meta) (BiDelta tBts) _ = [substSingle meta (MvBytes tBts)] matchBinding (BiLambda pFunc) (BiLambda tFunc) _   | pFunc == tFunc = [substEmpty]   | otherwise = []
src/Misc.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-}@@ -8,14 +9,16 @@  -- This module provides commonly used helper functions for other modules module Misc-  ( numToHex,-    strToHex,-    hexToStr,-    hexToNum,+  ( numToBts,+    strToBts,+    bytesToBts,+    btsToStr,+    btsToNum,     withVoidRho,     allPathsIn,     ensuredFile,     shuffle,+    btsToUnescapedStr,     pattern DataObject,   ) where@@ -27,7 +30,7 @@ import Data.Bits (Bits (shiftL), (.|.)) import qualified Data.Bits as IOArray import qualified Data.ByteString as B-import Data.ByteString.Builder (toLazyByteString, word64BE)+import Data.ByteString.Builder (toLazyByteString, word64BE, word8) import Data.ByteString.Lazy (unpack) import qualified Data.ByteString.Lazy.UTF8 as U import Data.Char (chr, isPrint, ord)@@ -53,7 +56,7 @@   show DirectoryDoesNotExist {..} = printf "Directory '%s' does not exist" dir  -- Minimal matcher function (required for view pattern)-matchDataoObject :: Expression -> Maybe (String, String)+matchDataoObject :: Expression -> Maybe (String, Bytes) matchDataoObject   ( ExApplication       (ExDispatch (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (AtLabel label))@@ -70,7 +73,7 @@     ) = Just (label, bts) matchDataoObject _ = Nothing -pattern DataObject :: String -> String -> Expression+pattern DataObject :: String -> Bytes -> Expression pattern DataObject label bts <- (matchDataoObject -> Just (label, bts))   where     DataObject label bts =@@ -124,35 +127,43 @@       )   return (concat paths) --- >>> hexToBts "40-14-00-00-00-00-00-00"+-- >>> btsToWord8 BtEmpty+-- []+-- >>> btsToWord8 (BtOne "01")+-- [1]+-- >>> btsToWord8 (BtMany [])+-- []+-- >>> btsToWord8 (BtMany ["40", "14", "00", "00", "00", "00", "00", "00"]) -- [64,20,0,0,0,0,0,0]--- >>> hexToBts "68-65-6C-6C-6F"--- [104,101,108,108,111]--- >>> hexToBts "01-01"--- [1,1]-hexToBts :: String -> [Word8]-hexToBts = map readHexByte . splitOnDash-  where-    splitOnDash = words . map (\c -> if c == '-' then ' ' else c)-    readHexByte hx = case readHex hx of-      [(v, "")] -> fromIntegral v-      _ -> error $ "Invalid hex byte: " ++ hx+btsToWord8 :: Bytes -> [Word8]+btsToWord8 BtEmpty = []+btsToWord8 (BtOne bt) = case readHex bt of+  [(hex, "")] -> [fromIntegral hex]+  _ -> error $ "Invalid hex byte; " ++ bt+btsToWord8 (BtMany []) = []+btsToWord8 (BtMany (bt : bts)) =+  let [next] = btsToWord8 (BtOne bt)+   in next : btsToWord8 (BtMany bts) -btsToHex :: [Word8] -> String-btsToHex bts = intercalate "-" (map (printf "%02X") bts)+-- >>> word8ToBytes [64, 20, 0]+-- BtMany ["40","14","00"]+word8ToBytes :: [Word8] -> Bytes+word8ToBytes [] = BtEmpty+word8ToBytes [w8] = BtOne (printf "%02X" w8)+word8ToBytes bts = BtMany (map (printf "%02X") bts) --- Convert hex string back to Double--- >>> hexToNum "40-14-00-00-00-00-00-00"+-- Convert Bytes back to Double+-- >>> btsToNum (BtMany ["40", "14", "00", "00", "00", "00", "00", "00"]) -- Left 5--- >>> hexToNum "BF-D0-00-00-00-00-00-00"+-- >>> btsToNum (BtMany ["BF", "D0", "00", "00", "00", "00", "00", "00"]) -- Right (-0.25)--- >>> hexToNum "40-45-00-00-00-00-00-00"+-- >>> btsToNum (BtMany ["40", "45", "00", "00", "00", "00", "00", "00"]) -- Left 42--- >>> hexToNum "40-45"+-- >>> btsToNum (BtMany ["40", "45"]) -- Expected 8 bytes for conversion, got 2-hexToNum :: String -> Either Integer Double-hexToNum hx =-  let bytes = hexToBts hx+btsToNum :: Bytes -> Either Integer Double+btsToNum hx =+  let bytes = btsToWord8 hx    in if length bytes /= 8         then error $ "Expected 8 bytes for conversion, got " ++ show (length bytes)         else@@ -174,58 +185,64 @@         .|. fromIntegral h     toWord64BE _ = error "Expected 8 bytes for Double" --- >>> numToHex 0.0--- "00-00-00-00-00-00-00-00"--- >>> numToHex 42--- "40-45-00-00-00-00-00-00"--- >>> numToHex (-0.25)--- "BF-D0-00-00-00-00-00-00"--- >>> numToHex 5--- "40-14-00-00-00-00-00-00"-numToHex :: Double -> String-numToHex num = btsToHex (unpack (toLazyByteString (word64BE (doubleToWord num))))+-- >>> numToBts 0.0+-- BtMany ["00","00","00","00","00","00","00","00"]+-- >>> numToBts 42+-- BtMany ["40","45","00","00","00","00","00","00"]+-- >>> numToBts (-0.25)+-- BtMany ["BF","D0","00","00","00","00","00","00"]+-- >>> numToBts 5+-- BtMany ["40","14","00","00","00","00","00","00"]+numToBts :: Double -> Bytes+numToBts num = word8ToBytes (unpack (toLazyByteString (word64BE (doubleToWord num)))) --- >>> strToHex "hello"--- "68-65-6C-6C-6F"--- >>> strToHex "world"--- "77-6F-72-6C-64"--- >>> strToHex ""--- "--"--- >>> strToHex "h"--- "68-"--- >>> strToHex "h\""--- "68-22"--- >>> strToHex "\x01\x01"--- "01-01"-strToHex :: String -> String-strToHex "" = "--"-strToHex [ch] = btsToHex (unpack (U.fromString [ch])) ++ "-"-strToHex str = btsToHex (unpack (U.fromString str))+-- >>> strToBts "hello"+-- BtMany ["68","65","6C","6C","6F"]+-- >>> strToBts "world"+-- BtMany ["77","6F","72","6C","64"]+-- >>> strToBts ""+-- BtEmpty+-- >>> strToBts "h"+-- BtOne "68"+-- >>> strToBts "h\""+-- BtMany ["68","22"]+-- >>> strToBts "\x01\x01"+-- BtMany ["01","01"]+strToBts :: String -> Bytes+strToBts "" = BtEmpty+strToBts [ch] = word8ToBytes (unpack (U.fromString [ch]))+strToBts str = word8ToBytes (unpack (U.fromString str)) +-- >>> bytesToBts "--"+-- BtEmpty+-- >>> bytesToBts "77-6F"+-- BtMany ["77","6F"]+-- >>> bytesToBts "01-"+-- BtOne "01"+bytesToBts :: String -> Bytes+bytesToBts "--" = BtEmpty+bytesToBts str =+  if length str == 3 && last str == '-'+    then BtOne (init str)+    else BtMany (map T.unpack (T.splitOn "-" (T.pack str)))+ -- Convert hex string like "68-65-6C-6C-6F" to "hello"--- >>> hexToStr "68-65-6C-6C-6F"+-- >>> btsToStr (BtMany ["68", "65", "6C", "6C", "6F"]) -- "hello"--- >>> hexToStr "--"--- ""--- >>> hexToStr "68-"+-- >>> btsToStr (BtOne "68") -- "h"--- >>> hexToStr "77-6F-72-6C-64"+-- >>> btsToStr (BtMany ["77", "6F", "72", "6C", "64"]) -- "world"--- >>> hexToStr ""+-- >>> btsToStr BtEmpty -- ""--- >>> hexToStr "68-22"+-- >>> btsToStr (BtMany ["68", "22"]) -- "h\\\""--- >>> hexToStr "01-02"+-- >>> btsToStr (BtMany ["01", "02"]) -- "\\x01\\x02"-hexToStr :: String -> String-hexToStr "--" = ""-hexToStr [] = ""-hexToStr hx = escapeStr (T.unpack $ T.decodeUtf8 $ B.pack (hexToBts cleaned))+btsToStr :: Bytes -> String+btsToStr BtEmpty = ""+btsToStr bytes = escapeStr (btsToUnescapedStr bytes)   where-    -- Remove trailing dash if present (from single-char case)-    cleaned :: String-    cleaned = if not (null hx) && last hx == '-' then init hx else hx-     escapeStr :: String -> String     escapeStr = concatMap escapeChar       where@@ -237,11 +254,20 @@           | isPrint c && c /= '\\' && c /= '"' = [c]           | otherwise = printf "\\x%02x" (ord c) +-- >>> btsToUnescapedStr (BtMany ["01", "02"])+-- "\SOH\STX"+-- >>> btsToUnescapedStr (BtMany ["77", "6F", "72", "6C", "64"])+-- "world"+-- >>> btsToUnescapedStr (BtMany ["68", "22"])+-- "h\""+btsToUnescapedStr :: Bytes -> String+btsToUnescapedStr bytes = T.unpack (T.decodeUtf8 (B.pack (btsToWord8 bytes)))+ -- Fast Fisher-Yates with mutable vectors. -- The function is generated by ChatGPT and claimed as -- fastest approach comparing to usage IOArray. -- >>> shuffle [1..20]--- [12,15,5,14,1,7,17,10,9,16,13,11,6,4,18,2,19,20,3,8]+-- [7,15,5,18,13,19,3,11,20,2,1,8,14,16,17,12,9,10,6,4] shuffle :: [a] -> IO [a] shuffle xs = do   gen <- newIOGenM =<< newStdGen
src/Parser.hs view
@@ -12,6 +12,7 @@     parseExpressionThrows,     parseAttribute,     parseBinding,+    parseBytes,   ) where @@ -24,7 +25,7 @@ import Data.Text.Internal.Fusion.Size (lowerBound) import Data.Void import GHC.Char (chr)-import Misc (numToHex, strToHex, withVoidRho)+import Misc import Numeric (readHex) import Text.Megaparsec import Text.Megaparsec.Char (alphaNumChar, char, digitChar, hexDigitChar, letterChar, lowerChar, space1, string, upperChar)@@ -42,21 +43,6 @@   show CouldNotParseProgram {..} = printf "Couldn't parse given phi program, cause: %s" message   show CouldNotParseExpression {..} = printf "Couldn't parse given phi program, cause: %s" message -dataExpression :: String -> String -> Expression-dataExpression obj bts =-  ExApplication-    (ExDispatch (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (AtLabel obj))-    ( BiTau-        (AtAlpha 0)-        ( ExApplication-            (ExDispatch (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (AtLabel "bytes"))-            ( BiTau-                (AtAlpha 0)-                (ExFormation [BiDelta bts, BiVoid AtRho])-            )-        )-    )- -- White space consumer whiteSpace :: Parser () whiteSpace = L.space space1 empty empty@@ -186,22 +172,26 @@       | otherwise = fail ("expected 0-9 or A-F, got " ++ show ch)  -- bytes+-- 0. meta: !b -- 1. empty: -- -- 2. one byte: 01- -- 3. many bytes: 01-02-...-FF-bytes :: Parser String+bytes :: Parser Bytes bytes =   lexeme     ( choice-        [ symbol "--",+        [ BtMeta <$> meta' 'd' "δ",+          symbol "--" >> return BtEmpty,           try $ do             first <- byte             rest <- some $ do-              dash <- char '-'-              bte <- byte-              return (dash : bte)-            return (first ++ concat rest),-          byte >>= \bte -> char '-' >>= \dash -> return (bte ++ [dash])+              _ <- char '-'+              byte+            return (BtMany (first : rest)),+          do+            bte <- byte+            _ <- char '-'+            return (BtOne bte)         ]         <?> "bytes"     )@@ -245,9 +235,6 @@       try $ do         _ <- delta         BiDelta <$> bytes,-      try $ do-        _ <- delta-        BiMetaDelta <$> meta 'b',       try metaBinding,       try $ do         _ <- lambda@@ -345,11 +332,11 @@                     Just '-' -> negate unsigned                     _ -> unsigned                 )-        return (dataExpression "number" (numToHex num)),+        return (DataObject "number" (numToBts num)),       lexeme $ do         _ <- char '"'         str <- manyTill (choice [escapedChar, noneOf ['\\', '"']]) (char '"')-        return (dataExpression "string" (strToHex str)),+        return (DataObject "string" (strToBts str)),       try (ExMeta <$> meta' 'e' "𝑒"),       ExDispatch ExThis <$> fullAttribute     ]@@ -438,6 +425,9 @@   case parsed of     Right parsed' -> Right parsed'     Left err -> Left (errorBundlePretty err)++parseBytes :: String -> Either String Bytes+parseBytes = parse' "bytes" bytes  parseBinding :: String -> Either String Binding parseBinding = parse' "binding" binding
src/Pretty.hs view
@@ -5,12 +5,16 @@  module Pretty   ( prettyExpression,+    prettyExpression',     prettyProgram,     prettyProgram',     prettyAttribute,     prettySubsts,     prettySubsts',+    prettySubst,     prettyBinding,+    prettyBytes,+    prettyExtraArg,     PrintMode (SWEET, SALTY),   ) where@@ -21,6 +25,8 @@ import Prettyprinter import Prettyprinter.Render.String (renderString) import Misc+import Data.List (intercalate)+import Yaml (ExtraArgument (..))  data PrintMode = SWEET | SALTY   deriving (Eq)@@ -46,6 +52,18 @@ prettyDashedArrow :: Doc ann prettyDashedArrow = pretty "⤍" +instance Pretty ExtraArgument where+  pretty (ArgExpression expr) = pretty (Formatted (SWEET, expr))+  pretty (ArgBinding bd) = pretty (Formatted (SWEET, bd))+  pretty (ArgAttribute attr) = pretty 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 Attribute where   pretty (AtLabel name) = pretty name   pretty (AtAlpha index) = pretty "α" <> pretty index@@ -77,7 +95,6 @@   pretty (Formatted (_, BiMeta meta)) = prettyMeta meta   pretty (Formatted (_, BiDelta bytes)) = pretty "Δ" <+> prettyDashedArrow <+> pretty bytes   pretty (Formatted (_, BiMetaLambda meta)) = pretty "λ" <+> prettyDashedArrow <+> prettyMeta meta-  pretty (Formatted (_, BiMetaDelta meta)) = pretty "Δ" <+> prettyDashedArrow <+> prettyMeta meta   pretty (Formatted (_, BiVoid attr)) = pretty attr <+> prettyArrow <+> pretty "∅"   pretty (Formatted (_, BiLambda func)) = pretty "λ" <+> prettyDashedArrow <+> pretty func @@ -109,8 +126,8 @@  instance Pretty (Formatted Expression) where   pretty (Formatted (SWEET, ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang"))) = pretty "Φ̇"-  pretty (Formatted (SWEET, DataObject "string" bytes)) = pretty "\"" <> pretty (hexToStr bytes) <> pretty "\""-  pretty (Formatted (SWEET, DataObject "number" bytes)) = either pretty pretty (hexToNum bytes)+  pretty (Formatted (SWEET, DataObject "string" bytes)) = pretty "\"" <> pretty (btsToStr bytes) <> pretty "\""+  pretty (Formatted (SWEET, DataObject "number" bytes)) = either pretty pretty (btsToNum bytes)   pretty (Formatted (SWEET, DataObject other bytes)) = pretty (Formatted (SALTY, DataObject other bytes))   pretty (Formatted (mode, ExFormation [binding])) = case binding of     BiTau _ _ -> vsep [pretty "⟦", indent 2 (pretty (Formatted (mode, binding))), pretty "⟧"]@@ -182,9 +199,18 @@ prettyBinding :: Binding -> String prettyBinding binding = render (Formatted (SALTY, binding)) +prettyExtraArg :: ExtraArgument -> String+prettyExtraArg = render++prettyBytes :: Bytes -> String+prettyBytes = render+ prettyAttribute :: Attribute -> String prettyAttribute = render +prettySubst :: Subst -> String+prettySubst = render+ prettySubsts :: [Subst] -> String prettySubsts = render @@ -193,6 +219,9 @@  prettyExpression :: Expression -> String prettyExpression expr = render (Formatted (SALTY, expr))++prettyExpression' :: Expression -> String+prettyExpression' expr = render (Formatted (SWEET, expr))  prettyProgram :: Program -> String prettyProgram prog = render (Formatted (SALTY, prog))
src/Replacer.hs view
@@ -1,13 +1,28 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE RecordWildCards #-}+ -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com -- SPDX-License-Identifier: MIT  -- The goal of the module is to traverse though the Program with replacing -- pattern sub expression with target expressions-module Replacer (replaceProgram) where+module Replacer (replaceProgram, replaceProgramThrows) where  import Ast+import Control.Exception (Exception, throwIO) import Matcher (Tail (TaApplication, TaDispatch))+import Pretty (prettyExpression, prettyProgram)+import Text.Printf (printf) +newtype ReplaceException = CouldNotReplace {prog :: Program}+  deriving (Exception)++instance Show ReplaceException where+  show CouldNotReplace {..} =+    printf+      "Couldn't replace expression in program, lists of patterns and targets has different lengths\nProgram: %s"+      (prettyProgram prog)+ replaceBindings :: [Binding] -> [Expression] -> [Expression] -> ([Binding], [Expression], [Expression]) replaceBindings bds [] [] = (bds, [], []) replaceBindings [] ptns repls = ([], ptns, repls)@@ -45,3 +60,8 @@       let (expr', _, _) = replaceExpression expr ptns repls        in Just (Program expr')   | otherwise = Nothing++replaceProgramThrows :: Program -> [Expression] -> [Expression] -> IO Program+replaceProgramThrows prog ptns repls = case replaceProgram prog ptns repls of+  Just prog' -> pure prog'+  _ -> throwIO (CouldNotReplace prog)
src/Rewriter.hs view
@@ -1,109 +1,108 @@-{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE RecordWildCards #-}-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}  -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com -- SPDX-License-Identifier: MIT -module Rewriter (rewrite, rewrite', RewriteContext (..), defaultRewriteContext) where+module Rewriter (rewrite, rewrite', RewriteContext (..)) where  import Ast import Builder import qualified Condition as C-import Control.Exception+import Data.Foldable (foldlM) import qualified Data.Map.Strict as M import Data.Maybe (catMaybes, fromMaybe, isJust) import Debug.Trace (trace) import Logger (logDebug)-import Matcher (MetaValue (MvAttribute, MvBindings, MvExpression), Subst (Subst), combine, combineMany, defaultScope, matchProgram, substEmpty, substSingle)+import Matcher (MetaValue (MvAttribute, MvBindings, MvExpression, MvBytes), Subst (Subst), combine, combineMany, defaultScope, matchProgram, substEmpty, substSingle) import Misc (ensuredFile) import Parser (parseProgram, parseProgramThrows)-import Pretty (PrintMode (SWEET), prettyAttribute, prettyExpression, prettyProgram, prettyProgram', prettySubsts)-import Replacer (replaceProgram)+import Pretty (PrintMode (SWEET), prettyAttribute, prettyExpression, prettyExpression', prettyProgram, prettyProgram', prettySubsts, prettyBytes)+import Replacer (replaceProgram, replaceProgramThrows)+import Term import Text.Printf import Yaml (ExtraArgument (..)) import qualified Yaml as Y  data RewriteContext = RewriteContext-  { program :: Program,-    maxDepth :: Integer+  { _program :: Program,+    _maxDepth :: Integer,+    _buildTerm :: BuildTermFunc   } -defaultRewriteContext :: Program -> RewriteContext-defaultRewriteContext prog = RewriteContext prog 25--data RewriteException-  = CouldNotBuild {expr :: Expression, substs :: [Subst]}-  | CouldNotReplace {prog :: Program, ptn :: Expression, res :: Expression}-  deriving (Exception)--instance Show RewriteException where-  show CouldNotBuild {..} =-    printf-      "Couldn't build given expression with provided substitutions\n--Expression: %s\n--Substitutions: %s"-      (prettyExpression expr)-      (prettySubsts substs)-  show CouldNotReplace {..} =-    printf-      "Couldn't replace expression in program by pattern\nProgram: %s\n--Pattern: %s\n--Result: %s"-      (prettyProgram prog)-      (prettyExpression ptn)-      (prettyExpression res)- -- Build pattern and result expression and replace patterns to results in given program buildAndReplace :: Program -> Expression -> Expression -> [Subst] -> IO Program-buildAndReplace program ptn res substs =-  case (buildExpressions ptn substs, buildExpressions res substs) of-    (Just ptns, Just repls) ->-      let repls' = map fst repls-          ptns' = map fst ptns-       in case replaceProgram program ptns' repls' of-            Just prog -> pure prog-            _ -> throwIO (CouldNotReplace program ptn res)-    (Nothing, _) -> throwIO (CouldNotBuild ptn substs)-    (_, Nothing) -> throwIO (CouldNotBuild res substs)+buildAndReplace program ptn res substs = do+  ptns <- buildExpressions ptn substs+  repls <- buildExpressions res substs+  let repls' = map fst repls+      ptns' = map fst ptns+  replaceProgramThrows program ptns' repls'  -- Extend list of given substitutions with extra substitutions from 'where' yaml rule section-extraSubstitutions :: Program -> Maybe [Y.Extra] -> [Subst] -> [Subst]-extraSubstitutions prog extras substs = case extras of-  Nothing -> substs-  Just extras' ->-    catMaybes-      [ foldl-          ( \(Just subst') extra -> do-              name <- case Y.meta extra of-                ArgExpression (ExMeta name) -> Just name-                ArgAttribute (AtMeta name) -> Just name-                ArgBinding (BiMeta name) -> Just name-                _ -> Nothing-              let func = Y.function extra-                  args = Y.args extra-              term <- buildTermFromFunction func args subst' prog-              let meta = case term of-                    TeExpression expr -> MvExpression expr defaultScope-                    TeAttribute attr -> MvAttribute attr-              combine (substSingle name meta) subst'-          )-          (Just subst)-          extras'-        | subst <- substs-      ]+extraSubstitutions :: Maybe [Y.Extra] -> [Subst] -> RewriteContext -> IO [Subst]+extraSubstitutions extras substs RewriteContext {..} = case extras of+  Nothing -> pure substs+  Just extras' -> do+    res <-+      sequence+        [ foldlM+            ( \(Just subst') extra -> do+                let maybeName = case Y.meta extra of+                      ArgExpression (ExMeta name) -> Just name+                      ArgAttribute (AtMeta name) -> Just name+                      ArgBinding (BiMeta name) -> Just name+                      ArgBytes (BtMeta name) -> Just name+                      _ -> Nothing+                    func = Y.function extra+                    args = Y.args extra+                term <- _buildTerm func args subst' _program+                meta <- case term of+                  TeExpression expr -> do+                    logDebug (printf "Function %s() returned expression:\n%s" func (prettyExpression' expr))+                    pure (MvExpression expr defaultScope)+                  TeAttribute attr -> do+                    logDebug (printf "Function %s() returned attribute:\n%s" func (prettyAttribute attr))+                    pure (MvAttribute attr)+                  TeBytes bytes -> do+                    logDebug (printf "Function %s() returned bytes: %s" func (prettyBytes bytes))+                    pure (MvBytes bytes)+                case maybeName of+                  Just name -> pure (combine (substSingle name meta) subst')+                  _ -> pure Nothing+            )+            (Just subst)+            extras'+          | subst <- substs+        ]+    pure (catMaybes res) -rewrite :: Program -> Program -> [Y.Rule] -> IO Program-rewrite program _ [] = pure program-rewrite program program' (rule : rest) = do+rewrite :: Program -> [Y.Rule] -> RewriteContext -> IO Program+rewrite program [] _ = pure program+rewrite program (rule : rest) ctx = do   let ptn = Y.pattern rule       res = Y.result rule       condition = Y.when rule   prog <- case C.matchProgramWithCondition ptn condition program of     Nothing -> pure program     Just matched -> do-      let substs = extraSubstitutions program' (Y.where_ rule) matched+      let ruleName = fromMaybe "unknown" (Y.name rule)+      logDebug (printf "Rule '%s' has been matched, applying..." ruleName)+      substs <- extraSubstitutions (Y.where_ rule) matched ctx       prog' <- buildAndReplace program ptn res substs-      logDebug (printf "%s\n%s" (fromMaybe "unknown" (Y.name rule)) (prettyProgram' prog' SWEET))+      if program == prog'+        then logDebug (printf "Applied '%s', no changes made" ruleName)+        else+          logDebug+            ( printf+                "Applied '%s' (%d nodes -> %d nodes):\n%s"+                ruleName+                (countNodes program)+                (countNodes prog')+                (prettyProgram' prog' SWEET)+            )       pure prog'-  rewrite prog program' rest+  rewrite prog rest ctx  -- @todo #169:30min Memorize previous rewritten programs. Right now in order not to --  get an infinite recursion during rewriting we just count have many times we apply@@ -113,19 +112,20 @@ --  been memorized - we fail because we got into infinite recursion. Ofc we should keep counting --  rewriting cycles if program just only grows on each rewriting. rewrite' :: Program -> [Y.Rule] -> RewriteContext -> IO Program-rewrite' prog rules RewriteContext {..} = _rewrite prog 0+rewrite' prog rules ctx = _rewrite prog 0   where     _rewrite :: Program -> Integer -> IO Program     _rewrite prog count = do-      logDebug (printf "Starting rewriting cycle %d out of %d" count maxDepth)-      if count == maxDepth+      let depth = _maxDepth ctx+      logDebug (printf "Starting rewriting cycle %d out of %d" count depth)+      if count == depth         then do-          logDebug (printf "Max amount of rewriting cycles is reached, rewriting is stopped")+          logDebug (printf "Max amount of rewriting cycles has been reached, rewriting is stopped")           pure prog         else do-          rewritten <- rewrite prog program rules+          rewritten <- rewrite prog rules ctx           if rewritten == prog             then do-              logDebug "Rewriting is stopped since it does not affect program anymore"+              logDebug "No rule matched, rewriting is stopped"               pure rewritten             else _rewrite rewritten (count + 1)
+ src/Term.hs view
@@ -0,0 +1,18 @@+-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com+-- SPDX-License-Identifier: MIT++-- The main goal of this module is breking cyclic dependency:+-- Dataize -> Functions -> Rewriter -> Dataize+-- Here we provide custom type BuildTermFunc and add it to+-- RewriteContext and DataizeContext. Now Dataize and Rewrite depends+-- only on Term module. This allows us to use Rewriter and Dataize in+-- Functions module because Rewriter does not depend on Functions anymore.+module Term where+  +import Yaml+import Matcher+import Ast++data Term = TeExpression Expression | TeAttribute Attribute | TeBytes Bytes++type BuildTermFunc = String -> [ExtraArgument] -> Subst -> Program -> IO Term
src/XMIR.hs view
@@ -28,7 +28,7 @@ import Data.Version (showVersion) import Misc import Paths_phino (version)-import Pretty (PrintMode, prettyAttribute, prettyBinding, prettyExpression, prettyProgram')+import Pretty (PrintMode, prettyAttribute, prettyBinding, prettyBytes, prettyExpression, prettyProgram') import Text.Printf (printf) import Text.Read (readMaybe) import qualified Text.Read as TR@@ -96,13 +96,13 @@   let bts =         object           [("as", prettyAttribute (AtAlpha 0)), ("base", "Q.org.eolang.bytes")]-          [object [] [NodeContent (T.pack bytes)]]+          [object [] [NodeContent (T.pack (prettyBytes bytes))]]    in pure         ( "Q.org.eolang.number",           if omitComments             then [bts]             else-              [ NodeComment (T.pack (either show show (hexToNum bytes))),+              [ NodeComment (T.pack (either show show (btsToNum bytes))),                 bts               ]         )@@ -110,13 +110,13 @@   let bts =         object           [("as", prettyAttribute (AtAlpha 0)), ("base", "Q.org.eolang.bytes")]-          [object [] [NodeContent (T.pack bytes)]]+          [object [] [NodeContent (T.pack (prettyBytes bytes))]]    in pure         ( "Q.org.eolang.string",           if omitComments             then [bts]             else-              [ NodeComment (T.pack ('"' : hexToStr bytes ++ "\"")),+              [ NodeComment (T.pack ('"' : btsToStr bytes ++ "\"")),                 bts               ]         )@@ -143,7 +143,7 @@   (base, children) <- expression expr ctx   pure (Just (object [("name", label), ("base", base)] children)) formationBinding (BiTau AtRho _) _ = pure Nothing-formationBinding (BiDelta bytes) _ = pure (Just (NodeContent (T.pack bytes)))+formationBinding (BiDelta bytes) _ = pure (Just (NodeContent (T.pack (prettyBytes bytes)))) formationBinding (BiLambda func) _ = pure (Just (object [("name", "λ")] [])) formationBinding (BiVoid AtRho) _ = pure Nothing formationBinding (BiVoid AtPhi) _ = pure (Just (object [("name", "φ"), ("base", "∅")] []))@@ -430,8 +430,8 @@                 pure (ExApplication expr (BiTau as (ExFormation (withVoidRho bds))))             | not (hasAttr "base" arg) && hasText arg = do                 as <- asToAttr arg idx-                text <- getText arg-                pure (ExApplication expr (BiTau as (ExFormation [BiDelta text, BiVoid AtRho])))+                bytes <- getText arg+                pure (ExApplication expr (BiTau as (ExFormation [BiDelta (bytesToBts bytes), BiVoid AtRho])))             | otherwise = do                 as <- asToAttr arg idx                 arg' <- xmirToExpression arg fqn
src/Yaml.hs view
@@ -41,6 +41,9 @@             Right attr -> pure attr       ) +instance FromJSON Bytes where+  parseJSON = parseJSON' "Bytes" parseBytes+ instance FromJSON Expression where   parseJSON = parseJSON' "Expression" parseExpression @@ -98,7 +101,8 @@     asum       [ ArgAttribute <$> parseJSON v,         ArgBinding <$> parseJSON v,-        ArgExpression <$> parseJSON v+        ArgExpression <$> parseJSON v,+        ArgBytes <$> parseJSON v       ]  instance FromJSON Extra where@@ -139,6 +143,7 @@   = ArgAttribute Attribute   | ArgExpression Expression   | ArgBinding Binding+  | ArgBytes Bytes   deriving (Generic, Show)  data Extra = Extra
test/BuilderSpec.hs view
@@ -8,7 +8,7 @@ import Control.Monad import Data.Map.Strict qualified as Map import Matcher-import Test.Hspec (Example (Arg), Expectation, Spec, SpecWith, describe, it, shouldBe)+import Test.Hspec (Example (Arg), Expectation, Spec, SpecWith, anyException, describe, it, shouldBe, shouldThrow)  test :: (Show a, Eq a) => (a -> Subst -> Maybe (a, a)) -> [(String, a, [(String, MetaValue)], Maybe (a, a))] -> SpecWith (Arg Expectation) test function useCases =@@ -81,15 +81,16 @@       ]    describe "buildExpressions" $ do-    it "!e => [(!e >> Q.x), (!e >> $.y)] => [Q.x, $.y]" $-      buildExpressions-        (ExMeta "e")-        [ substSingle "e" (MvExpression (ExDispatch ExGlobal (AtLabel "x")) defaultScope),-          substSingle "e" (MvExpression (ExDispatch ExThis (AtLabel "y")) defaultScope)-        ]-        `shouldBe` Just [(ExDispatch ExGlobal (AtLabel "x"), defaultScope), (ExDispatch ExThis (AtLabel "y"), defaultScope)]+    it "!e => [(!e >> Q.x), (!e >> $.y)] => [Q.x, $.y]" $ do+      built <-+        buildExpressions+          (ExMeta "e")+          [ substSingle "e" (MvExpression (ExDispatch ExGlobal (AtLabel "x")) defaultScope),+            substSingle "e" (MvExpression (ExDispatch ExThis (AtLabel "y")) defaultScope)+          ]+      built `shouldBe` [(ExDispatch ExGlobal (AtLabel "x"), defaultScope), (ExDispatch ExThis (AtLabel "y"), defaultScope)]     it "!e => [(!e1 >> Q.x)] => X" $       buildExpressions         (ExMeta "e")         [substSingle "e1" (MvExpression (ExDispatch ExGlobal (AtLabel "x")) defaultScope)]-        `shouldBe` Nothing+        `shouldThrow` anyException
test/DataizeSpec.hs view
@@ -3,12 +3,16 @@  module DataizeSpec (spec) where -import Ast (Attribute (AtLabel, AtPhi, AtRho), Binding (BiDelta, BiTau, BiVoid), Expression (ExApplication, ExDispatch, ExFormation, ExGlobal, ExTermination, ExThis), Program (Program))+import Ast import Control.Monad-import Dataize (dataize, dataize', morph, defaultDataizeContext, DataizeContext)+import Dataize (dataize, dataize', morph, DataizeContext (DataizeContext)) import Parser (parseProgramThrows) import Test.Hspec+import Functions (buildTermFromFunction) +defaultDataizeContext :: Program -> DataizeContext+defaultDataizeContext prog = DataizeContext prog 25 buildTermFromFunction+ test :: (Eq a, Show a) => (Expression -> DataizeContext -> IO (Maybe a)) -> [(String, Expression, Expression, Maybe a)] -> Spec test func useCases =   forM_ useCases $ \(desc, input, prog, output) ->@@ -16,7 +20,7 @@       res <- func input (defaultDataizeContext (Program prog))       res `shouldBe` output -testDataize :: [(String, String, String)] -> Spec+testDataize :: [(String, String, Bytes)] -> Spec testDataize useCases =   forM_ useCases $ \(name, prog, res) ->     it name $ do@@ -29,7 +33,7 @@   describe "morph" $     test       morph-      [ ("[[ D> 00- ]] => [[ D> 00- ]]", ExFormation [BiDelta "00-"], ExGlobal, Just (ExFormation [BiDelta "00-"])),+      [ ("[[ D> 00- ]] => [[ D> 00- ]]", ExFormation [BiDelta (BtOne "00")], ExGlobal, Just (ExFormation [BiDelta (BtOne "00")])),         ("T => T", ExTermination, ExGlobal, Just ExTermination),         ("$ => X", ExThis, ExGlobal, Nothing),         ("Q => X", ExGlobal, ExGlobal, Nothing),@@ -43,17 +47,17 @@   describe "dataize" $     test       dataize'-      [ ("[[ D> 00- ]] => 00-", ExFormation [BiDelta "00-"], ExGlobal, Just "00-"),+      [ ("[[ D> 00- ]] => 00-", ExFormation [BiDelta (BtOne "00")], ExGlobal, Just (BtOne "00")),         ("T => X", ExTermination, ExGlobal, Nothing),         ( "[[ @ -> [[ D> 00-]] ]] => 00-",-          ExFormation [BiTau AtPhi (ExFormation [BiDelta "00-", BiVoid AtRho]), BiVoid AtRho],+          ExFormation [BiTau AtPhi (ExFormation [BiDelta (BtOne "00"), BiVoid AtRho]), BiVoid AtRho],           ExGlobal,-          Just "00-"+          Just (BtOne "00")         ),         ( "[[ x -> [[ D> 01- ]] ]].x => 01-",-          ExDispatch (ExFormation [BiTau (AtLabel "x") (ExFormation [BiDelta "01-", BiVoid AtRho]), BiVoid AtRho]) (AtLabel "x"),+          ExDispatch (ExFormation [BiTau (AtLabel "x") (ExFormation [BiDelta (BtOne "01"), BiVoid AtRho]), BiVoid AtRho]) (AtLabel "x"),           ExGlobal,-          Just "01-"+          Just (BtOne "01")         ),         ( "[[ @ -> [[ x -> [[ D> 01-, y -> ? ]](y -> [[ ]]) ]].x ]] => 01-",           ExFormation@@ -65,7 +69,7 @@                             (AtLabel "x")                             ( ExApplication                                 ( ExFormation-                                    [ BiDelta "01-",+                                    [ BiDelta (BtOne "01"),                                       BiVoid (AtLabel "y"),                                       BiVoid AtRho                                     ]@@ -78,7 +82,7 @@                 )             ],           ExGlobal,-          Just "01-"+          Just (BtOne "01")         )       ] @@ -102,7 +106,7 @@             "  @ -> 5.plus(5)",             "]]"           ],-        "40-24-00-00-00-00-00-00"+        BtMany ["40", "24", "00", "00", "00", "00", "00", "00"]       ),       ( "Fahrenheit",         unlines@@ -125,7 +129,7 @@             "  c -> 25",             "]]"           ],-        "40-53-40-00-00-00-00-00"+        BtMany ["40", "53", "40", "00", "00", "00", "00", "00"]       ),       ( "Factorial",         unlines@@ -155,6 +159,6 @@             "  @ -> $.fac(3)",             "]]"           ],-        "40-18-00-00-00-00-00-00"+        BtMany ["40", "18", "00", "00", "00", "00", "00", "00"]       )     ]
test/MatcherSpec.hs view
@@ -117,13 +117,13 @@         ),         ( "[[!B]] => T:[[x -> ?, D> 01-, L> Func]] => (!B >> T)",           [BiMeta "B"],-          [BiVoid (AtLabel "x"), BiDelta "01-", BiLambda "Func"],+          [BiVoid (AtLabel "x"), BiDelta (BtOne "01"), BiLambda "Func"],           defaultScope,-          [[("B", MvBindings [BiVoid (AtLabel "x"), BiDelta "01-", BiLambda "Func"])]]+          [[("B", MvBindings [BiVoid (AtLabel "x"), BiDelta (BtOne "01"), BiLambda "Func"])]]         ),         ( "[[D> 00-]] => [[D> 00-, L> Func]] => []",-          [BiDelta "00-"],-          [BiDelta "00-", BiLambda "Func"],+          [BiDelta (BtOne "00")],+          [BiDelta (BtOne "00"), BiLambda "Func"],           defaultScope,           []         ),@@ -147,9 +147,9 @@         ),         ( "[[!B1, !x -> ?, !B2]] => [[y -> ?, D> -> 00-, L> Func]] => (!x >> y, !B1 >> [[]], !B2 >> [[D> -> 00-, L> Func]])",           [BiMeta "B1", BiVoid (AtMeta "x"), BiMeta "B2"],-          [BiVoid (AtLabel "y"), BiDelta "00-", BiLambda "Func"],+          [BiVoid (AtLabel "y"), BiDelta (BtOne "00"), BiLambda "Func"],           defaultScope,-          [[("B1", MvBindings []), ("B2", MvBindings [BiDelta "00-", BiLambda "Func"]), ("x", MvAttribute (AtLabel "y"))]]+          [[("B1", MvBindings []), ("B2", MvBindings [BiDelta (BtOne "00"), BiLambda "Func"]), ("x", MvAttribute (AtLabel "y"))]]         ),         ( "[[!x -> ?, !y -> ?]] => [[a -> ?, b -> ?]] => (!x >> a, !y >> b)",           [BiVoid (AtMeta "x"), BiVoid (AtMeta "y")],@@ -170,8 +170,8 @@           [[("B", MvBindings [BiTau (AtLabel "x") ExGlobal, BiTau (AtLabel "y") ExThis])]]         ),         ( "[[L> Func, D> 00-]] => [[D> 00-, L> Func]] => []",-          [BiLambda "Func", BiDelta "00-"],-          [BiDelta "00-", BiLambda "Func"],+          [BiLambda "Func", BiDelta (BtOne "00")],+          [BiDelta (BtOne "00"), BiLambda "Func"],           defaultScope,           []         ),@@ -397,9 +397,9 @@       let Subst joined =             maybeCombined               (Subst (Map.singleton "first" (MvAttribute AtPhi)))-              (Subst (Map.singleton "second" (MvBytes "00-")))+              (Subst (Map.singleton "second" (MvBytes (BtOne "00"))))       Map.lookup "first" joined `shouldBe` Just (MvAttribute AtPhi)-      Map.lookup "second" joined `shouldBe` Just (MvBytes "00-")+      Map.lookup "second" joined `shouldBe` Just (MvBytes (BtOne "00"))     it "leave values in the same substs" $ do       let rho = MvAttribute AtRho           first =@@ -419,7 +419,7 @@             Subst               ( Map.fromList                   [ ("x", MvAttribute AtRho),-                    ("y", MvBytes "1F-")+                    ("y", MvBytes (BtOne "1F"))                   ]               )           second = Subst (Map.singleton "x" (MvAttribute AtPhi))
test/ParserSpec.hs view
@@ -60,11 +60,11 @@         ("[[!a -> !e1]]", Just (ExFormation [BiTau (AtMeta "a") (ExMeta "e1")])),         ("Q * !t", Just (ExMetaTail ExGlobal "t")),         ("[[]](x -> $) * !t1", Just (ExMetaTail (ExApplication (ExFormation [BiVoid AtRho]) (BiTau (AtLabel "x") ExThis)) "t1")),-        ("[[D> --]]", Just (ExFormation [BiDelta "--", BiVoid AtRho])),-        ("[[D> 1F-]]", Just (ExFormation [BiDelta "1F-", BiVoid AtRho])),-        ("[[\n  L> Func,\n  D> 00-\n]]", Just (ExFormation [BiLambda "Func", BiDelta "00-", BiVoid AtRho])),-        ("[[D> 1F-2A-00]]", Just (ExFormation [BiDelta "1F-2A-00", BiVoid AtRho])),-        ("[[D> !b0]]", Just (ExFormation [BiMetaDelta "b0", BiVoid AtRho])),+        ("[[D> --]]", Just (ExFormation [BiDelta BtEmpty, BiVoid AtRho])),+        ("[[D> 1F-]]", Just (ExFormation [BiDelta (BtOne "1F"), BiVoid AtRho])),+        ("[[\n  L> Func,\n  D> 00-\n]]", Just (ExFormation [BiLambda "Func", BiDelta (BtOne "00"), BiVoid AtRho])),+        ("[[D> 1F-2A-00]]", Just (ExFormation [BiDelta (BtMany ["1F", "2A", "00"]), BiVoid AtRho])),+        ("[[D> !d0]]", Just (ExFormation [BiDelta (BtMeta "d0"), BiVoid AtRho])),         ("[[L> Function]]", Just (ExFormation [BiLambda "Function", BiVoid AtRho])),         ("[[L> !F3]]", Just (ExFormation [BiMetaLambda "F3", BiVoid AtRho])),         ("[[x() -> [[]] ]]", Just (ExFormation [BiTau (AtLabel "x") (ExFormation [BiVoid AtRho]), BiVoid AtRho])),@@ -161,7 +161,7 @@                                 (ExDispatch (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (AtLabel "bytes"))                                 ( BiTau                                     (AtAlpha 0)-                                    (ExFormation [BiDelta "40-14-00-00-00-00-00-00", BiVoid AtRho])+                                    (ExFormation [BiDelta (BtMany ["40", "14", "00", "00", "00", "00", "00", "00"]), BiVoid AtRho])                                 )                             )                         )@@ -180,7 +180,7 @@                                         (ExDispatch (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (AtLabel "bytes"))                                         ( BiTau                                             (AtAlpha 0)-                                            (ExFormation [BiDelta "40-14-00-00-00-00-00-00", BiVoid AtRho])+                                            (ExFormation [BiDelta (BtMany ["40", "14", "00", "00", "00", "00", "00", "00"]), BiVoid AtRho])                                         )                                     )                                 )@@ -198,7 +198,7 @@                                             (ExDispatch (ExDispatch (ExDispatch ExGlobal (AtLabel "org")) (AtLabel "eolang")) (AtLabel "bytes"))                                             ( BiTau                                                 (AtAlpha 0)-                                                (ExFormation [BiDelta "68-65-6C-6C-6F", BiVoid AtRho])+                                                (ExFormation [BiDelta (BtMany ["68", "65", "6C", "6C", "6F"]), BiVoid AtRho])                                             )                                         )                                     )
test/ReplacerSpec.hs view
@@ -47,8 +47,8 @@         ),         ("Q -> [[]] => ([], [$]) => X", Program (ExFormation []), [], [ExThis], Nothing),         ( "Q -> [[L> Func, D> 00-]] => ([ [[L> Func, D> 00-]] ], [Q]) => Q -> Q",-          Program (ExFormation [BiLambda "Func", BiDelta "00-"]),-          [ExFormation [BiLambda "Func", BiDelta "00-"]],+          Program (ExFormation [BiLambda "Func", BiDelta (BtOne "00")]),+          [ExFormation [BiLambda "Func", BiDelta (BtOne "00")]],           [ExGlobal],           Just (Program ExGlobal)         ),
test/RewriterSpec.hs view
@@ -21,6 +21,7 @@ import Yaml (normalizationRules) import Yaml qualified as Y import Rewriter (rewrite', RewriteContext (RewriteContext))+import Functions (buildTermFromFunction)  data Rules = Rules   { basic :: Maybe [String],@@ -91,7 +92,7 @@                   if normalize'                     then pure normalizationRules                     else pure []-              rewritten <- rewrite' program rules' (RewriteContext program repeat')+              rewritten <- rewrite' program rules' (RewriteContext program repeat' buildTermFromFunction)               result' <- parseProgramThrows (output pack)               unless (rewritten == result') $                 expectationFailure