phino 0.0.128 → 0.0.129
raw patch · 6 files changed
+172/−205 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- README.md +33/−33
- phino.cabal +1/−1
- src/Dataize.hs +18/−12
- src/Merge.hs +12/−1
- test/DataizeSpec.hs +51/−83
- test/MergeSpec.hs +57/−75
README.md view
@@ -34,7 +34,7 @@ ```bash cabal update-cabal install --overwrite-policy=always phino-0.0.127+cabal install --overwrite-policy=always phino-0.0.128 phino --version ``` @@ -900,55 +900,55 @@ === parse/phi === warmup: 3 iterations batches: 10 x 1- total: 1796596.921 μs- avg: 179659.692 μs- min: 164919.877 μs- max: 207942.466 μs- std dev: 16799.590 μs+ total: 1234878.258 μs+ avg: 123487.826 μs+ min: 114898.378 μs+ max: 147448.578 μs+ std dev: 12608.859 μs === parse/xmir === warmup: 3 iterations batches: 10 x 1- total: 7612275.214 μs- avg: 761227.521 μs- min: 709200.274 μs- max: 813312.545 μs- std dev: 30787.560 μs+ total: 6115346.630 μs+ avg: 611534.663 μs+ min: 553273.770 μs+ max: 658997.433 μs+ std dev: 26432.183 μs === rewrite/normalize === warmup: 3 iterations batches: 10 x 1- total: 641726.516 μs- avg: 64172.652 μs- min: 59940.799 μs- max: 76191.091 μs- std dev: 4666.243 μs+ total: 521385.086 μs+ avg: 52138.509 μs+ min: 46636.826 μs+ max: 63889.183 μs+ std dev: 5808.082 μs === print/sweet/multiline === warmup: 3 iterations batches: 10 x 1- total: 4232626.830 μs- avg: 423262.683 μs- min: 402756.415 μs- max: 452617.626 μs- std dev: 15405.204 μs+ total: 3741073.589 μs+ avg: 374107.359 μs+ min: 344671.911 μs+ max: 406026.195 μs+ std dev: 18304.000 μs === print/sweet/flat === warmup: 3 iterations batches: 10 x 1- total: 4143560.984 μs- avg: 414356.098 μs- min: 398710.605 μs- max: 431760.505 μs- std dev: 10740.809 μs+ total: 3807236.850 μs+ avg: 380723.685 μs+ min: 366420.230 μs+ max: 395219.831 μs+ std dev: 9900.160 μs === print/salty/multiline === warmup: 3 iterations batches: 10 x 1- total: 14017459.280 μs- avg: 1401745.928 μs- min: 1380342.970 μs- max: 1418756.423 μs- std dev: 14496.070 μs+ total: 11573351.855 μs+ avg: 1157335.186 μs+ min: 1122778.266 μs+ max: 1213750.752 μs+ std dev: 26107.625 μs ``` The results were calculated in [this GHA job][benchmark-gha]-on 2026-09-11 at 08:17,+on 2026-09-11 at 18:19, on Linux with 4 CPUs. <!-- benchmark_end -->@@ -997,4 +997,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/34577695934+[benchmark-gha]: https://github.com/objectionary/phino/actions/runs/34632126707
phino.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: phino-version: 0.0.128+version: 0.0.129 license: MIT synopsis: Command-Line Manipulator of 𝜑-Calculus Expressions description: Please see the README on GitHub at <https://github.com/objectionary/phino#readme>
src/Dataize.hs view
@@ -142,22 +142,28 @@ isLambda (BiLambda _) = True isLambda _ = False --- The same as 'lambda', but only for a formation that is saturated: one with no--- void binding left in it. A void is an argument the program has not given yet,--- so such a formation is a method waiting to be applied rather than an--- application waiting to be computed, and firing it would hand the atom a ∅--- where it expects a value. 𝔻 needs no such guard, since it fires only what--- dataization demands and nothing demands a method; the deep walk meets every--- one a program declares — the method table of the object model above all — so--- it asks first (see 'deepened').+-- The same as 'lambda', but only for a formation that is saturated: one with+-- every binding of it filled (see 'filled'). A void is an argument the program+-- has not given yet, so such a formation is a method waiting to be applied+-- rather than an application waiting to be computed, and firing it would hand+-- the atom a ∅ where it expects a value. 𝔻 needs no such guard, since it+-- fires only what dataization demands and nothing demands a method; the deep+-- walk meets every one a program declares — the method table of the object+-- model above all — so it asks first (see 'deepened'). saturated :: [Binding] -> Maybe (T.Text, Expression) saturated bds = case lambda bds of Just (func, ExFormation rest) | all filled rest -> Just (func, ExFormation rest) _ -> Nothing- where- filled :: Binding -> Bool- filled (BiVoid _) = False- filled _ = True++-- Whether a binding hands the formation something to work with. A void does+-- not: it names an argument the program has still to supply. Neither does ⊥:+-- the deep walk reduces a body in the scope of the formation around it, and a+-- formation standing unapplied still holds ρ ↦ ∅, so a ξ.ρ in that body comes+-- back as ⊥ rather than as the object the next dispatch supplies (#1196).+filled :: Binding -> Bool+filled (BiVoid _) = False+filled (BiTau _ ExTermination) = False+filled _ = True -- Run one frame of the 𝕄/𝔻 spine, attaching its derivation to a stuck atom or -- an exhausted budget escaping it. 'Stuck' is raised deep inside an atom, which
src/Merge.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE OverloadedStrings #-} -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com -- SPDX-License-Identifier: MIT@@ -45,7 +46,17 @@ ys' = [y | y <- ys, attributeFromBinding y `notElem` as] collisions = [(x, y) | x <- xs, y <- ys, attributeFromBinding x == attributeFromBinding y] ws <- mapM (uncurry mergeBinding) collisions- pure (xs' <> ys' <> ws)+ pure (unmarked (xs' <> ys' <> ws))+ where+ -- A 'Package' λ marks a pure path segment; when only one side carries it,+ -- the other side is a real object and the marker goes away (#1197)+ unmarked :: [Binding] -> [Binding]+ unmarked bindings+ | any marker xs == any marker ys = bindings+ | otherwise = filter (not . marker) bindings+ marker :: Binding -> Bool+ marker (BiLambda (Function "Package")) = True+ marker _ = False merge' :: [Expression] -> IO Expression merge' [] = throwIO EmptyExpressionList
test/DataizeSpec.hs view
@@ -1,5 +1,8 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com -- SPDX-License-Identifier: MIT@@ -10,18 +13,23 @@ import Atoms (Registry, emptyRegistry, readRegistry) import Control.Exception (SomeException) import Control.Monad+import Data.Aeson (FromJSON) import Data.IORef (modifyIORef', newIORef, readIORef) import Data.List (find, isInfixOf, nub) import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (fromMaybe, isJust)+import Data.Yaml qualified as Decode import Dataize (DataizeContext (..), Outcome (..), Steps (..), dataize, dataize', emptyState, execBuildTerm, insideUniverse, morph, morph') import Deps (Evaluation (..), Term (TeExpression), dontSaveEval, dontSaveStep)+import Files (allPathsIn) import Fixtures (fixtureRegistry, withNode, withServing, withShell) import Functions (buildTerm)+import GHC.Generics (Generic) import Matcher (substEmpty) import Parser (parseExpressionThrows) import Rewriter (Rewritten) import Rule (RuleContext (RuleContext), matchExpressionWithRule')+import System.FilePath (makeRelative) import Test.Hspec import Yaml (ExtraArgument (..)) import Yaml qualified@@ -71,20 +79,47 @@ (morphed, _) <- morph expr (defaultDataizeContext loc') morphed `shouldBe` expected --- The same as 'testMorph', with the deep walk on ('_deep') and the fixture λ--- functions registered, since a case that reduces anything has to fire one: it--- is pending where 'node' is not installed.-testDeep :: Registry -> [(String, String, String, String)] -> Spec-testDeep registry useCases =- forM_ useCases $ \(name, loc, src, res) ->- it name $- withNode $ do- expr <- parseExpressionThrows src- loc' <- parseExpressionThrows loc- expected <- parseExpressionThrows res- (morphed, _) <- morph expr (withAtoms registry (defaultDataizeContext loc')){_deep = True}- morphed `shouldBe` expected+-- One case of the deep walk, as a pack of 'test-resources/morph-deep-packs'+-- spells it: the program under 'input', wrapped in the fixture object model+-- where 'model' says so and run against the fixture λ functions where 'atoms'+-- does, entered at 'location' and answering either the program under 'result'+-- or the failure under 'fails'.+data DeepPack = DeepPack+ { location :: Maybe String+ , input :: String+ , model :: Maybe Bool+ , atoms :: Maybe Bool+ , partial :: Maybe Bool+ , result :: Maybe String+ , fails :: Maybe String+ }+ deriving (Generic, Show, FromJSON) +-- Walk one such pack with '_deep' on and check what it answers. A pack that+-- registers the fixture λ functions fires one under 'node', so it is pending+-- where 'node' is not installed.+testDeep :: Registry -> FilePath -> Expectation+testDeep registry pth = do+ DeepPack{..} <- Decode.decodeFileThrow pth+ expr <- parseExpressionThrows (if model == Just True then primitives input else input)+ loc <- parseExpressionThrows (fromMaybe "Q" location)+ let ctx =+ (defaultDataizeContext loc)+ { _deep = True+ , _partial = partial == Just True+ , _atoms = if atoms == Just True then registry else emptyRegistry+ }+ checked :: Expectation+ checked = case (result, fails) of+ (Just res, Nothing) -> do+ expected <- parseExpressionThrows res+ (morphed, _) <- morph expr ctx+ morphed `shouldBe` expected+ (Nothing, Just message) ->+ morph expr ctx `shouldThrow` (\err -> message `isInfixOf` show (err :: SomeException))+ _ -> expectationFailure "The pack holds neither a single 'result' nor a single 'fails'"+ if atoms == Just True then withNode checked else checked+ -- The EO objects the fixture λ functions answer for, declared the way -- 'number.eo' and 'bytes.eo' declare them, so a case below only has to spell -- the expression under φ. 'number.eq' is the one operation with no atom of its@@ -216,76 +251,9 @@ -- atom touched keeps the shape it was written in and the answer stays a -- program. describe "morph with '_deep'" $ do- testDeep- registry- [- ( "stands the answer of the λ that 'mf' left bare in its place"- , "Q.@"- , primitives "[[ x -> 5.plus( 6 ) ]]"- , "[[ x -> Q.number( φ -> Φ.bytes( φ ↦ ⟦ Δ ⤍ 40-26-00-00-00-00-00-00 ⟧ ) ) ]]"- )- ,- ( "fires the atom nested in the argument of the atom it fires"- , "Q.@"- , primitives "[[ x -> 5.plus( 6.plus( 7 ) ) ]]"- , "[[ x -> Q.number( φ -> Φ.bytes( φ ↦ ⟦ Δ ⤍ 40-32-00-00-00-00-00-00 ⟧ ) ) ]]"- )- ,- ( "keeps the answer of the last atom fired along one chain of them"- , "Q.@"- , primitives "[[ x -> 5.plus( 6 ).plus( 7 ) ]]"- , "[[ x -> Q.number( φ -> Φ.bytes( φ ↦ ⟦ Δ ⤍ 40-32-00-00-00-00-00-00 ⟧ ) ) ]]"- )- ,- ( "resolves the ξ of a binding against the formation that holds it"- , "Q.@"- , primitives "[[ n -> 5, x -> $.n.plus( 6 ) ]]"- , "[[ n -> 5, x -> Q.number( φ -> Φ.bytes( φ ↦ ⟦ Δ ⤍ 40-26-00-00-00-00-00-00 ⟧ ) ) ]]"- )- , -- The registry carries no 'L_number_nope', so there is nothing to fire- -- and the binding keeps the name it was written under-- ( "leaves the λ the registry does not serve as it was written"- , "Q.@"- , primitives "[[ x -> 5.nope ]]"- , "[[ x -> 5.nope ]]"- )- , -- A λ-formation whose bindings are still void is a method waiting to be- -- applied, not an application waiting to be computed: nothing demands- -- one, so 𝔻 never meets one, while the walk meets every one the object- -- model declares. Both the void ρ of 'not' and the void 'b' of 'eq'- -- keep their atoms unfired here.-- ( "leaves a λ-formation still waiting for its arguments alone"- , "Q.bytes"- , primitives "[[ ]]"- , "[[ φ -> ?, not -> [[ L> L_bytes_not ]], eq -> [[ b -> ?, L> L_bytes_eq ]] ]]"- )- , -- Nothing demands the argument of an atom that cannot fire, so 𝔻 never- -- reaches it; the walk does, and the atom around it stays in place-- ( "walks into the argument of an atom it cannot fire"- , "Q.@"- , primitives "[[ x -> [[ y -> ?, L> L_bar ]]( y -> 6.plus( 7 ) ) ]]"- , "[[ x -> [[ y -> ?, L> L_bar ]]( y -> Q.number( φ -> Φ.bytes( φ ↦ ⟦ Δ ⤍ 40-2A-00-00-00-00-00-00 ⟧ ) ) ) ]]"- )- ]-- -- An atom deeper on a binding's spine gets stuck exactly as it does under- -- 𝕄 alone: the run fails, unless '_partial' parks it, and then the binding- -- stays as it was written and the walk goes on- describe "a stuck atom on the spine of a binding" $ do- let stuck :: IO Expression- stuck = parseExpressionThrows "[[ x -> [[ L> Sym_arg_0 ]].foo ]]"- it "fails the run without '_partial'" $ do- expr <- stuck- morph expr (defaultDataizeContext ExRoot){_deep = True}- `shouldThrow` (\e -> "Atom 'Sym_arg_0' does not exist" `isInfixOf` show (e :: SomeException))-- it "leaves the binding as it was written under '_partial'" $ do- expr <- stuck- (morphed, _) <- morph expr (defaultDataizeContext ExRoot){_deep = True, _partial = True}- morphed `shouldBe` expr+ let resources = "test-resources/morph-deep-packs"+ packs <- runIO (allPathsIn resources)+ forM_ packs (\pth -> it (makeRelative resources pth) (testDeep registry pth)) -- The walk enters a dispatch through its target and fires the box it finds -- there before 𝕄 is ever asked about the dispatch, while 'ml' demands that
test/MergeSpec.hs view
@@ -1,95 +1,77 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+ -- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com -- SPDX-License-Identifier: MIT +{- | Tests for the Merge module that unites a few top level formations+into a single one.+-} module MergeSpec where import AST (Expression) import Control.Exception (SomeException, try) import Control.Monad (forM_)-import Data.List (intercalate)+import Data.Aeson+import Data.Yaml qualified as Yaml+import Files (allPathsIn)+import GHC.Generics (Generic) import Merge (merge) import Parser (parseExpressionThrows)-import Test.Hspec (Spec, anyException, describe, it, shouldBe, shouldContain, shouldThrow)+import Printer (printExpression)+import System.FilePath+import Test.Hspec+import Text.Printf (printf) +data YamlPack = YamlPack+ { left :: String+ , right :: String+ , result :: Maybe String+ , fails :: Maybe String+ }+ deriving (Generic, Show, FromJSON)++yamlPack :: FilePath -> IO YamlPack+yamlPack = Yaml.decodeFileThrow+ spec :: Spec spec = do- describe "merge expressions" $- forM_- [- ( ["[[ x -> 1 ]]", "[[ y -> 2 ]]"]- , "[[ x -> 1, y -> 2 ]]"- )- ,- ( ["[[ x -> [[ y -> 1 ]] ]]", "[[ x -> [[ z -> 2 ]] ]]"]- , "[[ x -> [[ y -> 1, z -> 2 ]] ]]"- )- ,- ( ["[[ x -> 1 ]]", "[[ x -> 1]]"]- , "[[ x -> 1]]"- )- ,- ( ["[[ org -> [[ eolang -> [[ number -> [[ ]] ]] ]] ]]", "[[ org -> [[ eolang -> [[ bytes -> [[ ]] ]] ]] ]]"]- , "[[ org -> [[ eolang -> [[ number -> [[ ]], bytes -> [[ ]] ]] ]] ]]"- )- ,- ( ["[[ x -> 1 ]]", "[[ y -> 2 ]]", "[[ z -> 3 ]]"]- , "[[ x -> 1, y -> 2, z -> 3 ]]"- )- ,- ( ["[[ x -> ? ]]", "[[ x -> ? ]]"]- , "[[ x -> ? ]]"- )- ,- ( ["[[ D> 42-, x -> [[ ]] ]]", "[[ D> 42-, y -> [[ ]] ]]"]- , "[[ x -> [[ ]], y -> [[ ]], D> 42- ]]"- )- ]- ( \(exprs, res) -> it res $ do- parsed <- mapM parseExpressionThrows exprs- merged <- merge parsed- res' <- parseExpressionThrows res- merged `shouldBe` res'- )-- describe "fails to merge" $+ describe "merge packs" $ do+ let resources = "test-resources/merge-packs"+ packs <- runIO (allPathsIn resources) forM_- [ ["Q", "$"]- , ["[[ x -> 1]]", "[[ x -> 2 ]]"]- , ["[[ x -> [[ y -> Q ]] ]]", "[[ x -> [[ y -> $ ]] ]]"]- ]- ( \exprs -> it (intercalate " and " exprs) $ do- parsed <- mapM parseExpressionThrows exprs- merge parsed `shouldThrow` anyException+ packs+ ( \pth -> it (makeRelative resources pth) $ do+ YamlPack{..} <- yamlPack pth+ parsed <- mapM parseExpressionThrows [left, right]+ case (result, fails) of+ (Just expected, Nothing) -> do+ merged <- merge parsed+ expected' <- parseExpressionThrows expected+ merged `shouldBe` expected'+ (Nothing, Just message) -> do+ thrown <- try (merge parsed) :: IO (Either SomeException Expression)+ case thrown of+ Left err -> show err `shouldContain` message+ Right merged -> expectationFailure (printf "Merge united the sides into %s, while the pack expects it to fail" (printExpression merged))+ _ -> expectationFailure "The pack holds neither a single 'result' nor a single 'fails'" ) - describe "merge exception messages" $- forM_- [- ( "EmptyExpressionList explains there is nothing to merge"- , []- , "Nothing to merge: provide at least one expression"- )- ,- ( "WrongExpressionFormat renders the offending non-formation expression"- , ["Q"]- , "Invalid expression format"- )- ,- ( "CanNotMergeBinding renders both conflicting bindings"- , ["[[ x -> 1 ]]", "[[ x -> 2 ]]"]- , "Can't merge two bindings, conflict found"- )- ]- ( \(desc, exprs, message) -> it desc $ do- parsed <- mapM parseExpressionThrows exprs- result <- try (merge parsed) :: IO (Either SomeException Expression)- case result of- Left err -> show err `shouldContain` message- Right _ -> fail ("expected merge to throw for: " ++ desc)- )+ describe "merges a list of any length" $ do+ it "unites three formations into one" $ do+ parsed <- mapM parseExpressionThrows ["[[ x -> 1 ]]", "[[ y -> 2 ]]", "[[ z -> 3 ]]"]+ merged <- merge parsed+ expected <- parseExpressionThrows "[[ x -> 1, y -> 2, z -> 3 ]]"+ merged `shouldBe` expected - describe "merge of a single expression" $- it "returns that expression unchanged" $ do+ it "returns a lonely formation untouched" $ do parsed <- parseExpressionThrows "[[ x -> 1 ]]" merged <- merge [parsed] merged `shouldBe` parsed++ it "dont accept an empty list of expressions" $ do+ thrown <- try (merge []) :: IO (Either SomeException Expression)+ case thrown of+ Left err -> show err `shouldContain` "Nothing to merge: provide at least one expression"+ Right merged -> expectationFailure (printf "Merge answered %s, while an empty list has nothing to unite" (printExpression merged))