phino 0.0.0.16 → 0.0.0.17

raw patch · 11 files changed

+183/−94 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• phino.cabal +1/−1
• src/Builder.hs +44/−8
• src/CLI.hs +18/−7
• src/Dataize.hs +56/−45
• src/Pretty.hs +3/−0
• src/Rewriter.hs +31/−18
• src/XMIR.hs +2/−2
• src/Yaml.hs +19/−5
• test/DataizeSpec.hs +5/−5
• test/PrettySpec.hs +2/−1
• test/RewriterSpec.hs +2/−2

@@ -1,7 +1,7 @@ cabal-version:      3.0  name:               phino-version:            0.0.0.16+version:            0.0.0.17 license:            MIT synopsis:           Command-Line Manipulator of 𝜑-Calculus Expressions description:        Please see the README on GitHub at <https://github.com/objectionary/phino#readme>

@@ -7,17 +7,22 @@ module Builder   ( buildExpressions,     buildExpression,-    buildExpressionFromFunction,+    buildTermFromFunction,     buildAttribute,     buildBinding,-    contextualize+    contextualize,+    Term (..),   ) where  import Ast import qualified Data.Map.Strict as Map import Matcher+import Pretty (prettyAttribute)+import Yaml (ExtraArgument (..)) +data Term = TeExpression Expression | TeAttribute Attribute+ contextualize :: Expression -> Expression -> Program -> Expression contextualize ExGlobal _ (Program expr) = expr contextualize ExThis expr _ = expr@@ -100,15 +105,46 @@     _ -> Nothing buildExpression expr _ = Just (expr, defaultScope) -buildExpressionFromFunction :: String -> [Expression] -> Subst -> Program -> Maybe Expression-buildExpressionFromFunction "contextualize" [expr, context] subst prog = do+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 (contextualize expr' context' prog)-buildExpressionFromFunction "scope" [expr] subst prog = do+  return (TeExpression (contextualize expr' context' prog))+buildTermFromFunction "scope" [ArgExpression expr] subst prog = do   (expr', scope) <- buildExpression expr subst-  return scope-buildExpressionFromFunction _ _ _ _ = Nothing+  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  -- Build a several expression from one expression and several substitutions buildExpressions :: Expression -> [Subst] -> Maybe [(Expression, Expression)]

@@ -16,7 +16,7 @@ import Data.Char (toLower, toUpper) import Data.List (intercalate) import Data.Version (showVersion)-import Dataize (dataize)+import Dataize (dataize, DataizeContext (DataizeContext)) import Logger import Misc (ensuredFile) import qualified Misc@@ -24,11 +24,11 @@ import Parser (parseProgramThrows) import Paths_phino (version) import Pretty (PrintMode (SALTY, SWEET), prettyProgram')-import Rewriter (rewrite')+import Rewriter (rewrite', RewriteContext (RewriteContext)) import System.Exit (ExitCode (..), exitFailure) import System.IO (getContents') import Text.Printf (printf)-import XMIR (parseXMIRThrows, printXMIR, programToXMIR, xmirToPhi, XmirContext (XmirContext))+import XMIR (XmirContext (XmirContext), parseXMIRThrows, printXMIR, programToXMIR, xmirToPhi) import Yaml (normalizationRules) import qualified Yaml as Y @@ -57,6 +57,7 @@ data OptsDataize = OptsDataize   { logLevel :: LogLevel,     inputFormat :: IOFormat,+    maxDepth :: Integer,     inputFile :: Maybe FilePath   } @@ -84,6 +85,9 @@ argInputFile :: Parser (Maybe FilePath) argInputFile = optional (argument str (metavar "FILE" <> help "Path to input file")) +optMaxDepth :: Parser Integer+optMaxDepth = option auto (long "max-depth" <> metavar "DEPTH" <> help "Max amount of rewritng cycles" <> value 25 <> showDefault)+ optInputFormat :: Parser IOFormat optInputFormat = option (parseIOFormat "input") (long "input" <> metavar "FORMAT" <> help "Program input format (phi, xmir)" <> value PHI <> showDefault) @@ -115,6 +119,7 @@     <$> ( OptsDataize             <$> optLogLevel             <*> optInputFormat+            <*> optMaxDepth             <*> argInputFile         ) @@ -132,7 +137,7 @@             <*> switch (long "shuffle" <> help "Shuffle rules before applying")             <*> switch (long "omit-listing" <> help "Omit full program listing in XMIR output")             <*> switch (long "omit-comments" <> help "Omit comments in XMIR output")-            <*> option auto (long "max-depth" <> metavar "DEPTH" <> help "Max amount of rewritng cycles" <> value 25 <> showDefault)+            <*> optMaxDepth             <*> argInputFile         ) @@ -169,12 +174,12 @@   setLogLevel' cmd   case cmd of     CmdRewrite OptsRewrite {..} -> do-      when (maxDepth <= 0) $ throwIO (InvalidRewriteArguments "--max-depth must be positive")+      validateMaxDepth maxDepth       logDebug (printf "Amount of rewriting cycles: %d" maxDepth)       input <- readInput inputFile       rules' <- getRules       program <- parseProgram input inputFormat-      rewritten <- rewrite' program program rules' maxDepth+      rewritten <- rewrite' program rules' (RewriteContext program maxDepth)       logDebug (printf "Printing rewritten 𝜑-program as %s" (show outputFormat))       out <- printProgram rewritten outputFormat printMode       putStrLn out@@ -209,11 +214,17 @@           xmir <- programToXMIR prog (XmirContext omitListing omitComments printMode)           pure (printXMIR xmir)     CmdDataize OptsDataize {..} -> do+      validateMaxDepth maxDepth       input <- readInput inputFile       prog <- parseProgram input inputFormat-      dataized <- dataize prog+      dataized <- dataize prog (DataizeContext prog maxDepth)       maybe (throwIO CouldNotDataize) putStrLn dataized   where+    validateMaxDepth :: Integer -> IO ()+    validateMaxDepth depth =+      when+        (depth <= 0)+        (throwIO (InvalidRewriteArguments "--max-depth must be positive"))     readInput :: Maybe FilePath -> IO String     readInput inputFile' = case inputFile' of       Just pth -> do

