diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,13 @@ # Changelog +## 0.1.0.3 - 2026-08-21 + +- Breaking: `ResultBudgetExhausted` now retains the ordered irreducible subset of its + terminal obstructions, so a repairable sibling cannot erase irreducibility + from the untraced bounded-repair result. +- Align the aggregate coherence suite and optimization policy with the focused + Delta test owners; the property-heavy epoch suite deliberately retains `-O2`. + ## 0.1.0.2 - 2026-07-22 - Documentation: each public front door — `Moonlight.Delta.Patch`, diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,6 +1,6 @@ MIT License -Copyright (c) 2026 The Blue Rose, Rosalia Fialkova +Copyright (c) 2026 Blue Rose Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal diff --git a/bench/repair/RepairBench.hs b/bench/repair/RepairBench.hs --- a/bench/repair/RepairBench.hs +++ b/bench/repair/RepairBench.hs @@ -63,7 +63,11 @@ case result of ResultConverged stateValue rounds -> stateValue + naturalWeight rounds ResultStuck stateValue obstructionValues rounds -> stateValue + obstructionWeight obstructionValues + naturalWeight rounds - ResultBudgetExhausted stateValue obstructionValues rounds -> stateValue + obstructionWeight obstructionValues + naturalWeight rounds + ResultBudgetExhausted stateValue obstructionValues irreducibleObstructions rounds -> + stateValue + + obstructionWeight obstructionValues + + length irreducibleObstructions + + naturalWeight rounds repairTraceScore :: Trace RepairObstruction Correction -> Int repairTraceScore (Trace rounds) = diff --git a/moonlight-delta.cabal b/moonlight-delta.cabal --- a/moonlight-delta.cabal +++ b/moonlight-delta.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: moonlight-delta -version: 0.1.0.2 +version: 0.1.0.3 synopsis: Boundary-aware delta calculus for Moonlight. description: Categorical and state-change delta vocabulary layered over moonlight-core. license: MIT @@ -132,7 +132,7 @@ common moonlight-delta-test-properties default-language: GHC2024 - ghc-options: -Wall -Wcompat + ghc-options: -Wall -Wcompat -O0 default-extensions: TypeFamilies build-depends: @@ -200,6 +200,10 @@ test/epoch test-support main-is: Main.hs + -- This property-heavy suite is runtime-sensitive even though its assertions + -- are not optimization-sensitive. O0 raised its exact execution from 55.66 + -- seconds to 145.22 seconds, so it retains the package's production O2. + ghc-options: -O2 other-modules: ComposeSpec ConstructionSpec @@ -262,11 +266,13 @@ , tasty-quickcheck >= 0.10 , QuickCheck >= 2.14 -test-suite moonlight-delta-test +-- The focused suites own behavior. This component owns only the union of their +-- module, instance, and dependency surfaces, compiled at the shared test O0. +test-suite moonlight-delta-coherence-test import: moonlight-delta-test-properties type: exitcode-stdio-1.0 hs-source-dirs: - test/aggregate + test/coherence test/core test/patch test/epoch diff --git a/src-patch/Moonlight/Delta/Patch/Internal/IncrementalDigest.hs b/src-patch/Moonlight/Delta/Patch/Internal/IncrementalDigest.hs --- a/src-patch/Moonlight/Delta/Patch/Internal/IncrementalDigest.hs +++ b/src-patch/Moonlight/Delta/Patch/Internal/IncrementalDigest.hs @@ -158,9 +158,8 @@ | DeltaHashDigestTrailingBytes {-# UNPACK #-} !Word64 | DeltaHashDigestUnknownStrategyTag {-# UNPACK #-} !Word64 | DeltaHashDigestIdentityMismatch - { deltaHashExpectedIdentity :: !DeltaHashDigestIdentity, - deltaHashEncodedIdentity :: !DeltaHashDigestIdentity - } + !DeltaHashDigestIdentity + !DeltaHashDigestIdentity deriving stock (Eq, Ord, Show) -- | Canonical CBOR serialization of the complete digest identity and both @@ -222,10 +221,10 @@ ) else Left - DeltaHashDigestIdentityMismatch - { deltaHashExpectedIdentity = expectedIdentity, - deltaHashEncodedIdentity = encodedIdentity - } + ( DeltaHashDigestIdentityMismatch + expectedIdentity + encodedIdentity + ) decodeDeltaHashDigestFields :: ByteString -> @@ -242,6 +241,7 @@ (fromIntegral (LazyByteString.length trailingBytes)) ) where + decodeFields :: CBOR.Decoder s (Word64, Word64, Word64, Word64, Word64) decodeFields = do fieldCount <- CBOR.decodeListLenCanonical if fieldCount == 5 diff --git a/src-repair/Moonlight/Delta/Repair.hs b/src-repair/Moonlight/Delta/Repair.hs --- a/src-repair/Moonlight/Delta/Repair.hs +++ b/src-repair/Moonlight/Delta/Repair.hs @@ -87,11 +87,14 @@ -- public — fabricating a result asserts nothing that supplying a vacuous -- kernel could not already assert. Truthfulness relative to a given kernel is -- the post-condition of 'boundedRepair', never an invariant of this type. +-- 'ResultBudgetExhausted' retains both the terminal obstruction set and its +-- ordered irreducible subset; budget exhaustion describes the run, not every +-- obstruction in that run. type Result :: Type -> Type -> Type data Result state obstruction = ResultConverged state Natural | ResultStuck state (NonEmpty obstruction) Natural - | ResultBudgetExhausted state (NonEmpty obstruction) Natural + | ResultBudgetExhausted state (NonEmpty obstruction) [obstruction] Natural deriving stock (Eq, Show) -- | A round-by-round account of a repair run, in chronological order. Like @@ -126,7 +129,7 @@ case result of ResultConverged _ rounds -> rounds ResultStuck _ _ rounds -> rounds - ResultBudgetExhausted _ _ rounds -> rounds + ResultBudgetExhausted _ _ _ rounds -> rounds isConverged :: Result state obstruction -> Bool isConverged result = @@ -139,7 +142,7 @@ case result of ResultConverged state _ -> state ResultStuck state _ _ -> state - ResultBudgetExhausted state _ _ -> state + ResultBudgetExhausted state _ _ _ -> state boundedRepair :: Kernel state obstruction correction -> @@ -183,7 +186,16 @@ StepConverged convergedState -> StepFinished (ResultConverged convergedState currentRound) Nothing StepObstructed obstructedState obstructionValues -> - StepFinished (ResultBudgetExhausted obstructedState obstructionValues currentRound) Nothing + let terminalIrreducibleObstructions = + irreducible (roundFor kernel obstructionValues) + in StepFinished + ( ResultBudgetExhausted + obstructedState + obstructionValues + terminalIrreducibleObstructions + currentRound + ) + Nothing | otherwise = case check kernel state of StepConverged convergedState -> diff --git a/test/aggregate/Main.hs b/test/aggregate/Main.hs deleted file mode 100644 --- a/test/aggregate/Main.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Main (main) where - -import qualified CoreTests -import qualified CrossCarrierLaws -import qualified EpochTests -import qualified PatchTests -import qualified RepairTests -import Test.Tasty (defaultMain, testGroup) - -main :: IO () -main = - defaultMain $ - testGroup - "moonlight-delta" - [ CoreTests.tests, - PatchTests.tests, - EpochTests.tests, - RepairTests.tests, - CrossCarrierLaws.tests - ] diff --git a/test/coherence/Main.hs b/test/coherence/Main.hs new file mode 100644 --- /dev/null +++ b/test/coherence/Main.hs @@ -0,0 +1,13 @@ +-- | Compile every focused test section against their dependency union. Empty +-- imports retain module and instance coherence without executing the focused +-- behavioral suites a second time. +module Main (main) where + +import CoreTests () +import CrossCarrierLaws () +import EpochTests () +import PatchTests () +import RepairTests () + +main :: IO () +main = pure () diff --git a/test/patch/DeltaHashGoldenOracle.hs b/test/patch/DeltaHashGoldenOracle.hs --- a/test/patch/DeltaHashGoldenOracle.hs +++ b/test/patch/DeltaHashGoldenOracle.hs @@ -15,7 +15,7 @@ ( Bits (complement, rotateL, shiftL, shiftR, xor, (.&.), (.|.)), FiniteBits (countLeadingZeros, finiteBitSize), ) -import Data.List (foldl', unfoldr) +import Data.List (unfoldr) import Data.Word (Word8, Word64) import Prelude diff --git a/test/patch/DeltaHashSpec.hs b/test/patch/DeltaHashSpec.hs --- a/test/patch/DeltaHashSpec.hs +++ b/test/patch/DeltaHashSpec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} module DeltaHashSpec @@ -53,6 +54,7 @@ import Moonlight.Delta.Patch qualified as Patch import Moonlight.Delta.Patch.Internal.IncrementalDigest ( DeltaHashDigestLanes (..), + DigestStrategy (..), RawDigest128 (..), deltaHashDigestLanes, ) @@ -67,7 +69,7 @@ forAll, listOf, vectorOf, - withMaxSuccess, + withNumTests, (.&&.), (===), ) @@ -160,7 +162,7 @@ -- genuine multi-row Patricia insertion and deletion, not the flat hash. merkleTriePatchAgreesWithRebuild :: Property merkleTriePatchAgreesWithRebuild = - withMaxSuccess 40 $ + withNumTests 40 $ forAll largeMapGen $ \beforeState -> forAll largeMapGen $ \afterState -> case (buildTestMerkleDeltaHash beforeState, buildTestMerkleDeltaHash afterState) of @@ -177,7 +179,7 @@ -- | @apply (compose p2 p1) == apply p2 <=< apply p1@ over trie-mode states. merkleComposedEqualsSequential :: Property merkleComposedEqualsSequential = - withMaxSuccess 25 $ + withNumTests 25 $ forAll largeMapGen $ \state0 -> forAll largeMapGen $ \state1 -> forAll largeMapGen $ \state2 -> @@ -192,7 +194,7 @@ multisetComposedEqualsSequential :: Property multisetComposedEqualsSequential = - withMaxSuccess 25 $ + withNumTests 25 $ forAll largeMapGen $ \state0 -> forAll largeMapGen $ \state1 -> forAll largeMapGen $ \state2 -> @@ -330,6 +332,7 @@ let initialState = Map.singleton 1 10 patch1 = Patch.singleton 1 (Patch.replace 10 11) patch2 = Patch.singleton 1 (Patch.replace 10 12) + patch3 :: Patch.Patch Int Int patch3 = Patch.empty underlyingFailure = DeltaHashPatchRejected @@ -1034,16 +1037,16 @@ @?= Right multisetDigest Patch.decodeMultisetDeltaHashDigest testEncoderVersion encodedMerkleDigest @?= Left - DeltaHashDigestIdentityMismatch - { deltaHashExpectedIdentity = multisetIdentity, - deltaHashEncodedIdentity = merkleIdentity - } + ( DeltaHashDigestIdentityMismatch + multisetIdentity + merkleIdentity + ) Patch.decodeMerkleDeltaHashDigest testEncoderVersion encodedMultisetDigest @?= Left - DeltaHashDigestIdentityMismatch - { deltaHashExpectedIdentity = merkleIdentity, - deltaHashEncodedIdentity = multisetIdentity - } + ( DeltaHashDigestIdentityMismatch + merkleIdentity + multisetIdentity + ) Patch.decodeMerkleDeltaHashDigest testEncoderVersion (encodedMerkleDigest <> ByteString.singleton 0) @?= Left (DeltaHashDigestTrailingBytes 1) versionedMerkle <- requireRight (Patch.buildMerkleDeltaHash shiftedEncoderVersion intEncoding intEncoding state) @@ -1054,10 +1057,10 @@ versionedMerkleIdentity = Patch.deltaHashDigestIdentity versionedMerkleDigest Patch.decodeMerkleDeltaHashDigest shiftedEncoderVersion encodedMerkleDigest @?= Left - DeltaHashDigestIdentityMismatch - { deltaHashExpectedIdentity = versionedMerkleIdentity, - deltaHashEncodedIdentity = merkleIdentity - } + ( DeltaHashDigestIdentityMismatch + versionedMerkleIdentity + merkleIdentity + ) (versionedMerkleDigest == merkleDigest) @?= False (versionedMultisetDigest == multisetDigest) @?= False shiftedMerkle <- requireRight (Patch.buildMerkleDeltaHash shiftedEncoderVersion shiftedEncoding intEncoding state) @@ -1181,8 +1184,11 @@ digestGoldenCase :: IO () digestGoldenCase = do let emptyNodeGolden = OracleDigest 0x86f54b9300a90465 0x63a57136d0551b36 + flatGolden :: DeltaHashDigestLanes 'MerkleDigestStrategy flatGolden = DeltaHashDigestLanes 0xa655a16f5418af01 0xcd90c77a2dfa851c + trieGolden :: DeltaHashDigestLanes 'MerkleDigestStrategy trieGolden = DeltaHashDigestLanes 0xb33b70f78e117412 0x613fb19ab70e2378 + multisetGolden :: DeltaHashDigestLanes 'MultisetDigestStrategy multisetGolden = DeltaHashDigestLanes 0x8cfd047cf5fb3aca 0x27f3f7852d13d309 oracleEmptyNodeDigest @?= emptyNodeGolden Node.emptyDigest Node.sipHashNodeCommitment diff --git a/test/repair/RepairTests.hs b/test/repair/RepairTests.hs --- a/test/repair/RepairTests.hs +++ b/test/repair/RepairTests.hs @@ -26,6 +26,7 @@ [ convergenceTest, noProgressBudgetTest, budgetExhaustionTest, + mixedObstructionBudgetTest, irreducibleTraceTest, foldTraceOrderingTest, focusRepairPreservesObstructedFocusStateTest, @@ -45,14 +46,20 @@ noProgressBudgetTest = testCase "no-op corrections exhaust budget instead of trusting a stable hash" $ boundedRepair noProgressKernel (Config 2) 0 - @?= ResultBudgetExhausted 0 (BelowTarget 1 :| []) 2 + @?= ResultBudgetExhausted 0 (BelowTarget 1 :| []) [] 2 budgetExhaustionTest :: TestTree budgetExhaustionTest = testCase "repair reports budget exhaustion with current obstruction" $ boundedRepair (incrementKernel 3) (Config 1) 0 - @?= ResultBudgetExhausted 1 (BelowTarget 3 :| []) 1 + @?= ResultBudgetExhausted 1 (BelowTarget 3 :| []) [] 1 +mixedObstructionBudgetTest :: TestTree +mixedObstructionBudgetTest = + testCase "budget exhaustion preserves terminal irreducible obstructions" $ + boundedRepair mixedObstructionKernel (Config 2) 0 + @?= ResultBudgetExhausted 2 (CannotRepair :| [BelowTarget 3]) [CannotRepair] 2 + irreducibleTraceTest :: TestTree irreducibleTraceTest = testCase "irreducible obstruction is traced as typed correction" $ do @@ -90,7 +97,7 @@ (sequenceRepair leftObstructedIncrementKernel rightKernelMustNotRun) (Config 1) (0 :: Int) - result @?= ResultBudgetExhausted 1 (Left (BelowTarget 3) :| []) 1 + result @?= ResultBudgetExhausted 1 (Left (BelowTarget 3) :| []) [] 1 traceProjection traceValue @?= [(Left (BelowTarget 3) :| [], Applied (Left (BelowTarget 3)) (Left Increment) :| [], 1, [])] @@ -144,6 +151,20 @@ { check = \state -> StepObstructed state (CannotRepair :| []), residuate = const Nothing, applyKernelCorrection = \state _ -> state + } + +mixedObstructionKernel :: Kernel Int RepairObstruction RepairCorrectionValue +mixedObstructionKernel = + Kernel + { check = \state -> StepObstructed state (CannotRepair :| [BelowTarget 3]), + residuate = \obstruction -> + case obstruction of + BelowTarget _ -> Just Increment + CannotRepair -> Nothing, + applyKernelCorrection = \state correction -> + case correction of + Increment -> state + 1 + Noop -> state } replaceFocus :: (outer, focus) -> focus -> (outer, focus)