phino 0.0.0.39 → 0.0.0.40

raw patch · 8 files changed

+64/−26 lines, 8 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/CLI.hs +21/−11
• src/Dataize.hs +2/−1
• src/Rewriter.hs +5/−4
• src/Rule.hs +20/−7
• test/CLISpec.hs +13/−0
• test/DataizeSpec.hs +1/−1
• test/RewriterSpec.hs +1/−1

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

@@ -60,6 +60,7 @@   { logLevel :: LogLevel,     inputFormat :: IOFormat,     maxDepth :: Integer,+    maxCycles :: Integer,     inputFile :: Maybe FilePath   } @@ -76,6 +77,7 @@     omitComments :: Bool,     must :: Integer,     maxDepth :: Integer,+    maxCycles :: Integer,     targetFile :: Maybe FilePath,     inputFile :: Maybe FilePath   }@@ -90,8 +92,11 @@ 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)+optMaxDepth = option auto (long "max-depth" <> metavar "DEPTH" <> help "Maximum number of rewriting iterations per rule" <> value 25 <> showDefault) +optMaxCycles :: Parser Integer+optMaxCycles = option auto (long "max-cycles" <> metavar "CYCLES" <> help "Maximum number of rewriting cycles across all rules" <> value 25 <> showDefault)+ optInputFormat :: Parser IOFormat optInputFormat = option (parseIOFormat "input") (long "input" <> metavar "FORMAT" <> help "Program input format (phi, xmir)" <> value PHI <> showDefault) @@ -124,6 +129,7 @@             <$> optLogLevel             <*> optInputFormat             <*> optMaxDepth+            <*> optMaxCycles             <*> argInputFile         ) @@ -145,6 +151,7 @@                     <|> option auto (long "must" <> metavar "N" <> help "Must-rewrite, stops execution if not exactly N rules applied (default 1 when specified without value, if 0 - flag is disabled)" <> value 0)                 )             <*> optMaxDepth+            <*> optMaxCycles             <*> optional (strOption (long "target" <> short 't' <> metavar "FILE" <> help "File to save output to"))             <*> argInputFile         )@@ -183,12 +190,13 @@   case cmd of     CmdRewrite OptsRewrite {..} -> do       validateMaxDepth maxDepth+      validateMaxCycles maxCycles       validateMust must       logDebug (printf "Amount of rewriting cycles: %d" maxDepth)       input <- readInput inputFile       rules' <- getRules       program <- parseProgram input inputFormat-      rewritten <- rewrite' program rules' (RewriteContext program maxDepth buildTerm must)+      rewritten <- rewrite' program rules' (RewriteContext program maxDepth maxCycles buildTerm must)       logDebug (printf "Printing rewritten 𝜑-program as %s" (show outputFormat))       prog <- printProgram rewritten outputFormat printMode       output prog@@ -234,21 +242,23 @@             logInfo (printf "The result program was saved in '%s'" file)     CmdDataize OptsDataize {..} -> do       validateMaxDepth maxDepth+      validateMaxCycles maxCycles       input <- readInput inputFile       prog <- parseProgram input inputFormat-      dataized <- dataize prog (DataizeContext prog maxDepth buildTerm)+      dataized <- dataize prog (DataizeContext prog maxDepth maxCycles buildTerm)       maybe (throwIO CouldNotDataize) (putStrLn . prettyBytes) dataized   where-    validateMaxDepth :: Integer -> IO ()-    validateMaxDepth depth =+    validateIntArgument :: Integer -> (Integer -> Bool) -> String -> IO ()+    validateIntArgument num cmp msg =       when-        (depth <= 0)-        (throwIO (InvalidRewriteArguments "--max-depth must be positive"))+        (cmp num)+        (throwIO (InvalidRewriteArguments msg))+    validateMaxDepth :: Integer -> IO ()+    validateMaxDepth depth = validateIntArgument depth (<= 0) "--max-depth must be positive"+    validateMaxCycles :: Integer -> IO ()+    validateMaxCycles cycles = validateIntArgument cycles (<= 0) "--max-cycles must be positive"     validateMust :: Integer -> IO ()-    validateMust must =-      when-        (must < 0)-        (throwIO (InvalidRewriteArguments "--must must be positive"))+    validateMust must = validateIntArgument must (< 0) "--must must be positive"     readInput :: Maybe FilePath -> IO String     readInput inputFile' = case inputFile' of       Just pth -> do

