phino 0.0.0.11 → 0.0.0.12

raw patch · 6 files changed

+37/−8 lines, 6 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 +3/−1
• src/Misc.hs +18/−2
• src/XMIR.hs +7/−3
• test/CLISpec.hs +6/−0
• test/PrettySpec.hs +2/−1

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

@@ -61,6 +61,7 @@     normalize :: Bool,     nothing :: Bool,     shuffle :: Bool,+    omitListing :: Bool,     maxDepth :: Integer   } @@ -82,6 +83,7 @@             <*> switch (long "normalize" <> help "Use built-in normalization rules")             <*> switch (long "nothing" <> help "Just desugar provided 𝜑-program")             <*> switch (long "shuffle" <> help "Shuffle rules before applying")+            <*> switch (long "omit-listing" <> help "Omit full program listing in XMIR output")             <*> option auto (long "max-depth" <> metavar "DEPTH" <> help "Max amount of rewritng cycles" <> value 25 <> showDefault)         ) @@ -199,5 +201,5 @@         printProgram :: Program -> IOFormat -> PrintMode -> IO String         printProgram prog PHI mode = pure (prettyProgram' prog mode)         printProgram prog XMIR mode = do-          xmir <- programToXMIR prog mode+          xmir <- programToXMIR prog mode omitListing           pure (printXMIR xmir)

@@ -17,7 +17,7 @@ import Data.ByteString.Builder (toLazyByteString, word64BE) import Data.ByteString.Lazy (unpack) import qualified Data.ByteString.Lazy.UTF8 as U-import Data.Char (chr)+import Data.Char (chr, isPrint, ord) import Data.List (intercalate) import qualified Data.Text as T import qualified Data.Text.Encoding as T@@ -143,6 +143,8 @@ -- "--" -- >>> strToHex "h" -- "68-"+-- >>> strToHex "h\""+-- "68-22" strToHex :: String -> String strToHex "" = "--" strToHex [ch] = btsToHex (unpack (U.fromString [ch])) ++ "-"@@ -159,13 +161,27 @@ -- "world" -- >>> hexToStr "" -- ""+-- >>> hexToStr "68-22"+-- "h\\\"" hexToStr :: String -> String hexToStr "--" = "" hexToStr [] = ""-hexToStr hx = T.unpack $ T.decodeUtf8 $ B.pack (hexToBts cleaned)+hexToStr hx = escapeStr (T.unpack $ T.decodeUtf8 $ B.pack (hexToBts cleaned))   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+        escapeChar '"'  = "\\\""+        escapeChar '\\' = "\\\\"+        escapeChar '\n' = "\\n"+        escapeChar '\t' = "\\t"+        escapeChar c+          | isPrint c && c /= '\\' && c /= '"' = [c]+          | otherwise = printf "\\x%02x" (ord c)  -- Fast Fisher-Yates with mutable vectors. -- The function is generated by ChatGPT and claimed as

@@ -166,11 +166,15 @@       nanos = floor (fractional * 1_000_000_000) :: Int   base ++ "." ++ printf "%09d" nanos ++ "Z" -programToXMIR :: Program -> PrintMode -> IO Document-programToXMIR (Program expr) mode = do+programToXMIR :: Program -> PrintMode -> Bool -> IO Document+programToXMIR (Program expr) mode omitListing = do   (pckg, expr') <- getPackage expr   root <- rootExpression expr'   now <- getCurrentTime+  let phi = prettyProgram' (Program expr) mode+      listing = if omitListing+        then show (length (lines phi)) ++ " lines of phi"+        else phi   pure     ( Document         (Prologue [] Nothing [])@@ -184,7 +188,7 @@               ("version", showVersion version),               ("xsi:noNamespaceSchemaLocation", "https://raw.githubusercontent.com/objectionary/eo/refs/heads/gh-pages/XMIR.xsd")             ]-            ( NodeElement (element "listing" [] [NodeContent (T.pack (prettyProgram' (Program expr) mode))])+            ( NodeElement (element "listing" [] [NodeContent (T.pack listing)])                 : root                 : metasWithPackage (intercalate "." pckg)             )

@@ -175,3 +175,9 @@                 "⟧}"               ]           ]++    it "rewrites as XMIR with omit-listing flag" $+      withStdin "Q -> [[ x -> Q.y ]]" $+        testCLI+          ["rewrite", "--nothing", "--output=xmir", "--omit-listing"]+          ["<?xml version=\"1.0\" encoding=\"UTF-8\"?>", "<object", "<listing>4 lines of phi</listing>", "  <o base=\"Q.y\" name=\"x\"/>"]

@@ -51,7 +51,8 @@             ("Q -> Q.x(x -> 1)(y -> 2)(z -> 3)", "{Φ.x(\n  x ↦ 1,\n  y ↦ 2,\n  z ↦ 3\n)}"),             ("Q -> Q.x(~0 -> Q.y)", "{Φ.x(\n  Φ.y\n)}"),             ("Q -> Q.x(~0 -> 1)(~1 -> 2)(~2 -> 3)", "{Φ.x(\n  1,\n  2,\n  3\n)}"),-            ("Q -> Q.x(~0 -> 1)(~2 -> 2)(~1 -> 3)", "{Φ.x(\n  α0 ↦ 1,\n  α2 ↦ 2,\n  α1 ↦ 3\n)}")+            ("Q -> 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)}")           ]     test prettyProgram' useCases