diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -34,7 +34,7 @@ ```bash cabal update -cabal install --overwrite-policy=always phino-0.0.0.67 +cabal install --overwrite-policy=always phino-0.0.0.68 phino --version ``` @@ -331,6 +331,17 @@ * `join` - accepts list of bindings and returns list of joined bindings. Duplicated `ρ`, `Δ` and `λ` attributes are ignored, all other duplicated attributes are replaced with unique attributes using `random-tau` function. +* `splice` - accepts three arguments: input bindings `𝐵-in`, a sentinel expression, + and replacement bindings `𝐵-rep`. Returns a new binding group where `𝐵-rep` + is inserted in front of every binding in `𝐵-in` whose value is a formation + with `φ` equal to the sentinel. Every spliced copy of `𝐵-rep` has its + `τ`-labelled attributes renamed via `random-tau` so the resulting binding + group has no duplicates. `𝐵-rep` must contain only `τ`-labelled bindings + (`BiTau (AtLabel _) _` or `BiVoid (AtLabel _)`); any `ρ`, `Δ`, `λ`, `φ`, + `α`, or meta-attribute binding in `𝐵-rep` makes the function fail fast + because such bindings cannot be renamed and would produce duplicates + when spliced at more than one position. When no binding matches the + sentinel, the output equals the input unchanged. ## Meta variables @@ -374,55 +385,55 @@ === parse/phi === warmup: 3 iterations batches: 10 x 1 - total: 1031210.405 μs - avg: 103121.040 μs - min: 93623.015 μs - max: 126930.202 μs - std dev: 13077.810 μs + total: 1431411.012 μs + avg: 143141.101 μs + min: 127073.145 μs + max: 171130.864 μs + std dev: 15649.917 μs === parse/xmir === warmup: 3 iterations batches: 10 x 1 - total: 6217322.833 μs - avg: 621732.283 μs - min: 554694.491 μs - max: 755833.179 μs - std dev: 55468.859 μs + total: 7598416.608 μs + avg: 759841.661 μs + min: 697811.420 μs + max: 822708.096 μs + std dev: 41396.013 μs === rewrite/normalize === warmup: 3 iterations batches: 10 x 1 - total: 312902.089 μs - avg: 31290.209 μs - min: 29879.534 μs - max: 34353.613 μs - std dev: 1360.426 μs + total: 364316.104 μs + avg: 36431.610 μs + min: 35585.946 μs + max: 38039.285 μs + std dev: 724.383 μs === print/sweet/multiline === warmup: 3 iterations batches: 10 x 1 - total: 3650499.458 μs - avg: 365049.946 μs - min: 336866.083 μs - max: 392609.052 μs - std dev: 14447.496 μs + total: 3936466.911 μs + avg: 393646.691 μs + min: 388074.584 μs + max: 398140.650 μs + std dev: 3449.956 μs === print/sweet/flat === warmup: 3 iterations batches: 10 x 1 - total: 3666297.385 μs - avg: 366629.738 μs - min: 342205.526 μs - max: 380537.332 μs - std dev: 10914.667 μs + total: 3778721.383 μs + avg: 377872.138 μs + min: 355092.443 μs + max: 394891.090 μs + std dev: 13649.562 μs === print/salty/multiline === warmup: 3 iterations batches: 10 x 1 - total: 11397878.380 μs - avg: 1139787.838 μs - min: 1105293.829 μs - max: 1179067.130 μs - std dev: 23579.734 μs + total: 13588867.661 μs + avg: 1358886.766 μs + min: 1332657.250 μs + max: 1380376.704 μs + std dev: 13948.257 μs ``` The results were calculated in [this GHA job][benchmark-gha] -on 2026-05-17 at 21:49, +on 2026-05-18 at 22:53, on Linux with 4 CPUs. @@ -458,4 +469,4 @@ [jna]: https://github.com/java-native-access/jna [jna-native]: https://github.com/java-native-access/jna/blob/master/src/com/sun/jna/Native.java [jeo]: https://github.com/objectionary/jeo-maven-plugin -[benchmark-gha]: https://github.com/objectionary/phino/actions/runs/26003582110 +[benchmark-gha]: https://github.com/objectionary/phino/actions/runs/26064953685 diff --git a/phino.cabal b/phino.cabal --- a/phino.cabal +++ b/phino.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: phino -version: 0.0.0.68 +version: 0.0.0.69 license: MIT synopsis: Command-Line Manipulator of 𝜑-Calculus Expressions description: Please see the README on GitHub at diff --git a/src/Functions.hs b/src/Functions.hs --- a/src/Functions.hs +++ b/src/Functions.hs @@ -19,7 +19,7 @@ import Matcher import Misc import Parser (parseAttributeThrows, parseNumberThrows) -import Printer (printAttribute, printExpression, printExtraArg) +import Printer (printAttribute, printBinding, printExpression, printExtraArg) import Random (randomString) import Regexp import Text.Printf (printf) @@ -44,6 +44,7 @@ buildTerm' "number" = _number buildTerm' "sum" = _sum buildTerm' "join" = _join +buildTerm' "splice" = _splice buildTerm' func = _unsupported func argToBytes :: Y.ExtraArgument -> Subst -> IO Bytes @@ -247,6 +248,57 @@ case unsafePerformIO (_randomTau (map Y.ArgAttribute (Set.toList attrs)) subst) of TeAttribute attr' -> attr' _ -> AtLabel "unknown" + +_splice :: BuildTermMethod +_splice [Y.ArgBinding inArg, Y.ArgExpression sentExpr, Y.ArgBinding repArg] subst = do + inBds <- buildBindingThrows inArg subst + repBds <- buildBindingThrows repArg subst + mapM_ validateRep repBds + (sentinel, _) <- buildExpressionThrows sentExpr subst + let avoid = map Y.ArgAttribute (attributesFromBindings (inBds ++ repBds)) + spliced <- splice inBds sentinel repBds avoid + pure (TeBindings spliced) + where + validateRep :: Binding -> IO () + validateRep (BiTau (AtLabel _) _) = pure () + validateRep (BiVoid (AtLabel _)) = pure () + validateRep bd = + throwIO + ( userError + ( printf + "Function splice() can only rename τ-labelled bindings in the replacement group, but got '%s' which would produce duplicates when spliced more than once" + (printBinding bd) + ) + ) + splice :: [Binding] -> Expression -> [Binding] -> [Y.ExtraArgument] -> IO [Binding] + splice [] _ _ _ = pure [] + splice (bd : rest) sent rep avoid + | matches sent bd = do + fresh <- traverse (renamed avoid) rep + tail' <- splice rest sent rep avoid + pure (fresh ++ bd : tail') + | otherwise = do + tail' <- splice rest sent rep avoid + pure (bd : tail') + matches :: Expression -> Binding -> Bool + matches sent (BiTau _ (ExFormation bds)) = any (isPhi sent) bds + matches _ _ = False + isPhi :: Expression -> Binding -> Bool + isPhi sent (BiTau AtPhi expr) = expr == sent + isPhi _ _ = False + renamed :: [Y.ExtraArgument] -> Binding -> IO Binding + renamed avoid (BiTau (AtLabel _) expr) = do + term <- _randomTau avoid subst + case term of + TeAttribute attr -> pure (BiTau attr expr) + _ -> throwIO (userError "Failed to generate fresh tau attribute for splice") + renamed avoid (BiVoid (AtLabel _)) = do + term <- _randomTau avoid subst + case term of + TeAttribute attr -> pure (BiVoid attr) + _ -> throwIO (userError "Failed to generate fresh tau attribute for splice") + renamed _ bd = pure bd +_splice _ _ = throwIO (userError "Function splice() requires exactly 3 arguments: input bindings, sentinel expression, replacement bindings") _unsupported :: BuildTermFunc _unsupported func _ _ = throwIO (userError (printf "Function %s() is not supported or does not exist" func)) diff --git a/test/FunctionsSpec.hs b/test/FunctionsSpec.hs --- a/test/FunctionsSpec.hs +++ b/test/FunctionsSpec.hs @@ -6,19 +6,32 @@ module FunctionsSpec where import AST +import Control.Exception (try) +import Control.Monad (void) import Data.Map.Strict qualified as Map +import Data.Text qualified as T import Deps (Term (TeBindings)) import Functions (buildTerm) import Logger (logDebug) import Matcher (MetaValue (MvBindings), Subst (Subst)) import Misc (uniqueBindings') import Printer (printExpression) -import Test.Hspec (Spec, describe, it, shouldBe) +import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy) import Text.Printf (printf) -import Yaml (ExtraArgument (ArgBinding)) +import Yaml (ExtraArgument (ArgBinding, ArgExpression)) +emit :: Expression +emit = ExDispatch (ExDispatch ExGlobal (AtLabel "hone")) (AtLabel "emit") + +phiBinding :: T.Text -> Expression -> Binding +phiBinding name body = BiTau (AtLabel name) (ExFormation [BiTau AtPhi body]) + +bodyOf :: Binding -> Maybe Expression +bodyOf (BiTau _ (ExFormation [BiTau AtPhi expr])) = Just expr +bodyOf _ = Nothing + spec :: Test.Hspec.Spec -spec = describe "Functions" $ +spec = describe "Functions" $ do Test.Hspec.it "contains only unique bindings after 'join'" $ do let first = ("B1", MvBindings [BiVoid AtRho, BiDelta BtEmpty, BiTau (AtLabel "x") ExGlobal, BiVoid (AtAlpha 0)]) second = ("B2", MvBindings [BiTau AtRho ExThis, BiLambda "Func", BiDelta (BtOne "00"), BiVoid (AtAlpha 1)]) @@ -28,3 +41,111 @@ bds' <- uniqueBindings' bds logDebug (printf "Joined bindings:\n%s" (printExpression (ExFormation bds'))) length bds' `shouldBe` 9 + Test.Hspec.it "splices replacement in the correct order before every sentinel match" $ do + let foo = ExDispatch ExGlobal (AtLabel "foo") + bar = ExDispatch ExGlobal (AtLabel "bar") + cpsBody = + [ phiBinding "x" foo + , phiBinding "emit1" emit + , phiBinding "y" bar + , phiBinding "emit2" emit + ] + autoBody = + [ phiBinding "add1" foo + , phiBinding "add2" bar + ] + subst = + Subst + ( Map.fromList + [ ("B-in", MvBindings cpsBody) + , ("B-rep", MvBindings autoBody) + ] + ) + TeBindings result <- + buildTerm + "splice" + [ ArgBinding (BiMeta "B-in") + , ArgExpression emit + , ArgBinding (BiMeta "B-rep") + ] + subst + bds <- uniqueBindings' result + logDebug (printf "Spliced bindings:\n%s" (printExpression (ExFormation bds))) + map bodyOf bds + `shouldBe` [ Just foo + , Just foo + , Just bar + , Just emit + , Just bar + , Just foo + , Just bar + , Just emit + ] + Test.Hspec.it "returns the input unchanged when no sentinel match is found" $ do + let foo = ExDispatch ExGlobal (AtLabel "foo") + body = [phiBinding "x" foo, phiBinding "y" foo] + subst = + Subst + ( Map.fromList + [ ("B-in", MvBindings body) + , ("B-rep", MvBindings [phiBinding "z" foo]) + ] + ) + TeBindings result <- + buildTerm + "splice" + [ ArgBinding (BiMeta "B-in") + , ArgExpression emit + , ArgBinding (BiMeta "B-rep") + ] + subst + result `shouldBe` body + Test.Hspec.it "produces only unique attributes for many splice positions" $ do + let foo = ExDispatch ExGlobal (AtLabel "foo") + body = [phiBinding (T.pack ('e' : show i)) emit | i <- [1 .. 5 :: Int]] + rep = [phiBinding "a" foo, phiBinding "b" foo] + subst = + Subst + ( Map.fromList + [ ("B-in", MvBindings body) + , ("B-rep", MvBindings rep) + ] + ) + TeBindings result <- + buildTerm + "splice" + [ ArgBinding (BiMeta "B-in") + , ArgExpression emit + , ArgBinding (BiMeta "B-rep") + ] + subst + bds <- uniqueBindings' result + bds `shouldSatisfy` ((== length body + 5 * length rep) . length) + Test.Hspec.it "fails fast when replacement contains a non-label binding" $ do + let body = [phiBinding "e1" emit, phiBinding "e2" emit] + rep = [phiBinding "a" emit, BiVoid AtRho] + subst = + Subst + ( Map.fromList + [ ("B-in", MvBindings body) + , ("B-rep", MvBindings rep) + ] + ) + outcome <- + try + ( void + ( buildTerm + "splice" + [ ArgBinding (BiMeta "B-in") + , ArgExpression emit + , ArgBinding (BiMeta "B-rep") + ] + subst + ) + ) :: + IO (Either IOError ()) + outcome `shouldSatisfy` isLeft + where + isLeft :: Either a b -> Bool + isLeft (Left _) = True + isLeft _ = False