@@ -1,20 +1,33 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}  -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com -- SPDX-License-Identifier: MIT -module Dataize (morph, dataize, dataize') where+module Dataize (morph, dataize, dataize', DataizeContext (..), defaultDataizeContext) where  import Ast-import Builder (buildExpressionFromFunction, contextualize)+import Builder (contextualize) import Condition (isNF) import Control.Exception (throwIO) import Data.List (partition) import Misc-import Rewriter (rewrite')+import Rewriter (RewriteContext (RewriteContext), rewrite') import Text.Printf (printf)+import XMIR (XmirContext (XmirContext)) import Yaml (normalizationRules) +data DataizeContext = DataizeContext+  { program :: Program,+    maxDepth :: Integer+  }++defaultDataizeContext :: Program -> DataizeContext+defaultDataizeContext prog = DataizeContext prog 25++switchContext :: DataizeContext -> RewriteContext+switchContext DataizeContext {..} = RewriteContext program maxDepth+ maybeBinding :: (Binding -> Bool) -> [Binding] -> (Maybe Binding, [Binding]) maybeBinding _ [] = (Nothing, []) maybeBinding func bds =@@ -32,12 +45,12 @@ maybePhi :: [Binding] -> (Maybe Binding, [Binding]) maybePhi = maybeBinding (\case (BiTau AtPhi _) -> True; _ -> False) -formation :: [Binding] -> Program -> IO (Maybe Expression)-formation bds prog = do+formation :: [Binding] -> DataizeContext -> IO (Maybe Expression)+formation bds ctx = do   let (lambda, bds') = maybeLambda bds   case lambda of     Just (BiLambda func) -> do-      obj' <- atom func (ExFormation bds') prog+      obj' <- atom func (ExFormation bds') ctx       case obj' of         Just obj -> pure (Just obj)         _ -> pure Nothing@@ -54,26 +67,26 @@       BiTau (AtLabel attr') expr' -> if attr' == attr then Just expr' else boundExpr bds       _ -> boundExpr bds -withTail :: Expression -> Program -> IO (Maybe Expression)+withTail :: Expression -> DataizeContext -> IO (Maybe Expression) withTail (ExApplication (ExFormation _) _) _ = pure Nothing withTail (ExApplication (ExDispatch ExGlobal _) _) _ = pure Nothing-withTail (ExApplication expr tau) prog = do-  exp' <- withTail expr prog+withTail (ExApplication expr tau) ctx = do+  exp' <- withTail expr ctx   case exp' of     Just exp -> pure (Just (ExApplication exp tau))     _ -> pure Nothing-withTail (ExDispatch (ExFormation bds) attr) prog = do-  obj' <- formation bds prog+withTail (ExDispatch (ExFormation bds) attr) ctx = do+  obj' <- formation bds ctx   case obj' of     Just obj -> pure (Just (ExDispatch obj attr))     _ -> pure Nothing-withTail (ExFormation bds) prog = formation bds prog-withTail (ExDispatch (ExDispatch ExGlobal (AtLabel label)) attr) (Program expr) = case phiDispatch label expr of+withTail (ExFormation bds) ctx = formation bds ctx+withTail (ExDispatch (ExDispatch ExGlobal (AtLabel label)) attr) (DataizeContext {program = Program expr}) = case phiDispatch label expr of   Just obj -> pure (Just (ExDispatch obj attr))   _ -> pure Nothing-withTail (ExDispatch ExGlobal (AtLabel label)) (Program expr) = pure (phiDispatch label expr)-withTail (ExDispatch expr attr) prog = do-  exp' <- withTail expr prog+withTail (ExDispatch ExGlobal (AtLabel label)) (DataizeContext {program = Program expr}) = pure (phiDispatch label expr)+withTail (ExDispatch expr attr) ctx = do+  exp' <- withTail expr ctx   case exp' of     Just exp -> pure (Just (ExDispatch exp attr))     _ -> pure Nothing@@ -91,25 +104,23 @@ -- LAMBDA: M([B1, λ -> F, B2] * t) -> M(e2 * t)   if e3 := [B1,B2] and e2 := F(e3) -- PHI:    M(Q.tau * t) -> M(e * t)               if Q -> [B1, tau -> e, B2], t is tail started with dispatch --         M(e) -> nothing                        otherwise--- @todo #169:30min Get rid of hard coded amount of normalization cycles. Right now the value 25 is hard coded.---  We need to pass it though function argument or global environment.-morph :: Expression -> Program -> IO (Maybe Expression)+morph :: Expression -> DataizeContext -> IO (Maybe Expression) morph ExTermination _ = pure (Just ExTermination) -- PRIM-morph (ExFormation bds) prog = do-  resolved <- withTail (ExFormation bds) prog+morph (ExFormation bds) ctx = do+  resolved <- withTail (ExFormation bds) ctx   case resolved of-    Just obj -> morph obj prog -- LAMBDA or PHI+    Just obj -> morph obj ctx -- LAMBDA or PHI     _ -> pure (Just (ExFormation bds)) -- PRIM-morph expr prog = do-  resolved <- withTail expr prog+morph expr ctx = do+  resolved <- withTail expr ctx   case resolved of-    Just obj -> morph obj prog+    Just obj -> morph obj ctx     _ ->       if isNF expr         then pure Nothing         else do-          (Program expr') <- rewrite' (Program expr) prog normalizationRules 25 -- NMZ-          morph expr' prog+          (Program expr') <- rewrite' (Program expr) normalizationRules (switchContext ctx) -- NMZ+          morph expr' ctx  -- The goal of 'dataize' function is retrieve bytes from given expression. --@@ -117,24 +128,24 @@ -- 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 -> IO (Maybe String)-dataize (Program expr) = dataize' expr (Program expr)+dataize :: Program -> DataizeContext -> IO (Maybe String)+dataize (Program expr) = dataize' expr -dataize' :: Expression -> Program -> IO (Maybe String)+dataize' :: Expression -> DataizeContext -> IO (Maybe String) dataize' ExTermination _ = pure Nothing-dataize' (ExFormation bds) prog = case maybeDelta bds of+dataize' (ExFormation bds) ctx = case maybeDelta bds of   (Just (BiDelta bytes), _) -> pure (Just bytes)   (Nothing, _) -> case maybePhi bds of     (Just (BiTau AtPhi expr), bds') -> case maybeLambda bds' of       (Just (BiLambda _), _) -> throwIO (userError "The 𝜑 and λ can't be present in formation at the same time")       (_, _) ->-        let expr' = contextualize expr (ExFormation bds) prog-         in dataize' expr' prog+        let expr' = contextualize expr (ExFormation bds) (program ctx)+         in dataize' expr' ctx     (Nothing, _) -> case maybeLambda bds of       (Just (BiLambda _), _) -> do-        morphed' <- morph (ExFormation bds) prog+        morphed' <- morph (ExFormation bds) ctx         case morphed' of-          Just morphed -> dataize' morphed prog+          Just morphed -> dataize' morphed ctx           _ -> pure Nothing       (Nothing, _) -> pure Nothing dataize' expr prog = do@@ -146,10 +157,10 @@ toDouble :: Integer -> Double toDouble = fromIntegral -atom :: String -> Expression -> Program -> IO (Maybe Expression)-atom "L_org_eolang_number_plus" self prog = do-  left <- dataize' (ExDispatch self (AtLabel "x")) prog-  right <- dataize' (ExDispatch self AtRho) prog+atom :: String -> Expression -> DataizeContext -> IO (Maybe Expression)+atom "L_org_eolang_number_plus" 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')@@ -157,9 +168,9 @@           sum = first + second       pure (Just (DataObject "number" (numToHex sum)))     _ -> pure Nothing-atom "L_org_eolang_number_times" self prog = do-  left <- dataize' (ExDispatch self (AtLabel "x")) prog-  right <- dataize' (ExDispatch self AtRho) prog+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')@@ -167,9 +178,9 @@           sum = first * second       pure (Just (DataObject "number" (numToHex sum)))     _ -> pure Nothing-atom "L_org_eolang_number_eq" self prog = do-  x <- dataize' (ExDispatch self (AtLabel "x")) prog-  rho <- dataize' (ExDispatch self AtRho) prog+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')

@@ -51,6 +51,8 @@   pretty (AtAlpha index) = pretty "α" <> pretty index   pretty AtRho = pretty "ρ"   pretty AtPhi = pretty "φ"+  pretty AtDelta = pretty "Δ"+  pretty AtLambda = pretty "λ"   pretty (AtMeta meta) = prettyMeta meta  instance Pretty (Formatted Binding) where@@ -69,6 +71,7 @@         BiVoid attr -> attr : voids bds         _ -> []       inlineVoids :: [Attribute] -> Doc ann+      inlineVoids [] = pretty attr <+> prettyArrow       inlineVoids voids' = pretty attr <> lparen <> hsep (punctuate comma (map pretty voids')) <> rparen <+> prettyArrow   pretty (Formatted (mode, BiTau attr expr)) = pretty attr <+> prettyArrow <+> pretty (Formatted (mode, expr))   pretty (Formatted (_, BiMeta meta)) = prettyMeta meta

@@ -6,7 +6,7 @@ -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com -- SPDX-License-Identifier: MIT -module Rewriter (rewrite, rewrite') where+module Rewriter (rewrite, rewrite', RewriteContext (..), defaultRewriteContext) where  import Ast import Builder@@ -14,15 +14,25 @@ import Control.Exception 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 Misc (ensuredFile) import Parser (parseProgram, parseProgramThrows)-import Pretty (PrintMode (SWEET), prettyExpression, prettyProgram, prettyProgram', prettySubsts)+import Pretty (PrintMode (SWEET), prettyAttribute, prettyExpression, prettyProgram, prettyProgram', prettySubsts) import Replacer (replaceProgram) import Text.Printf+import Yaml (ExtraArgument (..)) import qualified Yaml as Y +data RewriteContext = RewriteContext+  { program :: Program,+    maxDepth :: Integer+  }++defaultRewriteContext :: Program -> RewriteContext+defaultRewriteContext prog = RewriteContext prog 25+ data RewriteException   = CouldNotBuild {expr :: Expression, substs :: [Subst]}   | CouldNotReplace {prog :: Program, ptn :: Expression, res :: Expression}@@ -61,23 +71,25 @@   Just extras' ->     catMaybes       [ foldl-          ( \(Just subst') extra -> case Y.meta extra of-              ExMeta name -> do-                let func = Y.function extra-                    args = Y.args extra-                expr <- buildExpressionFromFunction func args subst' prog-                combine (substSingle name (MvExpression expr defaultScope)) subst'-              _ -> Just subst'+          ( \(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       ] --- @todo #169:30min Make original program global. There are some many places where we---  need access to original program like here, in Rewriter. Also it's needed in Builder and Dataize modules.---  Right now we pass this original program as argument. Maybe it would be better to move it to some global state---  since it's not changed during whole program processing. rewrite :: Program -> Program -> [Y.Rule] -> IO Program rewrite program _ [] = pure program rewrite program program' (rule : rest) = do@@ -93,14 +105,15 @@       pure prog'   rewrite prog program' rest --- @todo #169:30min Stop counting amount of rewriting cycles. Right now in order not to+-- @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 --  rewriting rules. If we reach given amount - we just stop. It's not idiomatic and may --  not work on big programs. We need to introduce some mechanism which would memorize --  all rewritten program on each step and if on some step we get the program that have already---  been memorized - we fail because we got into infinite recursion.-rewrite' :: Program -> Program -> [Y.Rule] -> Integer -> IO Program-rewrite' prog prog' rules maxDepth = _rewrite prog 0+--  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   where     _rewrite :: Program -> Integer -> IO Program     _rewrite prog count = do@@ -110,7 +123,7 @@           logDebug (printf "Max amount of rewriting cycles is reached, rewriting is stopped")           pure prog         else do-          rewritten <- rewrite prog prog' rules+          rewritten <- rewrite prog program rules           if rewritten == prog             then do               logDebug "Rewriting is stopped since it does not affect program anymore"

@@ -217,12 +217,12 @@         (Prologue [] Nothing [])         ( element             "object"-            [ ("xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance"),-              ("dob", formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S" now),+            [ ("dob", formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S" now),               ("ms", "0"),               ("revision", "1234567"),               ("time", time now),               ("version", showVersion version),+              ("xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance"),               ("xsi:noNamespaceSchemaLocation", "https://raw.githubusercontent.com/objectionary/eo/refs/heads/gh-pages/XMIR.xsd")             ]             ( if null pckg

@@ -29,9 +29,6 @@         Right parsed -> pure parsed     ) -instance FromJSON Expression where-  parseJSON = parseJSON' "Expression" parseExpression- instance FromJSON Attribute where   parseJSON =     withText@@ -44,6 +41,9 @@             Right attr -> pure attr       ) +instance FromJSON Expression where+  parseJSON = parseJSON' "Expression" parseExpression+ instance FromJSON Binding where   parseJSON = parseJSON' "Binding" parseBinding @@ -93,6 +93,14 @@             ]       ) +instance FromJSON ExtraArgument where+  parseJSON v =+    asum+      [ ArgAttribute <$> parseJSON v,+        ArgBinding <$> parseJSON v,+        ArgExpression <$> parseJSON v+      ]+ instance FromJSON Extra where   parseJSON = genericParseJSON defaultOptions @@ -127,10 +135,16 @@   | XI Expression   deriving (Generic, Show) +data ExtraArgument+  = ArgAttribute Attribute+  | ArgExpression Expression+  | ArgBinding Binding+  deriving (Generic, Show)+ data Extra = Extra-  { meta :: Expression,+  { meta :: ExtraArgument,     function :: String,-    args :: [Expression]+    args :: [ExtraArgument]   }   deriving (Generic, Show) 

@@ -5,23 +5,23 @@  import Ast (Attribute (AtLabel, AtPhi, AtRho), Binding (BiDelta, BiTau, BiVoid), Expression (ExApplication, ExDispatch, ExFormation, ExGlobal, ExTermination, ExThis), Program (Program)) import Control.Monad-import Dataize (dataize, dataize', morph)+import Dataize (dataize, dataize', morph, defaultDataizeContext, DataizeContext) import Parser (parseProgramThrows) import Test.Hspec -test :: (Eq a, Show a) => (Expression -> Program -> IO (Maybe a)) -> [(String, Expression, Expression, Maybe a)] -> Spec+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) ->     it desc $ do-      res <- func input (Program prog)+      res <- func input (defaultDataizeContext (Program prog))       res `shouldBe` output  testDataize :: [(String, String, String)] -> Spec testDataize useCases =   forM_ useCases $ \(name, prog, res) ->     it name $ do-      program <- parseProgramThrows prog-      value <- dataize program+      prog' <- parseProgramThrows prog+      value <- dataize prog' (defaultDataizeContext prog')       value `shouldBe` Just res  spec :: Spec

@@ -53,7 +53,8 @@             ("Q -> Q.x(~0 -> Q.y)", "{Φ.x(\n  Φ.y\n)}"),             ("Q -> Q.x(~0 -> 1)(~1 -> 2)(~2 -> 3)", "{Φ.x(\n  1,\n  2,\n  3\n)}"),             ("Q -> Q.x(~0 -> 1)(~2 -> 2)(~1 -> 3)", "{Φ.x(\n  α0 ↦ 1,\n  α2 ↦ 2,\n  α1 ↦ 3\n)}"),-            ("Q -> Φ.jeo.opcode.ldc(18, \"Reading \\\"\")", "{Φ.jeo.opcode.ldc(\n  18,\n  \"Reading \\\"\"\n)}")+            ("Q -> Φ.jeo.opcode.ldc(18, \"Reading \\\"\")", "{Φ.jeo.opcode.ldc(\n  18,\n  \"Reading \\\"\"\n)}"),+            ("Q -> [[ k -> [[]] ]]", "{⟦\n  k ↦ ⟦⟧\n⟧}")           ]     test prettyProgram' useCases 

@@ -20,7 +20,7 @@ import Test.Hspec (Spec, describe, expectationFailure, it, pending, runIO) import Yaml (normalizationRules) import Yaml qualified as Y-import Rewriter (rewrite')+import Rewriter (rewrite', RewriteContext (RewriteContext))  data Rules = Rules   { basic :: Maybe [String],@@ -91,7 +91,7 @@                   if normalize'                     then pure normalizationRules                     else pure []-              rewritten <- rewrite' program program rules' repeat'+              rewritten <- rewrite' program rules' (RewriteContext program repeat')               result' <- parseProgramThrows (output pack)               unless (rewritten == result') $                 expectationFailure