@@ -21,11 +21,12 @@ data DataizeContext = DataizeContext   { _program :: Program,     _maxDepth :: Integer,+    _maxCycles :: Integer,     _buildTerm :: BuildTermFunc   }  switchContext :: DataizeContext -> RewriteContext-switchContext DataizeContext {..} = RewriteContext _program _maxDepth _buildTerm 0+switchContext DataizeContext {..} = RewriteContext _program _maxDepth _maxCycles _buildTerm 0  maybeBinding :: (Binding -> Bool) -> [Binding] -> (Maybe Binding, [Binding]) maybeBinding _ [] = (Nothing, [])

@@ -30,6 +30,7 @@ data RewriteContext = RewriteContext   { _program :: Program,     _maxDepth :: Integer,+    _maxCycles :: Integer,     _buildTerm :: BuildTermFunc,     _must :: Integer   }@@ -151,17 +152,17 @@   where     _rewrite :: Program -> Integer -> IO Program     _rewrite prog count = do-      let depth = _maxDepth ctx+      let cycles = _maxCycles ctx           must = _must ctx       if must /= 0 && count - 1 > must         then throwIO (ContinueAfter must)         else-          if count - 1 == depth+          if count - 1 == cycles             then do-              logDebug (printf "Max amount of rewriting cycles for all rules (%d) has been reached, rewriting is stopped" depth)+              logDebug (printf "Max amount of rewriting cycles for all rules (%d) has been reached, rewriting is stopped" cycles)               pure prog             else do-              logDebug (printf "Starting rewriting cycle for all rules: %d out of %d" count depth)+              logDebug (printf "Starting rewriting cycle for all rules: %d out of %d" count cycles)               rewritten <- rewrite prog rules ctx               if rewritten == prog                 then do

@@ -25,6 +25,7 @@ import Text.Printf (printf) import Yaml (normalizationRules) import qualified Yaml as Y+import Control.Monad (when)  data RuleContext = RuleContext   { _program :: Program,@@ -233,6 +234,7 @@ extraSubstitutions substs extras RuleContext {..} = case extras of   Nothing -> pure substs   Just extras' -> do+    logDebug "Building extra substitutions..."     res <-       sequence         [ foldlM@@ -251,7 +253,7 @@                     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))+                    logDebug (printf "Function %s() returned attribute: %s" func (prettyAttribute attr))                     pure (MvAttribute attr)                   TeBytes bytes -> do                     logDebug (printf "Function %s() returned bytes: %s" func (prettyBytes bytes))@@ -271,11 +273,22 @@   let ptn = Y.pattern rule       matched = matchProgram ptn program    in if null matched-        then pure []+        then do+          logDebug "Pattern was not matched"+          pure []         else do-          when <- meetMaybeCondition (Y.when rule) matched ctx-          if null when-            then pure []+          when' <- meetMaybeCondition (Y.when rule) matched ctx+          if null when'+            then do+              logDebug "The 'when' condition wasn't met"+              pure []             else do-              extended <- extraSubstitutions when (Y.where_ rule) ctx-              meetMaybeCondition (Y.having rule) extended ctx+              extended <- extraSubstitutions when' (Y.where_ rule) ctx+              if null extended+                then do+                  logDebug "Substitution is empty after enxtending, maybe some metas are duplicated"+                  pure []+                else do+                  met <- meetMaybeCondition (Y.having rule) extended ctx+                  when (null met) (logDebug "The 'having' condition wan't met")+                  pure met

@@ -207,6 +207,19 @@               content `shouldBe` "{⟦⟧}"           ) +    it "rewrites with cycles" $+      withStdin "Q -> [[ x -> 1 ]]" $+        testCLI+          ["rewrite", "--sweet", "--rule=test-resources/cli/infinite.yaml", "--max-depth=1", "--max-cycles=2"]+          [ unlines+              [ "{⟦",+                "  x ↦ 1,",+                "  x ↦ 1,",+                "  x ↦ 1",+                "⟧}"+              ]+          ]+   describe "dataize" $ do     it "dataizes simple program" $       withStdin "Q -> [[ D> 01- ]]" $

@@ -11,7 +11,7 @@ import Functions (buildTerm)  defaultDataizeContext :: Program -> DataizeContext-defaultDataizeContext prog = DataizeContext prog 25 buildTerm+defaultDataizeContext prog = DataizeContext prog 25 1 buildTerm  test :: (Eq a, Show a) => (Expression -> DataizeContext -> IO (Maybe a)) -> [(String, Expression, Expression, Maybe a)] -> Spec test func useCases =

@@ -96,7 +96,7 @@                   if normalize'                     then pure normalizationRules                     else pure []-              rewritten <- rewrite' program rules' (RewriteContext program repeat' buildTerm must')+              rewritten <- rewrite' program rules' (RewriteContext program repeat' repeat' buildTerm must')               result' <- parseProgramThrows (output pack)               unless (rewritten == result') $                 expectationFailure